Annotation of rpl/lapack/lapack/dlapmr.f, revision 1.12
1.7 bertrand 1: *> \brief \b DLAPMR rearranges rows of a matrix as specified by a permutation vector.
1.4 bertrand 2: *
3: * =========== DOCUMENTATION ===========
4: *
1.11 bertrand 5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
1.4 bertrand 7: *
8: *> \htmlonly
1.11 bertrand 9: *> Download DLAPMR + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapmr.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapmr.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapmr.f">
1.4 bertrand 15: *> [TXT]</a>
1.11 bertrand 16: *> \endhtmlonly
1.4 bertrand 17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE DLAPMR( FORWRD, M, N, X, LDX, K )
1.11 bertrand 22: *
1.4 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.11 bertrand 31: *
1.4 bertrand 32: *
33: *> \par Purpose:
34: * =============
35: *>
36: *> \verbatim
37: *>
38: *> DLAPMR 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 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 (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: *
1.11 bertrand 95: *> \author Univ. of Tennessee
96: *> \author Univ. of California Berkeley
97: *> \author Univ. of Colorado Denver
98: *> \author NAG Ltd.
1.4 bertrand 99: *
1.11 bertrand 100: *> \date December 2016
1.4 bertrand 101: *
102: *> \ingroup doubleOTHERauxiliary
103: *
104: * =====================================================================
1.1 bertrand 105: SUBROUTINE DLAPMR( FORWRD, M, N, X, LDX, K )
106: *
1.11 bertrand 107: * -- LAPACK auxiliary routine (version 3.7.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.11 bertrand 110: * December 2016
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, IN, J, JJ
125: DOUBLE PRECISION TEMP
126: * ..
127: * .. Executable Statements ..
128: *
129: IF( M.LE.1 )
130: $ RETURN
131: *
132: DO 10 I = 1, M
133: K( I ) = -K( I )
134: 10 CONTINUE
135: *
136: IF( FORWRD ) THEN
137: *
138: * Forward permutation
139: *
140: DO 50 I = 1, M
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 JJ = 1, N
154: TEMP = X( J, JJ )
155: X( J, JJ ) = X( IN, JJ )
156: X( IN, JJ ) = 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, M
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 JJ = 1, N
184: TEMP = X( I, JJ )
185: X( I, JJ ) = X( J, JJ )
186: X( J, JJ ) = 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 ZLAPMT
202: *
203: END
204:
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dlapmr.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack