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