 LAPACK  3.8.0 LAPACK: Linear Algebra PACKage

◆ zhetrs_aa()

 subroutine zhetrs_aa ( character UPLO, integer N, integer NRHS, complex*16, dimension( lda, * ) A, integer LDA, integer, dimension( * ) IPIV, complex*16, dimension( ldb, * ) B, integer LDB, complex*16, dimension( * ) WORK, integer LWORK, integer INFO )

ZHETRS_AA

Purpose:
``` ZHETRS_AA solves a system of linear equations A*X = B with a complex
hermitian matrix A using the factorization A = U*T*U**H or
A = L*T*L**T computed by ZHETRF_AA.```
Parameters
 [in] UPLO ``` UPLO is CHARACTER*1 Specifies whether the details of the factorization are stored as an upper or lower triangular matrix. = 'U': Upper triangular, form is A = U*T*U**H; = 'L': Lower triangular, form is A = L*T*L**H.``` [in] N ``` N is INTEGER The order of the matrix A. N >= 0.``` [in] NRHS ``` NRHS is INTEGER The number of right hand sides, i.e., the number of columns of the matrix B. NRHS >= 0.``` [in] A ``` A is COMPLEX*16 array, dimension (LDA,N) Details of factors computed by ZHETRF_AA.``` [in] LDA ``` LDA is INTEGER The leading dimension of the array A. LDA >= max(1,N).``` [in] IPIV ``` IPIV is INTEGER array, dimension (N) Details of the interchanges as computed by ZHETRF_AA.``` [in,out] B ``` B is COMPLEX*16 array, dimension (LDB,NRHS) On entry, the right hand side matrix B. On exit, the solution matrix X.``` [in] LDB ``` LDB is INTEGER The leading dimension of the array B. LDB >= max(1,N).``` [in] WORK ` WORK is DOUBLE array, dimension (MAX(1,LWORK))` [in] LWORK ``` LWORK is INTEGER, LWORK >= MAX(1,3*N-2). \param[out] INFO \verbatim INFO is INTEGER = 0: successful exit < 0: if INFO = -i, the i-th argument had an illegal value```
Date
November 2017

Definition at line 132 of file zhetrs_aa.f.

