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