LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
slapmt.f
Go to the documentation of this file.
1 *> \brief \b SLAPMT performs a forward or backward permutation of the columns of a matrix.
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download SLAPMT + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slapmt.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slapmt.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slapmt.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE SLAPMT( FORWRD, M, N, X, LDX, K )
22 *
23 * .. Scalar Arguments ..
24 * LOGICAL FORWRD
25 * INTEGER LDX, M, N
26 * ..
27 * .. Array Arguments ..
28 * INTEGER K( * )
29 * REAL X( LDX, * )
30 * ..
31 *
32 *
33 *> \par Purpose:
34 * =============
35 *>
36 *> \verbatim
37 *>
38 *> SLAPMT rearranges the columns of the M by N matrix X as specified
39 *> by the permutation K(1),K(2),...,K(N) of the integers 1,...,N.
40 *> If FORWRD = .TRUE., forward permutation:
41 *>
42 *> X(*,K(J)) is moved X(*,J) for J = 1,2,...,N.
43 *>
44 *> If FORWRD = .FALSE., backward permutation:
45 *>
46 *> X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N.
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 REAL 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 (N)
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 *
95 *> \author Univ. of Tennessee
96 *> \author Univ. of California Berkeley
97 *> \author Univ. of Colorado Denver
98 *> \author NAG Ltd.
99 *
100 *> \date September 2012
101 *
102 *> \ingroup realOTHERauxiliary
103 *
104 * =====================================================================
105  SUBROUTINE slapmt( FORWRD, M, N, X, LDX, K )
106 *
107 * -- LAPACK auxiliary routine (version 3.4.2) --
108 * -- LAPACK is a software package provided by Univ. of Tennessee, --
109 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
110 * September 2012
111 *
112 * .. Scalar Arguments ..
113  LOGICAL forwrd
114  INTEGER ldx, m, n
115 * ..
116 * .. Array Arguments ..
117  INTEGER k( * )
118  REAL x( ldx, * )
119 * ..
120 *
121 * =====================================================================
122 *
123 * .. Local Scalars ..
124  INTEGER i, ii, j, in
125  REAL temp
126 * ..
127 * .. Executable Statements ..
128 *
129  IF( n.LE.1 )
130  $ return
131 *
132  DO 10 i = 1, n
133  k( i ) = -k( i )
134  10 continue
135 *
136  IF( forwrd ) THEN
137 *
138 * Forward permutation
139 *
140  DO 60 i = 1, n
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 ii = 1, m
154  temp = x( ii, j )
155  x( ii, j ) = x( ii, in )
156  x( ii, in ) = 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  60 continue
167 *
168  ELSE
169 *
170 * Backward permutation
171 *
172  DO 110 i = 1, n
173 *
174  IF( k( i ).GT.0 )
175  $ go to 100
176 *
177  k( i ) = -k( i )
178  j = k( i )
179  80 continue
180  IF( j.EQ.i )
181  $ go to 100
182 *
183  DO 90 ii = 1, m
184  temp = x( ii, i )
185  x( ii, i ) = x( ii, j )
186  x( ii, j ) = temp
187  90 continue
188 *
189  k( j ) = -k( j )
190  j = k( j )
191  go to 80
192 *
193  100 continue
194 
195  110 continue
196 *
197  END IF
198 *
199  return
200 *
201 * End of SLAPMT
202 *
203  END