Télécharger ddot.eso

Retour à la liste

Numérotation des lignes :

  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'
  58. call erreur(21)
  59. RETURN
  60. C
  61. C End of DCOPY
  62. C
  63. END
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  

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