Esope source files

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