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*> \date November 2017 135* 136*> \ingroup complexSYcomputational 137* 138* ===================================================================== 139 SUBROUTINE CSYTRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, 140 $ IPIV, IPIV2, B, LDB, INFO ) 141* 142* -- LAPACK computational routine (version 3.8.0) -- 143* -- LAPACK is a software package provided by Univ. of Tennessee, -- 144* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 145* November 2017 146* 147 IMPLICIT NONE 148* 149* .. Scalar Arguments .. 150 CHARACTER UPLO 151 INTEGER N, NRHS, LDA, LTB, LDB, INFO 152* .. 153* .. Array Arguments .. 154 INTEGER IPIV( * ), IPIV2( * ) 155 COMPLEX A( LDA, * ), TB( * ), B( LDB, * ) 156* .. 157* 158* ===================================================================== 159* 160 COMPLEX ONE 161 PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) 162* .. 163* .. Local Scalars .. 164 INTEGER LDTB, NB 165 LOGICAL UPPER 166* .. 167* .. External Functions .. 168 LOGICAL LSAME 169 EXTERNAL LSAME 170* .. 171* .. External Subroutines .. 172 EXTERNAL CGBTRS, CLASWP, CTRSM, XERBLA 173* .. 174* .. Intrinsic Functions .. 175 INTRINSIC MAX 176* .. 177* .. Executable Statements .. 178* 179 INFO = 0 180 UPPER = LSAME( UPLO, 'U' ) 181 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 182 INFO = -1 183 ELSE IF( N.LT.0 ) THEN 184 INFO = -2 185 ELSE IF( NRHS.LT.0 ) THEN 186 INFO = -3 187 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 188 INFO = -5 189 ELSE IF( LTB.LT.( 4*N ) ) THEN 190 INFO = -7 191 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN 192 INFO = -11 193 END IF 194 IF( INFO.NE.0 ) THEN 195 CALL XERBLA( 'CSYTRS_AA_2STAGE', -INFO ) 196 RETURN 197 END IF 198* 199* Quick return if possible 200* 201 IF( N.EQ.0 .OR. NRHS.EQ.0 ) 202 $ RETURN 203* 204* Read NB and compute LDTB 205* 206 NB = INT( TB( 1 ) ) 207 LDTB = LTB/N 208* 209 IF( UPPER ) THEN 210* 211* Solve A*X = B, where A = U**T*T*U. 212* 213 IF( N.GT.NB ) THEN 214* 215* Pivot, P**T * B -> B 216* 217 CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 ) 218* 219* Compute (U**T \ B) -> B [ (U**T \P**T * B) ] 220* 221 CALL CTRSM( 'L', 'U', 'T', 'U', N-NB, NRHS, ONE, A(1, NB+1), 222 $ LDA, B(NB+1, 1), LDB) 223* 224 END IF 225* 226* Compute T \ B -> B [ T \ (U**T \P**T * B) ] 227* 228 CALL CGBTRS( 'N', N, NB, NB, NRHS, TB, LDTB, IPIV2, B, LDB, 229 $ INFO) 230 IF( N.GT.NB ) THEN 231* 232* Compute (U \ B) -> B [ U \ (T \ (U**T \P**T * B) ) ] 233* 234 CALL CTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1), 235 $ LDA, B(NB+1, 1), LDB) 236* 237* Pivot, P * B -> B [ P * (U \ (T \ (U**T \P**T * B) )) ] 238* 239 CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 ) 240* 241 END IF 242* 243 ELSE 244* 245* Solve A*X = B, where A = L*T*L**T. 246* 247 IF( N.GT.NB ) THEN 248* 249* Pivot, P**T * B -> B 250* 251 CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 ) 252* 253* Compute (L \ B) -> B [ (L \P**T * B) ] 254* 255 CALL CTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1), 256 $ LDA, B(NB+1, 1), LDB) 257* 258 END IF 259* 260* Compute T \ B -> B [ T \ (L \P**T * B) ] 261* 262 CALL CGBTRS( 'N', N, NB, NB, NRHS, TB, LDTB, IPIV2, B, LDB, 263 $ INFO) 264 IF( N.GT.NB ) THEN 265* 266* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] 267* 268 CALL CTRSM( 'L', 'L', 'T', 'U', N-NB, NRHS, ONE, A(NB+1, 1), 269 $ LDA, B(NB+1, 1), LDB) 270* 271* Pivot, P * B -> B [ P * (L**T \ (T \ (L \P**T * B) )) ] 272* 273 CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 ) 274* 275 END IF 276 END IF 277* 278 RETURN 279* 280* End of CSYTRS_AA_2STAGE 281* 282 END 283