1: SUBROUTINE DLAPMR( FORWRD, M, N, X, LDX, K )
2: IMPLICIT NONE
3: *
4: * Originally DLAPMT
5: * -- LAPACK auxiliary routine (version 3.2) --
6: * -- LAPACK is a software package provided by Univ. of Tennessee, --
7: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
8: * November 2006
9: *
10: * Adapted to DLAPMR
11: * July 2010
12: *
13: * .. Scalar Arguments ..
14: LOGICAL FORWRD
15: INTEGER LDX, M, N
16: * ..
17: * .. Array Arguments ..
18: INTEGER K( * )
19: DOUBLE PRECISION X( LDX, * )
20: * ..
21: *
22: * Purpose
23: * =======
24: *
25: * DLAPMR rearranges the rows of the M by N matrix X as specified
26: * by the permutation K(1),K(2),...,K(M) of the integers 1,...,M.
27: * If FORWRD = .TRUE., forward permutation:
28: *
29: * X(K(I),*) is moved X(I,*) for I = 1,2,...,M.
30: *
31: * If FORWRD = .FALSE., backward permutation:
32: *
33: * X(I,*) is moved to X(K(I),*) for I = 1,2,...,M.
34: *
35: * Arguments
36: * =========
37: *
38: * FORWRD (input) LOGICAL
39: * = .TRUE., forward permutation
40: * = .FALSE., backward permutation
41: *
42: * M (input) INTEGER
43: * The number of rows of the matrix X. M >= 0.
44: *
45: * N (input) INTEGER
46: * The number of columns of the matrix X. N >= 0.
47: *
48: * X (input/output) DOUBLE PRECISION array, dimension (LDX,N)
49: * On entry, the M by N matrix X.
50: * On exit, X contains the permuted matrix X.
51: *
52: * LDX (input) INTEGER
53: * The leading dimension of the array X, LDX >= MAX(1,M).
54: *
55: * K (input/output) INTEGER array, dimension (M)
56: * On entry, K contains the permutation vector. K is used as
57: * internal workspace, but reset to its original value on
58: * output.
59: *
60: * =====================================================================
61: *
62: * .. Local Scalars ..
63: INTEGER I, IN, J, JJ
64: DOUBLE PRECISION TEMP
65: * ..
66: * .. Executable Statements ..
67: *
68: IF( M.LE.1 )
69: $ RETURN
70: *
71: DO 10 I = 1, M
72: K( I ) = -K( I )
73: 10 CONTINUE
74: *
75: IF( FORWRD ) THEN
76: *
77: * Forward permutation
78: *
79: DO 50 I = 1, M
80: *
81: IF( K( I ).GT.0 )
82: $ GO TO 40
83: *
84: J = I
85: K( J ) = -K( J )
86: IN = K( J )
87: *
88: 20 CONTINUE
89: IF( K( IN ).GT.0 )
90: $ GO TO 40
91: *
92: DO 30 JJ = 1, N
93: TEMP = X( J, JJ )
94: X( J, JJ ) = X( IN, JJ )
95: X( IN, JJ ) = TEMP
96: 30 CONTINUE
97: *
98: K( IN ) = -K( IN )
99: J = IN
100: IN = K( IN )
101: GO TO 20
102: *
103: 40 CONTINUE
104: *
105: 50 CONTINUE
106: *
107: ELSE
108: *
109: * Backward permutation
110: *
111: DO 90 I = 1, M
112: *
113: IF( K( I ).GT.0 )
114: $ GO TO 80
115: *
116: K( I ) = -K( I )
117: J = K( I )
118: 60 CONTINUE
119: IF( J.EQ.I )
120: $ GO TO 80
121: *
122: DO 70 JJ = 1, N
123: TEMP = X( I, JJ )
124: X( I, JJ ) = X( J, JJ )
125: X( J, JJ ) = TEMP
126: 70 CONTINUE
127: *
128: K( J ) = -K( J )
129: J = K( J )
130: GO TO 60
131: *
132: 80 CONTINUE
133: *
134: 90 CONTINUE
135: *
136: END IF
137: *
138: RETURN
139: *
140: * End of ZLAPMT
141: *
142: END
143:
CVSweb interface <joel.bertrand@systella.fr>