00001 /* spbsv.f -- translated by f2c (version 20061008). 00002 You must link the resulting object file with libf2c: 00003 on Microsoft Windows system, link with libf2c.lib; 00004 on Linux or Unix systems, link with .../path/to/libf2c.a -lm 00005 or, if you install libf2c.a in a standard place, with -lf2c -lm 00006 -- in that order, at the end of the command line, as in 00007 cc *.o -lf2c -lm 00008 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., 00009 00010 http://www.netlib.org/f2c/libf2c.zip 00011 */ 00012 00013 #include "f2c.h" 00014 #include "blaswrap.h" 00015 00016 /* Subroutine */ int spbsv_(char *uplo, integer *n, integer *kd, integer * 00017 nrhs, real *ab, integer *ldab, real *b, integer *ldb, integer *info) 00018 { 00019 /* System generated locals */ 00020 integer ab_dim1, ab_offset, b_dim1, b_offset, i__1; 00021 00022 /* Local variables */ 00023 extern logical lsame_(char *, char *); 00024 extern /* Subroutine */ int xerbla_(char *, integer *), spbtrf_( 00025 char *, integer *, integer *, real *, integer *, integer *), spbtrs_(char *, integer *, integer *, integer *, real *, 00026 integer *, real *, integer *, integer *); 00027 00028 00029 /* -- LAPACK driver routine (version 3.2) -- */ 00030 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ 00031 /* November 2006 */ 00032 00033 /* .. Scalar Arguments .. */ 00034 /* .. */ 00035 /* .. Array Arguments .. */ 00036 /* .. */ 00037 00038 /* Purpose */ 00039 /* ======= */ 00040 00041 /* SPBSV computes the solution to a real system of linear equations */ 00042 /* A * X = B, */ 00043 /* where A is an N-by-N symmetric positive definite band matrix and X */ 00044 /* and B are N-by-NRHS matrices. */ 00045 00046 /* The Cholesky decomposition is used to factor A as */ 00047 /* A = U**T * U, if UPLO = 'U', or */ 00048 /* A = L * L**T, if UPLO = 'L', */ 00049 /* where U is an upper triangular band matrix, and L is a lower */ 00050 /* triangular band matrix, with the same number of superdiagonals or */ 00051 /* subdiagonals as A. The factored form of A is then used to solve the */ 00052 /* system of equations A * X = B. */ 00053 00054 /* Arguments */ 00055 /* ========= */ 00056 00057 /* UPLO (input) CHARACTER*1 */ 00058 /* = 'U': Upper triangle of A is stored; */ 00059 /* = 'L': Lower triangle of A is stored. */ 00060 00061 /* N (input) INTEGER */ 00062 /* The number of linear equations, i.e., the order of the */ 00063 /* matrix A. N >= 0. */ 00064 00065 /* KD (input) INTEGER */ 00066 /* The number of superdiagonals of the matrix A if UPLO = 'U', */ 00067 /* or the number of subdiagonals if UPLO = 'L'. KD >= 0. */ 00068 00069 /* NRHS (input) INTEGER */ 00070 /* The number of right hand sides, i.e., the number of columns */ 00071 /* of the matrix B. NRHS >= 0. */ 00072 00073 /* AB (input/output) REAL array, dimension (LDAB,N) */ 00074 /* On entry, the upper or lower triangle of the symmetric band */ 00075 /* matrix A, stored in the first KD+1 rows of the array. The */ 00076 /* j-th column of A is stored in the j-th column of the array AB */ 00077 /* as follows: */ 00078 /* if UPLO = 'U', AB(KD+1+i-j,j) = A(i,j) for max(1,j-KD)<=i<=j; */ 00079 /* if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(N,j+KD). */ 00080 /* See below for further details. */ 00081 00082 /* On exit, if INFO = 0, the triangular factor U or L from the */ 00083 /* Cholesky factorization A = U**T*U or A = L*L**T of the band */ 00084 /* matrix A, in the same storage format as A. */ 00085 00086 /* LDAB (input) INTEGER */ 00087 /* The leading dimension of the array AB. LDAB >= KD+1. */ 00088 00089 /* B (input/output) REAL array, dimension (LDB,NRHS) */ 00090 /* On entry, the N-by-NRHS right hand side matrix B. */ 00091 /* On exit, if INFO = 0, the N-by-NRHS solution matrix X. */ 00092 00093 /* LDB (input) INTEGER */ 00094 /* The leading dimension of the array B. LDB >= max(1,N). */ 00095 00096 /* INFO (output) INTEGER */ 00097 /* = 0: successful exit */ 00098 /* < 0: if INFO = -i, the i-th argument had an illegal value */ 00099 /* > 0: if INFO = i, the leading minor of order i of A is not */ 00100 /* positive definite, so the factorization could not be */ 00101 /* completed, and the solution has not been computed. */ 00102 00103 /* Further Details */ 00104 /* =============== */ 00105 00106 /* The band storage scheme is illustrated by the following example, when */ 00107 /* N = 6, KD = 2, and UPLO = 'U': */ 00108 00109 /* On entry: On exit: */ 00110 00111 /* * * a13 a24 a35 a46 * * u13 u24 u35 u46 */ 00112 /* * a12 a23 a34 a45 a56 * u12 u23 u34 u45 u56 */ 00113 /* a11 a22 a33 a44 a55 a66 u11 u22 u33 u44 u55 u66 */ 00114 00115 /* Similarly, if UPLO = 'L' the format of A is as follows: */ 00116 00117 /* On entry: On exit: */ 00118 00119 /* a11 a22 a33 a44 a55 a66 l11 l22 l33 l44 l55 l66 */ 00120 /* a21 a32 a43 a54 a65 * l21 l32 l43 l54 l65 * */ 00121 /* a31 a42 a53 a64 * * l31 l42 l53 l64 * * */ 00122 00123 /* Array elements marked * are not used by the routine. */ 00124 00125 /* ===================================================================== */ 00126 00127 /* .. External Functions .. */ 00128 /* .. */ 00129 /* .. External Subroutines .. */ 00130 /* .. */ 00131 /* .. Intrinsic Functions .. */ 00132 /* .. */ 00133 /* .. Executable Statements .. */ 00134 00135 /* Test the input parameters. */ 00136 00137 /* Parameter adjustments */ 00138 ab_dim1 = *ldab; 00139 ab_offset = 1 + ab_dim1; 00140 ab -= ab_offset; 00141 b_dim1 = *ldb; 00142 b_offset = 1 + b_dim1; 00143 b -= b_offset; 00144 00145 /* Function Body */ 00146 *info = 0; 00147 if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) { 00148 *info = -1; 00149 } else if (*n < 0) { 00150 *info = -2; 00151 } else if (*kd < 0) { 00152 *info = -3; 00153 } else if (*nrhs < 0) { 00154 *info = -4; 00155 } else if (*ldab < *kd + 1) { 00156 *info = -6; 00157 } else if (*ldb < max(1,*n)) { 00158 *info = -8; 00159 } 00160 if (*info != 0) { 00161 i__1 = -(*info); 00162 xerbla_("SPBSV ", &i__1); 00163 return 0; 00164 } 00165 00166 /* Compute the Cholesky factorization A = U'*U or A = L*L'. */ 00167 00168 spbtrf_(uplo, n, kd, &ab[ab_offset], ldab, info); 00169 if (*info == 0) { 00170 00171 /* Solve the system A*X = B, overwriting B with X. */ 00172 00173 spbtrs_(uplo, n, kd, nrhs, &ab[ab_offset], ldab, &b[b_offset], ldb, 00174 info); 00175 00176 } 00177 return 0; 00178 00179 /* End of SPBSV */ 00180 00181 } /* spbsv_ */