00001 SUBROUTINE STBTRS( UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, 00002 $ LDB, 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, KD, LDAB, LDB, N, NRHS 00012 * .. 00013 * .. Array Arguments .. 00014 REAL AB( LDAB, * ), B( LDB, * ) 00015 * .. 00016 * 00017 * Purpose 00018 * ======= 00019 * 00020 * STBTRS solves a triangular system of the form 00021 * 00022 * A * X = B or A**T * X = B, 00023 * 00024 * where A is a triangular band matrix of order N, and B is an 00025 * N-by NRHS 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 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 * KD (input) INTEGER 00048 * The number of superdiagonals or subdiagonals of the 00049 * triangular band matrix A. KD >= 0. 00050 * 00051 * NRHS (input) INTEGER 00052 * The number of right hand sides, i.e., the number of columns 00053 * of the matrix B. NRHS >= 0. 00054 * 00055 * AB (input) REAL array, dimension (LDAB,N) 00056 * The upper or lower triangular band matrix A, stored in the 00057 * first kd+1 rows of AB. The j-th column of A is stored 00058 * in the j-th column of the array AB as follows: 00059 * if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j; 00060 * if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd). 00061 * If DIAG = 'U', the diagonal elements of A are not referenced 00062 * and are assumed to be 1. 00063 * 00064 * LDAB (input) INTEGER 00065 * The leading dimension of the array AB. LDAB >= KD+1. 00066 * 00067 * B (input/output) REAL array, dimension (LDB,NRHS) 00068 * On entry, the right hand side matrix B. 00069 * On exit, if INFO = 0, the solution matrix X. 00070 * 00071 * LDB (input) INTEGER 00072 * The leading dimension of the array B. LDB >= max(1,N). 00073 * 00074 * INFO (output) INTEGER 00075 * = 0: successful exit 00076 * < 0: if INFO = -i, the i-th argument had an illegal value 00077 * > 0: if INFO = i, the i-th diagonal element of A is zero, 00078 * indicating that the matrix is singular and the 00079 * solutions X have not been computed. 00080 * 00081 * ===================================================================== 00082 * 00083 * .. Parameters .. 00084 REAL ZERO 00085 PARAMETER ( ZERO = 0.0E+0 ) 00086 * .. 00087 * .. Local Scalars .. 00088 LOGICAL NOUNIT, UPPER 00089 INTEGER J 00090 * .. 00091 * .. External Functions .. 00092 LOGICAL LSAME 00093 EXTERNAL LSAME 00094 * .. 00095 * .. External Subroutines .. 00096 EXTERNAL STBSV, XERBLA 00097 * .. 00098 * .. Intrinsic Functions .. 00099 INTRINSIC MAX 00100 * .. 00101 * .. Executable Statements .. 00102 * 00103 * Test the input parameters. 00104 * 00105 INFO = 0 00106 NOUNIT = LSAME( DIAG, 'N' ) 00107 UPPER = LSAME( UPLO, 'U' ) 00108 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00109 INFO = -1 00110 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT. 00111 $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN 00112 INFO = -2 00113 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN 00114 INFO = -3 00115 ELSE IF( N.LT.0 ) THEN 00116 INFO = -4 00117 ELSE IF( KD.LT.0 ) THEN 00118 INFO = -5 00119 ELSE IF( NRHS.LT.0 ) THEN 00120 INFO = -6 00121 ELSE IF( LDAB.LT.KD+1 ) THEN 00122 INFO = -8 00123 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN 00124 INFO = -10 00125 END IF 00126 IF( INFO.NE.0 ) THEN 00127 CALL XERBLA( 'STBTRS', -INFO ) 00128 RETURN 00129 END IF 00130 * 00131 * Quick return if possible 00132 * 00133 IF( N.EQ.0 ) 00134 $ RETURN 00135 * 00136 * Check for singularity. 00137 * 00138 IF( NOUNIT ) THEN 00139 IF( UPPER ) THEN 00140 DO 10 INFO = 1, N 00141 IF( AB( KD+1, INFO ).EQ.ZERO ) 00142 $ RETURN 00143 10 CONTINUE 00144 ELSE 00145 DO 20 INFO = 1, N 00146 IF( AB( 1, INFO ).EQ.ZERO ) 00147 $ RETURN 00148 20 CONTINUE 00149 END IF 00150 END IF 00151 INFO = 0 00152 * 00153 * Solve A * X = B or A' * X = B. 00154 * 00155 DO 30 J = 1, NRHS 00156 CALL STBSV( UPLO, TRANS, DIAG, N, KD, AB, LDAB, B( 1, J ), 1 ) 00157 30 CONTINUE 00158 * 00159 RETURN 00160 * 00161 * End of STBTRS 00162 * 00163 END
1.7.2