Annotation of rpl/lapack/lapack/dlapmt.f, revision 1.18
1.11 bertrand 1: *> \brief \b DLAPMT performs a forward or backward permutation of the columns of a matrix.
1.8 bertrand 2: *
3: * =========== DOCUMENTATION ===========
4: *
1.15 bertrand 5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
1.8 bertrand 7: *
8: *> \htmlonly
1.15 bertrand 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">
1.8 bertrand 15: *> [TXT]</a>
1.15 bertrand 16: *> \endhtmlonly
1.8 bertrand 17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE DLAPMT( FORWRD, M, N, X, LDX, K )
1.15 bertrand 22: *
1.8 bertrand 23: * .. Scalar Arguments ..
24: * LOGICAL FORWRD
25: * INTEGER LDX, M, N
26: * ..
27: * .. Array Arguments ..
28: * INTEGER K( * )
29: * DOUBLE PRECISION X( LDX, * )
30: * ..
1.15 bertrand 31: *
1.8 bertrand 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: *
1.15 bertrand 95: *> \author Univ. of Tennessee
96: *> \author Univ. of California Berkeley
97: *> \author Univ. of Colorado Denver
98: *> \author NAG Ltd.
1.8 bertrand 99: *
100: *> \ingroup doubleOTHERauxiliary
101: *
102: * =====================================================================
1.1 bertrand 103: SUBROUTINE DLAPMT( FORWRD, M, N, X, LDX, K )
104: *
1.18 ! bertrand 105: * -- LAPACK auxiliary routine --
1.1 bertrand 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: DOUBLE PRECISION X( LDX, * )
116: * ..
117: *
118: * =====================================================================
119: *
120: * .. Local Scalars ..
121: INTEGER I, II, IN, J
122: DOUBLE PRECISION TEMP
123: * ..
124: * .. Executable Statements ..
125: *
126: IF( N.LE.1 )
127: $ RETURN
128: *
129: DO 10 I = 1, N
130: K( I ) = -K( I )
131: 10 CONTINUE
132: *
133: IF( FORWRD ) THEN
134: *
135: * Forward permutation
136: *
137: DO 50 I = 1, N
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 II = 1, M
151: TEMP = X( II, J )
152: X( II, J ) = X( II, IN )
153: X( II, IN ) = 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, N
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 II = 1, M
181: TEMP = X( II, I )
182: X( II, I ) = X( II, J )
183: X( II, J ) = 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 DLAPMT
199: *
200: END
CVSweb interface <joel.bertrand@systella.fr>