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