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