1      SUBROUTINE DLAPMT( FORWRD, M, N, X, LDX, K )
2*
3*  -- LAPACK auxiliary routine (version 3.0) --
4*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
5*     Courant Institute, Argonne National Lab, and Rice University
6*     March 31, 1993
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) INTEGER array, dimension (N)
51*          On entry, K contains the permutation vector.
52*
53*  =====================================================================
54*
55*     .. Local Scalars ..
56      INTEGER            I, II, IN, J
57      DOUBLE PRECISION   TEMP
58*     ..
59*     .. Executable Statements ..
60*
61      IF( N.LE.1 )
62     $   RETURN
63*
64      DO 10 I = 1, N
65         K( I ) = -K( I )
66   10 CONTINUE
67*
68      IF( FORWRD ) THEN
69*
70*        Forward permutation
71*
72         DO 50 I = 1, N
73*
74            IF( K( I ).GT.0 )
75     $         GO TO 40
76*
77            J = I
78            K( J ) = -K( J )
79            IN = K( J )
80*
81   20       CONTINUE
82            IF( K( IN ).GT.0 )
83     $         GO TO 40
84*
85            DO 30 II = 1, M
86               TEMP = X( II, J )
87               X( II, J ) = X( II, IN )
88               X( II, IN ) = TEMP
89   30       CONTINUE
90*
91            K( IN ) = -K( IN )
92            J = IN
93            IN = K( IN )
94            GO TO 20
95*
96   40       CONTINUE
97*
98   50    CONTINUE
99*
100      ELSE
101*
102*        Backward permutation
103*
104         DO 90 I = 1, N
105*
106            IF( K( I ).GT.0 )
107     $         GO TO 80
108*
109            K( I ) = -K( I )
110            J = K( I )
111   60       CONTINUE
112            IF( J.EQ.I )
113     $         GO TO 80
114*
115            DO 70 II = 1, M
116               TEMP = X( II, I )
117               X( II, I ) = X( II, J )
118               X( II, J ) = TEMP
119   70       CONTINUE
120*
121            K( J ) = -K( J )
122            J = K( J )
123            GO TO 60
124*
125   80       CONTINUE
126*
127   90    CONTINUE
128*
129      END IF
130*
131      RETURN
132*
133*     End of DLAPMT
134*
135      END
136