001:SUBROUTINESPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, 002: $ S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, 003: $ 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, LDA, LDAF, LDB, LDX, N, NRHS 013: REAL RCOND 014:* ..015:* .. Array Arguments ..016: INTEGERIWORK( * ) 017: REALA( LDA, * ),AF( LDAF, * ),B( LDB, * ), 018: $BERR( * ),FERR( * ),S( * ),WORK( * ), 019: $X( LDX, * ) 020:* ..021:*022:* Purpose023:* =======024:*025:* SPOSVX 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 matrix and X and B029:* 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 matrix and L is a lower triangular051:* 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, AF contains the factored form of A.080:* If EQUED = 'Y', the matrix A has been equilibrated081:* with scaling factors given by S. A and AF will not082:* be modified.083:* = 'N': The matrix A will be copied to AF and factored.084:* = 'E': The matrix A will be equilibrated if necessary, then085:* copied to AF 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:* NRHS (input) INTEGER096:* The number of right hand sides, i.e., the number of columns097:* of the matrices B and X. NRHS >= 0.098:*099:* A (input/output) REAL array, dimension (LDA,N)100:* On entry, the symmetric matrix A, except if FACT = 'F' and101:* EQUED = 'Y', then A must contain the equilibrated matrix102:* diag(S)*A*diag(S). If UPLO = 'U', the leading103:* N-by-N upper triangular part of A contains the upper104:* triangular part of the matrix A, and the strictly lower105:* triangular part of A is not referenced. If UPLO = 'L', the106:* leading N-by-N lower triangular part of A contains the lower107:* triangular part of the matrix A, and the strictly upper108:* triangular part of A is not referenced. A is not modified if109:* FACT = 'F' or 'N', or if FACT = 'E' and EQUED = 'N' on exit.110:*111:* On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by112:* diag(S)*A*diag(S).113:*114:* LDA (input) INTEGER115:* The leading dimension of the array A. LDA >= max(1,N).116:*117:* AF (input or output) REAL array, dimension (LDAF,N)118:* If FACT = 'F', then AF is an input argument and on entry119:* contains the triangular factor U or L from the Cholesky120:* factorization A = U**T*U or A = L*L**T, in the same storage121:* format as A. If EQUED .ne. 'N', then AF is the factored form122:* of the equilibrated matrix diag(S)*A*diag(S).123:*124:* If FACT = 'N', then AF is an output argument and on exit125:* returns the triangular factor U or L from the Cholesky126:* factorization A = U**T*U or A = L*L**T of the original127:* matrix A.128:*129:* If FACT = 'E', then AF is an output argument and on exit130:* returns the triangular factor U or L from the Cholesky131:* factorization A = U**T*U or A = L*L**T of the equilibrated132:* matrix A (see the description of A for the form of the133:* equilibrated matrix).134:*135:* LDAF (input) INTEGER136:* The leading dimension of the array AF. LDAF >= max(1,N).137:*138:* EQUED (input or output) CHARACTER*1139:* Specifies the form of equilibration that was done.140:* = 'N': No equilibration (always true if FACT = 'N').141:* = 'Y': Equilibration was done, i.e., A has been replaced by142:* diag(S) * A * diag(S).143:* EQUED is an input argument if FACT = 'F'; otherwise, it is an144:* output argument.145:*146:* S (input or output) REAL array, dimension (N)147:* The scale factors for A; not accessed if EQUED = 'N'. S is148:* an input argument if FACT = 'F'; otherwise, S is an output149:* argument. If FACT = 'F' and EQUED = 'Y', each element of S150:* must be positive.151:*152:* B (input/output) REAL array, dimension (LDB,NRHS)153:* On entry, the N-by-NRHS right hand side matrix B.154:* On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',155:* B is overwritten by diag(S) * B.156:*157:* LDB (input) INTEGER158:* The leading dimension of the array B. LDB >= max(1,N).159:*160:* X (output) REAL array, dimension (LDX,NRHS)161:* If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to162:* the original system of equations. Note that if EQUED = 'Y',163:* A and B are modified on exit, and the solution to the164:* equilibrated system is inv(diag(S))*X.165:*166:* LDX (input) INTEGER167:* The leading dimension of the array X. LDX >= max(1,N).168:*169:* RCOND (output) REAL170:* The estimate of the reciprocal condition number of the matrix171:* A after equilibration (if done). If RCOND is less than the172:* machine precision (in particular, if RCOND = 0), the matrix173:* is singular to working precision. This condition is174:* indicated by a return code of INFO > 0.175:*176:* FERR (output) REAL array, dimension (NRHS)177:* The estimated forward error bound for each solution vector178:* X(j) (the j-th column of the solution matrix X).179:* If XTRUE is the true solution corresponding to X(j), FERR(j)180:* is an estimated upper bound for the magnitude of the largest181:* element in (X(j) - XTRUE) divided by the magnitude of the182:* largest element in X(j). The estimate is as reliable as183:* the estimate for RCOND, and is almost always a slight184:* overestimate of the true error.185:*186:* BERR (output) REAL array, dimension (NRHS)187:* The componentwise relative backward error of each solution188:* vector X(j) (i.e., the smallest relative change in189:* any element of A or B that makes X(j) an exact solution).190:*191:* WORK (workspace) REAL array, dimension (3*N)192:*193:* IWORK (workspace) INTEGER array, dimension (N)194:*195:* INFO (output) INTEGER196:* = 0: successful exit197:* < 0: if INFO = -i, the i-th argument had an illegal value198:* > 0: if INFO = i, and i is199:* <= N: the leading minor of order i of A is200:* not positive definite, so the factorization201:* could not be completed, and the solution has not202:* been computed. RCOND = 0 is returned.203:* = N+1: U is nonsingular, but RCOND is less than machine204:* precision, meaning that the matrix is singular205:* to working precision. Nevertheless, the206:* solution and error bounds are computed because207:* there are a number of situations where the208:* computed solution can be more accurate than the209:* value of RCOND would suggest.210:*211:* =====================================================================212:*213:* .. Parameters ..214: REAL ZERO, ONE 215:PARAMETER( ZERO = 0.0E+0, ONE = 1.0E+0 ) 216:* ..217:* .. Local Scalars ..218:LOGICALEQUIL, NOFACT, RCEQU 219: INTEGER I, INFEQU, J 220: REAL AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM 221:* ..222:* .. External Functions ..223:LOGICALLSAME 224: REAL SLAMCH, SLANSY 225:EXTERNALLSAME, SLAMCH, SLANSY 226:* ..227:* .. External Subroutines ..228:EXTERNALSLACPY, SLAQSY, SPOCON, SPOEQU, SPORFS, SPOTRF, 229: $ SPOTRS, XERBLA 230:* ..231:* .. Intrinsic Functions ..232:INTRINSICMAX, MIN 233:* ..234:* .. Executable Statements ..235:*236: INFO = 0 237: NOFACT =LSAME( FACT, 'N' ) 238: EQUIL =LSAME( FACT, 'E' ) 239:IF( NOFACT .OR. EQUIL )THEN240: EQUED = 'N' 241: RCEQU = .FALSE. 242:ELSE243: RCEQU =LSAME( EQUED, 'Y' ) 244: SMLNUM =SLAMCH( 'Safe minimum' ) 245: BIGNUM = ONE / SMLNUM 246:ENDIF247:*248:* Test the input parameters.249:*250:IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) 251: $THEN252: INFO = -1 253:ELSEIF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) 254: $THEN255: INFO = -2 256:ELSEIF( N.LT.0 )THEN257: INFO = -3 258:ELSEIF( NRHS.LT.0 )THEN259: INFO = -4 260:ELSEIF( LDA.LT.MAX( 1, N ) )THEN261: INFO = -6 262:ELSEIF( LDAF.LT.MAX( 1, N ) )THEN263: INFO = -8 264:ELSEIF(LSAME( FACT, 'F' ) .AND. .NOT. 265: $ ( RCEQU .OR.LSAME( EQUED, 'N' ) ) )THEN266: INFO = -9 267:ELSE268:IF( RCEQU )THEN269: SMIN = BIGNUM 270: SMAX = ZERO 271:DO10 J = 1, N 272: SMIN =MIN( SMIN,S( J ) ) 273: SMAX =MAX( SMAX,S( J ) ) 274: 10CONTINUE275:IF( SMIN.LE.ZERO )THEN276: INFO = -10 277:ELSEIF( N.GT.0 )THEN278: SCOND =MAX( SMIN, SMLNUM ) /MIN( SMAX, BIGNUM ) 279:ELSE280: SCOND = ONE 281:ENDIF282:ENDIF283:IF( INFO.EQ.0 )THEN284:IF( LDB.LT.MAX( 1, N ) )THEN285: INFO = -12 286:ELSEIF( LDX.LT.MAX( 1, N ) )THEN287: INFO = -14 288:ENDIF289:ENDIF290:ENDIF291:*292:IF( INFO.NE.0 )THEN293:CALLXERBLA( 'SPOSVX', -INFO ) 294:RETURN295:ENDIF296:*297:IF( EQUIL )THEN298:*299:* Compute row and column scalings to equilibrate the matrix A.300:*301:CALLSPOEQU( N, A, LDA, S, SCOND, AMAX, INFEQU ) 302:IF( INFEQU.EQ.0 )THEN303:*304:* Equilibrate the matrix.305:*306:CALLSLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED ) 307: RCEQU =LSAME( EQUED, 'Y' ) 308:ENDIF309:ENDIF310:*311:* Scale the right hand side.312:*313:IF( RCEQU )THEN314:DO30 J = 1, NRHS 315:DO20 I = 1, N 316:B( I, J ) =S( I )*B( I, J ) 317: 20CONTINUE318: 30CONTINUE319:ENDIF320:*321:IF( NOFACT .OR. EQUIL )THEN322:*323:* Compute the Cholesky factorization A = U'*U or A = L*L'.324:*325:CALLSLACPY( UPLO, N, N, A, LDA, AF, LDAF ) 326:CALLSPOTRF( UPLO, N, AF, LDAF, INFO ) 327:*328:* Return if INFO is non-zero.329:*330:IF( INFO.GT.0 )THEN331: RCOND = ZERO 332:RETURN333:ENDIF334:ENDIF335:*336:* Compute the norm of the matrix A.337:*338: ANORM =SLANSY( '1', UPLO, N, A, LDA, WORK ) 339:*340:* Compute the reciprocal of the condition number of A.341:*342:CALLSPOCON( UPLO, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, INFO ) 343:*344:* Compute the solution matrix X.345:*346:CALLSLACPY( 'Full', N, NRHS, B, LDB, X, LDX ) 347:CALLSPOTRS( UPLO, N, NRHS, AF, LDAF, X, LDX, INFO ) 348:*349:* Use iterative refinement to improve the computed solution and350:* compute error bounds and backward error estimates for it.351:*352:CALLSPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, 353: $ FERR, BERR, WORK, IWORK, INFO ) 354:*355:* Transform the solution matrix X to a solution of the original356:* system.357:*358:IF( RCEQU )THEN359:DO50 J = 1, NRHS 360:DO40 I = 1, N 361:X( I, J ) =S( I )*X( I, J ) 362: 40CONTINUE363: 50CONTINUE364:DO60 J = 1, NRHS 365:FERR( J ) =FERR( J ) / SCOND 366: 60CONTINUE367:ENDIF368:*369:* Set INFO = N+1 if the matrix is singular to working precision.370:*371:IF( RCOND.LT.SLAMCH( 'Epsilon' ) ) 372: $ INFO = N + 1 373:*374:RETURN375:*376:* End of SPOSVX377:*378:END379: