1*> \brief \b ZHETRS_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 ZHETRS_AA_2STAGE + dependencies 12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetrs_aa_2stage.f"> 13*> [TGZ]</a> 14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetrs_aa_2stage.f"> 15*> [ZIP]</a> 16*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetrs_aa_2stage.f"> 17*> [TXT]</a> 18*> \endhtmlonly 19* 20* Definition: 21* =========== 22* 23* SUBROUTINE ZHETRS_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*16 A( LDA, * ), TB( * ), B( LDB, * ) 33* .. 34* 35*> \par Purpose: 36* ============= 37*> 38*> \verbatim 39*> 40*> ZHETRS_AA_2STAGE solves a system of linear equations A*X = B with a 41*> hermitian matrix A using the factorization A = U**H*T*U or 42*> A = L*T*L**H computed by ZHETRF_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**H*T*U; 54*> = 'L': Lower triangular, form is A = L*T*L**H. 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*16 array, dimension (LDA,N) 73*> Details of factors computed by ZHETRF_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*16 array, dimension (LTB) 85*> Details of factors computed by ZHETRF_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*> ZHETRF_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*> ZHETRF_AA_2STAGE. 106*> \endverbatim 107*> 108*> \param[in,out] B 109*> \verbatim 110*> B is COMPLEX*16 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*> \date November 2017 137* 138*> \ingroup complex16SYcomputational 139* 140* ===================================================================== 141 SUBROUTINE ZHETRS_AA_2STAGE( UPLO, N, NRHS, A, LDA, TB, LTB, 142 $ IPIV, IPIV2, B, LDB, INFO ) 143* 144* -- LAPACK computational routine (version 3.8.0) -- 145* -- LAPACK is a software package provided by Univ. of Tennessee, -- 146* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 147* November 2017 148* 149 IMPLICIT NONE 150* 151* .. Scalar Arguments .. 152 CHARACTER UPLO 153 INTEGER N, NRHS, LDA, LTB, LDB, INFO 154* .. 155* .. Array Arguments .. 156 INTEGER IPIV( * ), IPIV2( * ) 157 COMPLEX*16 A( LDA, * ), TB( * ), B( LDB, * ) 158* .. 159* 160* ===================================================================== 161* 162 COMPLEX*16 ONE 163 PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) ) 164* .. 165* .. Local Scalars .. 166 INTEGER LDTB, NB 167 LOGICAL UPPER 168* .. 169* .. External Functions .. 170 LOGICAL LSAME 171 EXTERNAL LSAME 172* .. 173* .. External Subroutines .. 174 EXTERNAL ZGBTRS, ZLASWP, ZTRSM, XERBLA 175* .. 176* .. Intrinsic Functions .. 177 INTRINSIC MAX 178* .. 179* .. Executable Statements .. 180* 181 INFO = 0 182 UPPER = LSAME( UPLO, 'U' ) 183 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 184 INFO = -1 185 ELSE IF( N.LT.0 ) THEN 186 INFO = -2 187 ELSE IF( NRHS.LT.0 ) THEN 188 INFO = -3 189 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 190 INFO = -5 191 ELSE IF( LTB.LT.( 4*N ) ) THEN 192 INFO = -7 193 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN 194 INFO = -11 195 END IF 196 IF( INFO.NE.0 ) THEN 197 CALL XERBLA( 'ZHETRS_AA_2STAGE', -INFO ) 198 RETURN 199 END IF 200* 201* Quick return if possible 202* 203 IF( N.EQ.0 .OR. NRHS.EQ.0 ) 204 $ RETURN 205* 206* Read NB and compute LDTB 207* 208 NB = INT( TB( 1 ) ) 209 LDTB = LTB/N 210* 211 IF( UPPER ) THEN 212* 213* Solve A*X = B, where A = U**H*T*U. 214* 215 IF( N.GT.NB ) THEN 216* 217* Pivot, P**T * B -> B 218* 219 CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 ) 220* 221* Compute (U**H \ B) -> B [ (U**H \P**T * B) ] 222* 223 CALL ZTRSM( 'L', 'U', 'C', 'U', N-NB, NRHS, ONE, A(1, NB+1), 224 $ LDA, B(NB+1, 1), LDB) 225* 226 END IF 227* 228* Compute T \ B -> B [ T \ (U**H \P**T * B) ] 229* 230 CALL ZGBTRS( 'N', N, NB, NB, NRHS, TB, LDTB, IPIV2, B, LDB, 231 $ INFO) 232 IF( N.GT.NB ) THEN 233* 234* Compute (U \ B) -> B [ U \ (T \ (U**H \P**T * B) ) ] 235* 236 CALL ZTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1), 237 $ LDA, B(NB+1, 1), LDB) 238* 239* Pivot, P * B -> B [ P * (U \ (T \ (U**H \P**T * B) )) ] 240* 241 CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 ) 242* 243 END IF 244* 245 ELSE 246* 247* Solve A*X = B, where A = L*T*L**H. 248* 249 IF( N.GT.NB ) THEN 250* 251* Pivot, P**T * B -> B 252* 253 CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 ) 254* 255* Compute (L \ B) -> B [ (L \P**T * B) ] 256* 257 CALL ZTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1), 258 $ LDA, B(NB+1, 1), LDB) 259* 260 END IF 261* 262* Compute T \ B -> B [ T \ (L \P**T * B) ] 263* 264 CALL ZGBTRS( 'N', N, NB, NB, NRHS, TB, LDTB, IPIV2, B, LDB, 265 $ INFO) 266 IF( N.GT.NB ) THEN 267* 268* Compute (L**H \ B) -> B [ L**H \ (T \ (L \P**T * B) ) ] 269* 270 CALL ZTRSM( 'L', 'L', 'C', 'U', N-NB, NRHS, ONE, A(NB+1, 1), 271 $ LDA, B(NB+1, 1), LDB) 272* 273* Pivot, P * B -> B [ P * (L**H \ (T \ (L \P**T * B) )) ] 274* 275 CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 ) 276* 277 END IF 278 END IF 279* 280 RETURN 281* 282* End of ZHETRS_AA_2STAGE 283* 284 END 285