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*> \ingroup realOTHERauxiliary
101*
102*  =====================================================================
103      SUBROUTINE SLAPMT( FORWRD, M, N, X, LDX, K )
104*
105*  -- LAPACK auxiliary routine --
106*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
107*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
108*
109*     .. Scalar Arguments ..
110      LOGICAL            FORWRD
111      INTEGER            LDX, M, N
112*     ..
113*     .. Array Arguments ..
114      INTEGER            K( * )
115      REAL               X( LDX, * )
116*     ..
117*
118*  =====================================================================
119*
120*     .. Local Scalars ..
121      INTEGER            I, II, J, IN
122      REAL               TEMP
123*     ..
124*     .. Executable Statements ..
125*
126      IF( N.LE.1 )
127     $   RETURN
128*
129      DO 10 I = 1, N
130         K( I ) = -K( I )
131   10 CONTINUE
132*
133      IF( FORWRD ) THEN
134*
135*        Forward permutation
136*
137         DO 60 I = 1, N
138*
139            IF( K( I ).GT.0 )
140     $         GO TO 40
141*
142            J = I
143            K( J ) = -K( J )
144            IN = K( J )
145*
146   20       CONTINUE
147            IF( K( IN ).GT.0 )
148     $         GO TO 40
149*
150            DO 30 II = 1, M
151               TEMP = X( II, J )
152               X( II, J ) = X( II, IN )
153               X( II, IN ) = TEMP
154   30       CONTINUE
155*
156            K( IN ) = -K( IN )
157            J = IN
158            IN = K( IN )
159            GO TO 20
160*
161   40       CONTINUE
162*
163   60    CONTINUE
164*
165      ELSE
166*
167*        Backward permutation
168*
169         DO 110 I = 1, N
170*
171            IF( K( I ).GT.0 )
172     $         GO TO 100
173*
174            K( I ) = -K( I )
175            J = K( I )
176   80       CONTINUE
177            IF( J.EQ.I )
178     $         GO TO 100
179*
180            DO 90 II = 1, M
181               TEMP = X( II, I )
182               X( II, I ) = X( II, J )
183               X( II, J ) = TEMP
184   90       CONTINUE
185*
186            K( J ) = -K( J )
187            J = K( J )
188            GO TO 80
189*
190  100       CONTINUE
191
192  110    CONTINUE
193*
194      END IF
195*
196      RETURN
197*
198*     End of SLAPMT
199*
200      END
201