LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cgbrfsx.f
Go to the documentation of this file.
00001 *> \brief \b CGBRFSX
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download CGBRFSX + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgbrfsx.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgbrfsx.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgbrfsx.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE CGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB,
00022 *                           LDAFB, IPIV, R, C, B, LDB, X, LDX, RCOND,
00023 *                           BERR, N_ERR_BNDS, ERR_BNDS_NORM,
00024 *                           ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK,
00025 *                           INFO )
00026 * 
00027 *       .. Scalar Arguments ..
00028 *       CHARACTER          TRANS, EQUED
00029 *       INTEGER            INFO, LDAB, LDAFB, LDB, LDX, N, KL, KU, NRHS,
00030 *      $                   NPARAMS, N_ERR_BNDS
00031 *       REAL               RCOND
00032 *       ..
00033 *       .. Array Arguments ..
00034 *       INTEGER            IPIV( * )
00035 *       COMPLEX            AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
00036 *      $                   X( LDX , * ),WORK( * )
00037 *       REAL               R( * ), C( * ), PARAMS( * ), BERR( * ),
00038 *      $                   ERR_BNDS_NORM( NRHS, * ),
00039 *      $                   ERR_BNDS_COMP( NRHS, * ), RWORK( * )
00040 *       ..
00041 *  
00042 *
00043 *> \par Purpose:
00044 *  =============
00045 *>
00046 *> \verbatim
00047 *>
00048 *>    CGBRFSX improves the computed solution to a system of linear
00049 *>    equations and provides error bounds and backward error estimates
00050 *>    for the solution.  In addition to normwise error bound, the code
00051 *>    provides maximum componentwise error bound if possible.  See
00052 *>    comments for ERR_BNDS_NORM and ERR_BNDS_COMP for details of the
00053 *>    error bounds.
00054 *>
00055 *>    The original system of linear equations may have been equilibrated
00056 *>    before calling this routine, as described by arguments EQUED, R
00057 *>    and C below. In this case, the solution and error bounds returned
00058 *>    are for the original unequilibrated system.
00059 *> \endverbatim
00060 *
00061 *  Arguments:
00062 *  ==========
00063 *
00064 *> \verbatim
00065 *>     Some optional parameters are bundled in the PARAMS array.  These
00066 *>     settings determine how refinement is performed, but often the
00067 *>     defaults are acceptable.  If the defaults are acceptable, users
00068 *>     can pass NPARAMS = 0 which prevents the source code from accessing
00069 *>     the PARAMS argument.
00070 *> \endverbatim
00071 *>
00072 *> \param[in] TRANS
00073 *> \verbatim
00074 *>          TRANS is CHARACTER*1
00075 *>     Specifies the form of the system of equations:
00076 *>       = 'N':  A * X = B     (No transpose)
00077 *>       = 'T':  A**T * X = B  (Transpose)
00078 *>       = 'C':  A**H * X = B  (Conjugate transpose = Transpose)
00079 *> \endverbatim
00080 *>
00081 *> \param[in] EQUED
00082 *> \verbatim
00083 *>          EQUED is CHARACTER*1
00084 *>     Specifies the form of equilibration that was done to A
00085 *>     before calling this routine. This is needed to compute
00086 *>     the solution and error bounds correctly.
00087 *>       = 'N':  No equilibration
00088 *>       = 'R':  Row equilibration, i.e., A has been premultiplied by
00089 *>               diag(R).
00090 *>       = 'C':  Column equilibration, i.e., A has been postmultiplied
00091 *>               by diag(C).
00092 *>       = 'B':  Both row and column equilibration, i.e., A has been
00093 *>               replaced by diag(R) * A * diag(C).
00094 *>               The right hand side B has been changed accordingly.
00095 *> \endverbatim
00096 *>
00097 *> \param[in] N
00098 *> \verbatim
00099 *>          N is INTEGER
00100 *>     The order of the matrix A.  N >= 0.
00101 *> \endverbatim
00102 *>
00103 *> \param[in] KL
00104 *> \verbatim
00105 *>          KL is INTEGER
00106 *>     The number of subdiagonals within the band of A.  KL >= 0.
00107 *> \endverbatim
00108 *>
00109 *> \param[in] KU
00110 *> \verbatim
00111 *>          KU is INTEGER
00112 *>     The number of superdiagonals within the band of A.  KU >= 0.
00113 *> \endverbatim
00114 *>
00115 *> \param[in] NRHS
00116 *> \verbatim
00117 *>          NRHS is INTEGER
00118 *>     The number of right hand sides, i.e., the number of columns
00119 *>     of the matrices B and X.  NRHS >= 0.
00120 *> \endverbatim
00121 *>
00122 *> \param[in] AB
00123 *> \verbatim
00124 *>          AB is DOUBLE PRECISION array, dimension (LDAB,N)
00125 *>     The original band matrix A, stored in rows 1 to KL+KU+1.
00126 *>     The j-th column of A is stored in the j-th column of the
00127 *>     array AB as follows:
00128 *>     AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(n,j+kl).
00129 *> \endverbatim
00130 *>
00131 *> \param[in] LDAB
00132 *> \verbatim
00133 *>          LDAB is INTEGER
00134 *>     The leading dimension of the array AB.  LDAB >= KL+KU+1.
00135 *> \endverbatim
00136 *>
00137 *> \param[in] AFB
00138 *> \verbatim
00139 *>          AFB is DOUBLE PRECISION array, dimension (LDAFB,N)
00140 *>     Details of the LU factorization of the band matrix A, as
00141 *>     computed by DGBTRF.  U is stored as an upper triangular band
00142 *>     matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
00143 *>     the multipliers used during the factorization are stored in
00144 *>     rows KL+KU+2 to 2*KL+KU+1.
00145 *> \endverbatim
00146 *>
00147 *> \param[in] LDAFB
00148 *> \verbatim
00149 *>          LDAFB is INTEGER
00150 *>     The leading dimension of the array AFB.  LDAFB >= 2*KL*KU+1.
00151 *> \endverbatim
00152 *>
00153 *> \param[in] IPIV
00154 *> \verbatim
00155 *>          IPIV is INTEGER array, dimension (N)
00156 *>     The pivot indices from SGETRF; for 1<=i<=N, row i of the
00157 *>     matrix was interchanged with row IPIV(i).
00158 *> \endverbatim
00159 *>
00160 *> \param[in,out] R
00161 *> \verbatim
00162 *>          R is REAL array, dimension (N)
00163 *>     The row scale factors for A.  If EQUED = 'R' or 'B', A is
00164 *>     multiplied on the left by diag(R); if EQUED = 'N' or 'C', R
00165 *>     is not accessed.  R is an input argument if FACT = 'F';
00166 *>     otherwise, R is an output argument.  If FACT = 'F' and
00167 *>     EQUED = 'R' or 'B', each element of R must be positive.
00168 *>     If R is output, each element of R is a power of the radix.
00169 *>     If R is input, each element of R should be a power of the radix
00170 *>     to ensure a reliable solution and error estimates. Scaling by
00171 *>     powers of the radix does not cause rounding errors unless the
00172 *>     result underflows or overflows. Rounding errors during scaling
00173 *>     lead to refining with a matrix that is not equivalent to the
00174 *>     input matrix, producing error estimates that may not be
00175 *>     reliable.
00176 *> \endverbatim
00177 *>
00178 *> \param[in,out] C
00179 *> \verbatim
00180 *>          C is REAL array, dimension (N)
00181 *>     The column scale factors for A.  If EQUED = 'C' or 'B', A is
00182 *>     multiplied on the right by diag(C); if EQUED = 'N' or 'R', C
00183 *>     is not accessed.  C is an input argument if FACT = 'F';
00184 *>     otherwise, C is an output argument.  If FACT = 'F' and
00185 *>     EQUED = 'C' or 'B', each element of C must be positive.
00186 *>     If C is output, each element of C is a power of the radix.
00187 *>     If C is input, each element of C should be a power of the radix
00188 *>     to ensure a reliable solution and error estimates. Scaling by
00189 *>     powers of the radix does not cause rounding errors unless the
00190 *>     result underflows or overflows. Rounding errors during scaling
00191 *>     lead to refining with a matrix that is not equivalent to the
00192 *>     input matrix, producing error estimates that may not be
00193 *>     reliable.
00194 *> \endverbatim
00195 *>
00196 *> \param[in] B
00197 *> \verbatim
00198 *>          B is REAL array, dimension (LDB,NRHS)
00199 *>     The right hand side matrix B.
00200 *> \endverbatim
00201 *>
00202 *> \param[in] LDB
00203 *> \verbatim
00204 *>          LDB is INTEGER
00205 *>     The leading dimension of the array B.  LDB >= max(1,N).
00206 *> \endverbatim
00207 *>
00208 *> \param[in,out] X
00209 *> \verbatim
00210 *>          X is REAL array, dimension (LDX,NRHS)
00211 *>     On entry, the solution matrix X, as computed by SGETRS.
00212 *>     On exit, the improved solution matrix X.
00213 *> \endverbatim
00214 *>
00215 *> \param[in] LDX
00216 *> \verbatim
00217 *>          LDX is INTEGER
00218 *>     The leading dimension of the array X.  LDX >= max(1,N).
00219 *> \endverbatim
00220 *>
00221 *> \param[out] RCOND
00222 *> \verbatim
00223 *>          RCOND is REAL
00224 *>     Reciprocal scaled condition number.  This is an estimate of the
00225 *>     reciprocal Skeel condition number of the matrix A after
00226 *>     equilibration (if done).  If this is less than the machine
00227 *>     precision (in particular, if it is zero), the matrix is singular
00228 *>     to working precision.  Note that the error may still be small even
00229 *>     if this number is very small and the matrix appears ill-
00230 *>     conditioned.
00231 *> \endverbatim
00232 *>
00233 *> \param[out] BERR
00234 *> \verbatim
00235 *>          BERR is REAL array, dimension (NRHS)
00236 *>     Componentwise relative backward error.  This is the
00237 *>     componentwise relative backward error of each solution vector X(j)
00238 *>     (i.e., the smallest relative change in any element of A or B that
00239 *>     makes X(j) an exact solution).
00240 *> \endverbatim
00241 *>
00242 *> \param[in] N_ERR_BNDS
00243 *> \verbatim
00244 *>          N_ERR_BNDS is INTEGER
00245 *>     Number of error bounds to return for each right hand side
00246 *>     and each type (normwise or componentwise).  See ERR_BNDS_NORM and
00247 *>     ERR_BNDS_COMP below.
00248 *> \endverbatim
00249 *>
00250 *> \param[out] ERR_BNDS_NORM
00251 *> \verbatim
00252 *>          ERR_BNDS_NORM is REAL array, dimension (NRHS, N_ERR_BNDS)
00253 *>     For each right-hand side, this array contains information about
00254 *>     various error bounds and condition numbers corresponding to the
00255 *>     normwise relative error, which is defined as follows:
00256 *>
00257 *>     Normwise relative error in the ith solution vector:
00258 *>             max_j (abs(XTRUE(j,i) - X(j,i)))
00259 *>            ------------------------------
00260 *>                  max_j abs(X(j,i))
00261 *>
00262 *>     The array is indexed by the type of error information as described
00263 *>     below. There currently are up to three pieces of information
00264 *>     returned.
00265 *>
00266 *>     The first index in ERR_BNDS_NORM(i,:) corresponds to the ith
00267 *>     right-hand side.
00268 *>
00269 *>     The second index in ERR_BNDS_NORM(:,err) contains the following
00270 *>     three fields:
00271 *>     err = 1 "Trust/don't trust" boolean. Trust the answer if the
00272 *>              reciprocal condition number is less than the threshold
00273 *>              sqrt(n) * slamch('Epsilon').
00274 *>
00275 *>     err = 2 "Guaranteed" error bound: The estimated forward error,
00276 *>              almost certainly within a factor of 10 of the true error
00277 *>              so long as the next entry is greater than the threshold
00278 *>              sqrt(n) * slamch('Epsilon'). This error bound should only
00279 *>              be trusted if the previous boolean is true.
00280 *>
00281 *>     err = 3  Reciprocal condition number: Estimated normwise
00282 *>              reciprocal condition number.  Compared with the threshold
00283 *>              sqrt(n) * slamch('Epsilon') to determine if the error
00284 *>              estimate is "guaranteed". These reciprocal condition
00285 *>              numbers are 1 / (norm(Z^{-1},inf) * norm(Z,inf)) for some
00286 *>              appropriately scaled matrix Z.
00287 *>              Let Z = S*A, where S scales each row by a power of the
00288 *>              radix so all absolute row sums of Z are approximately 1.
00289 *>
00290 *>     See Lapack Working Note 165 for further details and extra
00291 *>     cautions.
00292 *> \endverbatim
00293 *>
00294 *> \param[out] ERR_BNDS_COMP
00295 *> \verbatim
00296 *>          ERR_BNDS_COMP is REAL array, dimension (NRHS, N_ERR_BNDS)
00297 *>     For each right-hand side, this array contains information about
00298 *>     various error bounds and condition numbers corresponding to the
00299 *>     componentwise relative error, which is defined as follows:
00300 *>
00301 *>     Componentwise relative error in the ith solution vector:
00302 *>                    abs(XTRUE(j,i) - X(j,i))
00303 *>             max_j ----------------------
00304 *>                         abs(X(j,i))
00305 *>
00306 *>     The array is indexed by the right-hand side i (on which the
00307 *>     componentwise relative error depends), and the type of error
00308 *>     information as described below. There currently are up to three
00309 *>     pieces of information returned for each right-hand side. If
00310 *>     componentwise accuracy is not requested (PARAMS(3) = 0.0), then
00311 *>     ERR_BNDS_COMP is not accessed.  If N_ERR_BNDS .LT. 3, then at most
00312 *>     the first (:,N_ERR_BNDS) entries are returned.
00313 *>
00314 *>     The first index in ERR_BNDS_COMP(i,:) corresponds to the ith
00315 *>     right-hand side.
00316 *>
00317 *>     The second index in ERR_BNDS_COMP(:,err) contains the following
00318 *>     three fields:
00319 *>     err = 1 "Trust/don't trust" boolean. Trust the answer if the
00320 *>              reciprocal condition number is less than the threshold
00321 *>              sqrt(n) * slamch('Epsilon').
00322 *>
00323 *>     err = 2 "Guaranteed" error bound: The estimated forward error,
00324 *>              almost certainly within a factor of 10 of the true error
00325 *>              so long as the next entry is greater than the threshold
00326 *>              sqrt(n) * slamch('Epsilon'). This error bound should only
00327 *>              be trusted if the previous boolean is true.
00328 *>
00329 *>     err = 3  Reciprocal condition number: Estimated componentwise
00330 *>              reciprocal condition number.  Compared with the threshold
00331 *>              sqrt(n) * slamch('Epsilon') to determine if the error
00332 *>              estimate is "guaranteed". These reciprocal condition
00333 *>              numbers are 1 / (norm(Z^{-1},inf) * norm(Z,inf)) for some
00334 *>              appropriately scaled matrix Z.
00335 *>              Let Z = S*(A*diag(x)), where x is the solution for the
00336 *>              current right-hand side and S scales each row of
00337 *>              A*diag(x) by a power of the radix so all absolute row
00338 *>              sums of Z are approximately 1.
00339 *>
00340 *>     See Lapack Working Note 165 for further details and extra
00341 *>     cautions.
00342 *> \endverbatim
00343 *>
00344 *> \param[in] NPARAMS
00345 *> \verbatim
00346 *>          NPARAMS is INTEGER
00347 *>     Specifies the number of parameters set in PARAMS.  If .LE. 0, the
00348 *>     PARAMS array is never referenced and default values are used.
00349 *> \endverbatim
00350 *>
00351 *> \param[in,out] PARAMS
00352 *> \verbatim
00353 *>          PARAMS is / output) REAL array, dimension NPARAMS
00354 *>     Specifies algorithm parameters.  If an entry is .LT. 0.0, then
00355 *>     that entry will be filled with default value used for that
00356 *>     parameter.  Only positions up to NPARAMS are accessed; defaults
00357 *>     are used for higher-numbered parameters.
00358 *>
00359 *>       PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative
00360 *>            refinement or not.
00361 *>         Default: 1.0
00362 *>            = 0.0 : No refinement is performed, and no error bounds are
00363 *>                    computed.
00364 *>            = 1.0 : Use the double-precision refinement algorithm,
00365 *>                    possibly with doubled-single computations if the
00366 *>                    compilation environment does not support DOUBLE
00367 *>                    PRECISION.
00368 *>              (other values are reserved for future use)
00369 *>
00370 *>       PARAMS(LA_LINRX_ITHRESH_I = 2) : Maximum number of residual
00371 *>            computations allowed for refinement.
00372 *>         Default: 10
00373 *>         Aggressive: Set to 100 to permit convergence using approximate
00374 *>                     factorizations or factorizations other than LU. If
00375 *>                     the factorization uses a technique other than
00376 *>                     Gaussian elimination, the guarantees in
00377 *>                     err_bnds_norm and err_bnds_comp may no longer be
00378 *>                     trustworthy.
00379 *>
00380 *>       PARAMS(LA_LINRX_CWISE_I = 3) : Flag determining if the code
00381 *>            will attempt to find a solution with small componentwise
00382 *>            relative error in the double-precision algorithm.  Positive
00383 *>            is true, 0.0 is false.
00384 *>         Default: 1.0 (attempt componentwise convergence)
00385 *> \endverbatim
00386 *>
00387 *> \param[out] WORK
00388 *> \verbatim
00389 *>          WORK is COMPLEX array, dimension (2*N)
00390 *> \endverbatim
00391 *>
00392 *> \param[out] RWORK
00393 *> \verbatim
00394 *>          RWORK is REAL array, dimension (2*N)
00395 *> \endverbatim
00396 *>
00397 *> \param[out] INFO
00398 *> \verbatim
00399 *>          INFO is INTEGER
00400 *>       = 0:  Successful exit. The solution to every right-hand side is
00401 *>         guaranteed.
00402 *>       < 0:  If INFO = -i, the i-th argument had an illegal value
00403 *>       > 0 and <= N:  U(INFO,INFO) is exactly zero.  The factorization
00404 *>         has been completed, but the factor U is exactly singular, so
00405 *>         the solution and error bounds could not be computed. RCOND = 0
00406 *>         is returned.
00407 *>       = N+J: The solution corresponding to the Jth right-hand side is
00408 *>         not guaranteed. The solutions corresponding to other right-
00409 *>         hand sides K with K > J may not be guaranteed as well, but
00410 *>         only the first such right-hand side is reported. If a small
00411 *>         componentwise error is not requested (PARAMS(3) = 0.0) then
00412 *>         the Jth right-hand side is the first with a normwise error
00413 *>         bound that is not guaranteed (the smallest J such
00414 *>         that ERR_BNDS_NORM(J,1) = 0.0). By default (PARAMS(3) = 1.0)
00415 *>         the Jth right-hand side is the first with either a normwise or
00416 *>         componentwise error bound that is not guaranteed (the smallest
00417 *>         J such that either ERR_BNDS_NORM(J,1) = 0.0 or
00418 *>         ERR_BNDS_COMP(J,1) = 0.0). See the definition of
00419 *>         ERR_BNDS_NORM(:,1) and ERR_BNDS_COMP(:,1). To get information
00420 *>         about all of the right-hand sides check ERR_BNDS_NORM or
00421 *>         ERR_BNDS_COMP.
00422 *> \endverbatim
00423 *
00424 *  Authors:
00425 *  ========
00426 *
00427 *> \author Univ. of Tennessee 
00428 *> \author Univ. of California Berkeley 
00429 *> \author Univ. of Colorado Denver 
00430 *> \author NAG Ltd. 
00431 *
00432 *> \date April 2012
00433 *
00434 *> \ingroup complexGBcomputational
00435 *
00436 *  =====================================================================
00437       SUBROUTINE CGBRFSX( TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB,
00438      $                    LDAFB, IPIV, R, C, B, LDB, X, LDX, RCOND,
00439      $                    BERR, N_ERR_BNDS, ERR_BNDS_NORM,
00440      $                    ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK,
00441      $                    INFO )
00442 *
00443 *  -- LAPACK computational routine (version 3.4.1) --
00444 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00445 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00446 *     April 2012
00447 *
00448 *     .. Scalar Arguments ..
00449       CHARACTER          TRANS, EQUED
00450       INTEGER            INFO, LDAB, LDAFB, LDB, LDX, N, KL, KU, NRHS,
00451      $                   NPARAMS, N_ERR_BNDS
00452       REAL               RCOND
00453 *     ..
00454 *     .. Array Arguments ..
00455       INTEGER            IPIV( * )
00456       COMPLEX            AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
00457      $                   X( LDX , * ),WORK( * )
00458       REAL               R( * ), C( * ), PARAMS( * ), BERR( * ),
00459      $                   ERR_BNDS_NORM( NRHS, * ),
00460      $                   ERR_BNDS_COMP( NRHS, * ), RWORK( * )
00461 *     ..
00462 *
00463 *  ==================================================================
00464 *
00465 *     .. Parameters ..
00466       REAL               ZERO, ONE
00467       PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
00468       REAL               ITREF_DEFAULT, ITHRESH_DEFAULT,
00469      $                   COMPONENTWISE_DEFAULT
00470       REAL               RTHRESH_DEFAULT, DZTHRESH_DEFAULT
00471       PARAMETER          ( ITREF_DEFAULT = 1.0 )
00472       PARAMETER          ( ITHRESH_DEFAULT = 10.0 )
00473       PARAMETER          ( COMPONENTWISE_DEFAULT = 1.0 )
00474       PARAMETER          ( RTHRESH_DEFAULT = 0.5 )
00475       PARAMETER          ( DZTHRESH_DEFAULT = 0.25 )
00476       INTEGER            LA_LINRX_ITREF_I, LA_LINRX_ITHRESH_I,
00477      $                   LA_LINRX_CWISE_I
00478       PARAMETER          ( LA_LINRX_ITREF_I = 1,
00479      $                   LA_LINRX_ITHRESH_I = 2 )
00480       PARAMETER          ( LA_LINRX_CWISE_I = 3 )
00481       INTEGER            LA_LINRX_TRUST_I, LA_LINRX_ERR_I,
00482      $                   LA_LINRX_RCOND_I
00483       PARAMETER          ( LA_LINRX_TRUST_I = 1, LA_LINRX_ERR_I = 2 )
00484       PARAMETER          ( LA_LINRX_RCOND_I = 3 )
00485 *     ..
00486 *     .. Local Scalars ..
00487       CHARACTER(1)       NORM
00488       LOGICAL            ROWEQU, COLEQU, NOTRAN, IGNORE_CWISE
00489       INTEGER            J, TRANS_TYPE, PREC_TYPE, REF_TYPE, N_NORMS,
00490      $                   ITHRESH
00491       REAL               ANORM, RCOND_TMP, ILLRCOND_THRESH, ERR_LBND,
00492      $                   CWISE_WRONG, RTHRESH, UNSTABLE_THRESH
00493 *     ..
00494 *     .. External Subroutines ..
00495       EXTERNAL           XERBLA, CGBCON, CLA_GBRFSX_EXTENDED
00496 *     ..
00497 *     .. Intrinsic Functions ..
00498       INTRINSIC          MAX, SQRT, TRANSFER
00499 *     ..
00500 *     .. External Functions ..
00501       EXTERNAL           LSAME, BLAS_FPINFO_X, ILATRANS, ILAPREC
00502       EXTERNAL           SLAMCH, CLANGB, CLA_GBRCOND_X, CLA_GBRCOND_C
00503       REAL               SLAMCH, CLANGB, CLA_GBRCOND_X, CLA_GBRCOND_C
00504       LOGICAL            LSAME
00505       INTEGER            BLAS_FPINFO_X
00506       INTEGER            ILATRANS, ILAPREC
00507 *     ..
00508 *     .. Executable Statements ..
00509 *
00510 *     Check the input parameters.
00511 *
00512       INFO = 0
00513       TRANS_TYPE = ILATRANS( TRANS )
00514       REF_TYPE = INT( ITREF_DEFAULT )
00515       IF ( NPARAMS .GE. LA_LINRX_ITREF_I ) THEN
00516          IF ( PARAMS( LA_LINRX_ITREF_I ) .LT. 0.0 ) THEN
00517             PARAMS( LA_LINRX_ITREF_I ) = ITREF_DEFAULT
00518          ELSE
00519             REF_TYPE = PARAMS( LA_LINRX_ITREF_I )
00520          END IF
00521       END IF
00522 *
00523 *     Set default parameters.
00524 *
00525       ILLRCOND_THRESH = REAL( N ) * SLAMCH( 'Epsilon' )
00526       ITHRESH = INT( ITHRESH_DEFAULT )
00527       RTHRESH = RTHRESH_DEFAULT
00528       UNSTABLE_THRESH = DZTHRESH_DEFAULT
00529       IGNORE_CWISE = COMPONENTWISE_DEFAULT .EQ. 0.0
00530 *
00531       IF ( NPARAMS.GE.LA_LINRX_ITHRESH_I ) THEN
00532          IF ( PARAMS( LA_LINRX_ITHRESH_I ).LT.0.0 ) THEN
00533             PARAMS( LA_LINRX_ITHRESH_I ) = ITHRESH
00534          ELSE
00535             ITHRESH = INT( PARAMS( LA_LINRX_ITHRESH_I ) )
00536          END IF
00537       END IF
00538       IF ( NPARAMS.GE.LA_LINRX_CWISE_I ) THEN
00539          IF ( PARAMS( LA_LINRX_CWISE_I ).LT.0.0 ) THEN
00540             IF ( IGNORE_CWISE ) THEN
00541                PARAMS( LA_LINRX_CWISE_I ) = 0.0
00542             ELSE
00543                PARAMS( LA_LINRX_CWISE_I ) = 1.0
00544             END IF
00545          ELSE
00546             IGNORE_CWISE = PARAMS( LA_LINRX_CWISE_I ) .EQ. 0.0
00547          END IF
00548       END IF
00549       IF ( REF_TYPE .EQ. 0 .OR. N_ERR_BNDS .EQ. 0 ) THEN
00550          N_NORMS = 0
00551       ELSE IF ( IGNORE_CWISE ) THEN
00552          N_NORMS = 1
00553       ELSE
00554          N_NORMS = 2
00555       END IF
00556 *
00557       NOTRAN = LSAME( TRANS, 'N' )
00558       ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' )
00559       COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' )
00560 *
00561 *     Test input parameters.
00562 *
00563       IF( TRANS_TYPE.EQ.-1 ) THEN
00564         INFO = -1
00565       ELSE IF( .NOT.ROWEQU .AND. .NOT.COLEQU .AND.
00566      $         .NOT.LSAME( EQUED, 'N' ) ) THEN
00567         INFO = -2
00568       ELSE IF( N.LT.0 ) THEN
00569         INFO = -3
00570       ELSE IF( KL.LT.0 ) THEN
00571         INFO = -4
00572       ELSE IF( KU.LT.0 ) THEN
00573         INFO = -5
00574       ELSE IF( NRHS.LT.0 ) THEN
00575         INFO = -6
00576       ELSE IF( LDAB.LT.KL+KU+1 ) THEN
00577         INFO = -8
00578       ELSE IF( LDAFB.LT.2*KL+KU+1 ) THEN
00579         INFO = -10
00580       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
00581         INFO = -13
00582       ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
00583         INFO = -15
00584       END IF
00585       IF( INFO.NE.0 ) THEN
00586         CALL XERBLA( 'CGBRFSX', -INFO )
00587         RETURN
00588       END IF
00589 *
00590 *     Quick return if possible.
00591 *
00592       IF( N.EQ.0 .OR. NRHS.EQ.0 ) THEN
00593          RCOND = 1.0
00594          DO J = 1, NRHS
00595             BERR( J ) = 0.0
00596             IF ( N_ERR_BNDS .GE. 1 ) THEN
00597                ERR_BNDS_NORM( J, LA_LINRX_TRUST_I ) = 1.0
00598                ERR_BNDS_COMP( J, LA_LINRX_TRUST_I ) = 1.0
00599             END IF
00600             IF ( N_ERR_BNDS .GE. 2 ) THEN
00601                ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) = 0.0
00602                ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = 0.0
00603             END IF
00604             IF ( N_ERR_BNDS .GE. 3 ) THEN
00605                ERR_BNDS_NORM( J, LA_LINRX_RCOND_I ) = 1.0
00606                ERR_BNDS_COMP( J, LA_LINRX_RCOND_I ) = 1.0
00607             END IF
00608          END DO
00609          RETURN
00610       END IF
00611 *
00612 *     Default to failure.
00613 *
00614       RCOND = 0.0
00615       DO J = 1, NRHS
00616          BERR( J ) = 1.0
00617          IF ( N_ERR_BNDS .GE. 1 ) THEN
00618             ERR_BNDS_NORM( J, LA_LINRX_TRUST_I ) = 1.0
00619             ERR_BNDS_COMP( J, LA_LINRX_TRUST_I ) = 1.0
00620          END IF
00621          IF ( N_ERR_BNDS .GE. 2 ) THEN
00622             ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) = 1.0
00623             ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = 1.0
00624          END IF
00625          IF ( N_ERR_BNDS .GE. 3 ) THEN
00626             ERR_BNDS_NORM( J, LA_LINRX_RCOND_I ) = 0.0
00627             ERR_BNDS_COMP( J, LA_LINRX_RCOND_I ) = 0.0
00628          END IF
00629       END DO
00630 *
00631 *     Compute the norm of A and the reciprocal of the condition
00632 *     number of A.
00633 *
00634       IF( NOTRAN ) THEN
00635          NORM = 'I'
00636       ELSE
00637          NORM = '1'
00638       END IF
00639       ANORM = CLANGB( NORM, N, KL, KU, AB, LDAB, RWORK )
00640       CALL CGBCON( NORM, N, KL, KU, AFB, LDAFB, IPIV, ANORM, RCOND,
00641      $     WORK, RWORK, INFO )
00642 *
00643 *     Perform refinement on each right-hand side
00644 *
00645       IF ( REF_TYPE .NE. 0 ) THEN
00646 
00647          PREC_TYPE = ILAPREC( 'D' )
00648 
00649          IF ( NOTRAN ) THEN
00650             CALL CLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE,  N, KL, KU,
00651      $           NRHS, AB, LDAB, AFB, LDAFB, IPIV, COLEQU, C, B,
00652      $           LDB, X, LDX, BERR, N_NORMS, ERR_BNDS_NORM,
00653      $           ERR_BNDS_COMP, WORK, RWORK, WORK(N+1),
00654      $           TRANSFER (RWORK(1:2*N), (/ (ZERO, ZERO) /), N),
00655      $           RCOND, ITHRESH, RTHRESH, UNSTABLE_THRESH, IGNORE_CWISE,
00656      $           INFO )
00657          ELSE
00658             CALL CLA_GBRFSX_EXTENDED( PREC_TYPE, TRANS_TYPE,  N, KL, KU,
00659      $           NRHS, AB, LDAB, AFB, LDAFB, IPIV, ROWEQU, R, B,
00660      $           LDB, X, LDX, BERR, N_NORMS, ERR_BNDS_NORM,
00661      $           ERR_BNDS_COMP, WORK, RWORK, WORK(N+1),
00662      $           TRANSFER (RWORK(1:2*N), (/ (ZERO, ZERO) /), N),
00663      $           RCOND, ITHRESH, RTHRESH, UNSTABLE_THRESH, IGNORE_CWISE,
00664      $           INFO )
00665          END IF
00666       END IF
00667 
00668       ERR_LBND = MAX( 10.0, SQRT( REAL( N ) ) ) * SLAMCH( 'Epsilon' )
00669       IF (N_ERR_BNDS .GE. 1 .AND. N_NORMS .GE. 1) THEN
00670 *
00671 *     Compute scaled normwise condition number cond(A*C).
00672 *
00673          IF ( COLEQU .AND. NOTRAN ) THEN
00674             RCOND_TMP = CLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, AFB,
00675      $           LDAFB, IPIV, C, .TRUE., INFO, WORK, RWORK )
00676          ELSE IF ( ROWEQU .AND. .NOT. NOTRAN ) THEN
00677             RCOND_TMP = CLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, AFB,
00678      $           LDAFB, IPIV, R, .TRUE., INFO, WORK, RWORK )
00679          ELSE
00680             RCOND_TMP = CLA_GBRCOND_C( TRANS, N, KL, KU, AB, LDAB, AFB,
00681      $           LDAFB, IPIV, C, .FALSE., INFO, WORK, RWORK )
00682          END IF
00683          DO J = 1, NRHS
00684 *
00685 *     Cap the error at 1.0.
00686 *
00687             IF ( N_ERR_BNDS .GE. LA_LINRX_ERR_I
00688      $           .AND. ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) .GT. 1.0)
00689      $           ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) = 1.0
00690 *
00691 *     Threshold the error (see LAWN).
00692 *
00693             IF ( RCOND_TMP .LT. ILLRCOND_THRESH ) THEN
00694                ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) = 1.0
00695                ERR_BNDS_NORM( J, LA_LINRX_TRUST_I ) = 0.0
00696                IF ( INFO .LE. N ) INFO = N + J
00697             ELSE IF ( ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) .LT. ERR_LBND )
00698      $              THEN
00699                ERR_BNDS_NORM( J, LA_LINRX_ERR_I ) = ERR_LBND
00700                ERR_BNDS_NORM( J, LA_LINRX_TRUST_I ) = 1.0
00701             END IF
00702 *
00703 *     Save the condition number.
00704 *
00705             IF ( N_ERR_BNDS .GE. LA_LINRX_RCOND_I ) THEN
00706                ERR_BNDS_NORM( J, LA_LINRX_RCOND_I ) = RCOND_TMP
00707             END IF
00708 
00709          END DO
00710       END IF
00711 
00712       IF (N_ERR_BNDS .GE. 1 .AND. N_NORMS .GE. 2) THEN
00713 *
00714 *     Compute componentwise condition number cond(A*diag(Y(:,J))) for
00715 *     each right-hand side using the current solution as an estimate of
00716 *     the true solution.  If the componentwise error estimate is too
00717 *     large, then the solution is a lousy estimate of truth and the
00718 *     estimated RCOND may be too optimistic.  To avoid misleading users,
00719 *     the inverse condition number is set to 0.0 when the estimated
00720 *     cwise error is at least CWISE_WRONG.
00721 *
00722          CWISE_WRONG = SQRT( SLAMCH( 'Epsilon' ) )
00723          DO J = 1, NRHS
00724             IF (ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) .LT. CWISE_WRONG )
00725      $     THEN
00726                RCOND_TMP = CLA_GBRCOND_X( TRANS, N, KL, KU, AB, LDAB,
00727      $              AFB, LDAFB, IPIV, X( 1, J ), INFO, WORK, RWORK )
00728             ELSE
00729                RCOND_TMP = 0.0
00730             END IF
00731 *
00732 *     Cap the error at 1.0.
00733 *
00734             IF ( N_ERR_BNDS .GE. LA_LINRX_ERR_I
00735      $           .AND. ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) .GT. 1.0 )
00736      $           ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = 1.0
00737 *
00738 *     Threshold the error (see LAWN).
00739 *
00740             IF ( RCOND_TMP .LT. ILLRCOND_THRESH ) THEN
00741                ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = 1.0
00742                ERR_BNDS_COMP( J, LA_LINRX_TRUST_I ) = 0.0
00743                IF ( PARAMS( LA_LINRX_CWISE_I ) .EQ. 1.0
00744      $              .AND. INFO.LT.N + J ) INFO = N + J
00745             ELSE IF ( ERR_BNDS_COMP( J, LA_LINRX_ERR_I )
00746      $              .LT. ERR_LBND ) THEN
00747                ERR_BNDS_COMP( J, LA_LINRX_ERR_I ) = ERR_LBND
00748                ERR_BNDS_COMP( J, LA_LINRX_TRUST_I ) = 1.0
00749             END IF
00750 *
00751 *     Save the condition number.
00752 *
00753             IF ( N_ERR_BNDS .GE. LA_LINRX_RCOND_I ) THEN
00754                ERR_BNDS_COMP( J, LA_LINRX_RCOND_I ) = RCOND_TMP
00755             END IF
00756 
00757          END DO
00758       END IF
00759 *
00760       RETURN
00761 *
00762 *     End of CGBRFSX
00763 *
00764       END
 All Files Functions