LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
zhetrs_aa_2stage.f
Go to the documentation of this file.
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*> Download ZHETRS_AA_2STAGE + dependencies
11*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetrs_aa_2stage.f">
12*> [TGZ]</a>
13*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetrs_aa_2stage.f">
14*> [ZIP]</a>
15*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetrs_aa_2stage.f">
16*> [TXT]</a>
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE ZHETRS_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*> ZHETRS_AA_2STAGE solves a system of linear equations A*X = B with a
39*> hermitian matrix A using the factorization A = U**H*T*U or
40*> A = L*T*L**H computed by ZHETRF_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**H*T*U;
52*> = 'L': Lower triangular, form is A = L*T*L**H.
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 ZHETRF_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 ZHETRF_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*> ZHETRF_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*> ZHETRF_AA_2STAGE.
104*> \endverbatim
105*>
106*> \param[in,out] B
107*> \verbatim
108*> B is COMPLEX*16 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 hetrs_aa_2stage
135*
136* =====================================================================
137 SUBROUTINE zhetrs_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*16 A( LDA, * ), TB( * ), B( LDB, * )
153* ..
154*
155* =====================================================================
156*
157 COMPLEX*16 ONE
158 parameter( one = ( 1.0d+0, 0.0d+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 zgbtrs, zlaswp, ztrsm, 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( 'ZHETRS_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**H*T*U.
209*
210 IF( n.GT.nb ) THEN
211*
212* Pivot, P**T * B -> B
213*
214 CALL zlaswp( nrhs, b, ldb, nb+1, n, ipiv, 1 )
215*
216* Compute (U**H \ B) -> B [ (U**H \P**T * B) ]
217*
218 CALL ztrsm( 'L', 'U', 'C', 'U', n-nb, nrhs, one, a(1,
219 $ nb+1),
220 $ lda, b(nb+1, 1), ldb)
221*
222 END IF
223*
224* Compute T \ B -> B [ T \ (U**H \P**T * B) ]
225*
226 CALL zgbtrs( 'N', n, nb, nb, nrhs, tb, ldtb, ipiv2, b, ldb,
227 $ info)
228 IF( n.GT.nb ) THEN
229*
230* Compute (U \ B) -> B [ U \ (T \ (U**H \P**T * B) ) ]
231*
232 CALL ztrsm( 'L', 'U', 'N', 'U', n-nb, nrhs, one, a(1,
233 $ nb+1),
234 $ lda, b(nb+1, 1), ldb)
235*
236* Pivot, P * B -> B [ P * (U \ (T \ (U**H \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**H.
245*
246 IF( n.GT.nb ) THEN
247*
248* Pivot, P**T * B -> B
249*
250 CALL zlaswp( nrhs, b, ldb, nb+1, n, ipiv, 1 )
251*
252* Compute (L \ B) -> B [ (L \P**T * B) ]
253*
254 CALL ztrsm( 'L', 'L', 'N', 'U', n-nb, nrhs, one, a(nb+1,
255 $ 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 zgbtrs( 'N', n, nb, nb, nrhs, tb, ldtb, ipiv2, b, ldb,
263 $ info)
264 IF( n.GT.nb ) THEN
265*
266* Compute (L**H \ B) -> B [ L**H \ (T \ (L \P**T * B) ) ]
267*
268 CALL ztrsm( 'L', 'L', 'C', 'U', n-nb, nrhs, one, a(nb+1,
269 $ 1),
270 $ lda, b(nb+1, 1), ldb)
271*
272* Pivot, P * B -> B [ P * (L**H \ (T \ (L \P**T * B) )) ]
273*
274 CALL zlaswp( nrhs, b, ldb, nb+1, n, ipiv, -1 )
275*
276 END IF
277 END IF
278*
279 RETURN
280*
281* End of ZHETRS_AA_2STAGE
282*
283 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine zgbtrs(trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info)
ZGBTRS
Definition zgbtrs.f:137
subroutine zhetrs_aa_2stage(uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, info)
ZHETRS_AA_2STAGE
subroutine zlaswp(n, a, lda, k1, k2, ipiv, incx)
ZLASWP performs a series of row interchanges on a general rectangular matrix.
Definition zlaswp.f:113
subroutine ztrsm(side, uplo, transa, diag, m, n, alpha, a, lda, b, ldb)
ZTRSM
Definition ztrsm.f:180