 LAPACK 3.3.1 Linear Algebra PACKage

# cposvx.f

Go to the documentation of this file.
```00001       SUBROUTINE CPOSVX( FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED,
00002      \$                   S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK,
00003      \$                   RWORK, INFO )
00004 *
00005 *  -- LAPACK driver routine (version 3.3.1) --
00006 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00007 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00008 *  -- April 2011                                                      --
00009 *
00010 *     .. Scalar Arguments ..
00011       CHARACTER          EQUED, FACT, UPLO
00012       INTEGER            INFO, LDA, LDAF, LDB, LDX, N, NRHS
00013       REAL               RCOND
00014 *     ..
00015 *     .. Array Arguments ..
00016       REAL               BERR( * ), FERR( * ), RWORK( * ), S( * )
00017       COMPLEX            A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
00018      \$                   WORK( * ), X( LDX, * )
00019 *     ..
00020 *
00021 *  Purpose
00022 *  =======
00023 *
00024 *  CPOSVX uses the Cholesky factorization A = U**H*U or A = L*L**H to
00025 *  compute the solution to a complex system of linear equations
00026 *     A * X = B,
00027 *  where A is an N-by-N Hermitian positive definite matrix and X and B
00028 *  are N-by-NRHS matrices.
00029 *
00030 *  Error bounds on the solution and a condition estimate are also
00031 *  provided.
00032 *
00033 *  Description
00034 *  ===========
00035 *
00036 *  The following steps are performed:
00037 *
00038 *  1. If FACT = 'E', real scaling factors are computed to equilibrate
00039 *     the system:
00040 *        diag(S) * A * diag(S) * inv(diag(S)) * X = diag(S) * B
00041 *     Whether or not the system will be equilibrated depends on the
00042 *     scaling of the matrix A, but if equilibration is used, A is
00043 *     overwritten by diag(S)*A*diag(S) and B by diag(S)*B.
00044 *
00045 *  2. If FACT = 'N' or 'E', the Cholesky decomposition is used to
00046 *     factor the matrix A (after equilibration if FACT = 'E') as
00047 *        A = U**H* U,  if UPLO = 'U', or
00048 *        A = L * L**H,  if UPLO = 'L',
00049 *     where U is an upper triangular matrix and L is a lower triangular
00050 *     matrix.
00051 *
00052 *  3. If the leading i-by-i principal minor is not positive definite,
00053 *     then the routine returns with INFO = i. Otherwise, the factored
00054 *     form of A is used to estimate the condition number of the matrix
00055 *     A.  If the reciprocal of the condition number is less than machine
00056 *     precision, INFO = N+1 is returned as a warning, but the routine
00057 *     still goes on to solve for X and compute error bounds as
00058 *     described below.
00059 *
00060 *  4. The system of equations is solved for X using the factored form
00061 *     of A.
00062 *
00063 *  5. Iterative refinement is applied to improve the computed solution
00064 *     matrix and calculate error bounds and backward error estimates
00065 *     for it.
00066 *
00067 *  6. If equilibration was used, the matrix X is premultiplied by
00068 *     diag(S) so that it solves the original system before
00069 *     equilibration.
00070 *
00071 *  Arguments
00072 *  =========
00073 *
00074 *  FACT    (input) CHARACTER*1
00075 *          Specifies whether or not the factored form of the matrix A is
00076 *          supplied on entry, and if not, whether the matrix A should be
00077 *          equilibrated before it is factored.
00078 *          = 'F':  On entry, AF contains the factored form of A.
00079 *                  If EQUED = 'Y', the matrix A has been equilibrated
00080 *                  with scaling factors given by S.  A and AF will not
00081 *                  be modified.
00082 *          = 'N':  The matrix A will be copied to AF and factored.
00083 *          = 'E':  The matrix A will be equilibrated if necessary, then
00084 *                  copied to AF and factored.
00085 *
00086 *  UPLO    (input) CHARACTER*1
00087 *          = 'U':  Upper triangle of A is stored;
00088 *          = 'L':  Lower triangle of A is stored.
00089 *
00090 *  N       (input) INTEGER
00091 *          The number of linear equations, i.e., the order of the
00092 *          matrix A.  N >= 0.
00093 *
00094 *  NRHS    (input) INTEGER
00095 *          The number of right hand sides, i.e., the number of columns
00096 *          of the matrices B and X.  NRHS >= 0.
00097 *
00098 *  A       (input/output) COMPLEX array, dimension (LDA,N)
00099 *          On entry, the Hermitian matrix A, except if FACT = 'F' and
00100 *          EQUED = 'Y', then A must contain the equilibrated matrix
00101 *          diag(S)*A*diag(S).  If UPLO = 'U', the leading
00102 *          N-by-N upper triangular part of A contains the upper
00103 *          triangular part of the matrix A, and the strictly lower
00104 *          triangular part of A is not referenced.  If UPLO = 'L', the
00105 *          leading N-by-N lower triangular part of A contains the lower
00106 *          triangular part of the matrix A, and the strictly upper
00107 *          triangular part of A is not referenced.  A is not modified if
00108 *          FACT = 'F' or 'N', or if FACT = 'E' and EQUED = 'N' on exit.
00109 *
00110 *          On exit, if FACT = 'E' and EQUED = 'Y', A is overwritten by
00111 *          diag(S)*A*diag(S).
00112 *
00113 *  LDA     (input) INTEGER
00114 *          The leading dimension of the array A.  LDA >= max(1,N).
00115 *
00116 *  AF      (input or output) COMPLEX array, dimension (LDAF,N)
00117 *          If FACT = 'F', then AF is an input argument and on entry
00118 *          contains the triangular factor U or L from the Cholesky
00119 *          factorization A = U**H*U or A = L*L**H, in the same storage
00120 *          format as A.  If EQUED .ne. 'N', then AF is the factored form
00121 *          of the equilibrated matrix diag(S)*A*diag(S).
00122 *
00123 *          If FACT = 'N', then AF is an output argument and on exit
00124 *          returns the triangular factor U or L from the Cholesky
00125 *          factorization A = U**H*U or A = L*L**H of the original
00126 *          matrix A.
00127 *
00128 *          If FACT = 'E', then AF is an output argument and on exit
00129 *          returns the triangular factor U or L from the Cholesky
00130 *          factorization A = U**H*U or A = L*L**H of the equilibrated
00131 *          matrix A (see the description of A for the form of the
00132 *          equilibrated matrix).
00133 *
00134 *  LDAF    (input) INTEGER
00135 *          The leading dimension of the array AF.  LDAF >= max(1,N).
00136 *
00137 *  EQUED   (input or output) CHARACTER*1
00138 *          Specifies the form of equilibration that was done.
00139 *          = 'N':  No equilibration (always true if FACT = 'N').
00140 *          = 'Y':  Equilibration was done, i.e., A has been replaced by
00141 *                  diag(S) * A * diag(S).
00142 *          EQUED is an input argument if FACT = 'F'; otherwise, it is an
00143 *          output argument.
00144 *
00145 *  S       (input or output) REAL array, dimension (N)
00146 *          The scale factors for A; not accessed if EQUED = 'N'.  S is
00147 *          an input argument if FACT = 'F'; otherwise, S is an output
00148 *          argument.  If FACT = 'F' and EQUED = 'Y', each element of S
00149 *          must be positive.
00150 *
00151 *  B       (input/output) COMPLEX array, dimension (LDB,NRHS)
00152 *          On entry, the N-by-NRHS righthand side matrix B.
00153 *          On exit, if EQUED = 'N', B is not modified; if EQUED = 'Y',
00154 *          B is overwritten by diag(S) * B.
00155 *
00156 *  LDB     (input) INTEGER
00157 *          The leading dimension of the array B.  LDB >= max(1,N).
00158 *
00159 *  X       (output) COMPLEX array, dimension (LDX,NRHS)
00160 *          If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X to
00161 *          the original system of equations.  Note that if EQUED = 'Y',
00162 *          A and B are modified on exit, and the solution to the
00163 *          equilibrated system is inv(diag(S))*X.
00164 *
00165 *  LDX     (input) INTEGER
00166 *          The leading dimension of the array X.  LDX >= max(1,N).
00167 *
00168 *  RCOND   (output) REAL
00169 *          The estimate of the reciprocal condition number of the matrix
00170 *          A after equilibration (if done).  If RCOND is less than the
00171 *          machine precision (in particular, if RCOND = 0), the matrix
00172 *          is singular to working precision.  This condition is
00173 *          indicated by a return code of INFO > 0.
00174 *
00175 *  FERR    (output) REAL array, dimension (NRHS)
00176 *          The estimated forward error bound for each solution vector
00177 *          X(j) (the j-th column of the solution matrix X).
00178 *          If XTRUE is the true solution corresponding to X(j), FERR(j)
00179 *          is an estimated upper bound for the magnitude of the largest
00180 *          element in (X(j) - XTRUE) divided by the magnitude of the
00181 *          largest element in X(j).  The estimate is as reliable as
00182 *          the estimate for RCOND, and is almost always a slight
00183 *          overestimate of the true error.
00184 *
00185 *  BERR    (output) REAL array, dimension (NRHS)
00186 *          The componentwise relative backward error of each solution
00187 *          vector X(j) (i.e., the smallest relative change in
00188 *          any element of A or B that makes X(j) an exact solution).
00189 *
00190 *  WORK    (workspace) COMPLEX array, dimension (2*N)
00191 *
00192 *  RWORK   (workspace) REAL array, dimension (N)
00193 *
00194 *  INFO    (output) INTEGER
00195 *          = 0: successful exit
00196 *          < 0: if INFO = -i, the i-th argument had an illegal value
00197 *          > 0: if INFO = i, and i is
00198 *                <= N:  the leading minor of order i of A is
00199 *                       not positive definite, so the factorization
00200 *                       could not be completed, and the solution has not
00201 *                       been computed. RCOND = 0 is returned.
00202 *                = N+1: U is nonsingular, but RCOND is less than machine
00203 *                       precision, meaning that the matrix is singular
00204 *                       to working precision.  Nevertheless, the
00205 *                       solution and error bounds are computed because
00206 *                       there are a number of situations where the
00207 *                       computed solution can be more accurate than the
00208 *                       value of RCOND would suggest.
00209 *
00210 *  =====================================================================
00211 *
00212 *     .. Parameters ..
00213       REAL               ZERO, ONE
00214       PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
00215 *     ..
00216 *     .. Local Scalars ..
00217       LOGICAL            EQUIL, NOFACT, RCEQU
00218       INTEGER            I, INFEQU, J
00219       REAL               AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM
00220 *     ..
00221 *     .. External Functions ..
00222       LOGICAL            LSAME
00223       REAL               CLANHE, SLAMCH
00224       EXTERNAL           LSAME, CLANHE, SLAMCH
00225 *     ..
00226 *     .. External Subroutines ..
00227       EXTERNAL           CLACPY, CLAQHE, CPOCON, CPOEQU, CPORFS, CPOTRF,
00228      \$                   CPOTRS, XERBLA
00229 *     ..
00230 *     .. Intrinsic Functions ..
00231       INTRINSIC          MAX, MIN
00232 *     ..
00233 *     .. Executable Statements ..
00234 *
00235       INFO = 0
00236       NOFACT = LSAME( FACT, 'N' )
00237       EQUIL = LSAME( FACT, 'E' )
00238       IF( NOFACT .OR. EQUIL ) THEN
00239          EQUED = 'N'
00240          RCEQU = .FALSE.
00241       ELSE
00242          RCEQU = LSAME( EQUED, 'Y' )
00243          SMLNUM = SLAMCH( 'Safe minimum' )
00244          BIGNUM = ONE / SMLNUM
00245       END IF
00246 *
00247 *     Test the input parameters.
00248 *
00249       IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) )
00250      \$     THEN
00251          INFO = -1
00252       ELSE IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) )
00253      \$          THEN
00254          INFO = -2
00255       ELSE IF( N.LT.0 ) THEN
00256          INFO = -3
00257       ELSE IF( NRHS.LT.0 ) THEN
00258          INFO = -4
00259       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
00260          INFO = -6
00261       ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN
00262          INFO = -8
00263       ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT.
00264      \$         ( RCEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN
00265          INFO = -9
00266       ELSE
00267          IF( RCEQU ) THEN
00268             SMIN = BIGNUM
00269             SMAX = ZERO
00270             DO 10 J = 1, N
00271                SMIN = MIN( SMIN, S( J ) )
00272                SMAX = MAX( SMAX, S( J ) )
00273    10       CONTINUE
00274             IF( SMIN.LE.ZERO ) THEN
00275                INFO = -10
00276             ELSE IF( N.GT.0 ) THEN
00277                SCOND = MAX( SMIN, SMLNUM ) / MIN( SMAX, BIGNUM )
00278             ELSE
00279                SCOND = ONE
00280             END IF
00281          END IF
00282          IF( INFO.EQ.0 ) THEN
00283             IF( LDB.LT.MAX( 1, N ) ) THEN
00284                INFO = -12
00285             ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
00286                INFO = -14
00287             END IF
00288          END IF
00289       END IF
00290 *
00291       IF( INFO.NE.0 ) THEN
00292          CALL XERBLA( 'CPOSVX', -INFO )
00293          RETURN
00294       END IF
00295 *
00296       IF( EQUIL ) THEN
00297 *
00298 *        Compute row and column scalings to equilibrate the matrix A.
00299 *
00300          CALL CPOEQU( N, A, LDA, S, SCOND, AMAX, INFEQU )
00301          IF( INFEQU.EQ.0 ) THEN
00302 *
00303 *           Equilibrate the matrix.
00304 *
00305             CALL CLAQHE( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED )
00306             RCEQU = LSAME( EQUED, 'Y' )
00307          END IF
00308       END IF
00309 *
00310 *     Scale the right hand side.
00311 *
00312       IF( RCEQU ) THEN
00313          DO 30 J = 1, NRHS
00314             DO 20 I = 1, N
00315                B( I, J ) = S( I )*B( I, J )
00316    20       CONTINUE
00317    30    CONTINUE
00318       END IF
00319 *
00320       IF( NOFACT .OR. EQUIL ) THEN
00321 *
00322 *        Compute the Cholesky factorization A = U**H *U or A = L*L**H.
00323 *
00324          CALL CLACPY( UPLO, N, N, A, LDA, AF, LDAF )
00325          CALL CPOTRF( UPLO, N, AF, LDAF, INFO )
00326 *
00327 *        Return if INFO is non-zero.
00328 *
00329          IF( INFO.GT.0 )THEN
00330             RCOND = ZERO
00331             RETURN
00332          END IF
00333       END IF
00334 *
00335 *     Compute the norm of the matrix A.
00336 *
00337       ANORM = CLANHE( '1', UPLO, N, A, LDA, RWORK )
00338 *
00339 *     Compute the reciprocal of the condition number of A.
00340 *
00341       CALL CPOCON( UPLO, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, INFO )
00342 *
00343 *     Compute the solution matrix X.
00344 *
00345       CALL CLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
00346       CALL CPOTRS( UPLO, N, NRHS, AF, LDAF, X, LDX, INFO )
00347 *
00348 *     Use iterative refinement to improve the computed solution and
00349 *     compute error bounds and backward error estimates for it.
00350 *
00351       CALL CPORFS( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX,
00352      \$             FERR, BERR, WORK, RWORK, INFO )
00353 *
00354 *     Transform the solution matrix X to a solution of the original
00355 *     system.
00356 *
00357       IF( RCEQU ) THEN
00358          DO 50 J = 1, NRHS
00359             DO 40 I = 1, N
00360                X( I, J ) = S( I )*X( I, J )
00361    40       CONTINUE
00362    50    CONTINUE
00363          DO 60 J = 1, NRHS
00364             FERR( J ) = FERR( J ) / SCOND
00365    60    CONTINUE
00366       END IF
00367 *
00368 *     Set INFO = N+1 if the matrix is singular to working precision.
00369 *
00370       IF( RCOND.LT.SLAMCH( 'Epsilon' ) )
00371      \$   INFO = N + 1
00372 *
00373       RETURN
00374 *
00375 *     End of CPOSVX
00376 *
00377       END
```