195 SUBROUTINE zlarfb( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
196 $ t, ldt, c, ldc, work, ldwork )
204 CHARACTER DIRECT, SIDE, STOREV, TRANS
205 INTEGER K, LDC, LDT, LDV, LDWORK, M, N
208 COMPLEX*16 C( ldc, * ), T( ldt, * ), V( ldv, * ),
216 parameter( one = ( 1.0d+0, 0.0d+0 ) )
236 IF( m.LE.0 .OR. n.LE.0 )
239 IF( lsame( trans,
'N' ) )
THEN
245 IF( lsame( storev,
'C' ) )
THEN
247 IF( lsame( direct,
'F' ) )
THEN
253 IF( lsame( side,
'L' ) )
THEN
263 CALL zcopy( n, c( j, 1 ), ldc, work( 1, j ), 1 )
264 CALL zlacgv( n, work( 1, j ), 1 )
269 CALL ztrmm(
'Right',
'Lower',
'No transpose',
'Unit', n,
270 $ k, one, v, ldv, work, ldwork )
275 CALL zgemm(
'Conjugate transpose',
'No transpose', n,
276 $ k, m-k, one, c( k+1, 1 ), ldc,
277 $ v( k+1, 1 ), ldv, one, work, ldwork )
282 CALL ztrmm(
'Right',
'Upper', transt,
'Non-unit', n, k,
283 $ one, t, ldt, work, ldwork )
291 CALL zgemm(
'No transpose',
'Conjugate transpose',
292 $ m-k, n, k, -one, v( k+1, 1 ), ldv, work,
293 $ ldwork, one, c( k+1, 1 ), ldc )
298 CALL ztrmm(
'Right',
'Lower',
'Conjugate transpose',
299 $
'Unit', n, k, one, v, ldv, work, ldwork )
305 c( j, i ) = c( j, i ) - dconjg( work( i, j ) )
309 ELSE IF( lsame( side,
'R' ) )
THEN
318 CALL zcopy( m, c( 1, j ), 1, work( 1, j ), 1 )
323 CALL ztrmm(
'Right',
'Lower',
'No transpose',
'Unit', m,
324 $ k, one, v, ldv, work, ldwork )
329 CALL zgemm(
'No transpose',
'No transpose', m, k, n-k,
330 $ one, c( 1, k+1 ), ldc, v( k+1, 1 ), ldv,
331 $ one, work, ldwork )
336 CALL ztrmm(
'Right',
'Upper', trans,
'Non-unit', m, k,
337 $ one, t, ldt, work, ldwork )
345 CALL zgemm(
'No transpose',
'Conjugate transpose', m,
346 $ n-k, k, -one, work, ldwork, v( k+1, 1 ),
347 $ ldv, one, c( 1, k+1 ), ldc )
352 CALL ztrmm(
'Right',
'Lower',
'Conjugate transpose',
353 $
'Unit', m, k, one, v, ldv, work, ldwork )
359 c( i, j ) = c( i, j ) - work( i, j )
370 IF( lsame( side,
'L' ) )
THEN
380 CALL zcopy( n, c( m-k+j, 1 ), ldc, work( 1, j ), 1 )
381 CALL zlacgv( n, work( 1, j ), 1 )
386 CALL ztrmm(
'Right',
'Upper',
'No transpose',
'Unit', n,
387 $ k, one, v( m-k+1, 1 ), ldv, work, ldwork )
392 CALL zgemm(
'Conjugate transpose',
'No transpose', n,
393 $ k, m-k, one, c, ldc, v, ldv, one, work,
399 CALL ztrmm(
'Right',
'Lower', transt,
'Non-unit', n, k,
400 $ one, t, ldt, work, ldwork )
408 CALL zgemm(
'No transpose',
'Conjugate transpose',
409 $ m-k, n, k, -one, v, ldv, work, ldwork,
415 CALL ztrmm(
'Right',
'Upper',
'Conjugate transpose',
416 $
'Unit', n, k, one, v( m-k+1, 1 ), ldv, work,
423 c( m-k+j, i ) = c( m-k+j, i ) -
424 $ dconjg( work( i, j ) )
428 ELSE IF( lsame( side,
'R' ) )
THEN
437 CALL zcopy( m, c( 1, n-k+j ), 1, work( 1, j ), 1 )
442 CALL ztrmm(
'Right',
'Upper',
'No transpose',
'Unit', m,
443 $ k, one, v( n-k+1, 1 ), ldv, work, ldwork )
448 CALL zgemm(
'No transpose',
'No transpose', m, k, n-k,
449 $ one, c, ldc, v, ldv, one, work, ldwork )
454 CALL ztrmm(
'Right',
'Lower', trans,
'Non-unit', m, k,
455 $ one, t, ldt, work, ldwork )
463 CALL zgemm(
'No transpose',
'Conjugate transpose', m,
464 $ n-k, k, -one, work, ldwork, v, ldv, one,
470 CALL ztrmm(
'Right',
'Upper',
'Conjugate transpose',
471 $
'Unit', m, k, one, v( n-k+1, 1 ), ldv, work,
478 c( i, n-k+j ) = c( i, n-k+j ) - work( i, j )
484 ELSE IF( lsame( storev,
'R' ) )
THEN
486 IF( lsame( direct,
'F' ) )
THEN
491 IF( lsame( side,
'L' ) )
THEN
501 CALL zcopy( n, c( j, 1 ), ldc, work( 1, j ), 1 )
502 CALL zlacgv( n, work( 1, j ), 1 )
507 CALL ztrmm(
'Right',
'Upper',
'Conjugate transpose',
508 $
'Unit', n, k, one, v, ldv, work, ldwork )
513 CALL zgemm(
'Conjugate transpose',
514 $
'Conjugate transpose', n, k, m-k, one,
515 $ c( k+1, 1 ), ldc, v( 1, k+1 ), ldv, one,
521 CALL ztrmm(
'Right',
'Upper', transt,
'Non-unit', n, k,
522 $ one, t, ldt, work, ldwork )
530 CALL zgemm(
'Conjugate transpose',
531 $
'Conjugate transpose', m-k, n, k, -one,
532 $ v( 1, k+1 ), ldv, work, ldwork, one,
538 CALL ztrmm(
'Right',
'Upper',
'No transpose',
'Unit', n,
539 $ k, one, v, ldv, work, ldwork )
545 c( j, i ) = c( j, i ) - dconjg( work( i, j ) )
549 ELSE IF( lsame( side,
'R' ) )
THEN
558 CALL zcopy( m, c( 1, j ), 1, work( 1, j ), 1 )
563 CALL ztrmm(
'Right',
'Upper',
'Conjugate transpose',
564 $
'Unit', m, k, one, v, ldv, work, ldwork )
569 CALL zgemm(
'No transpose',
'Conjugate transpose', m,
570 $ k, n-k, one, c( 1, k+1 ), ldc,
571 $ v( 1, k+1 ), ldv, one, work, ldwork )
576 CALL ztrmm(
'Right',
'Upper', trans,
'Non-unit', m, k,
577 $ one, t, ldt, work, ldwork )
585 CALL zgemm(
'No transpose',
'No transpose', m, n-k, k,
586 $ -one, work, ldwork, v( 1, k+1 ), ldv, one,
592 CALL ztrmm(
'Right',
'Upper',
'No transpose',
'Unit', m,
593 $ k, one, v, ldv, work, ldwork )
599 c( i, j ) = c( i, j ) - work( i, j )
610 IF( lsame( side,
'L' ) )
THEN
620 CALL zcopy( n, c( m-k+j, 1 ), ldc, work( 1, j ), 1 )
621 CALL zlacgv( n, work( 1, j ), 1 )
626 CALL ztrmm(
'Right',
'Lower',
'Conjugate transpose',
627 $
'Unit', n, k, one, v( 1, m-k+1 ), ldv, work,
633 CALL zgemm(
'Conjugate transpose',
634 $
'Conjugate transpose', n, k, m-k, one, c,
635 $ ldc, v, ldv, one, work, ldwork )
640 CALL ztrmm(
'Right',
'Lower', transt,
'Non-unit', n, k,
641 $ one, t, ldt, work, ldwork )
649 CALL zgemm(
'Conjugate transpose',
650 $
'Conjugate transpose', m-k, n, k, -one, v,
651 $ ldv, work, ldwork, one, c, ldc )
656 CALL ztrmm(
'Right',
'Lower',
'No transpose',
'Unit', n,
657 $ k, one, v( 1, m-k+1 ), ldv, work, ldwork )
663 c( m-k+j, i ) = c( m-k+j, i ) -
664 $ dconjg( work( i, j ) )
668 ELSE IF( lsame( side,
'R' ) )
THEN
677 CALL zcopy( m, c( 1, n-k+j ), 1, work( 1, j ), 1 )
682 CALL ztrmm(
'Right',
'Lower',
'Conjugate transpose',
683 $
'Unit', m, k, one, v( 1, n-k+1 ), ldv, work,
689 CALL zgemm(
'No transpose',
'Conjugate transpose', m,
690 $ k, n-k, one, c, ldc, v, ldv, one, work,
696 CALL ztrmm(
'Right',
'Lower', trans,
'Non-unit', m, k,
697 $ one, t, ldt, work, ldwork )
705 CALL zgemm(
'No transpose',
'No transpose', m, n-k, k,
706 $ -one, work, ldwork, v, ldv, one, c, ldc )
711 CALL ztrmm(
'Right',
'Lower',
'No transpose',
'Unit', m,
712 $ k, one, v( 1, n-k+1 ), ldv, work, ldwork )
718 c( i, n-k+j ) = c( i, n-k+j ) - work( i, j )
subroutine zlarfb(SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, T, LDT, C, LDC, WORK, LDWORK)
ZLARFB applies a block reflector or its conjugate-transpose to a general rectangular matrix...
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine ztrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRMM