File:  [local] / rpl / lapack / lapack / dptsvx.f
Revision 1.20: download - view: text, annotated - select for diffs - revision graph
Mon Aug 7 08:39:05 2023 UTC (8 months, 3 weeks ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_35, rpl-4_1_34, HEAD
Première mise à jour de lapack et blas.

    1: *> \brief <b> DPTSVX computes the solution to system of linear equations A * X = B for PT matrices</b>
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at
    6: *            http://www.netlib.org/lapack/explore-html/
    7: *
    8: *> \htmlonly
    9: *> Download DPTSVX + dependencies
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dptsvx.f">
   11: *> [TGZ]</a>
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dptsvx.f">
   13: *> [ZIP]</a>
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dptsvx.f">
   15: *> [TXT]</a>
   16: *> \endhtmlonly
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE DPTSVX( FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX,
   22: *                          RCOND, FERR, BERR, WORK, INFO )
   23: *
   24: *       .. Scalar Arguments ..
   25: *       CHARACTER          FACT
   26: *       INTEGER            INFO, LDB, LDX, N, NRHS
   27: *       DOUBLE PRECISION   RCOND
   28: *       ..
   29: *       .. Array Arguments ..
   30: *       DOUBLE PRECISION   B( LDB, * ), BERR( * ), D( * ), DF( * ),
   31: *      $                   E( * ), EF( * ), FERR( * ), WORK( * ),
   32: *      $                   X( LDX, * )
   33: *       ..
   34: *
   35: *
   36: *> \par Purpose:
   37: *  =============
   38: *>
   39: *> \verbatim
   40: *>
   41: *> DPTSVX uses the factorization A = L*D*L**T to compute the solution
   42: *> to a real system of linear equations A*X = B, where A is an N-by-N
   43: *> symmetric positive definite tridiagonal matrix and X and B are
   44: *> N-by-NRHS matrices.
   45: *>
   46: *> Error bounds on the solution and a condition estimate are also
   47: *> provided.
   48: *> \endverbatim
   49: *
   50: *> \par Description:
   51: *  =================
   52: *>
   53: *> \verbatim
   54: *>
   55: *> The following steps are performed:
   56: *>
   57: *> 1. If FACT = 'N', the matrix A is factored as A = L*D*L**T, where L
   58: *>    is a unit lower bidiagonal matrix and D is diagonal.  The
   59: *>    factorization can also be regarded as having the form
   60: *>    A = U**T*D*U.
   61: *>
   62: *> 2. If the leading i-by-i principal minor is not positive definite,
   63: *>    then the routine returns with INFO = i. Otherwise, the factored
   64: *>    form of A is used to estimate the condition number of the matrix
   65: *>    A.  If the reciprocal of the condition number is less than machine
   66: *>    precision, INFO = N+1 is returned as a warning, but the routine
   67: *>    still goes on to solve for X and compute error bounds as
   68: *>    described below.
   69: *>
   70: *> 3. The system of equations is solved for X using the factored form
   71: *>    of A.
   72: *>
   73: *> 4. Iterative refinement is applied to improve the computed solution
   74: *>    matrix and calculate error bounds and backward error estimates
   75: *>    for it.
   76: *> \endverbatim
   77: *
   78: *  Arguments:
   79: *  ==========
   80: *
   81: *> \param[in] FACT
   82: *> \verbatim
   83: *>          FACT is CHARACTER*1
   84: *>          Specifies whether or not the factored form of A has been
   85: *>          supplied on entry.
   86: *>          = 'F':  On entry, DF and EF contain the factored form of A.
   87: *>                  D, E, DF, and EF will not be modified.
   88: *>          = 'N':  The matrix A will be copied to DF and EF and
   89: *>                  factored.
   90: *> \endverbatim
   91: *>
   92: *> \param[in] N
   93: *> \verbatim
   94: *>          N is INTEGER
   95: *>          The order of the matrix A.  N >= 0.
   96: *> \endverbatim
   97: *>
   98: *> \param[in] NRHS
   99: *> \verbatim
  100: *>          NRHS is INTEGER
  101: *>          The number of right hand sides, i.e., the number of columns
  102: *>          of the matrices B and X.  NRHS >= 0.
  103: *> \endverbatim
  104: *>
  105: *> \param[in] D
  106: *> \verbatim
  107: *>          D is DOUBLE PRECISION array, dimension (N)
  108: *>          The n diagonal elements of the tridiagonal matrix A.
  109: *> \endverbatim
  110: *>
  111: *> \param[in] E
  112: *> \verbatim
  113: *>          E is DOUBLE PRECISION array, dimension (N-1)
  114: *>          The (n-1) subdiagonal elements of the tridiagonal matrix A.
  115: *> \endverbatim
  116: *>
  117: *> \param[in,out] DF
  118: *> \verbatim
  119: *>          DF is DOUBLE PRECISION array, dimension (N)
  120: *>          If FACT = 'F', then DF is an input argument and on entry
  121: *>          contains the n diagonal elements of the diagonal matrix D
  122: *>          from the L*D*L**T factorization of A.
  123: *>          If FACT = 'N', then DF is an output argument and on exit
  124: *>          contains the n diagonal elements of the diagonal matrix D
  125: *>          from the L*D*L**T factorization of A.
  126: *> \endverbatim
  127: *>
  128: *> \param[in,out] EF
  129: *> \verbatim
  130: *>          EF is DOUBLE PRECISION array, dimension (N-1)
  131: *>          If FACT = 'F', then EF is an input argument and on entry
  132: *>          contains the (n-1) subdiagonal elements of the unit
  133: *>          bidiagonal factor L from the L*D*L**T factorization of A.
  134: *>          If FACT = 'N', then EF is an output argument and on exit
  135: *>          contains the (n-1) subdiagonal elements of the unit
  136: *>          bidiagonal factor L from the L*D*L**T factorization of A.
  137: *> \endverbatim
  138: *>
  139: *> \param[in] B
  140: *> \verbatim
  141: *>          B is DOUBLE PRECISION array, dimension (LDB,NRHS)
  142: *>          The N-by-NRHS right hand side matrix B.
  143: *> \endverbatim
  144: *>
  145: *> \param[in] LDB
  146: *> \verbatim
  147: *>          LDB is INTEGER
  148: *>          The leading dimension of the array B.  LDB >= max(1,N).
  149: *> \endverbatim
  150: *>
  151: *> \param[out] X
  152: *> \verbatim
  153: *>          X is DOUBLE PRECISION array, dimension (LDX,NRHS)
  154: *>          If INFO = 0 of INFO = N+1, the N-by-NRHS solution matrix X.
  155: *> \endverbatim
  156: *>
  157: *> \param[in] LDX
  158: *> \verbatim
  159: *>          LDX is INTEGER
  160: *>          The leading dimension of the array X.  LDX >= max(1,N).
  161: *> \endverbatim
  162: *>
  163: *> \param[out] RCOND
  164: *> \verbatim
  165: *>          RCOND is DOUBLE PRECISION
  166: *>          The reciprocal condition number of the matrix A.  If RCOND
  167: *>          is less than the machine precision (in particular, if
  168: *>          RCOND = 0), the matrix is singular to working precision.
  169: *>          This condition is indicated by a return code of INFO > 0.
  170: *> \endverbatim
  171: *>
  172: *> \param[out] FERR
  173: *> \verbatim
  174: *>          FERR is DOUBLE PRECISION array, dimension (NRHS)
  175: *>          The forward error bound for each solution vector
  176: *>          X(j) (the j-th column of the solution matrix X).
  177: *>          If XTRUE is the true solution corresponding to X(j), FERR(j)
  178: *>          is an estimated upper bound for the magnitude of the largest
  179: *>          element in (X(j) - XTRUE) divided by the magnitude of the
  180: *>          largest element in X(j).
  181: *> \endverbatim
  182: *>
  183: *> \param[out] BERR
  184: *> \verbatim
  185: *>          BERR is DOUBLE PRECISION array, dimension (NRHS)
  186: *>          The componentwise relative backward error of each solution
  187: *>          vector X(j) (i.e., the smallest relative change in any
  188: *>          element of A or B that makes X(j) an exact solution).
  189: *> \endverbatim
  190: *>
  191: *> \param[out] WORK
  192: *> \verbatim
  193: *>          WORK is DOUBLE PRECISION array, dimension (2*N)
  194: *> \endverbatim
  195: *>
  196: *> \param[out] INFO
  197: *> \verbatim
  198: *>          INFO is INTEGER
  199: *>          = 0:  successful exit
  200: *>          < 0:  if INFO = -i, the i-th argument had an illegal value
  201: *>          > 0:  if INFO = i, and i is
  202: *>                <= N:  the leading minor of order i of A is
  203: *>                       not positive definite, so the factorization
  204: *>                       could not be completed, and the solution has not
  205: *>                       been computed. RCOND = 0 is returned.
  206: *>                = N+1: U is nonsingular, but RCOND is less than machine
  207: *>                       precision, meaning that the matrix is singular
  208: *>                       to working precision.  Nevertheless, the
  209: *>                       solution and error bounds are computed because
  210: *>                       there are a number of situations where the
  211: *>                       computed solution can be more accurate than the
  212: *>                       value of RCOND would suggest.
  213: *> \endverbatim
  214: *
  215: *  Authors:
  216: *  ========
  217: *
  218: *> \author Univ. of Tennessee
  219: *> \author Univ. of California Berkeley
  220: *> \author Univ. of Colorado Denver
  221: *> \author NAG Ltd.
  222: *
  223: *> \ingroup doublePTsolve
  224: *
  225: *  =====================================================================
  226:       SUBROUTINE DPTSVX( FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX,
  227:      $                   RCOND, FERR, BERR, WORK, INFO )
  228: *
  229: *  -- LAPACK driver routine --
  230: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  231: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  232: *
  233: *     .. Scalar Arguments ..
  234:       CHARACTER          FACT
  235:       INTEGER            INFO, LDB, LDX, N, NRHS
  236:       DOUBLE PRECISION   RCOND
  237: *     ..
  238: *     .. Array Arguments ..
  239:       DOUBLE PRECISION   B( LDB, * ), BERR( * ), D( * ), DF( * ),
  240:      $                   E( * ), EF( * ), FERR( * ), WORK( * ),
  241:      $                   X( LDX, * )
  242: *     ..
  243: *
  244: *  =====================================================================
  245: *
  246: *     .. Parameters ..
  247:       DOUBLE PRECISION   ZERO
  248:       PARAMETER          ( ZERO = 0.0D+0 )
  249: *     ..
  250: *     .. Local Scalars ..
  251:       LOGICAL            NOFACT
  252:       DOUBLE PRECISION   ANORM
  253: *     ..
  254: *     .. External Functions ..
  255:       LOGICAL            LSAME
  256:       DOUBLE PRECISION   DLAMCH, DLANST
  257:       EXTERNAL           LSAME, DLAMCH, DLANST
  258: *     ..
  259: *     .. External Subroutines ..
  260:       EXTERNAL           DCOPY, DLACPY, DPTCON, DPTRFS, DPTTRF, DPTTRS,
  261:      $                   XERBLA
  262: *     ..
  263: *     .. Intrinsic Functions ..
  264:       INTRINSIC          MAX
  265: *     ..
  266: *     .. Executable Statements ..
  267: *
  268: *     Test the input parameters.
  269: *
  270:       INFO = 0
  271:       NOFACT = LSAME( FACT, 'N' )
  272:       IF( .NOT.NOFACT .AND. .NOT.LSAME( FACT, 'F' ) ) THEN
  273:          INFO = -1
  274:       ELSE IF( N.LT.0 ) THEN
  275:          INFO = -2
  276:       ELSE IF( NRHS.LT.0 ) THEN
  277:          INFO = -3
  278:       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
  279:          INFO = -9
  280:       ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
  281:          INFO = -11
  282:       END IF
  283:       IF( INFO.NE.0 ) THEN
  284:          CALL XERBLA( 'DPTSVX', -INFO )
  285:          RETURN
  286:       END IF
  287: *
  288:       IF( NOFACT ) THEN
  289: *
  290: *        Compute the L*D*L**T (or U**T*D*U) factorization of A.
  291: *
  292:          CALL DCOPY( N, D, 1, DF, 1 )
  293:          IF( N.GT.1 )
  294:      $      CALL DCOPY( N-1, E, 1, EF, 1 )
  295:          CALL DPTTRF( N, DF, EF, INFO )
  296: *
  297: *        Return if INFO is non-zero.
  298: *
  299:          IF( INFO.GT.0 )THEN
  300:             RCOND = ZERO
  301:             RETURN
  302:          END IF
  303:       END IF
  304: *
  305: *     Compute the norm of the matrix A.
  306: *
  307:       ANORM = DLANST( '1', N, D, E )
  308: *
  309: *     Compute the reciprocal of the condition number of A.
  310: *
  311:       CALL DPTCON( N, DF, EF, ANORM, RCOND, WORK, INFO )
  312: *
  313: *     Compute the solution vectors X.
  314: *
  315:       CALL DLACPY( 'Full', N, NRHS, B, LDB, X, LDX )
  316:       CALL DPTTRS( N, NRHS, DF, EF, X, LDX, INFO )
  317: *
  318: *     Use iterative refinement to improve the computed solutions and
  319: *     compute error bounds and backward error estimates for them.
  320: *
  321:       CALL DPTRFS( N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, BERR,
  322:      $             WORK, INFO )
  323: *
  324: *     Set INFO = N+1 if the matrix is singular to working precision.
  325: *
  326:       IF( RCOND.LT.DLAMCH( 'Epsilon' ) )
  327:      $   INFO = N + 1
  328: *
  329:       RETURN
  330: *
  331: *     End of DPTSVX
  332: *
  333:       END

CVSweb interface <joel.bertrand@systella.fr>