![]() ![]() | ![]() |
Mise à jour de lapack vers la version 3.3.0.
1: SUBROUTINE DTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, 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 DIAG, TRANS, UPLO 10: INTEGER INFO, LDB, N, NRHS 11: * .. 12: * .. Array Arguments .. 13: DOUBLE PRECISION AP( * ), B( LDB, * ) 14: * .. 15: * 16: * Purpose 17: * ======= 18: * 19: * DTPTRS solves a triangular system of the form 20: * 21: * A * X = B or A**T * X = B, 22: * 23: * where A is a triangular matrix of order N stored in packed format, 24: * and B is an N-by-NRHS matrix. A check is made to verify that A is 25: * 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: * AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2) 52: * The upper or lower triangular matrix A, packed columnwise in 53: * a linear array. The j-th column of A is stored in the array 54: * AP as follows: 55: * if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j; 56: * if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n. 57: * 58: * B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) 59: * On entry, the right hand side matrix B. 60: * On exit, if INFO = 0, the solution matrix X. 61: * 62: * LDB (input) INTEGER 63: * The leading dimension of the array B. LDB >= max(1,N). 64: * 65: * INFO (output) INTEGER 66: * = 0: successful exit 67: * < 0: if INFO = -i, the i-th argument had an illegal value 68: * > 0: if INFO = i, the i-th diagonal element of A is zero, 69: * indicating that the matrix is singular and the 70: * solutions X have not been computed. 71: * 72: * ===================================================================== 73: * 74: * .. Parameters .. 75: DOUBLE PRECISION ZERO 76: PARAMETER ( ZERO = 0.0D+0 ) 77: * .. 78: * .. Local Scalars .. 79: LOGICAL NOUNIT, UPPER 80: INTEGER J, JC 81: * .. 82: * .. External Functions .. 83: LOGICAL LSAME 84: EXTERNAL LSAME 85: * .. 86: * .. External Subroutines .. 87: EXTERNAL DTPSV, XERBLA 88: * .. 89: * .. Intrinsic Functions .. 90: INTRINSIC MAX 91: * .. 92: * .. Executable Statements .. 93: * 94: * Test the input parameters. 95: * 96: INFO = 0 97: UPPER = LSAME( UPLO, 'U' ) 98: NOUNIT = LSAME( DIAG, 'N' ) 99: IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 100: INFO = -1 101: ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. 102: $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN 103: INFO = -2 104: ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN 105: INFO = -3 106: ELSE IF( N.LT.0 ) THEN 107: INFO = -4 108: ELSE IF( NRHS.LT.0 ) THEN 109: INFO = -5 110: ELSE IF( LDB.LT.MAX( 1, N ) ) THEN 111: INFO = -8 112: END IF 113: IF( INFO.NE.0 ) THEN 114: CALL XERBLA( 'DTPTRS', -INFO ) 115: RETURN 116: END IF 117: * 118: * Quick return if possible 119: * 120: IF( N.EQ.0 ) 121: $ RETURN 122: * 123: * Check for singularity. 124: * 125: IF( NOUNIT ) THEN 126: IF( UPPER ) THEN 127: JC = 1 128: DO 10 INFO = 1, N 129: IF( AP( JC+INFO-1 ).EQ.ZERO ) 130: $ RETURN 131: JC = JC + INFO 132: 10 CONTINUE 133: ELSE 134: JC = 1 135: DO 20 INFO = 1, N 136: IF( AP( JC ).EQ.ZERO ) 137: $ RETURN 138: JC = JC + N - INFO + 1 139: 20 CONTINUE 140: END IF 141: END IF 142: INFO = 0 143: * 144: * Solve A * x = b or A' * x = b. 145: * 146: DO 30 J = 1, NRHS 147: CALL DTPSV( UPLO, TRANS, DIAG, N, AP, B( 1, J ), 1 ) 148: 30 CONTINUE 149: * 150: RETURN 151: * 152: * End of DTPTRS 153: * 154: END