001:SUBROUTINEDPBSVX( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, 002: $ EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, 003: $ WORK, IWORK, INFO ) 004:*005:* -- LAPACK driver routine (version 3.2) --006:* -- LAPACK is a software package provided by Univ. of Tennessee, --007:* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--008:* November 2006009:*010:* .. Scalar Arguments ..011: CHARACTER EQUED, FACT, UPLO 012: INTEGER INFO, KD, LDAB, LDAFB, LDB, LDX, N, NRHS 013: DOUBLE PRECISION RCOND 014:* ..015:* .. Array Arguments ..016: INTEGERIWORK( * ) 017: DOUBLE PRECISIONAB( LDAB, * ),AFB( LDAFB, * ),B( LDB, * ), 018: $BERR( * ),FERR( * ),S( * ),WORK( * ), 019: $X( LDX, * ) 020:* ..021:*022:* Purpose023:* =======024:*025:* DPBSVX uses the Cholesky factorization A = U**T*U or A = L*L**T to026:* compute the solution to a real system of linear equations027:* A * X = B,028:* where A is an N-by-N symmetric positive definite band matrix and X029:* and B are N-by-NRHS matrices.030:*031:* Error bounds on the solution and a condition estimate are also032:* provided.033:*034:* Description035:* ===========036:*037:* The following steps are performed:038:*039:* 1. If FACT = 'E', real scaling factors are computed to equilibrate040:* the system:041:* diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B042:* Whether or not the system will be equilibrated depends on the043:* scaling of the matrix A, but if equilibration is used, A is044:* overwritten by diag(S)*A*diag(S) and B by diag(S)*B.045:*046:* 2. If FACT = 'N' or 'E', the Cholesky decomposition is used to047:* factor the matrix A (after equilibration if FACT = 'E') as048:* A = U**T * U, if UPLO = 'U', or049:* A = L * L**T, if UPLO = 'L',050:* where U is an upper triangular band matrix, and L is a lower051:* triangular band matrix.052:*053:* 3. If the leading i-by-i principal minor is not positive definite,054:* then the routine returns with INFO = i. Otherwise, the factored055:* form of A is used to estimate the condition number of the matrix056:* A. If the reciprocal of the condition number is less than machine057:* precision, INFO = N+1 is returned as a warning, but the routine058:* still goes on to solve for X and compute error bounds as059:* described below.060:*061:* 4. The system of equations is solved for X using the factored form062:* of A.063:*064:* 5. Iterative refinement is applied to improve the computed solution065:* matrix and calculate error bounds and backward error estimates066:* for it.067:*068:* 6. If equilibration was used, the matrix X is premultiplied by069:* diag(S) so that it solves the original system before070:* equilibration.071:*072:* Arguments073:* =========074:*075:* FACT (input) CHARACTER*1076:* Specifies whether or not the factored form of the matrix A is077:* supplied on entry, and if not, whether the matrix A should be078:* equilibrated before it is factored.079:* = 'F': On entry, AFB contains the factored form of A.080:* If EQUED = 'Y', the matrix A has been equilibrated081:* with scaling factors given by S. AB and AFB will not082:* be modified.083:* = 'N': The matrix A will be copied to AFB and factored.084:* = 'E': The matrix A will be equilibrated if necessary, then085:* copied to AFB and factored.086:*087:* UPLO (input) CHARACTER*1088:* = 'U': Upper triangle of A is stored;089:* = 'L': Lower triangle of A is stored.090:*091:* N (input) INTEGER092:* The number of linear equations, i.e., the order of the093:* matrix A. N >= 0.094:*095:* KD (input) INTEGER096:* The number of superdiagonals of the matrix A if UPLO = 'U',097:* or the number of subdiagonals if UPLO = 'L'. KD >= 0.098:*099:* NRHS (input) INTEGER100:* The number of right-hand sides, i.e., the number of columns101:* of the matrices B and X. NRHS >= 0.102:*103:* AB (input/output) DOUBLE PRECISION array, dimension (LDAB,N)104:* On entry, the upper or lower triangle of the symmetric band105:* matrix A, stored in the first KD+1 rows of the array, except106:* if FACT = 'F' and EQUED = 'Y', then A must contain the107:* equilibrated matrix diag(S)*A*diag(S). The j-th column of A108:* is stored in the j-th column of the array AB as follows:109:* if UPLO = 'U', AB(KD+1+i-j,j) = A(i,j) for max(1,j-KD)<=i<=j;110:* if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(N,j+KD).111:* See below for further details.112:*113:* On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by114:* diag(S)*A*diag(S).115:*116:* LDAB (input) INTEGER117:* The leading dimension of the array A. LDAB >= KD+1.118:*119:* AFB (input or output) DOUBLE PRECISION array, dimension (LDAFB,N)120:* If FACT = 'F', then AFB is an input argument and on entry121:* contains the triangular factor U or L from the Cholesky122:* factorization A = U**T*U or A = L*L**T of the band matrix123:* A, in the same storage format as A (see AB). If EQUED = 'Y',124:* then AFB is the factored form of the equilibrated matrix A.125:*126:* If FACT = 'N', then AFB is an output argument and on exit127:* returns the triangular factor U or L from the Cholesky128:* factorization A = U**T*U or A = L*L**T.129:*130:* If FACT = 'E', then AFB is an output argument and on exit131:* returns the triangular factor U or L from the Cholesky132:* factorization A = U**T*U or A = L*L**T of the equilibrated133:* matrix A (see the description of A for the form of the134:* equilibrated matrix).135:*136:* LDAFB (input) INTEGER137:* The leading dimension of the array AFB. LDAFB >= KD+1.138:*139:* EQUED (input or output) CHARACTER*1140:* Specifies the form of equilibration that was done.141:* = 'N': No equilibration (always true if FACT = 'N').142:* = 'Y': Equilibration was done, i.e., A has been replaced by143:* diag(S) * A * diag(S).144:* EQUED is an input argument if FACT = 'F'; otherwise, it is an145:* output argument.146:*147:* S (input or output) DOUBLE PRECISION array, dimension (N)148:* The scale factors for A; not accessed if EQUED = 'N'. S is149:* an input argument if FACT = 'F'; otherwise, S is an output150:* argument. If FACT = 'F' and EQUED = 'Y', each element of S151:* must be positive.152:*153:* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)154:* On entry, the N-by-NRHS right hand side matrix B.155:* On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',156:* B is overwritten by diag(S) * B.157:*158:* LDB (input) INTEGER159:* The leading dimension of the array B. LDB >= max(1,N).160:*161:* X (output) DOUBLE PRECISION array, dimension (LDX,NRHS)162:* If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to163:* the original system of equations. Note that if EQUED = 'Y',164:* A and B are modified on exit, and the solution to the165:* equilibrated system is inv(diag(S))*X.166:*167:* LDX (input) INTEGER168:* The leading dimension of the array X. LDX >= max(1,N).169:*170:* RCOND (output) DOUBLE PRECISION171:* The estimate of the reciprocal condition number of the matrix172:* A after equilibration (if done). If RCOND is less than the173:* machine precision (in particular, if RCOND = 0), the matrix174:* is singular to working precision. This condition is175:* indicated by a return code of INFO > 0.176:*177:* FERR (output) DOUBLE PRECISION array, dimension (NRHS)178:* The estimated forward error bound for each solution vector179:* X(j) (the j-th column of the solution matrix X).180:* If XTRUE is the true solution corresponding to X(j), FERR(j)181:* is an estimated upper bound for the magnitude of the largest182:* element in (X(j) - XTRUE) divided by the magnitude of the183:* largest element in X(j). The estimate is as reliable as184:* the estimate for RCOND, and is almost always a slight185:* overestimate of the true error.186:*187:* BERR (output) DOUBLE PRECISION array, dimension (NRHS)188:* The componentwise relative backward error of each solution189:* vector X(j) (i.e., the smallest relative change in190:* any element of A or B that makes X(j) an exact solution).191:*192:* WORK (workspace) DOUBLE PRECISION array, dimension (3*N)193:*194:* IWORK (workspace) INTEGER array, dimension (N)195:*196:* INFO (output) INTEGER197:* = 0: successful exit198:* < 0: if INFO = -i, the i-th argument had an illegal value199:* > 0: if INFO = i, and i is200:* <= N: the leading minor of order i of A is201:* not positive definite, so the factorization202:* could not be completed, and the solution has not203:* been computed. RCOND = 0 is returned.204:* = N+1: U is nonsingular, but RCOND is less than machine205:* precision, meaning that the matrix is singular206:* to working precision. Nevertheless, the207:* solution and error bounds are computed because208:* there are a number of situations where the209:* computed solution can be more accurate than the210:* value of RCOND would suggest.211:*212:* Further Details213:* ===============214:*215:* The band storage scheme is illustrated by the following example, when216:* N = 6, KD = 2, and UPLO = 'U':217:*218:* Two-dimensional storage of the symmetric matrix A:219:*220:* a11 a12 a13221:* a22 a23 a24222:* a33 a34 a35223:* a44 a45 a46224:* a55 a56225:* (aij=conjg(aji)) a66226:*227:* Band storage of the upper triangle of A:228:*229:* * * a13 a24 a35 a46230:* * a12 a23 a34 a45 a56231:* a11 a22 a33 a44 a55 a66232:*233:* Similarly, if UPLO = 'L' the format of A is as follows:234:*235:* a11 a22 a33 a44 a55 a66236:* a21 a32 a43 a54 a65 *237:* a31 a42 a53 a64 * *238:*239:* Array elements marked * are not used by the routine.240:*241:* =====================================================================242:*243:* .. Parameters ..244: DOUBLE PRECISION ZERO, ONE 245:PARAMETER( ZERO = 0.0D+0, ONE = 1.0D+0 ) 246:* ..247:* .. Local Scalars ..248:LOGICALEQUIL, NOFACT, RCEQU, UPPER 249: INTEGER I, INFEQU, J, J1, J2 250: DOUBLE PRECISION AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM 251:* ..252:* .. External Functions ..253:LOGICALLSAME 254: DOUBLE PRECISION DLAMCH, DLANSB 255:EXTERNALLSAME, DLAMCH, DLANSB 256:* ..257:* .. External Subroutines ..258:EXTERNALDCOPY, DLACPY, DLAQSB, DPBCON, DPBEQU, DPBRFS, 259: $ DPBTRF, DPBTRS, XERBLA 260:* ..261:* .. Intrinsic Functions ..262:INTRINSICMAX, MIN 263:* ..264:* .. Executable Statements ..265:*266: INFO = 0 267: NOFACT =LSAME( FACT, 'N' ) 268: EQUIL =LSAME( FACT, 'E' ) 269: UPPER =LSAME( UPLO, 'U' ) 270:IF( NOFACT .OR. EQUIL )THEN271: EQUED = 'N' 272: RCEQU = .FALSE. 273:ELSE274: RCEQU =LSAME( EQUED, 'Y' ) 275: SMLNUM =DLAMCH( 'Safe minimum' ) 276: BIGNUM = ONE / SMLNUM 277:ENDIF278:*279:* Test the input parameters.280:*281:IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) 282: $THEN283: INFO = -1 284:ELSEIF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) )THEN285: INFO = -2 286:ELSEIF( N.LT.0 )THEN287: INFO = -3 288:ELSEIF( KD.LT.0 )THEN289: INFO = -4 290:ELSEIF( NRHS.LT.0 )THEN291: INFO = -5 292:ELSEIF( LDAB.LT.KD+1 )THEN293: INFO = -7 294:ELSEIF( LDAFB.LT.KD+1 )THEN295: INFO = -9 296:ELSEIF(LSAME( FACT, 'F' ) .AND. .NOT. 297: $ ( RCEQU .OR.LSAME( EQUED, 'N' ) ) )THEN298: INFO = -10 299:ELSE300:IF( RCEQU )THEN301: SMIN = BIGNUM 302: SMAX = ZERO 303:DO10 J = 1, N 304: SMIN =MIN( SMIN,S( J ) ) 305: SMAX =MAX( SMAX,S( J ) ) 306: 10CONTINUE307:IF( SMIN.LE.ZERO )THEN308: INFO = -11 309:ELSEIF( N.GT.0 )THEN310: SCOND =MAX( SMIN, SMLNUM ) /MIN( SMAX, BIGNUM ) 311:ELSE312: SCOND = ONE 313:ENDIF314:ENDIF315:IF( INFO.EQ.0 )THEN316:IF( LDB.LT.MAX( 1, N ) )THEN317: INFO = -13 318:ELSEIF( LDX.LT.MAX( 1, N ) )THEN319: INFO = -15 320:ENDIF321:ENDIF322:ENDIF323:*324:IF( INFO.NE.0 )THEN325:CALLXERBLA( 'DPBSVX', -INFO ) 326:RETURN327:ENDIF328:*329:IF( EQUIL )THEN330:*331:* Compute row and column scalings to equilibrate the matrix A.332:*333:CALLDPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFEQU ) 334:IF( INFEQU.EQ.0 )THEN335:*336:* Equilibrate the matrix.337:*338:CALLDLAQSB( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED ) 339: RCEQU =LSAME( EQUED, 'Y' ) 340:ENDIF341:ENDIF342:*343:* Scale the right-hand side.344:*345:IF( RCEQU )THEN346:DO30 J = 1, NRHS 347:DO20 I = 1, N 348:B( I, J ) =S( I )*B( I, J ) 349: 20CONTINUE350: 30CONTINUE351:ENDIF352:*353:IF( NOFACT .OR. EQUIL )THEN354:*355:* Compute the Cholesky factorization A = U'*U or A = L*L'.356:*357:IF( UPPER )THEN358:DO40 J = 1, N 359: J1 =MAX( J-KD, 1 ) 360:CALLDCOPY( J-J1+1,AB( KD+1-J+J1, J ), 1, 361: $AFB( KD+1-J+J1, J ), 1 ) 362: 40CONTINUE363:ELSE364:DO50 J = 1, N 365: J2 =MIN( J+KD, N ) 366:CALLDCOPY( J2-J+1,AB( 1, J ), 1,AFB( 1, J ), 1 ) 367: 50CONTINUE368:ENDIF369:*370:CALLDPBTRF( UPLO, N, KD, AFB, LDAFB, INFO ) 371:*372:* Return if INFO is non-zero.373:*374:IF( INFO.GT.0 )THEN375: RCOND = ZERO 376:RETURN377:ENDIF378:ENDIF379:*380:* Compute the norm of the matrix A.381:*382: ANORM =DLANSB( '1', UPLO, N, KD, AB, LDAB, WORK ) 383:*384:* Compute the reciprocal of the condition number of A.385:*386:CALLDPBCON( UPLO, N, KD, AFB, LDAFB, ANORM, RCOND, WORK, IWORK, 387: $ INFO ) 388:*389:* Compute the solution matrix X.390:*391:CALLDLACPY( 'Full', N, NRHS, B, LDB, X, LDX ) 392:CALLDPBTRS( UPLO, N, KD, NRHS, AFB, LDAFB, X, LDX, INFO ) 393:*394:* Use iterative refinement to improve the computed solution and395:* compute error bounds and backward error estimates for it.396:*397:CALLDPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X, 398: $ LDX, FERR, BERR, WORK, IWORK, INFO ) 399:*400:* Transform the solution matrix X to a solution of the original401:* system.402:*403:IF( RCEQU )THEN404:DO70 J = 1, NRHS 405:DO60 I = 1, N 406:X( I, J ) =S( I )*X( I, J ) 407: 60CONTINUE408: 70CONTINUE409:DO80 J = 1, NRHS 410:FERR( J ) =FERR( J ) / SCOND 411: 80CONTINUE412:ENDIF413:*414:* Set INFO = N+1 if the matrix is singular to working precision.415:*416:IF( RCOND.LT.DLAMCH( 'Epsilon' ) ) 417: $ INFO = N + 1 418:*419:RETURN420:*421:* End of DPBSVX422:*423:END424: