iswap.f 2.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899
  1. *DECK ISWAP
  2. SUBROUTINE ISWAP (N, IX, INCX, IY, INCY)
  3. C***BEGIN PROLOGUE ISWAP
  4. C***PURPOSE Interchange two vectors.
  5. C***LIBRARY SLATEC (BLAS)
  6. C***CATEGORY D1A5
  7. C***TYPE INTEGER (SSWAP-S, DSWAP-D, CSWAP-C, ISWAP-I)
  8. C***KEYWORDS BLAS, INTERCHANGE, LINEAR ALGEBRA, VECTOR
  9. C***AUTHOR Vandevender, W. H., (SNLA)
  10. C***DESCRIPTION
  11. C
  12. C Extended B L A S Subprogram
  13. C Description of Parameters
  14. C
  15. C --Input--
  16. C N number of elements in input vector(s)
  17. C IX integer vector with N elements
  18. C INCX storage spacing between elements of IX
  19. C IY integer vector with N elements
  20. C INCY storage spacing between elements of IY
  21. C
  22. C --Output--
  23. C IX input vector IY (unchanged if N .LE. 0)
  24. C IY input vector IX (unchanged if N .LE. 0)
  25. C
  26. C Interchange integer IX and integer IY.
  27. C For I = 0 to N-1, interchange IX(LX+I*INCX) and 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 850601 DATE WRITTEN
  38. C 861211 REVISION DATE from Version 3.2
  39. C 891214 Prologue converted to Version 4.0 format. (BAB)
  40. C 920310 Corrected definition of LX in DESCRIPTION. (WRB)
  41. C 920501 Reformatted the REFERENCES section. (WRB)
  42. C***END PROLOGUE ISWAP
  43. INTEGER IX(*), IY(*), ITEMP1, ITEMP2, ITEMP3
  44. C***FIRST EXECUTABLE STATEMENT ISWAP
  45. IF (N .LE. 0) RETURN
  46. IF (INCX .NE. INCY) GO TO 5
  47. IF (INCX-1) 5,20,60
  48. C
  49. C Code for unequal or nonpositive increments.
  50. C
  51. 5 IIX = 1
  52. IIY = 1
  53. IF (INCX .LT. 0) IIX = (1-N)*INCX + 1
  54. IF (INCY .LT. 0) IIY = (1-N)*INCY + 1
  55. DO 10 I = 1,N
  56. ITEMP1 = IX(IIX)
  57. IX(IIX) = IY(IIY)
  58. IY(IIY) = ITEMP1
  59. IIX = IIX + INCX
  60. IIY = IIY + INCY
  61. 10 CONTINUE
  62. RETURN
  63. C
  64. C Code for both increments equal to 1.
  65. C
  66. C Clean-up loop so remaining vector length is a multiple of 3.
  67. C
  68. 20 M = MOD(N,3)
  69. IF (M .EQ. 0) GO TO 40
  70. DO 30 I = 1,M
  71. ITEMP1 = IX(I)
  72. IX(I) = IY(I)
  73. IY(I) = ITEMP1
  74. 30 CONTINUE
  75. IF (N .LT. 3) RETURN
  76. 40 MP1 = M + 1
  77. DO 50 I = MP1,N,3
  78. ITEMP1 = IX(I)
  79. ITEMP2 = IX(I+1)
  80. ITEMP3 = IX(I+2)
  81. IX(I) = IY(I)
  82. IX(I+1) = IY(I+1)
  83. IX(I+2) = IY(I+2)
  84. IY(I) = ITEMP1
  85. IY(I+1) = ITEMP2
  86. IY(I+2) = ITEMP3
  87. 50 CONTINUE
  88. RETURN
  89. C
  90. C Code for equal, positive, non-unit increments.
  91. C
  92. 60 NS = N*INCX
  93. DO 70 I = 1,NS,INCX
  94. ITEMP1 = IX(I)
  95. IX(I) = IY(I)
  96. IY(I) = ITEMP1
  97. 70 CONTINUE
  98. RETURN
  99. END