Télécharger la plaquette Cast3M


fr en

Télécharger dcopy.eso

Retour à la liste

Numérotation des lignes : 

dcopy

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

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