Annotation of rpl/lapack/lapack/dlapmt.f, revision 1.8
1.8 ! bertrand 1: *> \brief \b DLAPMT
! 2: *
! 3: * =========== DOCUMENTATION ===========
! 4: *
! 5: * Online html documentation available at
! 6: * http://www.netlib.org/lapack/explore-html/
! 7: *
! 8: *> \htmlonly
! 9: *> Download DLAPMT + dependencies
! 10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapmt.f">
! 11: *> [TGZ]</a>
! 12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapmt.f">
! 13: *> [ZIP]</a>
! 14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapmt.f">
! 15: *> [TXT]</a>
! 16: *> \endhtmlonly
! 17: *
! 18: * Definition:
! 19: * ===========
! 20: *
! 21: * SUBROUTINE DLAPMT( 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: * DOUBLE PRECISION X( LDX, * )
! 30: * ..
! 31: *
! 32: *
! 33: *> \par Purpose:
! 34: * =============
! 35: *>
! 36: *> \verbatim
! 37: *>
! 38: *> DLAPMT rearranges the columns of the M by N matrix X as specified
! 39: *> by the permutation K(1),K(2),...,K(N) of the integers 1,...,N.
! 40: *> If FORWRD = .TRUE., forward permutation:
! 41: *>
! 42: *> X(*,K(J)) is moved X(*,J) for J = 1,2,...,N.
! 43: *>
! 44: *> If FORWRD = .FALSE., backward permutation:
! 45: *>
! 46: *> X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N.
! 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 DOUBLE PRECISION 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 (N)
! 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: *> \date November 2011
! 101: *
! 102: *> \ingroup doubleOTHERauxiliary
! 103: *
! 104: * =====================================================================
1.1 bertrand 105: SUBROUTINE DLAPMT( FORWRD, M, N, X, LDX, K )
106: *
1.8 ! bertrand 107: * -- LAPACK auxiliary routine (version 3.4.0) --
1.1 bertrand 108: * -- LAPACK is a software package provided by Univ. of Tennessee, --
109: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.8 ! bertrand 110: * November 2011
1.1 bertrand 111: *
112: * .. Scalar Arguments ..
113: LOGICAL FORWRD
114: INTEGER LDX, M, N
115: * ..
116: * .. Array Arguments ..
117: INTEGER K( * )
118: DOUBLE PRECISION X( LDX, * )
119: * ..
120: *
121: * =====================================================================
122: *
123: * .. Local Scalars ..
124: INTEGER I, II, IN, J
125: DOUBLE PRECISION TEMP
126: * ..
127: * .. Executable Statements ..
128: *
129: IF( N.LE.1 )
130: $ RETURN
131: *
132: DO 10 I = 1, N
133: K( I ) = -K( I )
134: 10 CONTINUE
135: *
136: IF( FORWRD ) THEN
137: *
138: * Forward permutation
139: *
140: DO 50 I = 1, N
141: *
142: IF( K( I ).GT.0 )
143: $ GO TO 40
144: *
145: J = I
146: K( J ) = -K( J )
147: IN = K( J )
148: *
149: 20 CONTINUE
150: IF( K( IN ).GT.0 )
151: $ GO TO 40
152: *
153: DO 30 II = 1, M
154: TEMP = X( II, J )
155: X( II, J ) = X( II, IN )
156: X( II, IN ) = TEMP
157: 30 CONTINUE
158: *
159: K( IN ) = -K( IN )
160: J = IN
161: IN = K( IN )
162: GO TO 20
163: *
164: 40 CONTINUE
165: *
166: 50 CONTINUE
167: *
168: ELSE
169: *
170: * Backward permutation
171: *
172: DO 90 I = 1, N
173: *
174: IF( K( I ).GT.0 )
175: $ GO TO 80
176: *
177: K( I ) = -K( I )
178: J = K( I )
179: 60 CONTINUE
180: IF( J.EQ.I )
181: $ GO TO 80
182: *
183: DO 70 II = 1, M
184: TEMP = X( II, I )
185: X( II, I ) = X( II, J )
186: X( II, J ) = TEMP
187: 70 CONTINUE
188: *
189: K( J ) = -K( J )
190: J = K( J )
191: GO TO 60
192: *
193: 80 CONTINUE
194: *
195: 90 CONTINUE
196: *
197: END IF
198: *
199: RETURN
200: *
201: * End of DLAPMT
202: *
203: END
CVSweb interface <joel.bertrand@systella.fr>