LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ zsytrf_aa_2stage()

subroutine zsytrf_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 
)

ZSYTRF_AA_2STAGE

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

Purpose:
 ZSYTRF_AA_2STAGE computes the factorization of a complex symmetric 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 complex symmetric 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
          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*16 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 zsytrf_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 czero, cone
180  parameter( czero = ( 0.0d+0, 0.0d+0 ),
181  $ cone = ( 1.0d+0, 0.0d+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, zgbtrf, zgemm, zgetrf,
197 * ..
198 * .. Intrinsic Functions ..
199  INTRINSIC 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( 'ZSYTRF_AA_2STAGE', -info )
223  RETURN
224  END IF
225 *
226 * Answer the query
227 *
228  nb = ilaenv( 1, 'ZSYTRF_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 L*D*L**T 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  $ cone, tb( td+1 + (i*nb)*ldtb ), ldtb-1,
295  $ a( (i-1)*nb+1, j*nb+1 ), lda,
296  $ czero, 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  $ cone, tb( td+nb+1 + ((i-1)*nb)*ldtb ),
307  $ ldtb-1,
308  $ a( (i-2)*nb+1, j*nb+1 ), lda,
309  $ czero, 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( 'Transpose', 'NoTranspose',
320  $ kb, kb, (j-1)*nb,
321  $ -cone, a( 1, j*nb+1 ), lda,
322  $ work( nb+1 ), n,
323  $ cone, 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( 'Transpose', 'NoTranspose',
326  $ kb, nb, kb,
327  $ cone, a( (j-1)*nb+1, j*nb+1 ), lda,
328  $ tb( td+nb+1 + ((j-1)*nb)*ldtb ), ldtb-1,
329  $ czero, work( 1 ), n )
330  CALL zgemm( 'NoTranspose', 'NoTranspose',
331  $ kb, kb, nb,
332  $ -cone, work( 1 ), n,
333  $ a( (j-2)*nb+1, j*nb+1 ), lda,
334  $ cone, tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
335  END IF
336 *
337 * Expand T(J,J) into full format
338 *
339  DO i = 1, kb
340  DO k = i+1, kb
341  tb( td+(k-i)+1 + (j*nb+i-1)*ldtb )
342  $ = tb( td-(k-(i+1)) + (j*nb+k-1)*ldtb )
343  END DO
344  END DO
345  IF( j.GT.0 ) THEN
346 c CALL CHEGST( 1, 'Upper', KB,
347 c $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
348 c $ A( (J-1)*NB+1, J*NB+1 ), LDA, IINFO )
349  CALL ztrsm( 'L', 'U', 'T', 'N', kb, kb, cone,
350  $ a( (j-1)*nb+1, j*nb+1 ), lda,
351  $ tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
352  CALL ztrsm( 'R', 'U', 'N', 'N', kb, kb, cone,
353  $ a( (j-1)*nb+1, j*nb+1 ), lda,
354  $ tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
355  END IF
356 *
357  IF( j.LT.nt-1 ) THEN
358  IF( j.GT.0 ) THEN
359 *
360 * Compute H(J,J)
361 *
362  IF( j.EQ.1 ) THEN
363  CALL zgemm( 'NoTranspose', 'NoTranspose',
364  $ kb, kb, kb,
365  $ cone, tb( td+1 + (j*nb)*ldtb ), ldtb-1,
366  $ a( (j-1)*nb+1, j*nb+1 ), lda,
367  $ czero, work( j*nb+1 ), n )
368  ELSE
369  CALL zgemm( 'NoTranspose', 'NoTranspose',
370  $ kb, kb, nb+kb,
371  $ cone, tb( td+nb+1 + ((j-1)*nb)*ldtb ),
372  $ ldtb-1,
373  $ a( (j-2)*nb+1, j*nb+1 ), lda,
374  $ czero, work( j*nb+1 ), n )
375  END IF
376 *
377 * Update with the previous column
378 *
379  CALL zgemm( 'Transpose', 'NoTranspose',
380  $ nb, n-(j+1)*nb, j*nb,
381  $ -cone, work( nb+1 ), n,
382  $ a( 1, (j+1)*nb+1 ), lda,
383  $ cone, a( j*nb+1, (j+1)*nb+1 ), lda )
384  END IF
385 *
386 * Copy panel to workspace to call ZGETRF
387 *
388  DO k = 1, nb
389  CALL zcopy( n-(j+1)*nb,
390  $ a( j*nb+k, (j+1)*nb+1 ), lda,
391  $ work( 1+(k-1)*n ), 1 )
392  END DO
393 *
394 * Factorize panel
395 *
396  CALL zgetrf( n-(j+1)*nb, nb,
397  $ work, n,
398  $ ipiv( (j+1)*nb+1 ), iinfo )
399 c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
400 c INFO = IINFO+(J+1)*NB
401 c END IF
402 *
403 * Copy panel back
404 *
405  DO k = 1, nb
406  CALL zcopy( n-(j+1)*nb,
407  $ work( 1+(k-1)*n ), 1,
408  $ a( j*nb+k, (j+1)*nb+1 ), lda )
409  END DO
410 *
411 * Compute T(J+1, J), zero out for GEMM update
412 *
413  kb = min(nb, n-(j+1)*nb)
414  CALL zlaset( 'Full', kb, nb, czero, czero,
415  $ tb( td+nb+1 + (j*nb)*ldtb), ldtb-1 )
416  CALL zlacpy( 'Upper', kb, nb,
417  $ work, n,
418  $ tb( td+nb+1 + (j*nb)*ldtb ), ldtb-1 )
419  IF( j.GT.0 ) THEN
420  CALL ztrsm( 'R', 'U', 'N', 'U', kb, nb, cone,
421  $ a( (j-1)*nb+1, j*nb+1 ), lda,
422  $ tb( td+nb+1 + (j*nb)*ldtb ), ldtb-1 )
423  END IF
424 *
425 * Copy T(J,J+1) into T(J+1, J), both upper/lower for GEMM
426 * updates
427 *
428  DO k = 1, nb
429  DO i = 1, kb
430  tb( td-nb+k-i+1 + (j*nb+nb+i-1)*ldtb )
431  $ = tb( td+nb+i-k+1 + (j*nb+k-1)*ldtb )
432  END DO
433  END DO
434  CALL zlaset( 'Lower', kb, nb, czero, cone,
435  $ a( j*nb+1, (j+1)*nb+1), lda )
436 *
437 * Apply pivots to trailing submatrix of A
438 *
439  DO k = 1, kb
440 * > Adjust ipiv
441  ipiv( (j+1)*nb+k ) = ipiv( (j+1)*nb+k ) + (j+1)*nb
442 *
443  i1 = (j+1)*nb+k
444  i2 = ipiv( (j+1)*nb+k )
445  IF( i1.NE.i2 ) THEN
446 * > Apply pivots to previous columns of L
447  CALL zswap( k-1, a( (j+1)*nb+1, i1 ), 1,
448  $ a( (j+1)*nb+1, i2 ), 1 )
449 * > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
450  CALL zswap( i2-i1-1, a( i1, i1+1 ), lda,
451  $ a( i1+1, i2 ), 1 )
452 * > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
453  CALL zswap( n-i2, a( i1, i2+1 ), lda,
454  $ a( i2, i2+1 ), lda )
455 * > Swap A(I1, I1) with A(I2, I2)
456  piv = a( i1, i1 )
457  a( i1, i1 ) = a( i2, i2 )
458  a( i2, i2 ) = piv
459 * > Apply pivots to previous columns of L
460  IF( j.GT.0 ) THEN
461  CALL zswap( j*nb, a( 1, i1 ), 1,
462  $ a( 1, i2 ), 1 )
463  END IF
464  ENDIF
465  END DO
466  END IF
467  END DO
468  ELSE
469 *
470 * .....................................................
471 * Factorize A as L*D*L**T using the lower triangle of A
472 * .....................................................
473 *
474  DO j = 0, nt-1
475 *
476 * Generate Jth column of W and H
477 *
478  kb = min(nb, n-j*nb)
479  DO i = 1, j-1
480  IF( i.EQ.1 ) THEN
481 * H(I,J) = T(I,I)*L(J,I)' + T(I+1,I)'*L(J,I+1)'
482  IF( i .EQ. (j-1) ) THEN
483  jb = nb+kb
484  ELSE
485  jb = 2*nb
486  END IF
487  CALL zgemm( 'NoTranspose', 'Transpose',
488  $ nb, kb, jb,
489  $ cone, tb( td+1 + (i*nb)*ldtb ), ldtb-1,
490  $ a( j*nb+1, (i-1)*nb+1 ), lda,
491  $ czero, work( i*nb+1 ), n )
492  ELSE
493 * 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)'
494  IF( i .EQ. (j-1) ) THEN
495  jb = 2*nb+kb
496  ELSE
497  jb = 3*nb
498  END IF
499  CALL zgemm( 'NoTranspose', 'Transpose',
500  $ nb, kb, jb,
501  $ cone, tb( td+nb+1 + ((i-1)*nb)*ldtb ),
502  $ ldtb-1,
503  $ a( j*nb+1, (i-2)*nb+1 ), lda,
504  $ czero, work( i*nb+1 ), n )
505  END IF
506  END DO
507 *
508 * Compute T(J,J)
509 *
510  CALL zlacpy( 'Lower', kb, kb, a( j*nb+1, j*nb+1 ), lda,
511  $ tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
512  IF( j.GT.1 ) THEN
513 * T(J,J) = L(J,1:J)*H(1:J)
514  CALL zgemm( 'NoTranspose', 'NoTranspose',
515  $ kb, kb, (j-1)*nb,
516  $ -cone, a( j*nb+1, 1 ), lda,
517  $ work( nb+1 ), n,
518  $ cone, tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
519 * T(J,J) += L(J,J)*T(J,J-1)*L(J,J-1)'
520  CALL zgemm( 'NoTranspose', 'NoTranspose',
521  $ kb, nb, kb,
522  $ cone, a( j*nb+1, (j-1)*nb+1 ), lda,
523  $ tb( td+nb+1 + ((j-1)*nb)*ldtb ), ldtb-1,
524  $ czero, work( 1 ), n )
525  CALL zgemm( 'NoTranspose', 'Transpose',
526  $ kb, kb, nb,
527  $ -cone, work( 1 ), n,
528  $ a( j*nb+1, (j-2)*nb+1 ), lda,
529  $ cone, tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
530  END IF
531 *
532 * Expand T(J,J) into full format
533 *
534  DO i = 1, kb
535  DO k = i+1, kb
536  tb( td-(k-(i+1)) + (j*nb+k-1)*ldtb )
537  $ = tb( td+(k-i)+1 + (j*nb+i-1)*ldtb )
538  END DO
539  END DO
540  IF( j.GT.0 ) THEN
541 c CALL CHEGST( 1, 'Lower', KB,
542 c $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
543 c $ A( J*NB+1, (J-1)*NB+1 ), LDA, IINFO )
544  CALL ztrsm( 'L', 'L', 'N', 'N', kb, kb, cone,
545  $ a( j*nb+1, (j-1)*nb+1 ), lda,
546  $ tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
547  CALL ztrsm( 'R', 'L', 'T', 'N', kb, kb, cone,
548  $ a( j*nb+1, (j-1)*nb+1 ), lda,
549  $ tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
550  END IF
551 *
552 * Symmetrize T(J,J)
553 *
554  DO i = 1, kb
555  DO k = i+1, kb
556  tb( td-(k-(i+1)) + (j*nb+k-1)*ldtb )
557  $ = tb( td+(k-i)+1 + (j*nb+i-1)*ldtb )
558  END DO
559  END DO
560 *
561  IF( j.LT.nt-1 ) THEN
562  IF( j.GT.0 ) THEN
563 *
564 * Compute H(J,J)
565 *
566  IF( j.EQ.1 ) THEN
567  CALL zgemm( 'NoTranspose', 'Transpose',
568  $ kb, kb, kb,
569  $ cone, tb( td+1 + (j*nb)*ldtb ), ldtb-1,
570  $ a( j*nb+1, (j-1)*nb+1 ), lda,
571  $ czero, work( j*nb+1 ), n )
572  ELSE
573  CALL zgemm( 'NoTranspose', 'Transpose',
574  $ kb, kb, nb+kb,
575  $ cone, tb( td+nb+1 + ((j-1)*nb)*ldtb ),
576  $ ldtb-1,
577  $ a( j*nb+1, (j-2)*nb+1 ), lda,
578  $ czero, work( j*nb+1 ), n )
579  END IF
580 *
581 * Update with the previous column
582 *
583  CALL zgemm( 'NoTranspose', 'NoTranspose',
584  $ n-(j+1)*nb, nb, j*nb,
585  $ -cone, a( (j+1)*nb+1, 1 ), lda,
586  $ work( nb+1 ), n,
587  $ cone, a( (j+1)*nb+1, j*nb+1 ), lda )
588  END IF
589 *
590 * Factorize panel
591 *
592  CALL zgetrf( n-(j+1)*nb, nb,
593  $ a( (j+1)*nb+1, j*nb+1 ), lda,
594  $ ipiv( (j+1)*nb+1 ), iinfo )
595 c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
596 c INFO = IINFO+(J+1)*NB
597 c END IF
598 *
599 * Compute T(J+1, J), zero out for GEMM update
600 *
601  kb = min(nb, n-(j+1)*nb)
602  CALL zlaset( 'Full', kb, nb, czero, czero,
603  $ tb( td+nb+1 + (j*nb)*ldtb), ldtb-1 )
604  CALL zlacpy( 'Upper', kb, nb,
605  $ a( (j+1)*nb+1, j*nb+1 ), lda,
606  $ tb( td+nb+1 + (j*nb)*ldtb ), ldtb-1 )
607  IF( j.GT.0 ) THEN
608  CALL ztrsm( 'R', 'L', 'T', 'U', kb, nb, cone,
609  $ a( j*nb+1, (j-1)*nb+1 ), lda,
610  $ tb( td+nb+1 + (j*nb)*ldtb ), ldtb-1 )
611  END IF
612 *
613 * Copy T(J+1,J) into T(J, J+1), both upper/lower for GEMM
614 * updates
615 *
616  DO k = 1, nb
617  DO i = 1, kb
618  tb( td-nb+k-i+1 + (j*nb+nb+i-1)*ldtb ) =
619  $ tb( td+nb+i-k+1 + (j*nb+k-1)*ldtb )
620  END DO
621  END DO
622  CALL zlaset( 'Upper', kb, nb, czero, cone,
623  $ a( (j+1)*nb+1, j*nb+1 ), lda )
624 *
625 * Apply pivots to trailing submatrix of A
626 *
627  DO k = 1, kb
628 * > Adjust ipiv
629  ipiv( (j+1)*nb+k ) = ipiv( (j+1)*nb+k ) + (j+1)*nb
630 *
631  i1 = (j+1)*nb+k
632  i2 = ipiv( (j+1)*nb+k )
633  IF( i1.NE.i2 ) THEN
634 * > Apply pivots to previous columns of L
635  CALL zswap( k-1, a( i1, (j+1)*nb+1 ), lda,
636  $ a( i2, (j+1)*nb+1 ), lda )
637 * > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
638  CALL zswap( i2-i1-1, a( i1+1, i1 ), 1,
639  $ a( i2, i1+1 ), lda )
640 * > Swap A(I2+1:M, I1) with A(I2+1:M, I2)
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 *
657 c CALL ZLASWP( J*NB, A( 1, 1 ), LDA,
658 c $ (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 * End of ZSYTRF_AA_2STAGE
667 *
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
Definition: zcopy.f:83
subroutine zlaswp(N, A, LDA, K1, K2, IPIV, INCX)
ZLASWP performs a series of row interchanges on a general rectangular matrix.
Definition: zlaswp.f:117
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 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: