LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ 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 subdiaonal 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.
Date
November 2017

Definition at line 162 of file zhetrf_aa_2stage.f.

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