Télécharger la plaquette Cast3M


fr en

Télécharger ddot.eso

Retour à la liste

Numérotation des lignes : 

ddot

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales