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