LAPACK  3.7.0
LAPACK: Linear Algebra PACKage
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

Download ZHETRS_AA + dependencies [TGZ] [ZIP] [TXT]

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,out]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
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
December 2016

Definition at line 132 of file zhetrs_aa.f.

132 *
133 * -- LAPACK computational routine (version 3.7.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 * December 2016
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, 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 *
zswap
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
Definition: zswap.f:52
zlacpy
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
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
zlacgv
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
Definition: zlacgv.f:76
ztrsm
subroutine ztrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRSM
Definition: ztrsm.f:182
zgtsv
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

Here is the call graph for this function:

Here is the caller graph for this function: