File:  [local] / rpl / lapack / lapack / dsysv_aa_2stage.f
Revision 1.3: download - view: text, annotated - select for diffs - revision graph
Mon Aug 7 08:39:09 2023 UTC (9 months, 1 week 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> DSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices</b>
    2: *
    3: * @generated from SRC/chesv_aa_2stage.f, fortran c -> d, Tue Oct 31 11:22:31 2017
    4: *
    5: *  =========== DOCUMENTATION ===========
    6: *
    7: * Online html documentation available at
    8: *            http://www.netlib.org/lapack/explore-html/
    9: *
   10: *> \htmlonly
   11: *> Download DSYSV_AA_2STAGE + dependencies
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsysv_aa_2stage.f">
   13: *> [TGZ]</a>
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsysv_aa_2stage.f">
   15: *> [ZIP]</a>
   16: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsysv_aa_2stage.f">
   17: *> [TXT]</a>
   18: *> \endhtmlonly
   19: *
   20: *  Definition:
   21: *  ===========
   22: *
   23: *      SUBROUTINE DSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
   24: *                                  IPIV, IPIV2, B, LDB, WORK, LWORK,
   25: *                                  INFO )
   26: *
   27: *       .. Scalar Arguments ..
   28: *       CHARACTER          UPLO
   29: *       INTEGER            N, NRHS, LDA, LTB, LDB, LWORK, INFO
   30: *       ..
   31: *       .. Array Arguments ..
   32: *       INTEGER            IPIV( * ), IPIV2( * )
   33: *       DOUBLE PRECISION   A( LDA, * ), TB( * ), B( LDB, *), WORK( * )
   34: *       ..
   35: *
   36: *> \par Purpose:
   37: *  =============
   38: *>
   39: *> \verbatim
   40: *>
   41: *> DSYSV_AA_2STAGE computes the solution to a real system of
   42: *> linear equations
   43: *>    A * X = B,
   44: *> where A is an N-by-N symmetric matrix and X and B are N-by-NRHS
   45: *> matrices.
   46: *>
   47: *> Aasen's 2-stage algorithm is used to factor A as
   48: *>    A = U**T * T * U,  if UPLO = 'U', or
   49: *>    A = L * T * L**T,  if UPLO = 'L',
   50: *> where U (or L) is a product of permutation and unit upper (lower)
   51: *> triangular matrices, and T is symmetric and band. The matrix T is
   52: *> then LU-factored with partial pivoting. The factored form of A
   53: *> is then used to solve the system of equations A * X = B.
   54: *>
   55: *> This is the blocked version of the algorithm, calling Level 3 BLAS.
   56: *> \endverbatim
   57: *
   58: *  Arguments:
   59: *  ==========
   60: *
   61: *> \param[in] UPLO
   62: *> \verbatim
   63: *>          UPLO is CHARACTER*1
   64: *>          = 'U':  Upper triangle of A is stored;
   65: *>          = 'L':  Lower triangle of A is stored.
   66: *> \endverbatim
   67: *>
   68: *> \param[in] N
   69: *> \verbatim
   70: *>          N is INTEGER
   71: *>          The order of the matrix A.  N >= 0.
   72: *> \endverbatim
   73: *>
   74: *> \param[in] NRHS
   75: *> \verbatim
   76: *>          NRHS is INTEGER
   77: *>          The number of right hand sides, i.e., the number of columns
   78: *>          of the matrix B.  NRHS >= 0.
   79: *> \endverbatim
   80: *>
   81: *> \param[in,out] A
   82: *> \verbatim
   83: *>          A is DOUBLE PRECISION array, dimension (LDA,N)
   84: *>          On entry, the symmetric matrix A.  If UPLO = 'U', the leading
   85: *>          N-by-N upper triangular part of A contains the upper
   86: *>          triangular part of the matrix A, and the strictly lower
   87: *>          triangular part of A is not referenced.  If UPLO = 'L', the
   88: *>          leading N-by-N lower triangular part of A contains the lower
   89: *>          triangular part of the matrix A, and the strictly upper
   90: *>          triangular part of A is not referenced.
   91: *>
   92: *>          On exit, L is stored below (or above) the subdiaonal blocks,
   93: *>          when UPLO  is 'L' (or 'U').
   94: *> \endverbatim
   95: *>
   96: *> \param[in] LDA
   97: *> \verbatim
   98: *>          LDA is INTEGER
   99: *>          The leading dimension of the array A.  LDA >= max(1,N).
  100: *> \endverbatim
  101: *>
  102: *> \param[out] TB
  103: *> \verbatim
  104: *>          TB is DOUBLE PRECISION array, dimension (LTB)
  105: *>          On exit, details of the LU factorization of the band matrix.
  106: *> \endverbatim
  107: *>
  108: *> \param[in] LTB
  109: *> \verbatim
  110: *>          LTB is INTEGER
  111: *>          The size of the array TB. LTB >= 4*N, internally
  112: *>          used to select NB such that LTB >= (3*NB+1)*N.
  113: *>
  114: *>          If LTB = -1, then a workspace query is assumed; the
  115: *>          routine only calculates the optimal size of LTB, 
  116: *>          returns this value as the first entry of TB, and
  117: *>          no error message related to LTB is issued by XERBLA.
  118: *> \endverbatim
  119: *>
  120: *> \param[out] IPIV
  121: *> \verbatim
  122: *>          IPIV is INTEGER array, dimension (N)
  123: *>          On exit, it contains the details of the interchanges, i.e.,
  124: *>          the row and column k of A were interchanged with the
  125: *>          row and column IPIV(k).
  126: *> \endverbatim
  127: *>
  128: *> \param[out] IPIV2
  129: *> \verbatim
  130: *>          IPIV2 is INTEGER array, dimension (N)
  131: *>          On exit, it contains the details of the interchanges, i.e.,
  132: *>          the row and column k of T were interchanged with the
  133: *>          row and column IPIV(k).
  134: *> \endverbatim
  135: *>
  136: *> \param[in,out] B
  137: *> \verbatim
  138: *>          B is DOUBLE PRECISION array, dimension (LDB,NRHS)
  139: *>          On entry, the right hand side matrix B.
  140: *>          On exit, the solution matrix X.
  141: *> \endverbatim
  142: *>
  143: *> \param[in] LDB
  144: *> \verbatim
  145: *>          LDB is INTEGER
  146: *>          The leading dimension of the array B.  LDB >= max(1,N).
  147: *> \endverbatim
  148: *>
  149: *> \param[out] WORK
  150: *> \verbatim
  151: *>          WORK is DOUBLE PRECISION workspace of size LWORK
  152: *> \endverbatim
  153: *>
  154: *> \param[in] LWORK
  155: *> \verbatim
  156: *>          LWORK is INTEGER
  157: *>          The size of WORK. LWORK >= N, internally used to select NB
  158: *>          such that LWORK >= N*NB.
  159: *>
  160: *>          If LWORK = -1, then a workspace query is assumed; the
  161: *>          routine only calculates the optimal size of the WORK array,
  162: *>          returns this value as the first entry of the WORK array, and
  163: *>          no error message related to LWORK is issued by XERBLA.
  164: *> \endverbatim
  165: *>
  166: *> \param[out] INFO
  167: *> \verbatim
  168: *>          INFO is INTEGER
  169: *>          = 0:  successful exit
  170: *>          < 0:  if INFO = -i, the i-th argument had an illegal value.
  171: *>          > 0:  if INFO = i, band LU factorization failed on i-th column
  172: *> \endverbatim
  173: *
  174: *  Authors:
  175: *  ========
  176: *
  177: *> \author Univ. of Tennessee
  178: *> \author Univ. of California Berkeley
  179: *> \author Univ. of Colorado Denver
  180: *> \author NAG Ltd.
  181: *
  182: *> \ingroup doubleSYsolve
  183: *
  184: *  =====================================================================
  185:       SUBROUTINE DSYSV_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB,
  186:      $                            IPIV, IPIV2, B, LDB, WORK, LWORK,
  187:      $                            INFO )
  188: *
  189: *  -- LAPACK computational routine --
  190: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  191: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  192: *
  193:       IMPLICIT NONE
  194: *
  195: *     .. Scalar Arguments ..
  196:       CHARACTER          UPLO
  197:       INTEGER            N, NRHS, LDA, LDB, LTB, LWORK, INFO
  198: *     ..
  199: *     .. Array Arguments ..
  200:       INTEGER            IPIV( * ), IPIV2( * )
  201:       DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), TB( * ), WORK( * )
  202: *     ..
  203: *
  204: *  =====================================================================
  205: *
  206: *     .. Local Scalars ..
  207:       LOGICAL            UPPER, TQUERY, WQUERY
  208:       INTEGER            LWKOPT
  209: *     ..
  210: *     .. External Functions ..
  211:       LOGICAL            LSAME
  212:       EXTERNAL           LSAME
  213: *     ..
  214: *     .. External Subroutines ..
  215:       EXTERNAL           DSYTRF_AA_2STAGE, DSYTRS_AA_2STAGE,
  216:      $                   XERBLA
  217: *     ..
  218: *     .. Intrinsic Functions ..
  219:       INTRINSIC          MAX
  220: *     ..
  221: *     .. Executable Statements ..
  222: *
  223: *     Test the input parameters.
  224: *
  225:       INFO = 0
  226:       UPPER = LSAME( UPLO, 'U' )
  227:       WQUERY = ( LWORK.EQ.-1 )
  228:       TQUERY = ( LTB.EQ.-1 )
  229:       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
  230:          INFO = -1
  231:       ELSE IF( N.LT.0 ) THEN
  232:          INFO = -2
  233:       ELSE IF( NRHS.LT.0 ) THEN
  234:          INFO = -3
  235:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  236:          INFO = -5
  237:       ELSE IF( LTB.LT.( 4*N ) .AND. .NOT.TQUERY ) THEN
  238:          INFO = -7
  239:       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
  240:          INFO = -11
  241:       ELSE IF( LWORK.LT.N .AND. .NOT.WQUERY ) THEN
  242:          INFO = -13
  243:       END IF
  244: *
  245:       IF( INFO.EQ.0 ) THEN
  246:          CALL DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, -1, IPIV,
  247:      $                          IPIV2, WORK, -1, INFO )
  248:          LWKOPT = INT( WORK(1) )
  249:       END IF
  250: *
  251:       IF( INFO.NE.0 ) THEN
  252:          CALL XERBLA( 'DSYSV_AA_2STAGE', -INFO )
  253:          RETURN
  254:       ELSE IF( WQUERY .OR. TQUERY ) THEN
  255:          RETURN
  256:       END IF
  257: *
  258: *
  259: *     Compute the factorization A = U**T*T*U or A = L*T*L**T.
  260: *
  261:       CALL DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2,
  262:      $                       WORK, LWORK, INFO )
  263:       IF( INFO.EQ.0 ) THEN
  264: *
  265: *        Solve the system A*X = B, overwriting B with X.
  266: *
  267:          CALL DSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, IPIV,
  268:      $                          IPIV2, B, LDB, INFO )
  269: *
  270:       END IF
  271: *
  272:       WORK( 1 ) = LWKOPT
  273: *
  274:       RETURN
  275: *
  276: *     End of DSYSV_AA_2STAGE
  277: *
  278:       END

CVSweb interface <joel.bertrand@systella.fr>