LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ zhetrf_aa_2stage()

subroutine zhetrf_aa_2stage ( character  uplo,
integer  n,
complex*16, dimension( lda, * )  a,
integer  lda,
complex*16, dimension( * )  tb,
integer  ltb,
integer, dimension( * )  ipiv,
integer, dimension( * )  ipiv2,
complex*16, dimension( * )  work,
integer  lwork,
integer  info 
)

ZHETRF_AA_2STAGE

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

Purpose:
 ZHETRF_AA_2STAGE computes the factorization of a double hermitian matrix A
 using the Aasen's algorithm.  The form of the factorization is

    A = U**H*T*U  or  A = L*T*L**H

 where U (or L) is a product of permutation and unit upper (lower)
 triangular matrices, and T is a hermitian band matrix with the
 bandwidth of NB (NB is internally selected and stored in TB( 1 ), and T is 
 LU factorized with partial pivoting).

 This is the blocked version of the algorithm, calling Level 3 BLAS.
Parameters
[in]UPLO
          UPLO is CHARACTER*1
          = 'U':  Upper triangle of A is stored;
          = 'L':  Lower triangle of A is stored.
[in]N
          N is INTEGER
          The order of the matrix A.  N >= 0.
[in,out]A
          A is COMPLEX*16 array, dimension (LDA,N)
          On entry, the hermitian matrix A.  If UPLO = 'U', the leading
          N-by-N upper triangular part of A contains the upper
          triangular part of the matrix A, and the strictly lower
          triangular part of A is not referenced.  If UPLO = 'L', the
          leading N-by-N lower triangular part of A contains the lower
          triangular part of the matrix A, and the strictly upper
          triangular part of A is not referenced.

          On exit, L is stored below (or above) the subdiagonal blocks,
          when UPLO  is 'L' (or 'U').
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,N).
[out]TB
          TB is COMPLEX*16 array, dimension (LTB)
          On exit, details of the LU factorization of the band matrix.
[in]LTB
          LTB is INTEGER
          The size of the array TB. LTB >= 4*N, internally
          used to select NB such that LTB >= (3*NB+1)*N.

          If LTB = -1, then a workspace query is assumed; the
          routine only calculates the optimal size of LTB, 
          returns this value as the first entry of TB, and
          no error message related to LTB is issued by XERBLA.
[out]IPIV
          IPIV is INTEGER array, dimension (N)
          On exit, it contains the details of the interchanges, i.e.,
          the row and column k of A were interchanged with the
          row and column IPIV(k).
[out]IPIV2
          IPIV2 is INTEGER array, dimension (N)
          On exit, it contains the details of the interchanges, i.e.,
          the row and column k of T were interchanged with the
          row and column IPIV(k).
[out]WORK
          WORK is COMPLEX*16 workspace of size LWORK
[in]LWORK
          LWORK is INTEGER
          The size of WORK. LWORK >= N, internally used to select NB
          such that LWORK >= N*NB.

          If LWORK = -1, then a workspace query is assumed; the
          routine only calculates the optimal size of the WORK array,
          returns this value as the first entry of the WORK array, and
          no error message related to LWORK is issued by XERBLA.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value.
          > 0:  if INFO = i, band LU factorization failed on i-th column
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 158 of file zhetrf_aa_2stage.f.

