Télécharger dcopy.eso

Retour à la liste

Numérotation des lignes :

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

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