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.

clapmr.f 4.7 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201
  1. *> \brief \b CLAPMR rearranges rows of a matrix as specified by a permutation vector.
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download CLAPMR + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clapmr.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clapmr.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clapmr.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE CLAPMR( FORWRD, M, N, X, LDX, K )
  22. *
  23. * .. Scalar Arguments ..
  24. * LOGICAL FORWRD
  25. * INTEGER LDX, M, N
  26. * ..
  27. * .. Array Arguments ..
  28. * INTEGER K( * )
  29. * COMPLEX X( LDX, * )
  30. * ..
  31. *
  32. *
  33. *> \par Purpose:
  34. * =============
  35. *>
  36. *> \verbatim
  37. *>
  38. *> CLAPMR rearranges the rows of the M by N matrix X as specified
  39. *> by the permutation K(1),K(2),...,K(M) of the integers 1,...,M.
  40. *> If FORWRD = .TRUE., forward permutation:
  41. *>
  42. *> X(K(I),*) is moved X(I,*) for I = 1,2,...,M.
  43. *>
  44. *> If FORWRD = .FALSE., backward permutation:
  45. *>
  46. *> X(I,*) is moved to X(K(I),*) for I = 1,2,...,M.
  47. *> \endverbatim
  48. *
  49. * Arguments:
  50. * ==========
  51. *
  52. *> \param[in] FORWRD
  53. *> \verbatim
  54. *> FORWRD is LOGICAL
  55. *> = .TRUE., forward permutation
  56. *> = .FALSE., backward permutation
  57. *> \endverbatim
  58. *>
  59. *> \param[in] M
  60. *> \verbatim
  61. *> M is INTEGER
  62. *> The number of rows of the matrix X. M >= 0.
  63. *> \endverbatim
  64. *>
  65. *> \param[in] N
  66. *> \verbatim
  67. *> N is INTEGER
  68. *> The number of columns of the matrix X. N >= 0.
  69. *> \endverbatim
  70. *>
  71. *> \param[in,out] X
  72. *> \verbatim
  73. *> X is COMPLEX array, dimension (LDX,N)
  74. *> On entry, the M by N matrix X.
  75. *> On exit, X contains the permuted matrix X.
  76. *> \endverbatim
  77. *>
  78. *> \param[in] LDX
  79. *> \verbatim
  80. *> LDX is INTEGER
  81. *> The leading dimension of the array X, LDX >= MAX(1,M).
  82. *> \endverbatim
  83. *>
  84. *> \param[in,out] K
  85. *> \verbatim
  86. *> K is INTEGER array, dimension (M)
  87. *> On entry, K contains the permutation vector. K is used as
  88. *> internal workspace, but reset to its original value on
  89. *> output.
  90. *> \endverbatim
  91. *
  92. * Authors:
  93. * ========
  94. *
  95. *> \author Univ. of Tennessee
  96. *> \author Univ. of California Berkeley
  97. *> \author Univ. of Colorado Denver
  98. *> \author NAG Ltd.
  99. *
  100. *> \ingroup complexOTHERauxiliary
  101. *
  102. * =====================================================================
  103. SUBROUTINE CLAPMR( FORWRD, M, N, X, LDX, K )
  104. *
  105. * -- LAPACK auxiliary routine --
  106. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  107. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  108. *
  109. * .. Scalar Arguments ..
  110. LOGICAL FORWRD
  111. INTEGER LDX, M, N
  112. * ..
  113. * .. Array Arguments ..
  114. INTEGER K( * )
  115. COMPLEX X( LDX, * )
  116. * ..
  117. *
  118. * =====================================================================
  119. *
  120. * .. Local Scalars ..
  121. INTEGER I, IN, J, JJ
  122. COMPLEX TEMP
  123. * ..
  124. * .. Executable Statements ..
  125. *
  126. IF( M.LE.1 )
  127. $ RETURN
  128. *
  129. DO 10 I = 1, M
  130. K( I ) = -K( I )
  131. 10 CONTINUE
  132. *
  133. IF( FORWRD ) THEN
  134. *
  135. * Forward permutation
  136. *
  137. DO 50 I = 1, M
  138. *
  139. IF( K( I ).GT.0 )
  140. $ GO TO 40
  141. *
  142. J = I
  143. K( J ) = -K( J )
  144. IN = K( J )
  145. *
  146. 20 CONTINUE
  147. IF( K( IN ).GT.0 )
  148. $ GO TO 40
  149. *
  150. DO 30 JJ = 1, N
  151. TEMP = X( J, JJ )
  152. X( J, JJ ) = X( IN, JJ )
  153. X( IN, JJ ) = TEMP
  154. 30 CONTINUE
  155. *
  156. K( IN ) = -K( IN )
  157. J = IN
  158. IN = K( IN )
  159. GO TO 20
  160. *
  161. 40 CONTINUE
  162. *
  163. 50 CONTINUE
  164. *
  165. ELSE
  166. *
  167. * Backward permutation
  168. *
  169. DO 90 I = 1, M
  170. *
  171. IF( K( I ).GT.0 )
  172. $ GO TO 80
  173. *
  174. K( I ) = -K( I )
  175. J = K( I )
  176. 60 CONTINUE
  177. IF( J.EQ.I )
  178. $ GO TO 80
  179. *
  180. DO 70 JJ = 1, N
  181. TEMP = X( I, JJ )
  182. X( I, JJ ) = X( J, JJ )
  183. X( J, JJ ) = TEMP
  184. 70 CONTINUE
  185. *
  186. K( J ) = -K( J )
  187. J = K( J )
  188. GO TO 60
  189. *
  190. 80 CONTINUE
  191. *
  192. 90 CONTINUE
  193. *
  194. END IF
  195. *
  196. RETURN
  197. *
  198. * End of CLAPMR
  199. *
  200. END