00001 SUBROUTINE SPBTRS( UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO ) 00002 * 00003 * -- LAPACK routine (version 3.2) -- 00004 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00005 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00006 * November 2006 00007 * 00008 * .. Scalar Arguments .. 00009 CHARACTER UPLO 00010 INTEGER INFO, KD, LDAB, LDB, N, NRHS 00011 * .. 00012 * .. Array Arguments .. 00013 REAL AB( LDAB, * ), B( LDB, * ) 00014 * .. 00015 * 00016 * Purpose 00017 * ======= 00018 * 00019 * SPBTRS solves a system of linear equations A*X = B with a symmetric 00020 * positive definite band matrix A using the Cholesky factorization 00021 * A = U**T*U or A = L*L**T computed by SPBTRF. 00022 * 00023 * Arguments 00024 * ========= 00025 * 00026 * UPLO (input) CHARACTER*1 00027 * = 'U': Upper triangular factor stored in AB; 00028 * = 'L': Lower triangular factor stored in AB. 00029 * 00030 * N (input) INTEGER 00031 * The order of the matrix A. N >= 0. 00032 * 00033 * KD (input) INTEGER 00034 * The number of superdiagonals of the matrix A if UPLO = 'U', 00035 * or the number of subdiagonals if UPLO = 'L'. KD >= 0. 00036 * 00037 * NRHS (input) INTEGER 00038 * The number of right hand sides, i.e., the number of columns 00039 * of the matrix B. NRHS >= 0. 00040 * 00041 * AB (input) REAL array, dimension (LDAB,N) 00042 * The triangular factor U or L from the Cholesky factorization 00043 * A = U**T*U or A = L*L**T of the band matrix A, stored in the 00044 * first KD+1 rows of the array. The j-th column of U or L is 00045 * stored in the j-th column of the array AB as follows: 00046 * if UPLO ='U', AB(kd+1+i-j,j) = U(i,j) for max(1,j-kd)<=i<=j; 00047 * if UPLO ='L', AB(1+i-j,j) = L(i,j) for j<=i<=min(n,j+kd). 00048 * 00049 * LDAB (input) INTEGER 00050 * The leading dimension of the array AB. LDAB >= KD+1. 00051 * 00052 * B (input/output) REAL array, dimension (LDB,NRHS) 00053 * On entry, the right hand side matrix B. 00054 * On exit, the solution matrix X. 00055 * 00056 * LDB (input) INTEGER 00057 * The leading dimension of the array B. LDB >= max(1,N). 00058 * 00059 * INFO (output) INTEGER 00060 * = 0: successful exit 00061 * < 0: if INFO = -i, the i-th argument had an illegal value 00062 * 00063 * ===================================================================== 00064 * 00065 * .. Local Scalars .. 00066 LOGICAL UPPER 00067 INTEGER J 00068 * .. 00069 * .. External Functions .. 00070 LOGICAL LSAME 00071 EXTERNAL LSAME 00072 * .. 00073 * .. External Subroutines .. 00074 EXTERNAL STBSV, XERBLA 00075 * .. 00076 * .. Intrinsic Functions .. 00077 INTRINSIC MAX 00078 * .. 00079 * .. Executable Statements .. 00080 * 00081 * Test the input parameters. 00082 * 00083 INFO = 0 00084 UPPER = LSAME( UPLO, 'U' ) 00085 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00086 INFO = -1 00087 ELSE IF( N.LT.0 ) THEN 00088 INFO = -2 00089 ELSE IF( KD.LT.0 ) THEN 00090 INFO = -3 00091 ELSE IF( NRHS.LT.0 ) THEN 00092 INFO = -4 00093 ELSE IF( LDAB.LT.KD+1 ) THEN 00094 INFO = -6 00095 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN 00096 INFO = -8 00097 END IF 00098 IF( INFO.NE.0 ) THEN 00099 CALL XERBLA( 'SPBTRS', -INFO ) 00100 RETURN 00101 END IF 00102 * 00103 * Quick return if possible 00104 * 00105 IF( N.EQ.0 .OR. NRHS.EQ.0 ) 00106 $ RETURN 00107 * 00108 IF( UPPER ) THEN 00109 * 00110 * Solve A*X = B where A = U'*U. 00111 * 00112 DO 10 J = 1, NRHS 00113 * 00114 * Solve U'*X = B, overwriting B with X. 00115 * 00116 CALL STBSV( 'Upper', 'Transpose', 'Non-unit', N, KD, AB, 00117 $ LDAB, B( 1, J ), 1 ) 00118 * 00119 * Solve U*X = B, overwriting B with X. 00120 * 00121 CALL STBSV( 'Upper', 'No transpose', 'Non-unit', N, KD, AB, 00122 $ LDAB, B( 1, J ), 1 ) 00123 10 CONTINUE 00124 ELSE 00125 * 00126 * Solve A*X = B where A = L*L'. 00127 * 00128 DO 20 J = 1, NRHS 00129 * 00130 * Solve L*X = B, overwriting B with X. 00131 * 00132 CALL STBSV( 'Lower', 'No transpose', 'Non-unit', N, KD, AB, 00133 $ LDAB, B( 1, J ), 1 ) 00134 * 00135 * Solve L'*X = B, overwriting B with X. 00136 * 00137 CALL STBSV( 'Lower', 'Transpose', 'Non-unit', N, KD, AB, 00138 $ LDAB, B( 1, J ), 1 ) 00139 20 CONTINUE 00140 END IF 00141 * 00142 RETURN 00143 * 00144 * End of SPBTRS 00145 * 00146 END
1.7.2