Annotation of rpl/lapack/lapack/zhetrs_aa.f, revision 1.1
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: *>
! 70: *> \param[in,out] A
! 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: *
! 125: *> \date December 2016
! 126: *
! 127: *> \ingroup complex16HEcomputational
! 128: *
! 129: * =====================================================================
! 130: SUBROUTINE ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
! 131: $ WORK, LWORK, INFO )
! 132: *
! 133: * -- LAPACK computational routine (version 3.7.0) --
! 134: * -- LAPACK is a software package provided by Univ. of Tennessee, --
! 135: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
! 136: * December 2016
! 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 ..
! 163: EXTERNAL ZGTSV, ZSWAP, ZTRSM, XERBLA
! 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>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zhetrs_aa.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack