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