File:
[local] /
rpl /
lapack /
lapack /
dlapmt.f
Revision
1.13:
download - view:
text,
annotated -
select for diffs -
revision graph
Mon Jan 27 09:28:21 2014 UTC (10 years, 7 months ago) by
bertrand
Branches:
MAIN
CVS tags:
rpl-4_1_24,
rpl-4_1_23,
rpl-4_1_22,
rpl-4_1_21,
rpl-4_1_20,
rpl-4_1_19,
rpl-4_1_18,
rpl-4_1_17,
HEAD
Cohérence.
1: *> \brief \b DLAPMT performs a forward or backward permutation of the columns of a matrix.
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 September 2012
101: *
102: *> \ingroup doubleOTHERauxiliary
103: *
104: * =====================================================================
105: SUBROUTINE DLAPMT( FORWRD, M, N, X, LDX, K )
106: *
107: * -- LAPACK auxiliary routine (version 3.4.2) --
108: * -- LAPACK is a software package provided by Univ. of Tennessee, --
109: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
110: * September 2012
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>