Esope source files

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