LAPACK 3.3.0
|
00001 SUBROUTINE DTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, 00002 $ INFO ) 00003 * 00004 * -- LAPACK routine (version 3.2) -- 00005 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00006 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00007 * November 2006 00008 * 00009 * .. Scalar Arguments .. 00010 CHARACTER DIAG, TRANS, UPLO 00011 INTEGER INFO, LDA, LDB, N, NRHS 00012 * .. 00013 * .. Array Arguments .. 00014 DOUBLE PRECISION A( LDA, * ), B( LDB, * ) 00015 * .. 00016 * 00017 * Purpose 00018 * ======= 00019 * 00020 * DTRTRS solves a triangular system of the form 00021 * 00022 * A * X = B or A**T * X = B, 00023 * 00024 * where A is a triangular matrix of order N, and B is an N-by-NRHS 00025 * matrix. A check is made to verify that A is nonsingular. 00026 * 00027 * Arguments 00028 * ========= 00029 * 00030 * UPLO (input) CHARACTER*1 00031 * = 'U': A is upper triangular; 00032 * = 'L': A is lower triangular. 00033 * 00034 * TRANS (input) CHARACTER*1 00035 * Specifies the form of the system of equations: 00036 * = 'N': A * X = B (No transpose) 00037 * = 'T': A**T * X = B (Transpose) 00038 * = 'C': A**H * X = B (Conjugate transpose = Transpose) 00039 * 00040 * DIAG (input) CHARACTER*1 00041 * = 'N': A is non-unit triangular; 00042 * = 'U': A is unit triangular. 00043 * 00044 * N (input) INTEGER 00045 * The order of the matrix A. N >= 0. 00046 * 00047 * NRHS (input) INTEGER 00048 * The number of right hand sides, i.e., the number of columns 00049 * of the matrix B. NRHS >= 0. 00050 * 00051 * A (input) DOUBLE PRECISION array, dimension (LDA,N) 00052 * The triangular matrix A. If UPLO = 'U', the leading N-by-N 00053 * upper triangular part of the array A contains the upper 00054 * triangular matrix, and the strictly lower triangular part of 00055 * A is not referenced. If UPLO = 'L', the leading N-by-N lower 00056 * triangular part of the array A contains the lower triangular 00057 * matrix, and the strictly upper triangular part of A is not 00058 * referenced. If DIAG = 'U', the diagonal elements of A are 00059 * also not referenced and are assumed to be 1. 00060 * 00061 * LDA (input) INTEGER 00062 * The leading dimension of the array A. LDA >= max(1,N). 00063 * 00064 * B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) 00065 * On entry, the right hand side matrix B. 00066 * On exit, if INFO = 0, the solution matrix X. 00067 * 00068 * LDB (input) INTEGER 00069 * The leading dimension of the array B. LDB >= max(1,N). 00070 * 00071 * INFO (output) INTEGER 00072 * = 0: successful exit 00073 * < 0: if INFO = -i, the i-th argument had an illegal value 00074 * > 0: if INFO = i, the i-th diagonal element of A is zero, 00075 * indicating that the matrix is singular and the solutions 00076 * X have not been computed. 00077 * 00078 * ===================================================================== 00079 * 00080 * .. Parameters .. 00081 DOUBLE PRECISION ZERO, ONE 00082 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) 00083 * .. 00084 * .. Local Scalars .. 00085 LOGICAL NOUNIT 00086 * .. 00087 * .. External Functions .. 00088 LOGICAL LSAME 00089 EXTERNAL LSAME 00090 * .. 00091 * .. External Subroutines .. 00092 EXTERNAL DTRSM, XERBLA 00093 * .. 00094 * .. Intrinsic Functions .. 00095 INTRINSIC MAX 00096 * .. 00097 * .. Executable Statements .. 00098 * 00099 * Test the input parameters. 00100 * 00101 INFO = 0 00102 NOUNIT = LSAME( DIAG, 'N' ) 00103 IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00104 INFO = -1 00105 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. 00106 $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN 00107 INFO = -2 00108 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN 00109 INFO = -3 00110 ELSE IF( N.LT.0 ) THEN 00111 INFO = -4 00112 ELSE IF( NRHS.LT.0 ) THEN 00113 INFO = -5 00114 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 00115 INFO = -7 00116 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN 00117 INFO = -9 00118 END IF 00119 IF( INFO.NE.0 ) THEN 00120 CALL XERBLA( 'DTRTRS', -INFO ) 00121 RETURN 00122 END IF 00123 * 00124 * Quick return if possible 00125 * 00126 IF( N.EQ.0 ) 00127 $ RETURN 00128 * 00129 * Check for singularity. 00130 * 00131 IF( NOUNIT ) THEN 00132 DO 10 INFO = 1, N 00133 IF( A( INFO, INFO ).EQ.ZERO ) 00134 $ RETURN 00135 10 CONTINUE 00136 END IF 00137 INFO = 0 00138 * 00139 * Solve A * x = b or A' * x = b. 00140 * 00141 CALL DTRSM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B, 00142 $ LDB ) 00143 * 00144 RETURN 00145 * 00146 * End of DTRTRS 00147 * 00148 END