00001 SUBROUTINE CTRTRS( 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 COMPLEX A( LDA, * ), B( LDB, * ) 00015 * .. 00016 * 00017 * Purpose 00018 * ======= 00019 * 00020 * CTRTRS solves a triangular system of the form 00021 * 00022 * A * X = B, A**T * X = B, or A**H * 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) 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) COMPLEX 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) COMPLEX 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 COMPLEX ZERO, ONE 00082 PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ), 00083 $ ONE = ( 1.0E+0, 0.0E+0 ) ) 00084 * .. 00085 * .. Local Scalars .. 00086 LOGICAL NOUNIT 00087 * .. 00088 * .. External Functions .. 00089 LOGICAL LSAME 00090 EXTERNAL LSAME 00091 * .. 00092 * .. External Subroutines .. 00093 EXTERNAL CTRSM, XERBLA 00094 * .. 00095 * .. Intrinsic Functions .. 00096 INTRINSIC MAX 00097 * .. 00098 * .. Executable Statements .. 00099 * 00100 * Test the input parameters. 00101 * 00102 INFO = 0 00103 NOUNIT = LSAME( DIAG, 'N' ) 00104 IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00105 INFO = -1 00106 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. 00107 $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN 00108 INFO = -2 00109 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN 00110 INFO = -3 00111 ELSE IF( N.LT.0 ) THEN 00112 INFO = -4 00113 ELSE IF( NRHS.LT.0 ) THEN 00114 INFO = -5 00115 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 00116 INFO = -7 00117 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN 00118 INFO = -9 00119 END IF 00120 IF( INFO.NE.0 ) THEN 00121 CALL XERBLA( 'CTRTRS', -INFO ) 00122 RETURN 00123 END IF 00124 * 00125 * Quick return if possible 00126 * 00127 IF( N.EQ.0 ) 00128 $ RETURN 00129 * 00130 * Check for singularity. 00131 * 00132 IF( NOUNIT ) THEN 00133 DO 10 INFO = 1, N 00134 IF( A( INFO, INFO ).EQ.ZERO ) 00135 $ RETURN 00136 10 CONTINUE 00137 END IF 00138 INFO = 0 00139 * 00140 * Solve A * x = b, A**T * x = b, or A**H * x = b. 00141 * 00142 CALL CTRSM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B, 00143 $ LDB ) 00144 * 00145 RETURN 00146 * 00147 * End of CTRTRS 00148 * 00149 END
1.7.2