![]() ![]() | ![]() |
Mise à jour de lapack vers la version 3.3.0.
1: SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) 2: * 3: * -- LAPACK routine (version 3.2) -- 4: * -- LAPACK is a software package provided by Univ. of Tennessee, -- 5: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 6: * November 2006 7: * 8: * .. Scalar Arguments .. 9: CHARACTER TRANS 10: INTEGER INFO, LDA, LDB, N, NRHS 11: * .. 12: * .. Array Arguments .. 13: INTEGER IPIV( * ) 14: DOUBLE PRECISION A( LDA, * ), B( LDB, * ) 15: * .. 16: * 17: * Purpose 18: * ======= 19: * 20: * DGETRS solves a system of linear equations 21: * A * X = B or A' * X = B 22: * with a general N-by-N matrix A using the LU factorization computed 23: * by DGETRF. 24: * 25: * Arguments 26: * ========= 27: * 28: * TRANS (input) CHARACTER*1 29: * Specifies the form of the system of equations: 30: * = 'N': A * X = B (No transpose) 31: * = 'T': A'* X = B (Transpose) 32: * = 'C': A'* X = B (Conjugate transpose = Transpose) 33: * 34: * N (input) INTEGER 35: * The order of the matrix A. N >= 0. 36: * 37: * NRHS (input) INTEGER 38: * The number of right hand sides, i.e., the number of columns 39: * of the matrix B. NRHS >= 0. 40: * 41: * A (input) DOUBLE PRECISION array, dimension (LDA,N) 42: * The factors L and U from the factorization A = P*L*U 43: * as computed by DGETRF. 44: * 45: * LDA (input) INTEGER 46: * The leading dimension of the array A. LDA >= max(1,N). 47: * 48: * IPIV (input) INTEGER array, dimension (N) 49: * The pivot indices from DGETRF; for 1<=i<=N, row i of the 50: * matrix was interchanged with row IPIV(i). 51: * 52: * B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) 53: * On entry, the right hand side matrix B. 54: * On exit, the solution matrix X. 55: * 56: * LDB (input) INTEGER 57: * The leading dimension of the array B. LDB >= max(1,N). 58: * 59: * INFO (output) INTEGER 60: * = 0: successful exit 61: * < 0: if INFO = -i, the i-th argument had an illegal value 62: * 63: * ===================================================================== 64: * 65: * .. Parameters .. 66: DOUBLE PRECISION ONE 67: PARAMETER ( ONE = 1.0D+0 ) 68: * .. 69: * .. Local Scalars .. 70: LOGICAL NOTRAN 71: * .. 72: * .. External Functions .. 73: LOGICAL LSAME 74: EXTERNAL LSAME 75: * .. 76: * .. External Subroutines .. 77: EXTERNAL DLASWP, DTRSM, XERBLA 78: * .. 79: * .. Intrinsic Functions .. 80: INTRINSIC MAX 81: * .. 82: * .. Executable Statements .. 83: * 84: * Test the input parameters. 85: * 86: INFO = 0 87: NOTRAN = LSAME( TRANS, 'N' ) 88: IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. 89: $ LSAME( TRANS, 'C' ) ) THEN 90: INFO = -1 91: ELSE IF( N.LT.0 ) THEN 92: INFO = -2 93: ELSE IF( NRHS.LT.0 ) THEN 94: INFO = -3 95: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 96: INFO = -5 97: ELSE IF( LDB.LT.MAX( 1, N ) ) THEN 98: INFO = -8 99: END IF 100: IF( INFO.NE.0 ) THEN 101: CALL XERBLA( 'DGETRS', -INFO ) 102: RETURN 103: END IF 104: * 105: * Quick return if possible 106: * 107: IF( N.EQ.0 .OR. NRHS.EQ.0 ) 108: $ RETURN 109: * 110: IF( NOTRAN ) THEN 111: * 112: * Solve A * X = B. 113: * 114: * Apply row interchanges to the right hand sides. 115: * 116: CALL DLASWP( NRHS, B, LDB, 1, N, IPIV, 1 ) 117: * 118: * Solve L*X = B, overwriting B with X. 119: * 120: CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS, 121: $ ONE, A, LDA, B, LDB ) 122: * 123: * Solve U*X = B, overwriting B with X. 124: * 125: CALL DTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N, 126: $ NRHS, ONE, A, LDA, B, LDB ) 127: ELSE 128: * 129: * Solve A' * X = B. 130: * 131: * Solve U'*X = B, overwriting B with X. 132: * 133: CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS, 134: $ ONE, A, LDA, B, LDB ) 135: * 136: * Solve L'*X = B, overwriting B with X. 137: * 138: CALL DTRSM( 'Left', 'Lower', 'Transpose', 'Unit', N, NRHS, ONE, 139: $ A, LDA, B, LDB ) 140: * 141: * Apply row interchanges to the solution vectors. 142: * 143: CALL DLASWP( NRHS, B, LDB, 1, N, IPIV, -1 ) 144: END IF 145: * 146: RETURN 147: * 148: * End of DGETRS 149: * 150: END