Télécharger dlaswp.eso

Retour à la liste

Numérotation des lignes :

  1. C DLASWP SOURCE BP208322 20/09/18 21:16:07 10718
  2. *> \brief \b DLASWP performs a series of row interchanges on a general rectangular matrix.
  3. *
  4. * =========== DOCUMENTATION ===========
  5. *
  6. * Online html documentation available at
  7. * http://www.netlib.org/lapack/explore-html/
  8. *
  9. *> \htmlonly
  10. *> Download DLASWP + dependencies
  11. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaswp.f">
  12. *> [TGZ]</a>
  13. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaswp.f">
  14. *> [ZIP]</a>
  15. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaswp.f">
  16. *> [TXT]</a>
  17. *> \endhtmlonly
  18. *
  19. * Definition:
  20. * ===========
  21. *
  22. * SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX )
  23. *
  24. * .. Scalar Arguments ..
  25. * INTEGER INCX, K1, K2, LDA, N
  26. * ..
  27. * .. Array Arguments ..
  28. * INTEGER IPIV( * )
  29. * REAL A( LDA, * )
  30. * ..
  31. *
  32. *
  33. *> \par Purpose:
  34. * =============
  35. *>
  36. *> \verbatim
  37. *>
  38. *> SLASWP performs a series of row interchanges on the matrix A.
  39. *> One row interchange is initiated for each of rows K1 through K2 of A.
  40. *> \endverbatim
  41. *
  42. * Arguments:
  43. * ==========
  44. *
  45. *> \param[in] N
  46. *> \verbatim
  47. *> N is INTEGER
  48. *> The number of columns of the matrix A.
  49. *> \endverbatim
  50. *>
  51. *> \param[in,out] A
  52. *> \verbatim
  53. *> A is REAL array, dimension (LDA,N)
  54. *> On entry, the matrix of column dimension N to which the row
  55. *> interchanges will be applied.
  56. *> On exit, the permuted matrix.
  57. *> \endverbatim
  58. *>
  59. *> \param[in] LDA
  60. *> \verbatim
  61. *> LDA is INTEGER
  62. *> The leading dimension of the array A.
  63. *> \endverbatim
  64. *>
  65. *> \param[in] K1
  66. *> \verbatim
  67. *> K1 is INTEGER
  68. *> The first element of IPIV for which a row interchange will
  69. *> be done.
  70. *> \endverbatim
  71. *>
  72. *> \param[in] K2
  73. *> \verbatim
  74. *> K2 is INTEGER
  75. *> (K2-K1+1) is the number of elements of IPIV for which a row
  76. *> interchange will be done.
  77. *> \endverbatim
  78. *>
  79. *> \param[in] IPIV
  80. *> \verbatim
  81. *> IPIV is INTEGER array, dimension (K1+(K2-K1)*abs(INCX))
  82. *> The vector of pivot indices. Only the elements in positions
  83. *> K1 through K1+(K2-K1)*abs(INCX) of IPIV are accessed.
  84. *> IPIV(K1+(K-K1)*abs(INCX)) = L implies rows K and L are to be
  85. *> interchanged.
  86. *> \endverbatim
  87. *>
  88. *> \param[in] INCX
  89. *> \verbatim
  90. *> INCX is INTEGER
  91. *> The increment between successive values of IPIV. If INCX
  92. *> is negative, the pivots are applied in reverse order.
  93. *> \endverbatim
  94. *
  95. * Authors:
  96. * ========
  97. *
  98. *> \author Univ. of Tennessee
  99. *> \author Univ. of California Berkeley
  100. *> \author Univ. of Colorado Denver
  101. *> \author NAG Ltd.
  102. *
  103. *> \date June 2017
  104. *
  105. *> \ingroup realOTHERauxiliary
  106. *
  107. *> \par Further Details:
  108. * =====================
  109. *>
  110. *> \verbatim
  111. *>
  112. *> Modified by
  113. *> R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
  114. *> \endverbatim
  115. *>
  116. * =====================================================================
  117. SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX )
  118. *
  119. * -- LAPACK auxiliary routine (version 3.7.1) --
  120. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  121. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  122. * June 2017
  123.  
  124. IMPLICIT INTEGER(I-N)
  125. IMPLICIT REAL*8(A-H,O-Z)
  126. *
  127. * .. Scalar Arguments ..
  128. INTEGER INCX, K1, K2, LDA, N
  129. * ..
  130. * .. Array Arguments ..
  131. INTEGER IPIV( * )
  132. REAL*8 A( LDA, * )
  133. * ..
  134. *
  135. * =====================================================================
  136. *
  137. * .. Local Scalars ..
  138. INTEGER I, I1, I2, INC, IP, IX, IX0, J, K, N32
  139. REAL*8 TEMP
  140. * ..
  141. * .. Executable Statements ..
  142. *
  143. * Interchange row I with row IPIV(K1+(I-K1)*abs(INCX)) for each of rows
  144. * K1 through K2.
  145. *
  146. IF( INCX.GT.0 ) THEN
  147. IX0 = K1
  148. I1 = K1
  149. I2 = K2
  150. INC = 1
  151. ELSE IF( INCX.LT.0 ) THEN
  152. IX0 = K1 + ( K1-K2 )*INCX
  153. I1 = K2
  154. I2 = K1
  155. INC = -1
  156. ELSE
  157. RETURN
  158. END IF
  159. *
  160. N32 = ( N / 32 )*32
  161. IF( N32.NE.0 ) THEN
  162. DO 30 J = 1, N32, 32
  163. IX = IX0
  164. DO 20 I = I1, I2, INC
  165. IP = IPIV( IX )
  166. IF( IP.NE.I ) THEN
  167. DO 10 K = J, J + 31
  168. TEMP = A( I, K )
  169. A( I, K ) = A( IP, K )
  170. A( IP, K ) = TEMP
  171. 10 CONTINUE
  172. END IF
  173. IX = IX + INCX
  174. 20 CONTINUE
  175. 30 CONTINUE
  176. END IF
  177. IF( N32.NE.N ) THEN
  178. N32 = N32 + 1
  179. IX = IX0
  180. DO 50 I = I1, I2, INC
  181. IP = IPIV( IX )
  182. IF( IP.NE.I ) THEN
  183. DO 40 K = N32, N
  184. TEMP = A( I, K )
  185. A( I, K ) = A( IP, K )
  186. A( IP, K ) = TEMP
  187. 40 CONTINUE
  188. END IF
  189. IX = IX + INCX
  190. 50 CONTINUE
  191. END IF
  192. *
  193. RETURN
  194. *
  195. * End of DLASWP
  196. *
  197. END
  198.  
  199.  
  200.  

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