LAPACK  3.8.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*T*U**T  or  A = L*T*L**T

 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 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 array, dimension (LTB)
          On exit, details of the LU factorization of the band matrix.
[in]LTB
          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
          IPIV 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 workspace of size LWORK
[in]LWORK
          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 160 of file zhetrf_aa_2stage.f.

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