SUBROUTINE DLAPMT( FORWRD, M, N, X, LDX, K ) * * -- LAPACK auxiliary routine (version 3.1) -- * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. * November 2006 * * .. Scalar Arguments .. LOGICAL FORWRD INTEGER LDX, M, N * .. * .. Array Arguments .. INTEGER K( * ) DOUBLE PRECISION X( LDX, * ) * .. * * Purpose * ======= * * DLAPMT rearranges the columns of the M by N matrix X as specified * by the permutation K(1),K(2),...,K(N) of the integers 1,...,N. * If FORWRD = .TRUE., forward permutation: * * X(*,K(J)) is moved X(*,J) for J = 1,2,...,N. * * If FORWRD = .FALSE., backward permutation: * * X(*,J) is moved to X(*,K(J)) for J = 1,2,...,N. * * Arguments * ========= * * FORWRD (input) LOGICAL * = .TRUE., forward permutation * = .FALSE., backward permutation * * M (input) INTEGER * The number of rows of the matrix X. M >= 0. * * N (input) INTEGER * The number of columns of the matrix X. N >= 0. * * X (input/output) DOUBLE PRECISION array, dimension (LDX,N) * On entry, the M by N matrix X. * On exit, X contains the permuted matrix X. * * LDX (input) INTEGER * The leading dimension of the array X, LDX >= MAX(1,M). * * K (input/output) INTEGER array, dimension (N) * On entry, K contains the permutation vector. K is used as * internal workspace, but reset to its original value on * output. * * ===================================================================== * * .. Local Scalars .. INTEGER I, II, IN, J DOUBLE PRECISION TEMP * .. * .. Executable Statements .. * IF( N.LE.1 ) $ RETURN * DO 10 I = 1, N K( I ) = -K( I ) 10 CONTINUE * IF( FORWRD ) THEN * * Forward permutation * DO 50 I = 1, N * IF( K( I ).GT.0 ) $ GO TO 40 * J = I K( J ) = -K( J ) IN = K( J ) * 20 CONTINUE IF( K( IN ).GT.0 ) $ GO TO 40 * DO 30 II = 1, M TEMP = X( II, J ) X( II, J ) = X( II, IN ) X( II, IN ) = TEMP 30 CONTINUE * K( IN ) = -K( IN ) J = IN IN = K( IN ) GO TO 20 * 40 CONTINUE * 50 CONTINUE * ELSE * * Backward permutation * DO 90 I = 1, N * IF( K( I ).GT.0 ) $ GO TO 80 * K( I ) = -K( I ) J = K( I ) 60 CONTINUE IF( J.EQ.I ) $ GO TO 80 * DO 70 II = 1, M TEMP = X( II, I ) X( II, I ) = X( II, J ) X( II, J ) = TEMP 70 CONTINUE * K( J ) = -K( J ) J = K( J ) GO TO 60 * 80 CONTINUE * 90 CONTINUE * END IF * RETURN * * End of DLAPMT * END