001:       SUBROUTINE DLAPMT( FORWRD, M, N, X, LDX, K )
002: *
003: *  -- LAPACK auxiliary routine (version 3.2) --
004: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
005: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
006: *     November 2006
007: *
008: *     .. Scalar Arguments ..
009:       LOGICAL            FORWRD
010:       INTEGER            LDX, M, N
011: *     ..
012: *     .. Array Arguments ..
013:       INTEGER            K( * )
014:       DOUBLE PRECISION   X( LDX, * )
015: *     ..
016: *
017: *  Purpose
018: *  =======
019: *
020: *  DLAPMT rearranges the columns of the M by N matrix X as specified
021: *  by the permutation K(1),K(2),...,K(N) of the integers 1,...,N.
022: *  If FORWRD = .TRUE.,  forward permutation:
023: *
024: *       X(*,K(J)) is moved X(*,J) for J = 1,2,...,N.
025: *
026: *  If FORWRD = .FALSE., backward permutation:
027: *
028: *       X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N.
029: *
030: *  Arguments
031: *  =========
032: *
033: *  FORWRD  (input) LOGICAL
034: *          = .TRUE., forward permutation
035: *          = .FALSE., backward permutation
036: *
037: *  M       (input) INTEGER
038: *          The number of rows of the matrix X. M >= 0.
039: *
040: *  N       (input) INTEGER
041: *          The number of columns of the matrix X. N >= 0.
042: *
043: *  X       (input/output) DOUBLE PRECISION array, dimension (LDX,N)
044: *          On entry, the M by N matrix X.
045: *          On exit, X contains the permuted matrix X.
046: *
047: *  LDX     (input) INTEGER
048: *          The leading dimension of the array X, LDX >= MAX(1,M).
049: *
050: *  K       (input/output) INTEGER array, dimension (N)
051: *          On entry, K contains the permutation vector. K is used as
052: *          internal workspace, but reset to its original value on
053: *          output.
054: *
055: *  =====================================================================
056: *
057: *     .. Local Scalars ..
058:       INTEGER            I, II, IN, J
059:       DOUBLE PRECISION   TEMP
060: *     ..
061: *     .. Executable Statements ..
062: *
063:       IF( N.LE.1 )
064:      $   RETURN
065: *
066:       DO 10 I = 1, N
067:          K( I ) = -K( I )
068:    10 CONTINUE
069: *
070:       IF( FORWRD ) THEN
071: *
072: *        Forward permutation
073: *
074:          DO 50 I = 1, N
075: *
076:             IF( K( I ).GT.0 )
077:      $         GO TO 40
078: *
079:             J = I
080:             K( J ) = -K( J )
081:             IN = K( J )
082: *
083:    20       CONTINUE
084:             IF( K( IN ).GT.0 )
085:      $         GO TO 40
086: *
087:             DO 30 II = 1, M
088:                TEMP = X( II, J )
089:                X( II, J ) = X( II, IN )
090:                X( II, IN ) = TEMP
091:    30       CONTINUE
092: *
093:             K( IN ) = -K( IN )
094:             J = IN
095:             IN = K( IN )
096:             GO TO 20
097: *
098:    40       CONTINUE
099: *
100:    50    CONTINUE
101: *
102:       ELSE
103: *
104: *        Backward permutation
105: *
106:          DO 90 I = 1, N
107: *
108:             IF( K( I ).GT.0 )
109:      $         GO TO 80
110: *
111:             K( I ) = -K( I )
112:             J = K( I )
113:    60       CONTINUE
114:             IF( J.EQ.I )
115:      $         GO TO 80
116: *
117:             DO 70 II = 1, M
118:                TEMP = X( II, I )
119:                X( II, I ) = X( II, J )
120:                X( II, J ) = TEMP
121:    70       CONTINUE
122: *
123:             K( J ) = -K( J )
124:             J = K( J )
125:             GO TO 60
126: *
127:    80       CONTINUE
128: *
129:    90    CONTINUE
130: *
131:       END IF
132: *
133:       RETURN
134: *
135: *     End of DLAPMT
136: *
137:       END
138: