Télécharger la plaquette Cast3M


fr en

Télécharger daxpy.eso

Retour à la liste

Numérotation des lignes : 

daxpy

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

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