LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ chetrf_aa_2stage()

subroutine chetrf_aa_2stage ( character  UPLO,
integer  N,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( * )  TB,
integer  LTB,
integer, dimension( * )  IPIV,
integer, dimension( * )  IPIV2,
complex, dimension( * )  WORK,
integer  LWORK,
integer  INFO 
)

CHETRF_AA_2STAGE

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

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