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