Télécharger daxpy.eso

Retour à la liste

Numérotation des lignes :

  1. C DAXPY SOURCE BP208322 15/10/13 21:15:19 8670
  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.EQ.0) RETURN
  20. IF(N.LT.0) GOTO 9999
  21. IF (DA.EQ.0.0D0) RETURN
  22. IF(INCX.NE.1.OR.INCY.NE.1) THEN
  23. C
  24. C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS
  25. C NOT EQUAL TO 1
  26. C
  27. IX = 1
  28. IY = 1
  29. IF(INCX.LT.0)IX = (-N+1)*INCX + 1
  30. IF(INCY.LT.0)IY = (-N+1)*INCY + 1
  31. DO 10 I = 1,N
  32. DY(IY) = DY(IY) + DA*DX(IX)
  33. IX = IX + INCX
  34. IY = IY + INCY
  35. 10 CONTINUE
  36. ELSE
  37. C
  38. C CODE FOR BOTH INCREMENTS EQUAL TO 1
  39. C
  40. DO 30 I = 1, N
  41. DY(I) = DY(I) + DA*DX(I)
  42. 30 CONTINUE
  43. ENDIF
  44. C
  45. C Normal termination
  46. C
  47. RETURN
  48. C
  49. C Error handling
  50. C
  51. 9999 CONTINUE
  52. WRITE(IOIMP,*) 'dimension lower than 1',N,' transmitted'
  53. WRITE(IOIMP,*) 'to subroutine daxpy : nothing done'
  54. call erreur(21)
  55. RETURN
  56. C
  57. C End of DAXPY
  58. C
  59. END
  60.  
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  

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