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.

icopy.f 3.3 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148
  1. *> \brief \b ICOPY
  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 ICOPY( N, SX, INCX, SY, INCY )
  12. *
  13. * .. Scalar Arguments ..
  14. * INTEGER INCX, INCY, N
  15. * ..
  16. * .. Array Arguments ..
  17. * INTEGER SX( * ), SY( * )
  18. * ..
  19. *
  20. *
  21. *> \par Purpose:
  22. * =============
  23. *>
  24. *> \verbatim
  25. *>
  26. *> ICOPY copies an integer vector x to an integer vector y.
  27. *> Uses unrolled loops for increments equal to 1.
  28. *> \endverbatim
  29. *
  30. * Arguments:
  31. * ==========
  32. *
  33. *> \param[in] N
  34. *> \verbatim
  35. *> N is INTEGER
  36. *> The length of the vectors SX and SY.
  37. *> \endverbatim
  38. *>
  39. *> \param[in] SX
  40. *> \verbatim
  41. *> SX is INTEGER array, dimension (1+(N-1)*abs(INCX))
  42. *> The vector X.
  43. *> \endverbatim
  44. *>
  45. *> \param[in] INCX
  46. *> \verbatim
  47. *> INCX is INTEGER
  48. *> The spacing between consecutive elements of SX.
  49. *> \endverbatim
  50. *>
  51. *> \param[out] SY
  52. *> \verbatim
  53. *> SY is INTEGER array, dimension (1+(N-1)*abs(INCY))
  54. *> The vector Y.
  55. *> \endverbatim
  56. *>
  57. *> \param[in] INCY
  58. *> \verbatim
  59. *> INCY is INTEGER
  60. *> The spacing between consecutive elements of SY.
  61. *> \endverbatim
  62. *
  63. * Authors:
  64. * ========
  65. *
  66. *> \author Univ. of Tennessee
  67. *> \author Univ. of California Berkeley
  68. *> \author Univ. of Colorado Denver
  69. *> \author NAG Ltd.
  70. *
  71. *> \date December 2016
  72. *
  73. *> \ingroup aux_lin
  74. *
  75. * =====================================================================
  76. SUBROUTINE ICOPY( N, SX, INCX, SY, INCY )
  77. *
  78. * -- LAPACK test routine (version 3.7.0) --
  79. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  80. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  81. * December 2016
  82. *
  83. * .. Scalar Arguments ..
  84. INTEGER INCX, INCY, N
  85. * ..
  86. * .. Array Arguments ..
  87. INTEGER SX( * ), SY( * )
  88. * ..
  89. *
  90. * =====================================================================
  91. *
  92. * .. Local Scalars ..
  93. INTEGER I, IX, IY, M, MP1
  94. * ..
  95. * .. Intrinsic Functions ..
  96. INTRINSIC MOD
  97. * ..
  98. * .. Executable Statements ..
  99. *
  100. IF( N.LE.0 )
  101. $ RETURN
  102. IF( INCX.EQ.1 .AND. INCY.EQ.1 )
  103. $ GO TO 20
  104. *
  105. * Code for unequal increments or equal increments not equal to 1
  106. *
  107. IX = 1
  108. IY = 1
  109. IF( INCX.LT.0 )
  110. $ IX = ( -N+1 )*INCX + 1
  111. IF( INCY.LT.0 )
  112. $ IY = ( -N+1 )*INCY + 1
  113. DO 10 I = 1, N
  114. SY( IY ) = SX( IX )
  115. IX = IX + INCX
  116. IY = IY + INCY
  117. 10 CONTINUE
  118. RETURN
  119. *
  120. * Code for both increments equal to 1
  121. *
  122. * Clean-up loop
  123. *
  124. 20 CONTINUE
  125. M = MOD( N, 7 )
  126. IF( M.EQ.0 )
  127. $ GO TO 40
  128. DO 30 I = 1, M
  129. SY( I ) = SX( I )
  130. 30 CONTINUE
  131. IF( N.LT.7 )
  132. $ RETURN
  133. 40 CONTINUE
  134. MP1 = M + 1
  135. DO 50 I = MP1, N, 7
  136. SY( I ) = SX( I )
  137. SY( I+1 ) = SX( I+1 )
  138. SY( I+2 ) = SX( I+2 )
  139. SY( I+3 ) = SX( I+3 )
  140. SY( I+4 ) = SX( I+4 )
  141. SY( I+5 ) = SX( I+5 )
  142. SY( I+6 ) = SX( I+6 )
  143. 50 CONTINUE
  144. RETURN
  145. *
  146. * End of ICOPY
  147. *
  148. END