icopy.f 2.4 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586
  1. *DECK ICOPY
  2. SUBROUTINE ICOPY (N, IX, INCX, IY, INCY)
  3. C***BEGIN PROLOGUE ICOPY
  4. C***PURPOSE Copy a vector.
  5. C***LIBRARY SLATEC (BLAS)
  6. C***CATEGORY D1A5
  7. C***TYPE INTEGER (ICOPY-S, DCOPY-D, CCOPY-C, ICOPY-I)
  8. C***KEYWORDS BLAS, COPY, LINEAR ALGEBRA, VECTOR
  9. C***AUTHOR Boland, W. Robert, (LANL)
  10. C Clemens, Reginald, (PLK)
  11. C***DESCRIPTION
  12. C
  13. C B L A S Subprogram
  14. C Description of Parameters
  15. C
  16. C --Input--
  17. C N number of elements in input vector(s)
  18. C IX integer vector with N elements
  19. C INCX storage spacing between elements of IX
  20. C IY integer vector with N elements
  21. C INCY storage spacing between elements of IY
  22. C
  23. C --Output--
  24. C IY copy of vector IX (unchanged if N .LE. 0)
  25. C
  26. C Copy integer IX to integer IY.
  27. C For I = 0 to N-1, copy IX(LX+I*INCX) to IY(LY+I*INCY),
  28. C where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
  29. C defined in a similar way using INCY.
  30. C
  31. C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
  32. C Krogh, Basic linear algebra subprograms for Fortran
  33. C usage, Algorithm No. 539, Transactions on Mathematical
  34. C Software 5, 3 (September 1979), pp. 308-323.
  35. C***ROUTINES CALLED (NONE)
  36. C***REVISION HISTORY (YYMMDD)
  37. C 930201 DATE WRITTEN
  38. C***END PROLOGUE ICOPY
  39. INTEGER IX(*), IY(*)
  40. C***FIRST EXECUTABLE STATEMENT ICOPY
  41. IF (N .LE. 0) RETURN
  42. IF (INCX .EQ. INCY) IF (INCX-1) 5,20,60
  43. C
  44. C Code for unequal or nonpositive increments.
  45. C
  46. 5 IIX = 1
  47. IIY = 1
  48. IF (INCX .LT. 0) IIX = (-N+1)*INCX + 1
  49. IF (INCY .LT. 0) IIY = (-N+1)*INCY + 1
  50. DO 10 I = 1,N
  51. IY(IIY) = IX(IIX)
  52. IIX = IIX + INCX
  53. IIY = IIY + INCY
  54. 10 CONTINUE
  55. RETURN
  56. C
  57. C Code for both increments equal to 1.
  58. C
  59. C Clean-up loop so remaining vector length is a multiple of 7.
  60. C
  61. 20 M = MOD(N,7)
  62. IF (M .EQ. 0) GO TO 40
  63. DO 30 I = 1,M
  64. IY(I) = IX(I)
  65. 30 CONTINUE
  66. IF (N .LT. 7) RETURN
  67. 40 MP1 = M + 1
  68. DO 50 I = MP1,N,7
  69. IY(I) = IX(I)
  70. IY(I+1) = IX(I+1)
  71. IY(I+2) = IX(I+2)
  72. IY(I+3) = IX(I+3)
  73. IY(I+4) = IX(I+4)
  74. IY(I+5) = IX(I+5)
  75. IY(I+6) = IX(I+6)
  76. 50 CONTINUE
  77. RETURN
  78. C
  79. C Code for equal, positive, non-unit increments.
  80. C
  81. 60 NS = N*INCX
  82. DO 70 I = 1,NS,INCX
  83. IY(I) = IX(I)
  84. 70 CONTINUE
  85. RETURN
  86. END