LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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 subdiagonal 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.

Definition at line 158 of file zsytrf_aa_2stage.f.

160*
161* -- LAPACK computational routine --
162* -- LAPACK is a software package provided by Univ. of Tennessee, --
163* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
164*
165 IMPLICIT NONE
166*
167* .. Scalar Arguments ..
168 CHARACTER UPLO
169 INTEGER N, LDA, LTB, LWORK, INFO
170* ..
171* .. Array Arguments ..
172 INTEGER IPIV( * ), IPIV2( * )
173 COMPLEX*16 A( LDA, * ), TB( * ), WORK( * )
174* ..
175*
176* =====================================================================
177* .. Parameters ..
178 COMPLEX*16 CZERO, CONE
179 parameter( czero = ( 0.0d+0, 0.0d+0 ),
180 $ cone = ( 1.0d+0, 0.0d+0 ) )
181*
182* .. Local Scalars ..
183 LOGICAL UPPER, TQUERY, WQUERY
184 INTEGER I, J, K, I1, I2, TD
185 INTEGER LDTB, NB, KB, JB, NT, IINFO
186 COMPLEX*16 PIV
187* ..
188* .. External Functions ..
189 LOGICAL LSAME
190 INTEGER ILAENV
191 EXTERNAL lsame, ilaenv
192* ..
193* .. External Subroutines ..
194 EXTERNAL xerbla, zcopy, zgbtrf, zgemm, zgetrf,
195 $ zlacpy, zlaset, zlaswp, ztrsm, zswap
196* ..
197* .. Intrinsic Functions ..
198 INTRINSIC min, max
199* ..
200* .. Executable Statements ..
201*
202* Test the input parameters.
203*
204 info = 0
205 upper = lsame( uplo, 'U' )
206 wquery = ( lwork.EQ.-1 )
207 tquery = ( ltb.EQ.-1 )
208 IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
209 info = -1
210 ELSE IF( n.LT.0 ) THEN
211 info = -2
212 ELSE IF( lda.LT.max( 1, n ) ) THEN
213 info = -4
214 ELSE IF ( ltb .LT. 4*n .AND. .NOT.tquery ) THEN
215 info = -6
216 ELSE IF ( lwork .LT. n .AND. .NOT.wquery ) THEN
217 info = -10
218 END IF
219*
220 IF( info.NE.0 ) THEN
221 CALL xerbla( 'ZSYTRF_AA_2STAGE', -info )
222 RETURN
223 END IF
224*
225* Answer the query
226*
227 nb = ilaenv( 1, 'ZSYTRF_AA_2STAGE', uplo, n, -1, -1, -1 )
228 IF( info.EQ.0 ) THEN
229 IF( tquery ) THEN
230 tb( 1 ) = (3*nb+1)*n
231 END IF
232 IF( wquery ) THEN
233 work( 1 ) = n*nb
234 END IF
235 END IF
236 IF( tquery .OR. wquery ) THEN
237 RETURN
238 END IF
239*
240* Quick return
241*
242 IF ( n.EQ.0 ) THEN
243 RETURN
244 ENDIF
245*
246* Determine the number of the block size
247*
248 ldtb = ltb/n
249 IF( ldtb .LT. 3*nb+1 ) THEN
250 nb = (ldtb-1)/3
251 END IF
252 IF( lwork .LT. nb*n ) THEN
253 nb = lwork/n
254 END IF
255*
256* Determine the number of the block columns
257*
258 nt = (n+nb-1)/nb
259 td = 2*nb
260 kb = min(nb, n)
261*
262* Initialize vectors/matrices
263*
264 DO j = 1, kb
265 ipiv( j ) = j
266 END DO
267*
268* Save NB
269*
270 tb( 1 ) = nb
271*
272 IF( upper ) THEN
273*
274* .....................................................
275* Factorize A as U**T*D*U using the upper triangle of A
276* .....................................................
277*
278 DO j = 0, nt-1
279*
280* Generate Jth column of W and H
281*
282 kb = min(nb, n-j*nb)
283 DO i = 1, j-1
284 IF( i.EQ.1 ) THEN
285* H(I,J) = T(I,I)*U(I,J) + T(I+1,I)*U(I+1,J)
286 IF( i .EQ. (j-1) ) THEN
287 jb = nb+kb
288 ELSE
289 jb = 2*nb
290 END IF
291 CALL zgemm( 'NoTranspose', 'NoTranspose',
292 $ nb, kb, jb,
293 $ cone, tb( td+1 + (i*nb)*ldtb ), ldtb-1,
294 $ a( (i-1)*nb+1, j*nb+1 ), lda,
295 $ czero, work( i*nb+1 ), n )
296 ELSE
297* 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)
298 IF( i .EQ. (j-1) ) THEN
299 jb = 2*nb+kb
300 ELSE
301 jb = 3*nb
302 END IF
303 CALL zgemm( 'NoTranspose', 'NoTranspose',
304 $ nb, kb, jb,
305 $ cone, tb( td+nb+1 + ((i-1)*nb)*ldtb ),
306 $ ldtb-1,
307 $ a( (i-2)*nb+1, j*nb+1 ), lda,
308 $ czero, work( i*nb+1 ), n )
309 END IF
310 END DO
311*
312* Compute T(J,J)
313*
314 CALL zlacpy( 'Upper', kb, kb, a( j*nb+1, j*nb+1 ), lda,
315 $ tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
316 IF( j.GT.1 ) THEN
317* T(J,J) = U(1:J,J)'*H(1:J)
318 CALL zgemm( 'Transpose', 'NoTranspose',
319 $ kb, kb, (j-1)*nb,
320 $ -cone, a( 1, j*nb+1 ), lda,
321 $ work( nb+1 ), n,
322 $ cone, tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
323* T(J,J) += U(J,J)'*T(J,J-1)*U(J-1,J)
324 CALL zgemm( 'Transpose', 'NoTranspose',
325 $ kb, nb, kb,
326 $ cone, a( (j-1)*nb+1, j*nb+1 ), lda,
327 $ tb( td+nb+1 + ((j-1)*nb)*ldtb ), ldtb-1,
328 $ czero, work( 1 ), n )
329 CALL zgemm( 'NoTranspose', 'NoTranspose',
330 $ kb, kb, nb,
331 $ -cone, work( 1 ), n,
332 $ a( (j-2)*nb+1, j*nb+1 ), lda,
333 $ cone, tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
334 END IF
335*
336* Expand T(J,J) into full format
337*
338 DO i = 1, kb
339 DO k = i+1, kb
340 tb( td+(k-i)+1 + (j*nb+i-1)*ldtb )
341 $ = tb( td-(k-(i+1)) + (j*nb+k-1)*ldtb )
342 END DO
343 END DO
344 IF( j.GT.0 ) THEN
345c CALL CHEGST( 1, 'Upper', KB,
346c $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
347c $ A( (J-1)*NB+1, J*NB+1 ), LDA, IINFO )
348 CALL ztrsm( 'L', 'U', 'T', 'N', kb, kb, cone,
349 $ a( (j-1)*nb+1, j*nb+1 ), lda,
350 $ tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
351 CALL ztrsm( 'R', 'U', 'N', 'N', kb, kb, cone,
352 $ a( (j-1)*nb+1, j*nb+1 ), lda,
353 $ tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
354 END IF
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 $ cone, tb( td+1 + (j*nb)*ldtb ), ldtb-1,
365 $ a( (j-1)*nb+1, j*nb+1 ), lda,
366 $ czero, work( j*nb+1 ), n )
367 ELSE
368 CALL zgemm( 'NoTranspose', 'NoTranspose',
369 $ kb, kb, nb+kb,
370 $ cone, tb( td+nb+1 + ((j-1)*nb)*ldtb ),
371 $ ldtb-1,
372 $ a( (j-2)*nb+1, j*nb+1 ), lda,
373 $ czero, work( j*nb+1 ), n )
374 END IF
375*
376* Update with the previous column
377*
378 CALL zgemm( 'Transpose', 'NoTranspose',
379 $ nb, n-(j+1)*nb, j*nb,
380 $ -cone, work( nb+1 ), n,
381 $ a( 1, (j+1)*nb+1 ), lda,
382 $ cone, 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 )
398c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
399c INFO = IINFO+(J+1)*NB
400c END IF
401*
402* Copy panel back
403*
404 DO k = 1, nb
405 CALL zcopy( n-(j+1)*nb,
406 $ work( 1+(k-1)*n ), 1,
407 $ a( j*nb+k, (j+1)*nb+1 ), lda )
408 END DO
409*
410* Compute T(J+1, J), zero out for GEMM update
411*
412 kb = min(nb, n-(j+1)*nb)
413 CALL zlaset( 'Full', kb, nb, czero, czero,
414 $ tb( td+nb+1 + (j*nb)*ldtb), ldtb-1 )
415 CALL zlacpy( 'Upper', kb, nb,
416 $ work, n,
417 $ tb( td+nb+1 + (j*nb)*ldtb ), ldtb-1 )
418 IF( j.GT.0 ) THEN
419 CALL ztrsm( 'R', 'U', 'N', 'U', kb, nb, cone,
420 $ a( (j-1)*nb+1, j*nb+1 ), lda,
421 $ tb( td+nb+1 + (j*nb)*ldtb ), ldtb-1 )
422 END IF
423*
424* Copy T(J,J+1) into T(J+1, J), both upper/lower for GEMM
425* updates
426*
427 DO k = 1, nb
428 DO i = 1, kb
429 tb( td-nb+k-i+1 + (j*nb+nb+i-1)*ldtb )
430 $ = tb( td+nb+i-k+1 + (j*nb+k-1)*ldtb )
431 END DO
432 END DO
433 CALL zlaset( 'Lower', kb, nb, czero, cone,
434 $ a( j*nb+1, (j+1)*nb+1), lda )
435*
436* Apply pivots to trailing submatrix of A
437*
438 DO k = 1, kb
439* > Adjust ipiv
440 ipiv( (j+1)*nb+k ) = ipiv( (j+1)*nb+k ) + (j+1)*nb
441*
442 i1 = (j+1)*nb+k
443 i2 = ipiv( (j+1)*nb+k )
444 IF( i1.NE.i2 ) THEN
445* > Apply pivots to previous columns of L
446 CALL zswap( k-1, a( (j+1)*nb+1, i1 ), 1,
447 $ a( (j+1)*nb+1, i2 ), 1 )
448* > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
449 IF( i2.GT.(i1+1) )
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 IF( i2.LT.n )
454 $ CALL zswap( n-i2, a( i1, i2+1 ), lda,
455 $ a( i2, i2+1 ), lda )
456* > Swap A(I1, I1) with A(I2, I2)
457 piv = a( i1, i1 )
458 a( i1, i1 ) = a( i2, i2 )
459 a( i2, i2 ) = piv
460* > Apply pivots to previous columns of L
461 IF( j.GT.0 ) THEN
462 CALL zswap( j*nb, a( 1, i1 ), 1,
463 $ a( 1, i2 ), 1 )
464 END IF
465 ENDIF
466 END DO
467 END IF
468 END DO
469 ELSE
470*
471* .....................................................
472* Factorize A as L*D*L**T using the lower triangle of A
473* .....................................................
474*
475 DO j = 0, nt-1
476*
477* Generate Jth column of W and H
478*
479 kb = min(nb, n-j*nb)
480 DO i = 1, j-1
481 IF( i.EQ.1 ) THEN
482* H(I,J) = T(I,I)*L(J,I)' + T(I+1,I)'*L(J,I+1)'
483 IF( i .EQ. (j-1) ) THEN
484 jb = nb+kb
485 ELSE
486 jb = 2*nb
487 END IF
488 CALL zgemm( 'NoTranspose', 'Transpose',
489 $ nb, kb, jb,
490 $ cone, tb( td+1 + (i*nb)*ldtb ), ldtb-1,
491 $ a( j*nb+1, (i-1)*nb+1 ), lda,
492 $ czero, work( i*nb+1 ), n )
493 ELSE
494* 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)'
495 IF( i .EQ. (j-1) ) THEN
496 jb = 2*nb+kb
497 ELSE
498 jb = 3*nb
499 END IF
500 CALL zgemm( 'NoTranspose', 'Transpose',
501 $ nb, kb, jb,
502 $ cone, tb( td+nb+1 + ((i-1)*nb)*ldtb ),
503 $ ldtb-1,
504 $ a( j*nb+1, (i-2)*nb+1 ), lda,
505 $ czero, work( i*nb+1 ), n )
506 END IF
507 END DO
508*
509* Compute T(J,J)
510*
511 CALL zlacpy( 'Lower', kb, kb, a( j*nb+1, j*nb+1 ), lda,
512 $ tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
513 IF( j.GT.1 ) THEN
514* T(J,J) = L(J,1:J)*H(1:J)
515 CALL zgemm( 'NoTranspose', 'NoTranspose',
516 $ kb, kb, (j-1)*nb,
517 $ -cone, a( j*nb+1, 1 ), lda,
518 $ work( nb+1 ), n,
519 $ cone, tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
520* T(J,J) += L(J,J)*T(J,J-1)*L(J,J-1)'
521 CALL zgemm( 'NoTranspose', 'NoTranspose',
522 $ kb, nb, kb,
523 $ cone, a( j*nb+1, (j-1)*nb+1 ), lda,
524 $ tb( td+nb+1 + ((j-1)*nb)*ldtb ), ldtb-1,
525 $ czero, work( 1 ), n )
526 CALL zgemm( 'NoTranspose', 'Transpose',
527 $ kb, kb, nb,
528 $ -cone, work( 1 ), n,
529 $ a( j*nb+1, (j-2)*nb+1 ), lda,
530 $ cone, tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
531 END IF
532*
533* Expand T(J,J) into full format
534*
535 DO i = 1, kb
536 DO k = i+1, kb
537 tb( td-(k-(i+1)) + (j*nb+k-1)*ldtb )
538 $ = tb( td+(k-i)+1 + (j*nb+i-1)*ldtb )
539 END DO
540 END DO
541 IF( j.GT.0 ) THEN
542c CALL CHEGST( 1, 'Lower', KB,
543c $ TB( TD+1 + (J*NB)*LDTB ), LDTB-1,
544c $ A( J*NB+1, (J-1)*NB+1 ), LDA, IINFO )
545 CALL ztrsm( 'L', 'L', 'N', 'N', kb, kb, cone,
546 $ a( j*nb+1, (j-1)*nb+1 ), lda,
547 $ tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
548 CALL ztrsm( 'R', 'L', 'T', 'N', kb, kb, cone,
549 $ a( j*nb+1, (j-1)*nb+1 ), lda,
550 $ tb( td+1 + (j*nb)*ldtb ), ldtb-1 )
551 END IF
552*
553* Symmetrize T(J,J)
554*
555 DO i = 1, kb
556 DO k = i+1, kb
557 tb( td-(k-(i+1)) + (j*nb+k-1)*ldtb )
558 $ = tb( td+(k-i)+1 + (j*nb+i-1)*ldtb )
559 END DO
560 END DO
561*
562 IF( j.LT.nt-1 ) THEN
563 IF( j.GT.0 ) THEN
564*
565* Compute H(J,J)
566*
567 IF( j.EQ.1 ) THEN
568 CALL zgemm( 'NoTranspose', 'Transpose',
569 $ kb, kb, kb,
570 $ cone, tb( td+1 + (j*nb)*ldtb ), ldtb-1,
571 $ a( j*nb+1, (j-1)*nb+1 ), lda,
572 $ czero, work( j*nb+1 ), n )
573 ELSE
574 CALL zgemm( 'NoTranspose', 'Transpose',
575 $ kb, kb, nb+kb,
576 $ cone, tb( td+nb+1 + ((j-1)*nb)*ldtb ),
577 $ ldtb-1,
578 $ a( j*nb+1, (j-2)*nb+1 ), lda,
579 $ czero, work( j*nb+1 ), n )
580 END IF
581*
582* Update with the previous column
583*
584 CALL zgemm( 'NoTranspose', 'NoTranspose',
585 $ n-(j+1)*nb, nb, j*nb,
586 $ -cone, a( (j+1)*nb+1, 1 ), lda,
587 $ work( nb+1 ), n,
588 $ cone, a( (j+1)*nb+1, j*nb+1 ), lda )
589 END IF
590*
591* Factorize panel
592*
593 CALL zgetrf( n-(j+1)*nb, nb,
594 $ a( (j+1)*nb+1, j*nb+1 ), lda,
595 $ ipiv( (j+1)*nb+1 ), iinfo )
596c IF (IINFO.NE.0 .AND. INFO.EQ.0) THEN
597c INFO = IINFO+(J+1)*NB
598c END IF
599*
600* Compute T(J+1, J), zero out for GEMM update
601*
602 kb = min(nb, n-(j+1)*nb)
603 CALL zlaset( 'Full', kb, nb, czero, czero,
604 $ tb( td+nb+1 + (j*nb)*ldtb), ldtb-1 )
605 CALL zlacpy( 'Upper', kb, nb,
606 $ a( (j+1)*nb+1, j*nb+1 ), lda,
607 $ tb( td+nb+1 + (j*nb)*ldtb ), ldtb-1 )
608 IF( j.GT.0 ) THEN
609 CALL ztrsm( 'R', 'L', 'T', 'U', kb, nb, cone,
610 $ a( j*nb+1, (j-1)*nb+1 ), lda,
611 $ tb( td+nb+1 + (j*nb)*ldtb ), ldtb-1 )
612 END IF
613*
614* Copy T(J+1,J) into T(J, J+1), both upper/lower for GEMM
615* updates
616*
617 DO k = 1, nb
618 DO i = 1, kb
619 tb( td-nb+k-i+1 + (j*nb+nb+i-1)*ldtb ) =
620 $ tb( td+nb+i-k+1 + (j*nb+k-1)*ldtb )
621 END DO
622 END DO
623 CALL zlaset( 'Upper', kb, nb, czero, cone,
624 $ a( (j+1)*nb+1, j*nb+1 ), lda )
625*
626* Apply pivots to trailing submatrix of A
627*
628 DO k = 1, kb
629* > Adjust ipiv
630 ipiv( (j+1)*nb+k ) = ipiv( (j+1)*nb+k ) + (j+1)*nb
631*
632 i1 = (j+1)*nb+k
633 i2 = ipiv( (j+1)*nb+k )
634 IF( i1.NE.i2 ) THEN
635* > Apply pivots to previous columns of L
636 CALL zswap( k-1, a( i1, (j+1)*nb+1 ), lda,
637 $ a( i2, (j+1)*nb+1 ), lda )
638* > Swap A(I1+1:M, I1) with A(I2, I1+1:M)
639 IF( i2.GT.(i1+1) )
640 $ CALL zswap( i2-i1-1, a( i1+1, i1 ), 1,
641 $ a( i2, i1+1 ), lda )
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*
660c CALL ZLASWP( J*NB, A( 1, 1 ), LDA,
661c $ (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 ZSYTRF_AA_2STAGE
672*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
zcopy
subroutine zcopy(n, zx, incx, zy, incy)
ZCOPY
Definition zcopy.f:81
zgbtrf
subroutine zgbtrf(m, n, kl, ku, ab, ldab, ipiv, info)
ZGBTRF
Definition zgbtrf.f:144
zgemm
subroutine zgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
ZGEMM
Definition zgemm.f:188
zgetrf
subroutine zgetrf(m, n, a, lda, ipiv, info)
ZGETRF
Definition zgetrf.f:108
ilaenv
integer function ilaenv(ispec, name, opts, n1, n2, n3, n4)
ILAENV
Definition ilaenv.f:162
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:103
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:106
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:115
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
zswap
subroutine zswap(n, zx, incx, zy, incy)
ZSWAP
Definition zswap.f:81
ztrsm
subroutine ztrsm(side, uplo, transa, diag, m, n, alpha, a, lda, b, ldb)
ZTRSM
Definition ztrsm.f:180
Here is the call graph for this function:
Here is the caller graph for this function: