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