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