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 zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine ztrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRMM
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
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...