Esope source files

   1 : C DAXPY     SOURCE    CHAT      06/03/29    21:18:18     5360           
   2 :       SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY)
   3 : C     
   4 : C     CONSTANT TIMES A VECTOR PLUS A VECTOR.
   5 : C          y <- ax + y
   6 : C     USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE.
   7 : C     JACK DONGARRA, LINPACK, 3/11/78.
   8 : C     MODIFIED 12/3/93, ARRAY(1) DECLARATIONS CHANGED TO ARRAY(*)
   9 : C     
  10 : C     modified 16/2/98 double precision -> real*8
  11 : C                      no unrolled loops : compiler can do that
  12 : C                      added error handling
  13 : C     
  14 :       IMPLICIT INTEGER(I-N)
  15 : -INC CCOPTIO
  16 :       REAL*8  DX(*),DY(*),DA
  17 :       INTEGER I,INCX,INCY,IX,IY,N
  18 : C     
  19 :       IF(N.LE.0) GOTO 9999
  20 :       IF (DA.EQ.0.0D0) RETURN
  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) = DY(IY) + DA*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) = DY(I) + DA*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 daxpy : nothing done'
  52 :       call erreur(21)
  53 :       RETURN
  54 : C     
  55 : C     End of DAXPY
  56 : C     
  57 :       END
  58 : 
  59 : 
  60 : 
  61 : 
  62 : 
  63 :  
  64 :  
  65 :