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
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