195 SUBROUTINE clarfb( 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 C( ldc, * ), T( ldt, * ), V( ldv, * ),
216 parameter ( one = ( 1.0e+0, 0.0e+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 ccopy( n, c( j, 1 ), ldc, work( 1, j ), 1 )
264 CALL clacgv( n, work( 1, j ), 1 )
269 CALL ctrmm(
'Right',
'Lower',
'No transpose',
'Unit', n,
270 $ k, one, v, ldv, work, ldwork )
275 CALL cgemm(
'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 ctrmm(
'Right',
'Upper', transt,
'Non-unit', n, k,
283 $ one, t, ldt, work, ldwork )
291 CALL cgemm(
'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 ctrmm(
'Right',
'Lower',
'Conjugate transpose',
299 $
'Unit', n, k, one, v, ldv, work, ldwork )
305 c( j, i ) = c( j, i ) - conjg( work( i, j ) )
309 ELSE IF( lsame( side,
'R' ) )
THEN
318 CALL ccopy( m, c( 1, j ), 1, work( 1, j ), 1 )
323 CALL ctrmm(
'Right',
'Lower',
'No transpose',
'Unit', m,
324 $ k, one, v, ldv, work, ldwork )
329 CALL cgemm(
'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 ctrmm(
'Right',
'Upper', trans,
'Non-unit', m, k,
337 $ one, t, ldt, work, ldwork )
345 CALL cgemm(
'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 ctrmm(
'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 ccopy( n, c( m-k+j, 1 ), ldc, work( 1, j ), 1 )
381 CALL clacgv( n, work( 1, j ), 1 )
386 CALL ctrmm(
'Right',
'Upper',
'No transpose',
'Unit', n,
387 $ k, one, v( m-k+1, 1 ), ldv, work, ldwork )
392 CALL cgemm(
'Conjugate transpose',
'No transpose', n,
393 $ k, m-k, one, c, ldc, v, ldv, one, work,
399 CALL ctrmm(
'Right',
'Lower', transt,
'Non-unit', n, k,
400 $ one, t, ldt, work, ldwork )
408 CALL cgemm(
'No transpose',
'Conjugate transpose',
409 $ m-k, n, k, -one, v, ldv, work, ldwork,
415 CALL ctrmm(
'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 $ conjg( work( i, j ) )
428 ELSE IF( lsame( side,
'R' ) )
THEN
437 CALL ccopy( m, c( 1, n-k+j ), 1, work( 1, j ), 1 )
442 CALL ctrmm(
'Right',
'Upper',
'No transpose',
'Unit', m,
443 $ k, one, v( n-k+1, 1 ), ldv, work, ldwork )
448 CALL cgemm(
'No transpose',
'No transpose', m, k, n-k,
449 $ one, c, ldc, v, ldv, one, work, ldwork )
454 CALL ctrmm(
'Right',
'Lower', trans,
'Non-unit', m, k,
455 $ one, t, ldt, work, ldwork )
463 CALL cgemm(
'No transpose',
'Conjugate transpose', m,
464 $ n-k, k, -one, work, ldwork, v, ldv, one,
470 CALL ctrmm(
'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 ccopy( n, c( j, 1 ), ldc, work( 1, j ), 1 )
502 CALL clacgv( n, work( 1, j ), 1 )
507 CALL ctrmm(
'Right',
'Upper',
'Conjugate transpose',
508 $
'Unit', n, k, one, v, ldv, work, ldwork )
513 CALL cgemm(
'Conjugate transpose',
514 $
'Conjugate transpose', n, k, m-k, one,
515 $ c( k+1, 1 ), ldc, v( 1, k+1 ), ldv, one,
521 CALL ctrmm(
'Right',
'Upper', transt,
'Non-unit', n, k,
522 $ one, t, ldt, work, ldwork )
530 CALL cgemm(
'Conjugate transpose',
531 $
'Conjugate transpose', m-k, n, k, -one,
532 $ v( 1, k+1 ), ldv, work, ldwork, one,
538 CALL ctrmm(
'Right',
'Upper',
'No transpose',
'Unit', n,
539 $ k, one, v, ldv, work, ldwork )
545 c( j, i ) = c( j, i ) - conjg( work( i, j ) )
549 ELSE IF( lsame( side,
'R' ) )
THEN
558 CALL ccopy( m, c( 1, j ), 1, work( 1, j ), 1 )
563 CALL ctrmm(
'Right',
'Upper',
'Conjugate transpose',
564 $
'Unit', m, k, one, v, ldv, work, ldwork )
569 CALL cgemm(
'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 ctrmm(
'Right',
'Upper', trans,
'Non-unit', m, k,
577 $ one, t, ldt, work, ldwork )
585 CALL cgemm(
'No transpose',
'No transpose', m, n-k, k,
586 $ -one, work, ldwork, v( 1, k+1 ), ldv, one,
592 CALL ctrmm(
'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 ccopy( n, c( m-k+j, 1 ), ldc, work( 1, j ), 1 )
621 CALL clacgv( n, work( 1, j ), 1 )
626 CALL ctrmm(
'Right',
'Lower',
'Conjugate transpose',
627 $
'Unit', n, k, one, v( 1, m-k+1 ), ldv, work,
633 CALL cgemm(
'Conjugate transpose',
634 $
'Conjugate transpose', n, k, m-k, one, c,
635 $ ldc, v, ldv, one, work, ldwork )
640 CALL ctrmm(
'Right',
'Lower', transt,
'Non-unit', n, k,
641 $ one, t, ldt, work, ldwork )
649 CALL cgemm(
'Conjugate transpose',
650 $
'Conjugate transpose', m-k, n, k, -one, v,
651 $ ldv, work, ldwork, one, c, ldc )
656 CALL ctrmm(
'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 $ conjg( work( i, j ) )
668 ELSE IF( lsame( side,
'R' ) )
THEN
677 CALL ccopy( m, c( 1, n-k+j ), 1, work( 1, j ), 1 )
682 CALL ctrmm(
'Right',
'Lower',
'Conjugate transpose',
683 $
'Unit', m, k, one, v( 1, n-k+1 ), ldv, work,
689 CALL cgemm(
'No transpose',
'Conjugate transpose', m,
690 $ k, n-k, one, c, ldc, v, ldv, one, work,
696 CALL ctrmm(
'Right',
'Lower', trans,
'Non-unit', m, k,
697 $ one, t, ldt, work, ldwork )
705 CALL cgemm(
'No transpose',
'No transpose', m, n-k, k,
706 $ -one, work, ldwork, v, ldv, one, c, ldc )
711 CALL ctrmm(
'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 clacgv(N, X, INCX)
CLACGV conjugates a complex vector.
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine clarfb(SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, T, LDT, C, LDC, WORK, LDWORK)
CLARFB applies a block reflector or its conjugate-transpose to a general rectangular matrix...
subroutine ctrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRMM
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM