Annotation of rpl/lapack/lapack/zhetrs_aa.f, revision 1.3

1.1       bertrand    1: *> \brief \b ZHETRS_AA
                      2: *
                      3: *  =========== DOCUMENTATION ===========
                      4: *
                      5: * Online html documentation available at
                      6: *            http://www.netlib.org/lapack/explore-html/
                      7: *
                      8: *> \htmlonly
                      9: *> Download ZHETRS_AA + dependencies
                     10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetrs_aa.f">
                     11: *> [TGZ]</a>
                     12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetrs_aa.f">
                     13: *> [ZIP]</a>
                     14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetrs_aa.f">
                     15: *> [TXT]</a>
                     16: *> \endhtmlonly
                     17: *
                     18: *  Definition:
                     19: *  ===========
                     20: *
                     21: *       SUBROUTINE ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
                     22: *                             WORK, LWORK, INFO )
                     23: *
                     24: *       .. Scalar Arguments ..
                     25: *       CHARACTER          UPLO
                     26: *       INTEGER            N, NRHS, LDA, LDB, LWORK, INFO
                     27: *       ..
                     28: *       .. Array Arguments ..
                     29: *       INTEGER            IPIV( * )
                     30: *       COMPLEX*16         A( LDA, * ), B( LDB, * ), WORK( * )
                     31: *       ..
                     32: *
                     33: *
                     34: *
                     35: *> \par Purpose:
                     36: *  =============
                     37: *>
                     38: *> \verbatim
                     39: *>
                     40: *> ZHETRS_AA solves a system of linear equations A*X = B with a complex
                     41: *> hermitian matrix A using the factorization A = U*T*U**H or
                     42: *> A = L*T*L**T computed by ZHETRF_AA.
                     43: *> \endverbatim
                     44: *
                     45: *  Arguments:
                     46: *  ==========
                     47: *
                     48: *> \param[in] UPLO
                     49: *> \verbatim
                     50: *>          UPLO is CHARACTER*1
                     51: *>          Specifies whether the details of the factorization are stored
                     52: *>          as an upper or lower triangular matrix.
                     53: *>          = 'U':  Upper triangular, form is A = U*T*U**H;
                     54: *>          = 'L':  Lower triangular, form is A = L*T*L**H.
                     55: *> \endverbatim
                     56: *>
                     57: *> \param[in] N
                     58: *> \verbatim
                     59: *>          N is INTEGER
                     60: *>          The order of the matrix A.  N >= 0.
                     61: *> \endverbatim
                     62: *>
                     63: *> \param[in] NRHS
                     64: *> \verbatim
                     65: *>          NRHS is INTEGER
                     66: *>          The number of right hand sides, i.e., the number of columns
                     67: *>          of the matrix B.  NRHS >= 0.
                     68: *> \endverbatim
                     69: *>
1.3     ! bertrand   70: *> \param[in] A
1.1       bertrand   71: *> \verbatim
                     72: *>          A is COMPLEX*16 array, dimension (LDA,N)
                     73: *>          Details of factors computed by ZHETRF_AA.
                     74: *> \endverbatim
                     75: *>
                     76: *> \param[in] LDA
                     77: *> \verbatim
                     78: *>          LDA is INTEGER
                     79: *>          The leading dimension of the array A.  LDA >= max(1,N).
                     80: *> \endverbatim
                     81: *>
                     82: *> \param[in] IPIV
                     83: *> \verbatim
                     84: *>          IPIV is INTEGER array, dimension (N)
                     85: *>          Details of the interchanges as computed by ZHETRF_AA.
                     86: *> \endverbatim
                     87: *>
                     88: *> \param[in,out] B
                     89: *> \verbatim
                     90: *>          B is COMPLEX*16 array, dimension (LDB,NRHS)
                     91: *>          On entry, the right hand side matrix B.
                     92: *>          On exit, the solution matrix X.
                     93: *> \endverbatim
                     94: *>
                     95: *> \param[in] LDB
                     96: *> \verbatim
                     97: *>          LDB is INTEGER
                     98: *>          The leading dimension of the array B.  LDB >= max(1,N).
                     99: *> \endverbatim
                    100: *>
                    101: *> \param[in] WORK
                    102: *> \verbatim
                    103: *>          WORK is DOUBLE array, dimension (MAX(1,LWORK))
                    104: *> \endverbatim
                    105: *>
                    106: *> \param[in] LWORK
                    107: *> \verbatim
                    108: *>          LWORK is INTEGER, LWORK >= MAX(1,3*N-2).
                    109: *>
                    110: *> \param[out] INFO
                    111: *> \verbatim
                    112: *>          INFO is INTEGER
                    113: *>          = 0:  successful exit
                    114: *>          < 0:  if INFO = -i, the i-th argument had an illegal value
                    115: *> \endverbatim
                    116: *
                    117: *  Authors:
                    118: *  ========
                    119: *
                    120: *> \author Univ. of Tennessee
                    121: *> \author Univ. of California Berkeley
                    122: *> \author Univ. of Colorado Denver
                    123: *> \author NAG Ltd.
                    124: *
1.3     ! bertrand  125: *> \date November 2017
1.1       bertrand  126: *
                    127: *> \ingroup complex16HEcomputational
                    128: *
                    129: *  =====================================================================
                    130:       SUBROUTINE ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
                    131:      $                      WORK, LWORK, INFO )
                    132: *
1.3     ! bertrand  133: *  -- LAPACK computational routine (version 3.8.0) --
1.1       bertrand  134: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                    135: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.3     ! bertrand  136: *     November 2017
1.1       bertrand  137: *
                    138:       IMPLICIT NONE
                    139: *
                    140: *     .. Scalar Arguments ..
                    141:       CHARACTER          UPLO
                    142:       INTEGER            N, NRHS, LDA, LDB, LWORK, INFO
                    143: *     ..
                    144: *     .. Array Arguments ..
                    145:       INTEGER            IPIV( * )
                    146:       COMPLEX*16         A( LDA, * ), B( LDB, * ), WORK( * )
                    147: *     ..
                    148: *
                    149: *  =====================================================================
                    150: *
                    151:       COMPLEX*16         ONE
                    152:       PARAMETER          ( ONE = 1.0D+0 )
                    153: *     ..
                    154: *     .. Local Scalars ..
                    155:       LOGICAL            LQUERY, UPPER
                    156:       INTEGER            K, KP, LWKOPT
                    157: *     ..
                    158: *     .. External Functions ..
                    159:       LOGICAL            LSAME
                    160:       EXTERNAL           LSAME
                    161: *     ..
                    162: *     .. External Subroutines ..