132 *
133 * -- LAPACK computational routine (version 3.8.0) --
134 * -- LAPACK is a software package provided by Univ. of Tennessee, --
135 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
136 * November 2017
137 *
138  IMPLICIT NONE
139 *
140 * .. Scalar Arguments ..
141  CHARACTER uplo
142  INTEGER n, nrhs, lda, ldb, lwork, info
143 * ..
144 * .. Array Arguments ..
145  INTEGER ipiv( * )
146  COMPLEX*16 a( lda, * ), b( ldb, * ), work( * )
147 * ..
148 *
149 * =====================================================================
150 *
151  COMPLEX*16 one
152  parameter( one = 1.0d+0 )
153 * ..
154 * .. Local Scalars ..
155  LOGICAL lquery, upper
156  INTEGER k, kp, lwkopt
157 * ..
158 * .. External Functions ..
159  LOGICAL lsame
160  EXTERNAL lsame
161 * ..
162 * .. External Subroutines ..
163  EXTERNAL zgtsv, zswap, ztrsm, zlacgv, zlacpy, xerbla
164 * ..
165 * .. Intrinsic Functions ..
166  INTRINSIC max
167 * ..
168 * .. Executable Statements ..
169 *
170  info = 0
171  upper = lsame( uplo, 'U' )
172  lquery = ( lwork.EQ.-1 )
173  IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
174  info = -1
175  ELSE IF( n.LT.0 ) THEN
176  info = -2
177  ELSE IF( nrhs.LT.0 ) THEN
178  info = -3
179  ELSE IF( lda.LT.max( 1, n ) ) THEN
180  info = -5
181  ELSE IF( ldb.LT.max( 1, n ) ) THEN
182  info = -8
183  ELSE IF( lwork.LT.max( 1, 3*n-2 ) .AND. .NOT.lquery ) THEN
184  info = -10
185  END IF
186  IF( info.NE.0 ) THEN
187  CALL xerbla( 'ZHETRS_AA', -info )
188  RETURN
189  ELSE IF( lquery ) THEN
190  lwkopt = (3*n-2)
191  work( 1 ) = lwkopt
192  RETURN
193  END IF
194 *
195 * Quick return if possible
196 *
197  IF( n.EQ.0 .OR. nrhs.EQ.0 )
198  \$ RETURN
199 *
200  IF( upper ) THEN
201 *
202 * Solve A*X = B, where A = U*T*U**T.
203 *
204 * Pivot, P**T * B
205 *
206  DO k = 1, n
207  kp = ipiv( k )
208  IF( kp.NE.k )
209  \$ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
210  END DO
211 *
212 * Compute (U \P**T * B) -> B [ (U \P**T * B) ]
213 *
214  CALL ztrsm('L', 'U', 'C', 'U', n-1, nrhs, one, a( 1, 2 ), lda,
215  \$ b( 2, 1 ), ldb)
216 *
217 * Compute T \ B -> B [ T \ (U \P**T * B) ]
218 *
219  CALL zlacpy( 'F', 1, n, a(1, 1), lda+1, work(n), 1)
220  IF( n.GT.1 ) THEN
221  CALL zlacpy( 'F', 1, n-1, a( 1, 2 ), lda+1, work( 2*n ), 1)
222  CALL zlacpy( 'F', 1, n-1, a( 1, 2 ), lda+1, work( 1 ), 1)
223  CALL zlacgv( n-1, work( 1 ), 1 )
224  END IF
225  CALL zgtsv(n, nrhs, work(1), work(n), work(2*n), b, ldb,
226  \$ info)
227 *
228 * Compute (U**T \ B) -> B [ U**T \ (T \ (U \P**T * B) ) ]
229 *
230  CALL ztrsm( 'L', 'U', 'N', 'U', n-1, nrhs, one, a( 1, 2 ), lda,
231  \$ b(2, 1), ldb)
232 *
233 * Pivot, P * B [ P * (U**T \ (T \ (U \P**T * B) )) ]
234 *
235  DO k = n, 1, -1
236  kp = ipiv( k )
237  IF( kp.NE.k )
238  \$ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
239  END DO
240 *
241  ELSE
242 *
243 * Solve A*X = B, where A = L*T*L**T.
244 *
245 * Pivot, P**T * B
246 *
247  DO k = 1, n
248  kp = ipiv( k )
249  IF( kp.NE.k )
250  \$ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
251  END DO
252 *
253 * Compute (L \P**T * B) -> B [ (L \P**T * B) ]
254 *
255  CALL ztrsm( 'L', 'L', 'N', 'U', n-1, nrhs, one, a( 2, 1 ), lda,
256  \$ b(2, 1), ldb)
257 *
258 * Compute T \ B -> B [ T \ (L \P**T * B) ]
259 *
260  CALL zlacpy( 'F', 1, n, a(1, 1), lda+1, work(n), 1)
261  IF( n.GT.1 ) THEN
262  CALL zlacpy( 'F', 1, n-1, a( 2, 1 ), lda+1, work( 1 ), 1)
263  CALL zlacpy( 'F', 1, n-1, a( 2, 1 ), lda+1, work( 2*n ), 1)
264  CALL zlacgv( n-1, work( 2*n ), 1 )
265  END IF
266  CALL zgtsv(n, nrhs, work(1), work(n), work(2*n), b, ldb,
267  \$ info)
268 *
269 * Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ]
270 *
271  CALL ztrsm( 'L', 'L', 'C', 'U', n-1, nrhs, one, a( 2, 1 ), lda,
272  \$ b( 2, 1 ), ldb)
273 *
274 * Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ]
275 *
276  DO k = n, 1, -1
277  kp = ipiv( k )
278  IF( kp.NE.k )
279  \$ CALL zswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
280  END DO
281 *
282  END IF
283 *
284  RETURN
285 *
286 * End of ZHETRS_AA
287 *
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
Definition: zlacgv.f:76
subroutine zgtsv(N, NRHS, DL, D, DU, B, LDB, INFO)
ZGTSV computes the solution to system of linear equations A * X = B for GT matrices ...
Definition: zgtsv.f:126
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
Definition: zswap.f:83
subroutine ztrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRSM
Definition: ztrsm.f:182
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
Here is the call graph for this function:
Here is the caller graph for this function: