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
204