1.3     ! bertrand  163:       EXTERNAL           ZGTSV, ZSWAP, ZTRSM, ZLACGV, ZLACPY, XERBLA
1.1       bertrand  164: *     ..
                    165: *     .. Intrinsic Functions ..
                    166:       INTRINSIC          MAX
                    167: *     ..
                    168: *     .. Executable Statements ..
                    169: *
                    170:       INFO = 0
                    171:       UPPER = LSAME( UPLO, 'U' )
                    172:       LQUERY = ( LWORK.EQ.-1 )
                    173:       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
                    174:          INFO = -1
                    175:       ELSE IF( N.LT.0 ) THEN
                    176:          INFO = -2
                    177:       ELSE IF( NRHS.LT.0 ) THEN
                    178:          INFO = -3
                    179:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
                    180:          INFO = -5
                    181:       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
                    182:          INFO = -8
                    183:       ELSE IF( LWORK.LT.MAX( 1, 3*N-2 ) .AND. .NOT.LQUERY ) THEN
                    184:          INFO = -10
                    185:       END IF
                    186:       IF( INFO.NE.0 ) THEN
                    187:          CALL XERBLA( 'ZHETRS_AA', -INFO )
                    188:          RETURN
                    189:       ELSE IF( LQUERY ) THEN
                    190:          LWKOPT = (3*N-2)
                    191:          WORK( 1 ) = LWKOPT
                    192:          RETURN
                    193:       END IF
                    194: *
                    195: *     Quick return if possible
                    196: *
                    197:       IF( N.EQ.0 .OR. NRHS.EQ.0 )
                    198:      $   RETURN
                    199: *
                    200:       IF( UPPER ) THEN
                    201: *
                    202: *        Solve A*X = B, where A = U*T*U**T.
                    203: *
                    204: *        Pivot, P**T * B
                    205: *
                    206:          DO K = 1, N
                    207:             KP = IPIV( K )
                    208:             IF( KP.NE.K )
                    209:      $          CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
                    210:          END DO
                    211: *
                    212: *        Compute (U \P**T * B) -> B    [ (U \P**T * B) ]
                    213: *
                    214:          CALL ZTRSM('L', 'U', 'C', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,
                    215:      $               B( 2, 1 ), LDB)
                    216: *
                    217: *        Compute T \ B -> B   [ T \ (U \P**T * B) ]
                    218: *
                    219:          CALL ZLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1)
                    220:          IF( N.GT.1 ) THEN
                    221:              CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), 1)
                    222:              CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), 1)
                    223:              CALL ZLACGV( N-1, WORK( 1 ), 1 )
                    224:          END IF
                    225:          CALL ZGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB,
                    226:      $              INFO)
                    227: *
                    228: *        Compute (U**T \ B) -> B   [ U**T \ (T \ (U \P**T * B) ) ]
                    229: *
                    230:          CALL ZTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,
                    231:      $               B(2, 1), LDB)
                    232: *
                    233: *        Pivot, P * B  [ P * (U**T \ (T \ (U \P**T * B) )) ]
                    234: *
                    235:          DO K = N, 1, -1
                    236:             KP = IPIV( K )
                    237:             IF( KP.NE.K )
                    238:      $         CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
                    239:          END DO
                    240: *
                    241:       ELSE
                    242: *
                    243: *        Solve A*X = B, where A = L*T*L**T.
                    244: *
                    245: *        Pivot, P**T * B
                    246: *
                    247:          DO K = 1, N
                    248:             KP = IPIV( K )
                    249:             IF( KP.NE.K )
                    250:      $         CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
                    251:          END DO
                    252: *
                    253: *        Compute (L \P**T * B) -> B    [ (L \P**T * B) ]
                    254: *
                    255:          CALL ZTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA,
                    256:      $               B(2, 1), LDB)
                    257: *
                    258: *        Compute T \ B -> B   [ T \ (L \P**T * B) ]
                    259: *
                    260:          CALL ZLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1)
                    261:          IF( N.GT.1 ) THEN
                    262:              CALL ZLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), 1)
                    263:              CALL ZLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), 1)
                    264:              CALL ZLACGV( N-1, WORK( 2*N ), 1 )
                    265:          END IF
                    266:          CALL ZGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB,
                    267:      $              INFO)
                    268: *
                    269: *        Compute (L**T \ B) -> B   [ L**T \ (T \ (L \P**T * B) ) ]
                    270: *
                    271:          CALL ZTRSM( 'L', 'L', 'C', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA,
                    272:      $              B( 2, 1 ), LDB)
                    273: *
                    274: *        Pivot, P * B  [ P * (L**T \ (T \ (L \P**T * B) )) ]
                    275: *
                    276:          DO K = N, 1, -1
                    277:             KP = IPIV( K )
                    278:             IF( KP.NE.K )
                    279:      $         CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
                    280:          END DO
                    281: *
                    282:       END IF
                    283: *
                    284:       RETURN
                    285: *
                    286: *     End of ZHETRS_AA
                    287: *
                    288:       END

CVSweb interface <joel.bertrand@systella.fr>