160*
161* -- LAPACK computational routine --
162* -- LAPACK is a software package provided by Univ. of Tennessee, --
163* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
164*
165 IMPLICIT NONE
166*
167* .. Scalar Arguments ..
168 CHARACTER UPLO
169 INTEGER N, LDA, LTB, LWORK, INFO
170* ..
171* .. Array Arguments ..
172 INTEGER IPIV( * ), IPIV2( * )
173 COMPLEX*16 A( LDA, * ), TB( * ), WORK( * )
174* ..
175*
176* =====================================================================
177* .. Parameters ..
178 COMPLEX*16 ZERO, ONE
179 parameter( zero = ( 0.0e+0, 0.0e+0 ),
180 $ one = ( 1.0e+0, 0.0e+0 ) )
181*
182* .. Local Scalars ..
183 LOGICAL UPPER, TQUERY, WQUERY
184 INTEGER I, J, K, I1, I2, TD
185 INTEGER LDTB, NB, KB, JB, NT, IINFO
186 COMPLEX*16 PIV
187* ..
188* .. External Functions ..
189 LOGICAL LSAME
190 INTEGER ILAENV
191 EXTERNAL lsame, ilaenv
192* ..
193* .. External Subroutines ..
194 EXTERNAL xerbla, zcopy, zlacgv, zlacpy,
195 $ zlaset, zgbtrf, zgemm, zgetrf,
196 $ zhegst, zswap, ztrsm
197* ..
198* .. Intrinsic Functions ..
199 INTRINSIC dconjg, min, max
200* ..
201* .. Executable Statements ..
202*
203* Test the input parameters.
204*
205 info = 0
206 upper = lsame( uplo, 'U' )
207 wquery = ( lwork.EQ.-1 )
208 tquery = ( ltb.EQ.-1 )
209 IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
210 info = -1
211 ELSE IF( n.LT.0 ) THEN
212 info = -2
213 ELSE IF( lda.LT.max( 1, n ) ) THEN
214 info = -4
215 ELSE IF ( ltb .LT. 4*n .AND. .NOT.tquery ) THEN
216 info = -6
217 ELSE IF ( lwork .LT. n .AND. .NOT.wquery ) THEN
218 info = -10
219 END IF
220*
221 IF( info.NE.0 ) THEN
222 CALL xerbla( 'ZHETRF_AA_2STAGE', -info )
223 RETURN
224 END IF
225*
226* Answer the query
227*
228 nb = ilaenv( 1, 'ZHETRF_AA_2STAGE', uplo, n, -1, -1, -1 )
229 IF( info.EQ.0 ) THEN
230 IF( tquery ) THEN
231 tb( 1 ) = (3*nb+1)*n
232 END IF
233 IF( wquery ) THEN
234 work( 1 ) = n*nb
235 END IF
236 END IF
237 IF( tquery .OR. wquery ) THEN
238 RETURN
239 END IF
240*
241* Quick return
242*
243 IF ( n.EQ.0 ) THEN
244 RETURN
245 ENDIF
246*
247* Determine the number of the block size
248*
249 ldtb = ltb/n
250 IF( ldtb .LT. 3*nb+1 ) THEN
251 nb = (ldtb-1)/3
252 END IF
253 IF( lwork .LT. nb*n ) THEN
254 nb = lwork/n
255 END IF
256*
257* Determine the number of the block columns
258*
259 nt = (n+nb-1)/nb
260 td = 2*nb
261 kb = min(nb, n)
262*
263* Initialize vectors/matrices
264*
265 DO j = 1, kb
266 ipiv( j ) = j
267 END DO
268*
269* Save NB
270*
271 tb( 1 ) = nb
272*
273 IF( upper ) THEN
274*
275* .....................................................
276* Factorize A as U**H*D*U using the upper triangle of A
277* .....................................................
278*
279 DO j = 0, nt-1
280*
281* Generate Jth column of W and H
282*
283 kb = min(nb, n-j*nb)
284 DO i = 1, j-1
285 IF( i.EQ.1 ) THEN
286* H(I,J) = T(I,I)*U(I,J) + T(I+1,I)*U(I+1,J)
287 IF( i .EQ. (j-1) ) THEN
288 jb = nb+kb
289 ELSE
290 jb = 2*nb
291 END IF
292 CALL zgemm( 'NoTranspose', 'NoTranspose',
293 $ nb, kb, jb,
294 $ one, tb( td+1 + (i*nb)*ldtb ), ldtb-1,
295 $ a( (i-1)*nb+1, j*nb+1 ), lda,
296 $ zero, work( i*nb+1 ), n )
297 ELSE
298* H(I,J) = T(I,I-1)*U(I-1,J) + T(I,I)*U(I,J) + T(I,I+1)*U(I+1,J)
299 IF( i .EQ. (j-1) ) THEN
300 jb = 2*nb+kb
301 ELSE
302 jb = 3*nb
303 END IF
304 CALL zgemm( 'NoTranspose', 'NoTranspose',
305 $ nb, kb, jb,
306 $ one, tb( td+nb+1 + ((i-1)*nb)*ldtb ),
307 $ ldtb-1,
308 $ a( (i-2)*nb+1, j*nb+1 ), lda,
309 $ zero, work( i*nb+1 ), n )
310 END IF
311 END DO
312*
313* Compute T(J,J)
314*
315 CALL zlacpy( 'Upper', kb, kb, a( j*nb+1, j*nb+1 ), lda,
316 $ tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
317 IF( j.GT.1 ) THEN
318* T(J,J) = U(1:J,J)'*H(1:J)
319 CALL zgemm( 'Conjugate transpose', 'NoTranspose',
320 $ kb, kb, (j-1)*nb,
321 $ -one, a( 1, j*nb+1 ), lda,
322 $ work( nb+1 ), n,
323 $ one, tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
324* T(J,J) += U(J,J)'*T(J,J-1)*U(J-1,J)
325 CALL zgemm( 'Conjugate transpose', 'NoTranspose',
326 $ kb, nb, kb,
327 $ one, a( (j-1)*nb+1, j*nb+1 ), lda,
328 $ tb( td+nb+1 + ((j-1)*nb)*ldtb ), ldtb-1,
329 $ zero, work( 1 ), n )
330 CALL zgemm( 'NoTranspose', 'NoTranspose',
331 $ kb, kb, nb,
332 $ -one, work( 1 ), n,
333 $ a( (j-2)*nb+1, j*nb+1 ), lda,
334 $ one, tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
335 END IF
336 IF( j.GT.0 ) THEN
337 CALL zhegst( 1, 'Upper', kb,
338 $ tb( td+1 + (j*nb)*ldtb ), ldtb-1,
339 $ a( (j-1)*nb+1, j*nb+1 ), lda, iinfo )
340 END IF
341*
342* Expand T(J,J) into full format
343*
344 DO i = 1, kb
345 tb( td+1 + (j*nb+i-1)*ldtb )
346 $ = real( tb( td+1 + (j*nb+i-1)*ldtb ) )
347 DO k = i+1, kb
348 tb( td+(k-i)+1 + (j*nb+i-1)*ldtb )
349 $ = dconjg( tb( td-(k-(i+1)) + (j*nb+k-1)*ldtb ) )
350 END DO
351 END DO
352*
353 IF( j.LT.nt-1 ) THEN
354 IF( j.GT.0 ) THEN
355*
356* Compute H(J,J)
357*
358 IF( j.EQ.1 ) THEN
359 CALL zgemm( 'NoTranspose', 'NoTranspose',
360 $ kb, kb, kb,
361 $ one, tb( td+1 + (j*nb)*ldtb ), ldtb-1,
362 $ a( (j-1)*nb+1, j*nb+1 ), lda,
363 $ zero, work( j*nb+1 ), n )
364 ELSE
365 CALL zgemm( 'NoTranspose', 'NoTranspose',
366 $ kb, kb, nb+kb,
367 $ one, tb( td+nb+1 + ((j-1)*nb)*ldtb ),
368 $ ldtb-1,
369 $ a( (j-2)*nb+1, j*nb+1 ), lda,
370 $ zero, work( j*nb+1 ), n )
371 END IF
372*
373* Update with the previous column
374*
375 CALL zgemm( 'Conjugate transpose', 'NoTranspose',
376 $ nb, n-(j+1)*nb, j*nb,
377 $ -one, work( nb+1 ), n,
378 $ a( 1, (j+1)*nb+1 ), lda,
379 $ one, a( j*nb+1, (j+1)*nb+1 ), lda )
380 END IF
381*
382* Copy panel to workspace to call ZGETRF
383*
384 DO k = 1, nb
385 CALL zcopy( n-(j+1)*nb,
386 $ a( j*nb+k, (j+1)*nb+1 ), lda,
387 $ work( 1+(k-1)*n ), 1 )
388 END DO
389*
390* Factorize panel
391*
392 CALL zgetrf( n-(j+1)*nb, nb,
393 $ work, n,
394 $ ipiv( (j+1)*nb+1 ), iinfo )
395c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
396c INFO = IINFO+(J+1)*NB
397c END IF
398*
399* Copy panel back
400*
401 DO k = 1, nb
402*
403* Copy only L-factor
404*
405 CALL zcopy( n-k-(j+1)*nb,
406 $ work( k+1+(k-1)*n ), 1,
407 $ a( j*nb+k, (j+1)*nb+k+1 ), lda )
408*
409* Transpose U-factor to be copied back into T(J+1, J)
410*
411 CALL zlacgv( k, work( 1+(k-1)*n ), 1 )
412 END DO
413*
414* Compute T(J+1, J), zero out for GEMM update
415*
416 kb = min(nb, n-(j+1)*nb)
417 CALL zlaset( 'Full', kb, nb, zero, zero,
418 $ tb( td+nb+1 + (j*nb)*ldtb) , ldtb-1 )
419 CALL zlacpy( 'Upper', kb, nb,
420 $ work, n,
421 $ tb( td+nb+1 + (j*nb)*ldtb ), ldtb-1 )
422 IF( j.GT.0 ) THEN
423 CALL ztrsm( 'R', 'U', 'N', 'U', kb, nb, one,
424 $ a( (j-1)*nb+1, j*nb+1 ), lda,
425 $ tb( td+nb+1 + (j*nb)*ldtb ), ldtb-1 )
426 END IF
427*
428* Copy T(J,J+1) into T(J+1, J), both upper/lower for GEMM
429* updates
430*
431 DO k = 1, nb
432 DO i = 1, kb
433 tb( td-nb+k-i+1 + (j*nb+nb+i-1)*ldtb )
434 $ = dconjg( tb( td+nb+i-k+1 + (j*nb+k-1)*ldtb ) )
435 END DO
436 END DO
437 CALL zlaset( 'Lower', kb, nb, zero, one,
438 $ a( j*nb+1, (j+1)*nb+1), lda )
439*
440* Apply pivots to trailing submatrix of A
441*
442 DO k = 1, kb
443* > Adjust ipiv
444 ipiv( (j+1)*nb+k ) = ipiv( (j+1)*nb+k ) + (j+1)*nb
445*
446 i1 = (j+1)*nb+k
447 i2 = ipiv( (j+1)*nb+k )
448 IF( i1.NE.i2 ) THEN
449* > Apply pivots to previous columns of L
450 CALL zswap( k-1, a( (j+1)*nb+1, i1 ), 1,
451 $ a( (j+1)*nb+1, i2 ), 1 )
452* > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
453 IF( i2.GT.(i1+1) ) THEN
454 CALL zswap( i2-i1-1, a( i1, i1+1 ), lda,
455 $ a( i1+1, i2 ), 1 )
456 CALL zlacgv( i2-i1-1, a( i1+1, i2 ), 1 )
457 END IF
458 CALL zlacgv( i2-i1, a( i1, i1+1 ), lda )
459* > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
460 IF( i2.LT.n )
461 $ CALL zswap( n-i2, a( i1, i2+1 ), lda,
462 $ a( i2, i2+1 ), lda )
463* > Swap A(I1, I1) with A(I2, I2)
464 piv = a( i1, i1 )
465 a( i1, i1 ) = a( i2, i2 )
466 a( i2, i2 ) = piv
467* > Apply pivots to previous columns of L
468 IF( j.GT.0 ) THEN
469 CALL zswap( j*nb, a( 1, i1 ), 1,
470 $ a( 1, i2 ), 1 )
471 END IF
472 ENDIF
473 END DO
474 END IF
475 END DO
476 ELSE
477*
478* .....................................................
479* Factorize A as L*D*L**H using the lower triangle of A
480* .....................................................
481*
482 DO j = 0, nt-1
483*
484* Generate Jth column of W and H
485*
486 kb = min(nb, n-j*nb)
487 DO i = 1, j-1
488 IF( i.EQ.1 ) THEN
489* H(I,J) = T(I,I)*L(J,I)' + T(I+1,I)'*L(J,I+1)'
490 IF( i .EQ. (j-1) ) THEN
491 jb = nb+kb
492 ELSE
493 jb = 2*nb
494 END IF
495 CALL zgemm( 'NoTranspose', 'Conjugate transpose',
496 $ nb, kb, jb,
497 $ one, tb( td+1 + (i*nb)*ldtb ), ldtb-1,
498 $ a( j*nb+1, (i-1)*nb+1 ), lda,
499 $ zero, work( i*nb+1 ), n )
500 ELSE
501* H(I,J) = T(I,I-1)*L(J,I-1)' + T(I,I)*L(J,I)' + T(I,I+1)*L(J,I+1)'
502 IF( i .EQ. (j-1) ) THEN
503 jb = 2*nb+kb
504 ELSE
505 jb = 3*nb
506 END IF
507 CALL zgemm( 'NoTranspose', 'Conjugate transpose',
508 $ nb, kb, jb,
509 $ one, tb( td+nb+1 + ((i-1)*nb)*ldtb ),
510 $ ldtb-1,
511 $ a( j*nb+1, (i-2)*nb+1 ), lda,
512 $ zero, work( i*nb+1 ), n )
513 END IF
514 END DO
515*
516* Compute T(J,J)
517*
518 CALL zlacpy( 'Lower', kb, kb, a( j*nb+1, j*nb+1 ), lda,
519 $ tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
520 IF( j.GT.1 ) THEN
521* T(J,J) = L(J,1:J)*H(1:J)
522 CALL zgemm( 'NoTranspose', 'NoTranspose',
523 $ kb, kb, (j-1)*nb,
524 $ -one, a( j*nb+1, 1 ), lda,
525 $ work( nb+1 ), n,
526 $ one, tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
527* T(J,J) += L(J,J)*T(J,J-1)*L(J,J-1)'
528 CALL zgemm( 'NoTranspose', 'NoTranspose',
529 $ kb, nb, kb,
530 $ one, a( j*nb+1, (j-1)*nb+1 ), lda,
531 $ tb( td+nb+1 + ((j-1)*nb)*ldtb ), ldtb-1,
532 $ zero, work( 1 ), n )
533 CALL zgemm( 'NoTranspose', 'Conjugate transpose',
534 $ kb, kb, nb,
535 $ -one, work( 1 ), n,
536 $ a( j*nb+1, (j-2)*nb+1 ), lda,
537 $ one, tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
538 END IF
539 IF( j.GT.0 ) THEN
540 CALL zhegst( 1, 'Lower', kb,
541 $ tb( td+1 + (j*nb)*ldtb ), ldtb-1,
542 $ a( j*nb+1, (j-1)*nb+1 ), lda, iinfo )
543 END IF
544*
545* Expand T(J,J) into full format
546*
547 DO i = 1, kb
548 tb( td+1 + (j*nb+i-1)*ldtb )
549 $ = real( tb( td+1 + (j*nb+i-1)*ldtb ) )
550 DO k = i+1, kb
551 tb( td-(k-(i+1)) + (j*nb+k-1)*ldtb )
552 $ = dconjg( tb( td+(k-i)+1 + (j*nb+i-1)*ldtb ) )
553 END DO
554 END DO
555*
556 IF( j.LT.nt-1 ) THEN
557 IF( j.GT.0 ) THEN
558*
559* Compute H(J,J)
560*
561 IF( j.EQ.1 ) THEN
562 CALL zgemm( 'NoTranspose', 'Conjugate transpose',
563 $ kb, kb, kb,
564 $ one, tb( td+1 + (j*nb)*ldtb ), ldtb-1,
565 $ a( j*nb+1, (j-1)*nb+1 ), lda,
566 $ zero, work( j*nb+1 ), n )
567 ELSE
568 CALL zgemm( 'NoTranspose', 'Conjugate transpose',
569 $ kb, kb, nb+kb,
570 $ one, tb( td+nb+1 + ((j-1)*nb)*ldtb ),
571 $ ldtb-1,
572 $ a( j*nb+1, (j-2)*nb+1 ), lda,
573 $ zero, work( j*nb+1 ), n )
574 END IF
575*
576* Update with the previous column
577*
578 CALL zgemm( 'NoTranspose', 'NoTranspose',
579 $ n-(j+1)*nb, nb, j*nb,
580 $ -one, a( (j+1)*nb+1, 1 ), lda,
581 $ work( nb+1 ), n,
582 $ one, a( (j+1)*nb+1, j*nb+1 ), lda )
583 END IF
584*
585* Factorize panel
586*
587 CALL zgetrf( n-(j+1)*nb, nb,
588 $ a( (j+1)*nb+1, j*nb+1 ), lda,
589 $ ipiv( (j+1)*nb+1 ), iinfo )
590c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
591c INFO = IINFO+(J+1)*NB
592c END IF
593*
594* Compute T(J+1, J), zero out for GEMM update
595*
596 kb = min(nb, n-(j+1)*nb)
597 CALL zlaset( 'Full', kb, nb, zero, zero,
598 $ tb( td+nb+1 + (j*nb)*ldtb) , ldtb-1 )
599 CALL zlacpy( 'Upper', kb, nb,
600 $ a( (j+1)*nb+1, j*nb+1 ), lda,
601 $ tb( td+nb+1 + (j*nb)*ldtb ), ldtb-1 )
602 IF( j.GT.0 ) THEN
603 CALL ztrsm( 'R', 'L', 'C', 'U', kb, nb, one,
604 $ a( j*nb+1, (j-1)*nb+1 ), lda,
605 $ tb( td+nb+1 + (j*nb)*ldtb ), ldtb-1 )
606 END IF
607*
608* Copy T(J+1,J) into T(J, J+1), both upper/lower for GEMM
609* updates
610*
611 DO k = 1, nb
612 DO i = 1, kb
613 tb( td-nb+k-i+1 + (j*nb+nb+i-1)*ldtb )
614 $ = dconjg( tb( td+nb+i-k+1 + (j*nb+k-1)*ldtb ) )
615 END DO
616 END DO
617 CALL zlaset( 'Upper', kb, nb, zero, one,
618 $ a( (j+1)*nb+1, j*nb+1), lda )
619*
620* Apply pivots to trailing submatrix of A
621*
622 DO k = 1, kb
623* > Adjust ipiv
624 ipiv( (j+1)*nb+k ) = ipiv( (j+1)*nb+k ) + (j+1)*nb
625*
626 i1 = (j+1)*nb+k
627 i2 = ipiv( (j+1)*nb+k )
628 IF( i1.NE.i2 ) THEN
629* > Apply pivots to previous columns of L
630 CALL zswap( k-1, a( i1, (j+1)*nb+1 ), lda,
631 $ a( i2, (j+1)*nb+1 ), lda )
632* > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
633 IF( i2.GT.(i1+1) ) THEN
634 CALL zswap( i2-i1-1, a( i1+1, i1 ), 1,
635 $ a( i2, i1+1 ), lda )
636 CALL zlacgv( i2-i1-1, a( i2, i1+1 ), lda )
637 END IF
638 CALL zlacgv( i2-i1, a( i1+1, i1 ), 1 )
639* > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
640 IF( i2.LT.n )
641 $ CALL zswap( n-i2, a( i2+1, i1 ), 1,
642 $ a( i2+1, i2 ), 1 )
643* > Swap A(I1, I1) with A(I2, I2)
644 piv = a( i1, i1 )
645 a( i1, i1 ) = a( i2, i2 )
646 a( i2, i2 ) = piv
647* > Apply pivots to previous columns of L
648 IF( j.GT.0 ) THEN
649 CALL zswap( j*nb, a( i1, 1 ), lda,
650 $ a( i2, 1 ), lda )
651 END IF
652 ENDIF
653 END DO
654*
655* Apply pivots to previous columns of L
656*
657c CALL ZLASWP( J*NB, A( 1, 1 ), LDA,
658c $ (J+1)*NB+1, (J+1)*NB+KB, IPIV, 1 )
659 END IF
660 END DO
661 END IF
662*
663* Factor the band matrix
664 CALL zgbtrf( n, n, nb, nb, tb, ldtb, ipiv2, info )
665*
666 RETURN
667*
668* End of ZHETRF_AA_2STAGE
669*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
zcopy
subroutine zcopy(n, zx, incx, zy, incy)
ZCOPY
Definition zcopy.f:81
zgbtrf
subroutine zgbtrf(m, n, kl, ku, ab, ldab, ipiv, info)
ZGBTRF
Definition zgbtrf.f:144
zgemm
subroutine zgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
ZGEMM
Definition zgemm.f:188
zgetrf
subroutine zgetrf(m, n, a, lda, ipiv, info)
ZGETRF
Definition zgetrf.f:108
zhegst
subroutine zhegst(itype, uplo, n, a, lda, b, ldb, info)
ZHEGST
Definition zhegst.f:128
ilaenv
integer function ilaenv(ispec, name, opts, n1, n2, n3, n4)
ILAENV
Definition ilaenv.f:162
zlacgv
subroutine zlacgv(n, x, incx)
ZLACGV conjugates a complex vector.
Definition zlacgv.f:74
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:103
zlaset
subroutine zlaset(uplo, m, n, alpha, beta, a, lda)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition zlaset.f:106
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
zswap
subroutine zswap(n, zx, incx, zy, incy)
ZSWAP
Definition zswap.f:81
ztrsm
subroutine ztrsm(side, uplo, transa, diag, m, n, alpha, a, lda, b, ldb)
ZTRSM
Definition ztrsm.f:180
Here is the call graph for this function:
Here is the caller graph for this function: