![]() ![]() | ![]() |
Mise à jour de lapack vers la version 3.3.0.
1: SUBROUTINE DLAPMR( FORWRD, M, N, X, LDX, K ) 2: IMPLICIT NONE 3: * 4: * Originally DLAPMT 5: * -- LAPACK auxiliary routine (version 3.2) -- 6: * -- LAPACK is a software package provided by Univ. of Tennessee, -- 7: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 8: * November 2006 9: * 10: * Adapted to DLAPMR 11: * July 2010 12: * 13: * .. Scalar Arguments .. 14: LOGICAL FORWRD 15: INTEGER LDX, M, N 16: * .. 17: * .. Array Arguments .. 18: INTEGER K( * ) 19: DOUBLE PRECISION X( LDX, * ) 20: * .. 21: * 22: * Purpose 23: * ======= 24: * 25: * DLAPMR rearranges the rows of the M by N matrix X as specified 26: * by the permutation K(1),K(2),...,K(M) of the integers 1,...,M. 27: * If FORWRD = .TRUE., forward permutation: 28: * 29: * X(K(I),*) is moved X(I,*) for I = 1,2,...,M. 30: * 31: * If FORWRD = .FALSE., backward permutation: 32: * 33: * X(I,*) is moved to X(K(I),*) for I = 1,2,...,M. 34: * 35: * Arguments 36: * ========= 37: * 38: * FORWRD (input) LOGICAL 39: * = .TRUE., forward permutation 40: * = .FALSE., backward permutation 41: * 42: * M (input) INTEGER 43: * The number of rows of the matrix X. M >= 0. 44: * 45: * N (input) INTEGER 46: * The number of columns of the matrix X. N >= 0. 47: * 48: * X (input/output) DOUBLE PRECISION array, dimension (LDX,N) 49: * On entry, the M by N matrix X. 50: * On exit, X contains the permuted matrix X. 51: * 52: * LDX (input) INTEGER 53: * The leading dimension of the array X, LDX >= MAX(1,M). 54: * 55: * K (input/output) INTEGER array, dimension (M) 56: * On entry, K contains the permutation vector. K is used as 57: * internal workspace, but reset to its original value on 58: * output. 59: * 60: * ===================================================================== 61: * 62: * .. Local Scalars .. 63: INTEGER I, IN, J, JJ 64: DOUBLE PRECISION TEMP 65: * .. 66: * .. Executable Statements .. 67: * 68: IF( M.LE.1 ) 69: $ RETURN 70: * 71: DO 10 I = 1, M 72: K( I ) = -K( I ) 73: 10 CONTINUE 74: * 75: IF( FORWRD ) THEN 76: * 77: * Forward permutation 78: * 79: DO 50 I = 1, M 80: * 81: IF( K( I ).GT.0 ) 82: $ GO TO 40 83: * 84: J = I 85: K( J ) = -K( J ) 86: IN = K( J ) 87: * 88: 20 CONTINUE 89: IF( K( IN ).GT.0 ) 90: $ GO TO 40 91: * 92: DO 30 JJ = 1, N 93: TEMP = X( J, JJ ) 94: X( J, JJ ) = X( IN, JJ ) 95: X( IN, JJ ) = TEMP 96: 30 CONTINUE 97: * 98: K( IN ) = -K( IN ) 99: J = IN 100: IN = K( IN ) 101: GO TO 20 102: * 103: 40 CONTINUE 104: * 105: 50 CONTINUE 106: * 107: ELSE 108: * 109: * Backward permutation 110: * 111: DO 90 I = 1, M 112: * 113: IF( K( I ).GT.0 ) 114: $ GO TO 80 115: * 116: K( I ) = -K( I ) 117: J = K( I ) 118: 60 CONTINUE 119: IF( J.EQ.I ) 120: $ GO TO 80 121: * 122: DO 70 JJ = 1, N 123: TEMP = X( I, JJ ) 124: X( I, JJ ) = X( J, JJ ) 125: X( J, JJ ) = TEMP 126: 70 CONTINUE 127: * 128: K( J ) = -K( J ) 129: J = K( J ) 130: GO TO 60 131: * 132: 80 CONTINUE 133: * 134: 90 CONTINUE 135: * 136: END IF 137: * 138: RETURN 139: * 140: * End of ZLAPMT 141: * 142: END 143: