1*> \brief \b CHETRS_AA_2STAGE 2* 3* @generated from SRC/dsytrs_aa_2stage.f, fortran d -> c, Mon Oct 30 11:59:02 2017 4* 5* =========== DOCUMENTATION =========== 6* 7* Online html documentation available at 8* http://www.netlib.org/lapack/explore-html/ 9* 10*> \htmlonly 11*> Download CHETRS_AA_2STAGE + dependencies 12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetrs_aa_2stage.f"> 13*> [TGZ]</a> 14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetrs_aa_2stage.f"> 15*> [ZIP]</a> 16*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetrs_aa_2stage.f"> 17*> [TXT]</a> 18*> \endhtmlonly 19* 20* Definition: 21* =========== 22* 23* SUBROUTINE CHETRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, IPIV, 24* IPIV2, B, LDB, INFO ) 25* 26* .. Scalar Arguments .. 27* CHARACTER UPLO 28* INTEGER N, NRHS, LDA, LTB, LDB, INFO 29* .. 30* .. Array Arguments .. 31* INTEGER IPIV( * ), IPIV2( * ) 32* COMPLEX A( LDA, * ), TB( * ), B( LDB, * ) 33* .. 34* 35*> \par Purpose: 36* ============= 37*> 38*> \verbatim 39*> 40*> CHETRS_AA_2STAGE solves a system of linear equations A*X = B with a real 41*> hermitian matrix A using the factorization A = U**T*T*U or 42*> A = L*T*L**T computed by CHETRF_AA_2STAGE. 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*T*U; 54*> = 'L': Lower triangular, form is A = L*T*L**T. 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] A 71*> \verbatim 72*> A is COMPLEX array, dimension (LDA,N) 73*> Details of factors computed by CHETRF_AA_2STAGE. 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[out] TB 83*> \verbatim 84*> TB is COMPLEX array, dimension (LTB) 85*> Details of factors computed by CHETRF_AA_2STAGE. 86*> \endverbatim 87*> 88*> \param[in] LTB 89*> \verbatim 90*> LTB is INTEGER 91*> The size of the array TB. LTB >= 4*N. 92*> \endverbatim 93*> 94*> \param[in] IPIV 95*> \verbatim 96*> IPIV is INTEGER array, dimension (N) 97*> Details of the interchanges as computed by 98*> CHETRF_AA_2STAGE. 99*> \endverbatim 100*> 101*> \param[in] IPIV2 102*> \verbatim 103*> IPIV2 is INTEGER array, dimension (N) 104*> Details of the interchanges as computed by 105*> CHETRF_AA_2STAGE. 106*> \endverbatim 107*> 108*> \param[in,out] B 109*> \verbatim 110*> B is COMPLEX array, dimension (LDB,NRHS) 111*> On entry, the right hand side matrix B. 112*> On exit, the solution matrix X. 113*> \endverbatim 114*> 115*> \param[in] LDB 116*> \verbatim 117*> LDB is INTEGER 118*> The leading dimension of the array B. LDB >= max(1,N). 119*> \endverbatim 120*> 121*> \param[out] INFO 122*> \verbatim 123*> INFO is INTEGER 124*> = 0: successful exit 125*> < 0: if INFO = -i, the i-th argument had an illegal value 126*> \endverbatim 127* 128* Authors: 129* ======== 130* 131*> \author Univ. of Tennessee 132*> \author Univ. of California Berkeley 133*> \author Univ. of Colorado Denver 134*> \author NAG Ltd. 135* 136*> \ingroup complexSYcomputational 137* 138* ===================================================================== 139 SUBROUTINE CHETRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, 140 $ IPIV, IPIV2, B, LDB, INFO ) 141* 142* -- LAPACK computational routine -- 143* -- LAPACK is a software package provided by Univ. of Tennessee, -- 144* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 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 A( LDA, * ), TB( * ), B( LDB, * ) 155* .. 156* 157* ===================================================================== 158* 159 COMPLEX 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 CGBTRS, CLASWP, CTRSM, 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( 'CHETRS_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*T*U. 211* 212 IF( N.GT.NB ) THEN 213* 214* Pivot, P**T * B -> B 215* 216 CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 ) 217* 218* Compute (U**T \ B) -> B [ (U**T \P**T * B) ] 219* 220 CALL CTRSM( 'L', 'U', 'C', '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 CGBTRS( '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 CTRSM( '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 CLASWP( 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 CLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 ) 251* 252* Compute (L \P**T * B) -> B [ (L \P**T * B) ] 253* 254 CALL CTRSM( '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 CGBTRS( '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 CTRSM( 'L', 'L', 'C', '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 CLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 ) 273* 274 END IF 275 END IF 276* 277 RETURN 278* 279* End of CHETRS_AA_2STAGE 280* 281 END 282