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