You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

sswap.f 2.7 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122
  1. *> \brief \b SSWAP
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. * Definition:
  9. * ===========
  10. *
  11. * SUBROUTINE SSWAP(N,SX,INCX,SY,INCY)
  12. *
  13. * .. Scalar Arguments ..
  14. * INTEGER INCX,INCY,N
  15. * ..
  16. * .. Array Arguments ..
  17. * REAL SX(*),SY(*)
  18. * ..
  19. *
  20. *
  21. *> \par Purpose:
  22. * =============
  23. *>
  24. *> \verbatim
  25. *>
  26. *> interchanges two vectors.
  27. *> uses unrolled loops for increments equal to 1.
  28. *> \endverbatim
  29. *
  30. * Authors:
  31. * ========
  32. *
  33. *> \author Univ. of Tennessee
  34. *> \author Univ. of California Berkeley
  35. *> \author Univ. of Colorado Denver
  36. *> \author NAG Ltd.
  37. *
  38. *> \date November 2011
  39. *
  40. *> \ingroup single_blas_level1
  41. *
  42. *> \par Further Details:
  43. * =====================
  44. *>
  45. *> \verbatim
  46. *>
  47. *> jack dongarra, linpack, 3/11/78.
  48. *> modified 12/3/93, array(1) declarations changed to array(*)
  49. *> \endverbatim
  50. *>
  51. * =====================================================================
  52. SUBROUTINE SSWAP(N,SX,INCX,SY,INCY)
  53. *
  54. * -- Reference BLAS level1 routine (version 3.4.0) --
  55. * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
  56. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  57. * November 2011
  58. *
  59. * .. Scalar Arguments ..
  60. INTEGER INCX,INCY,N
  61. * ..
  62. * .. Array Arguments ..
  63. REAL SX(*),SY(*)
  64. * ..
  65. *
  66. * =====================================================================
  67. *
  68. * .. Local Scalars ..
  69. REAL STEMP
  70. INTEGER I,IX,IY,M,MP1
  71. * ..
  72. * .. Intrinsic Functions ..
  73. INTRINSIC MOD
  74. * ..
  75. IF (N.LE.0) RETURN
  76. IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
  77. *
  78. * code for both increments equal to 1
  79. *
  80. *
  81. * clean-up loop
  82. *
  83. M = MOD(N,3)
  84. IF (M.NE.0) THEN
  85. DO I = 1,M
  86. STEMP = SX(I)
  87. SX(I) = SY(I)
  88. SY(I) = STEMP
  89. END DO
  90. IF (N.LT.3) RETURN
  91. END IF
  92. MP1 = M + 1
  93. DO I = MP1,N,3
  94. STEMP = SX(I)
  95. SX(I) = SY(I)
  96. SY(I) = STEMP
  97. STEMP = SX(I+1)
  98. SX(I+1) = SY(I+1)
  99. SY(I+1) = STEMP
  100. STEMP = SX(I+2)
  101. SX(I+2) = SY(I+2)
  102. SY(I+2) = STEMP
  103. END DO
  104. ELSE
  105. *
  106. * code for unequal increments or equal increments not equal
  107. * to 1
  108. *
  109. IX = 1
  110. IY = 1
  111. IF (INCX.LT.0) IX = (-N+1)*INCX + 1
  112. IF (INCY.LT.0) IY = (-N+1)*INCY + 1
  113. DO I = 1,N
  114. STEMP = SX(IX)
  115. SX(IX) = SY(IY)
  116. SY(IY) = STEMP
  117. IX = IX + INCX
  118. IY = IY + INCY
  119. END DO
  120. END IF
  121. RETURN
  122. END