Esope source files

   1 : C DSCAL     SOURCE    CHAT      06/03/29    21:18:55     5360           
   2 :       SUBROUTINE DSCAL(N,DA,DX,INCX)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C     
   6 : C     SCALES A VECTOR BY A CONSTANT.
   7 : C         x <- ax
   8 : C     USES UNROLLED LOOPS FOR INCREMENT EQUAL TO ONE.
   9 : C     JACK DONGARRA, LINPACK, 3/11/78
  10 : C     MODIFIED 3/93 TO RETURN IF INCX .LE.0.
  11 : C     MODIFIED 12/3/93, ARRAY(1) DECLARATIONS CHANGED TO ARRAY(*)
  12 : C     
  13 : C     modified 5/11/98 double precision -> real*8
  14 : C                      no unrolled loops : compiler can do that
  15 : C                      added error handling
  16 : C     
  17 : -INC CCOPTIO
  18 : C     
  19 :       REAL*8 DA,DX(*)
  20 :       INTEGER I,INCX,N,NINCX
  21 : C     
  22 :       IF( N.LE.0 .OR. INCX.LE.0 ) GOTO 9999
  23 :       IF(INCX.NE.1) THEN
  24 : C     
  25 : C        CODE FOR INCREMENT NOT EQUAL TO 1
  26 : C     
  27 :          NINCX = N*INCX
  28 :          DO 10 I = 1,NINCX,INCX
  29 :             DX(I) = DA*DX(I)
  30 :  10      CONTINUE
  31 :       ELSE
  32 : C     
  33 : C        CODE FOR INCREMENT EQUAL TO 1
  34 : C     
  35 :          DO 30 I = 1,N
  36 :             DX(I) = DA*DX(I)
  37 :  30      CONTINUE
  38 :       ENDIF
  39 : C     
  40 : C     Normal termination
  41 : C     
  42 :       RETURN
  43 : C     
  44 : C     Error handling
  45 : C     
  46 :  9999 CONTINUE
  47 :       WRITE(IOIMP,*) 'dimension or increment lower than 1 transmitted'
  48 :       WRITE(IOIMP,*) 'to subroutine dscal : nothing done'
  48 :       call erreur(21)
  49 :       RETURN
  50 : C     
  51 : C     End of DSCAL
  52 : C     
  53 :       END
  54 : 
  55 : 
  56 : 
  57 : 
  58 : 
  59 :  
  60 :  
  61 :