ztprfb()

subroutine ztprfb	(	character	side,
		character	trans,
		character	direct,
		character	storev,
		integer	m,
		integer	n,
		integer	k,
		integer	l,
		complex*16, dimension( ldv, * )	v,
		integer	ldv,
		complex*16, dimension( ldt, * )	t,
		integer	ldt,
		complex*16, dimension( lda, * )	a,
		integer	lda,
		complex*16, dimension( ldb, * )	b,
		integer	ldb,
		complex*16, dimension( ldwork, * )	work,
		integer	ldwork )

ZTPRFB applies a complex "triangular-pentagonal" block reflector to a complex matrix, which is composed of two blocks.

Download ZTPRFB + dependencies [TGZ] [ZIP] [TXT]

Purpose:

!>
!> ZTPRFB applies a complex  block reflector H or its
!> conjugate transpose H**H to a complex matrix C, which is composed of two
!> blocks A and B, either from the left or right.
!>
!> 

Parameters

[in]	SIDE	!> SIDE is CHARACTER*1 !> = 'L': apply H or H**H from the Left !> = 'R': apply H or H**H from the Right !>
[in]	TRANS	!> TRANS is CHARACTER*1 !> = 'N': apply H (No transpose) !> = 'C': apply H**H (Conjugate transpose) !>
[in]	DIRECT	!> DIRECT is CHARACTER*1 !> Indicates how H is formed from a product of elementary !> reflectors !> = 'F': H = H(1) H(2) . . . H(k) (Forward) !> = 'B': H = H(k) . . . H(2) H(1) (Backward) !>
[in]	STOREV	!> STOREV is CHARACTER*1 !> Indicates how the vectors which define the elementary !> reflectors are stored: !> = 'C': Columns !> = 'R': Rows !>
[in]	M	!> M is INTEGER !> The number of rows of the matrix B. !> M >= 0. !>
[in]	N	!> N is INTEGER !> The number of columns of the matrix B. !> N >= 0. !>
[in]	K	!> K is INTEGER !> The order of the matrix T, i.e. the number of elementary !> reflectors whose product defines the block reflector. !> K >= 0. !>
[in]	L	!> L is INTEGER !> The order of the trapezoidal part of V. !> K >= L >= 0. See Further Details. !>
[in]	V	!> V is COMPLEX*16 array, dimension !> (LDV,K) if STOREV = 'C' !> (LDV,M) if STOREV = 'R' and SIDE = 'L' !> (LDV,N) if STOREV = 'R' and SIDE = 'R' !> The pentagonal matrix V, which contains the elementary reflectors !> H(1), H(2), ..., H(K). See Further Details. !>
[in]	LDV	!> LDV is INTEGER !> The leading dimension of the array V. !> If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M); !> if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N); !> if STOREV = 'R', LDV >= K. !>
[in]	T	!> T is COMPLEX*16 array, dimension (LDT,K) !> The triangular K-by-K matrix T in the representation of the !> block reflector. !>
[in]	LDT	!> LDT is INTEGER !> The leading dimension of the array T. !> LDT >= K. !>
[in,out]	A	!> A is COMPLEX*16 array, dimension !> (LDA,N) if SIDE = 'L' or (LDA,K) if SIDE = 'R' !> On entry, the K-by-N or M-by-K matrix A. !> On exit, A is overwritten by the corresponding block of !> H*C or H**H*C or C*H or C*H**H. See Further Details. !>
[in]	LDA	!> LDA is INTEGER !> The leading dimension of the array A. !> If SIDE = 'L', LDA >= max(1,K); !> If SIDE = 'R', LDA >= max(1,M). !>
[in,out]	B	!> B is COMPLEX*16 array, dimension (LDB,N) !> On entry, the M-by-N matrix B. !> On exit, B is overwritten by the corresponding block of !> H*C or H**H*C or C*H or C*H**H. See Further Details. !>
[in]	LDB	!> LDB is INTEGER !> The leading dimension of the array B. !> LDB >= max(1,M). !>
[out]	WORK	!> WORK is COMPLEX*16 array, dimension !> (LDWORK,N) if SIDE = 'L', !> (LDWORK,K) if SIDE = 'R'. !>
[in]	LDWORK	!> LDWORK is INTEGER !> The leading dimension of the array WORK. !> If SIDE = 'L', LDWORK >= K; !> if SIDE = 'R', LDWORK >= M. !>

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Further Details:

!>
!>  The matrix C is a composite matrix formed from blocks A and B.
!>  The block B is of size M-by-N; if SIDE = 'R', A is of size M-by-K,
!>  and if SIDE = 'L', A is of size K-by-N.
!>
!>  If SIDE = 'R' and DIRECT = 'F', C = [A B].
!>
!>  If SIDE = 'L' and DIRECT = 'F', C = [A]
!>                                      [B].
!>
!>  If SIDE = 'R' and DIRECT = 'B', C = [B A].
!>
!>  If SIDE = 'L' and DIRECT = 'B', C = [B]
!>                                      [A].
!>
!>  The pentagonal matrix V is composed of a rectangular block V1 and a
!>  trapezoidal block V2.  The size of the trapezoidal block is determined by
!>  the parameter L, where 0<=L<=K.  If L=K, the V2 block of V is triangular;
!>  if L=0, there is no trapezoidal block, thus V = V1 is rectangular.
!>
!>  If DIRECT = 'F' and STOREV = 'C':  V = [V1]
!>                                         [V2]
!>     - V2 is upper trapezoidal (first L rows of K-by-K upper triangular)
!>
!>  If DIRECT = 'F' and STOREV = 'R':  V = [V1 V2]
!>
!>     - V2 is lower trapezoidal (first L columns of K-by-K lower triangular)
!>
!>  If DIRECT = 'B' and STOREV = 'C':  V = [V2]
!>                                         [V1]
!>     - V2 is lower trapezoidal (last L rows of K-by-K lower triangular)
!>
!>  If DIRECT = 'B' and STOREV = 'R':  V = [V2 V1]
!>
!>     - V2 is upper trapezoidal (last L columns of K-by-K upper triangular)
!>
!>  If STOREV = 'C' and SIDE = 'L', V is M-by-K with V2 L-by-K.
!>
!>  If STOREV = 'C' and SIDE = 'R', V is N-by-K with V2 L-by-K.
!>
!>  If STOREV = 'R' and SIDE = 'L', V is K-by-M with V2 K-by-L.
!>
!>  If STOREV = 'R' and SIDE = 'R', V is K-by-N with V2 K-by-L.
!> 

Definition at line 247 of file ztprfb.f.

*
*  -- LAPACK auxiliary routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      CHARACTER DIRECT, SIDE, STOREV, TRANS
      INTEGER   K, L, LDA, LDB, LDT, LDV, LDWORK, M, N
*     ..
*     .. Array Arguments ..
      COMPLEX*16   A( LDA, * ), B( LDB, * ), T( LDT, * ),
     $          V( LDV, * ), WORK( LDWORK, * )
*     ..
*
*  ==========================================================================
*
*     .. Parameters ..
      COMPLEX*16   ONE, ZERO
      parameter( one = (1.0,0.0), zero = (0.0,0.0) )
*     ..
*     .. Local Scalars ..
      INTEGER   I, J, MP, NP, KP
      LOGICAL   LEFT, FORWARD, COLUMN, RIGHT, BACKWARD, ROW
*     ..
*     .. External Functions ..
      LOGICAL   LSAME
      EXTERNAL  lsame
*     ..
*     .. External Subroutines ..
      EXTERNAL  zgemm, ztrmm
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC conjg
*     ..
*     .. Executable Statements ..
*
*     Quick return if possible
*
      IF( m.LE.0 .OR. n.LE.0 .OR. k.LE.0 .OR. l.LT.0 ) RETURN
*
      IF( lsame( storev, 'C' ) ) THEN
         column = .true.
         row = .false.
      ELSE IF ( lsame( storev, 'R' ) ) THEN
         column = .false.
         row = .true.
      ELSE
         column = .false.
         row = .false.
      END IF
*
      IF( lsame( side, 'L' ) ) THEN
         left = .true.
         right = .false.
      ELSE IF( lsame( side, 'R' ) ) THEN
         left = .false.
         right = .true.
      ELSE
         left = .false.
         right = .false.
      END IF
*
      IF( lsame( direct, 'F' ) ) THEN
         forward = .true.
         backward = .false.
      ELSE IF( lsame( direct, 'B' ) ) THEN
         forward = .false.
         backward = .true.
      ELSE
         forward = .false.
         backward = .false.
      END IF
*
* ---------------------------------------------------------------------------
*
      IF( column .AND. forward .AND. left  ) THEN
*
* ---------------------------------------------------------------------------
*
*        Let  W =  [ I ]    (K-by-K)
*                  [ V ]    (M-by-K)
*
*        Form  H C  or  H**H C  where  C = [ A ]  (K-by-N)
*                                          [ B ]  (M-by-N)
*
*        H = I - W T W**H          or  H**H = I - W T**H W**H
*
*        A = A -   T (A + V**H B)  or  A = A -   T**H (A + V**H B)
*        B = B - V T (A + V**H B)  or  B = B - V T**H (A + V**H B)
*
* ---------------------------------------------------------------------------
*
         mp = min( m-l+1, m )
         kp = min( l+1, k )
*
         DO j = 1, n
            DO i = 1, l
               work( i, j ) = b( m-l+i, j )
            END DO
         END DO
         CALL ztrmm( 'L', 'U', 'C', 'N', l, n, one, v( mp, 1 ), ldv,
     $               work, ldwork )
         CALL zgemm( 'C', 'N', l, n, m-l, one, v, ldv, b, ldb,
     $               one, work, ldwork )
         CALL zgemm( 'C', 'N', k-l, n, m, one, v( 1, kp ), ldv,
     $               b, ldb, zero, work( kp, 1 ), ldwork )
*
         DO j = 1, n
            DO i = 1, k
               work( i, j ) = work( i, j ) + a( i, j )
            END DO
         END DO
*
         CALL ztrmm( 'L', 'U', trans, 'N', k, n, one, t, ldt,
     $               work, ldwork )
*
         DO j = 1, n
            DO i = 1, k
               a( i, j ) = a( i, j ) - work( i, j )
            END DO
         END DO
*
         CALL zgemm( 'N', 'N', m-l, n, k, -one, v, ldv, work, ldwork,
     $               one, b, ldb )
         CALL zgemm( 'N', 'N', l, n, k-l, -one, v( mp, kp ), ldv,
     $               work( kp, 1 ), ldwork, one, b( mp, 1 ),  ldb )
         CALL ztrmm( 'L', 'U', 'N', 'N', l, n, one, v( mp, 1 ), ldv,
     $               work, ldwork )
         DO j = 1, n
            DO i = 1, l
               b( m-l+i, j ) = b( m-l+i, j ) - work( i, j )
            END DO
         END DO
*
* ---------------------------------------------------------------------------
*
      ELSE IF( column .AND. forward .AND. right ) THEN
*
* ---------------------------------------------------------------------------
*
*        Let  W =  [ I ]    (K-by-K)
*                  [ V ]    (N-by-K)
*
*        Form  C H or  C H**H  where  C = [ A B ] (A is M-by-K, B is M-by-N)
*
*        H = I - W T W**H          or  H**H = I - W T**H W**H
*
*        A = A - (A + B V) T      or  A = A - (A + B V) T**H
*        B = B - (A + B V) T V**H  or  B = B - (A + B V) T**H V**H
*
* ---------------------------------------------------------------------------
*
         np = min( n-l+1, n )
         kp = min( l+1, k )
*
         DO j = 1, l
            DO i = 1, m
               work( i, j ) = b( i, n-l+j )
            END DO
         END DO
         CALL ztrmm( 'R', 'U', 'N', 'N', m, l, one, v( np, 1 ), ldv,
     $               work, ldwork )
         CALL zgemm( 'N', 'N', m, l, n-l, one, b, ldb,
     $               v, ldv, one, work, ldwork )
         CALL zgemm( 'N', 'N', m, k-l, n, one, b, ldb,
     $               v( 1, kp ), ldv, zero, work( 1, kp ), ldwork )
*
         DO j = 1, k
            DO i = 1, m
               work( i, j ) = work( i, j ) + a( i, j )
            END DO
         END DO
*
         CALL ztrmm( 'R', 'U', trans, 'N', m, k, one, t, ldt,
     $               work, ldwork )
*
         DO j = 1, k
            DO i = 1, m
               a( i, j ) = a( i, j ) - work( i, j )
            END DO
         END DO
*
         CALL zgemm( 'N', 'C', m, n-l, k, -one, work, ldwork,
     $               v, ldv, one, b, ldb )
         CALL zgemm( 'N', 'C', m, l, k-l, -one, work( 1, kp ),
     $               ldwork,
     $               v( np, kp ), ldv, one, b( 1, np ), ldb )
         CALL ztrmm( 'R', 'U', 'C', 'N', m, l, one, v( np, 1 ), ldv,
     $               work, ldwork )
         DO j = 1, l
            DO i = 1, m
               b( i, n-l+j ) = b( i, n-l+j ) - work( i, j )
            END DO
         END DO
*
* ---------------------------------------------------------------------------
*
      ELSE IF( column .AND. backward .AND. left ) THEN
*
* ---------------------------------------------------------------------------
*
*        Let  W =  [ V ]    (M-by-K)
*                  [ I ]    (K-by-K)
*
*        Form  H C  or  H**H C  where  C = [ B ]  (M-by-N)
*                                          [ A ]  (K-by-N)
*
*        H = I - W T W**H          or  H**H = I - W T**H W**H
*
*        A = A -   T (A + V**H B)  or  A = A -   T**H (A + V**H B)
*        B = B - V T (A + V**H B)  or  B = B - V T**H (A + V**H B)
*
* ---------------------------------------------------------------------------
*
         mp = min( l+1, m )
         kp = min( k-l+1, k )
*
         DO j = 1, n
            DO i = 1, l
               work( k-l+i, j ) = b( i, j )
            END DO
         END DO
*
         CALL ztrmm( 'L', 'L', 'C', 'N', l, n, one, v( 1, kp ), ldv,
     $               work( kp, 1 ), ldwork )
         CALL zgemm( 'C', 'N', l, n, m-l, one, v( mp, kp ), ldv,
     $               b( mp, 1 ), ldb, one, work( kp, 1 ), ldwork )
         CALL zgemm( 'C', 'N', k-l, n, m, one, v, ldv,
     $               b, ldb, zero, work, ldwork )
*
         DO j = 1, n
            DO i = 1, k
               work( i, j ) = work( i, j ) + a( i, j )
            END DO
         END DO
*
         CALL ztrmm( 'L', 'L', trans, 'N', k, n, one, t, ldt,
     $               work, ldwork )
*
         DO j = 1, n
            DO i = 1, k
               a( i, j ) = a( i, j ) - work( i, j )
            END DO
         END DO
*
         CALL zgemm( 'N', 'N', m-l, n, k, -one, v( mp, 1 ), ldv,
     $               work, ldwork, one, b( mp, 1 ), ldb )
         CALL zgemm( 'N', 'N', l, n, k-l, -one, v, ldv,
     $               work, ldwork, one, b,  ldb )
         CALL ztrmm( 'L', 'L', 'N', 'N', l, n, one, v( 1, kp ), ldv,
     $               work( kp, 1 ), ldwork )
         DO j = 1, n
            DO i = 1, l
               b( i, j ) = b( i, j ) - work( k-l+i, j )
            END DO
         END DO
*
* ---------------------------------------------------------------------------
*
      ELSE IF( column .AND. backward .AND. right ) THEN
*
* ---------------------------------------------------------------------------
*
*        Let  W =  [ V ]    (N-by-K)
*                  [ I ]    (K-by-K)
*
*        Form  C H  or  C H**H  where  C = [ B A ] (B is M-by-N, A is M-by-K)
*
*        H = I - W T W**H          or  H**H = I - W T**H W**H
*
*        A = A - (A + B V) T      or  A = A - (A + B V) T**H
*        B = B - (A + B V) T V**H  or  B = B - (A + B V) T**H V**H
*
* ---------------------------------------------------------------------------
*
         np = min( l+1, n )
         kp = min( k-l+1, k )
*
         DO j = 1, l
            DO i = 1, m
               work( i, k-l+j ) = b( i, j )
            END DO
         END DO
         CALL ztrmm( 'R', 'L', 'N', 'N', m, l, one, v( 1, kp ), ldv,
     $               work( 1, kp ), ldwork )
         CALL zgemm( 'N', 'N', m, l, n-l, one, b( 1, np ), ldb,
     $               v( np, kp ), ldv, one, work( 1, kp ), ldwork )
         CALL zgemm( 'N', 'N', m, k-l, n, one, b, ldb,
     $               v, ldv, zero, work, ldwork )
*
         DO j = 1, k
            DO i = 1, m
               work( i, j ) = work( i, j ) + a( i, j )
            END DO
         END DO
*
         CALL ztrmm( 'R', 'L', trans, 'N', m, k, one, t, ldt,
     $               work, ldwork )
*
         DO j = 1, k
            DO i = 1, m
               a( i, j ) = a( i, j ) - work( i, j )
            END DO
         END DO
*
         CALL zgemm( 'N', 'C', m, n-l, k, -one, work, ldwork,
     $               v( np, 1 ), ldv, one, b( 1, np ), ldb )
         CALL zgemm( 'N', 'C', m, l, k-l, -one, work, ldwork,
     $               v, ldv, one, b, ldb )
         CALL ztrmm( 'R', 'L', 'C', 'N', m, l, one, v( 1, kp ), ldv,
     $               work( 1, kp ), ldwork )
         DO j = 1, l
            DO i = 1, m
               b( i, j ) = b( i, j ) - work( i, k-l+j )
            END DO
         END DO
*
* ---------------------------------------------------------------------------
*
      ELSE IF( row .AND. forward .AND. left ) THEN
*
* ---------------------------------------------------------------------------
*
*        Let  W =  [ I V ] ( I is K-by-K, V is K-by-M )
*
*        Form  H C  or  H**H C  where  C = [ A ]  (K-by-N)
*                                          [ B ]  (M-by-N)
*
*        H = I - W**H T W          or  H**H = I - W**H T**H W
*
*        A = A -     T (A + V B)  or  A = A -     T**H (A + V B)
*        B = B - V**H T (A + V B)  or  B = B - V**H T**H (A + V B)
*
* ---------------------------------------------------------------------------
*
         mp = min( m-l+1, m )
         kp = min( l+1, k )
*
         DO j = 1, n
            DO i = 1, l
               work( i, j ) = b( m-l+i, j )
            END DO
         END DO
         CALL ztrmm( 'L', 'L', 'N', 'N', l, n, one, v( 1, mp ), ldv,
     $               work, ldb )
         CALL zgemm( 'N', 'N', l, n, m-l, one, v, ldv,b, ldb,
     $               one, work, ldwork )
         CALL zgemm( 'N', 'N', k-l, n, m, one, v( kp, 1 ), ldv,
     $               b, ldb, zero, work( kp, 1 ), ldwork )
*
         DO j = 1, n
            DO i = 1, k
               work( i, j ) = work( i, j ) + a( i, j )
            END DO
         END DO
*
         CALL ztrmm( 'L', 'U', trans, 'N', k, n, one, t, ldt,
     $               work, ldwork )
*
         DO j = 1, n
            DO i = 1, k
               a( i, j ) = a( i, j ) - work( i, j )
            END DO
         END DO
*
         CALL zgemm( 'C', 'N', m-l, n, k, -one, v, ldv, work, ldwork,
     $               one, b, ldb )
         CALL zgemm( 'C', 'N', l, n, k-l, -one, v( kp, mp ), ldv,
     $               work( kp, 1 ), ldwork, one, b( mp, 1 ), ldb )
         CALL ztrmm( 'L', 'L', 'C', 'N', l, n, one, v( 1, mp ), ldv,
     $               work, ldwork )
         DO j = 1, n
            DO i = 1, l
               b( m-l+i, j ) = b( m-l+i, j ) - work( i, j )
            END DO
         END DO
*
* ---------------------------------------------------------------------------
*
      ELSE IF( row .AND. forward .AND. right ) THEN
*
* ---------------------------------------------------------------------------
*
*        Let  W =  [ I V ] ( I is K-by-K, V is K-by-N )
*
*        Form  C H  or  C H**H  where  C = [ A B ] (A is M-by-K, B is M-by-N)
*
*        H = I - W**H T W            or  H**H = I - W**H T**H W
*
*        A = A - (A + B V**H) T      or  A = A - (A + B V**H) T**H
*        B = B - (A + B V**H) T V    or  B = B - (A + B V**H) T**H V
*
* ---------------------------------------------------------------------------
*
         np = min( n-l+1, n )
         kp = min( l+1, k )
*
         DO j = 1, l
            DO i = 1, m
               work( i, j ) = b( i, n-l+j )
            END DO
         END DO
         CALL ztrmm( 'R', 'L', 'C', 'N', m, l, one, v( 1, np ), ldv,
     $               work, ldwork )
         CALL zgemm( 'N', 'C', m, l, n-l, one, b, ldb, v, ldv,
     $               one, work, ldwork )
         CALL zgemm( 'N', 'C', m, k-l, n, one, b, ldb,
     $               v( kp, 1 ), ldv, zero, work( 1, kp ), ldwork )
*
         DO j = 1, k
            DO i = 1, m
               work( i, j ) = work( i, j ) + a( i, j )
            END DO
         END DO
*
         CALL ztrmm( 'R', 'U', trans, 'N', m, k, one, t, ldt,
     $               work, ldwork )
*
         DO j = 1, k
            DO i = 1, m
               a( i, j ) = a( i, j ) - work( i, j )
            END DO
         END DO
*
         CALL zgemm( 'N', 'N', m, n-l, k, -one, work, ldwork,
     $               v, ldv, one, b, ldb )
         CALL zgemm( 'N', 'N', m, l, k-l, -one, work( 1, kp ),
     $               ldwork,
     $               v( kp, np ), ldv, one, b( 1, np ), ldb )
         CALL ztrmm( 'R', 'L', 'N', 'N', m, l, one, v( 1, np ), ldv,
     $               work, ldwork )
         DO j = 1, l
            DO i = 1, m
               b( i, n-l+j ) = b( i, n-l+j ) - work( i, j )
            END DO
         END DO
*
* ---------------------------------------------------------------------------
*
      ELSE IF( row .AND. backward .AND. left ) THEN
*
* ---------------------------------------------------------------------------
*
*        Let  W =  [ V I ] ( I is K-by-K, V is K-by-M )
*
*        Form  H C  or  H**H C  where  C = [ B ]  (M-by-N)
*                                          [ A ]  (K-by-N)
*
*        H = I - W**H T W          or  H**H = I - W**H T**H W
*
*        A = A -     T (A + V B)  or  A = A -     T**H (A + V B)
*        B = B - V**H T (A + V B)  or  B = B - V**H T**H (A + V B)
*
* ---------------------------------------------------------------------------
*
         mp = min( l+1, m )
         kp = min( k-l+1, k )
*
         DO j = 1, n
            DO i = 1, l
               work( k-l+i, j ) = b( i, j )
            END DO
         END DO
         CALL ztrmm( 'L', 'U', 'N', 'N', l, n, one, v( kp, 1 ), ldv,
     $               work( kp, 1 ), ldwork )
         CALL zgemm( 'N', 'N', l, n, m-l, one, v( kp, mp ), ldv,
     $               b( mp, 1 ), ldb, one, work( kp, 1 ), ldwork )
         CALL zgemm( 'N', 'N', k-l, n, m, one, v, ldv, b, ldb,
     $               zero, work, ldwork )
*
         DO j = 1, n
            DO i = 1, k
               work( i, j ) = work( i, j ) + a( i, j )
            END DO
         END DO
*
         CALL ztrmm( 'L', 'L ', trans, 'N', k, n, one, t, ldt,
     $               work, ldwork )
*
         DO j = 1, n
            DO i = 1, k
               a( i, j ) = a( i, j ) - work( i, j )
            END DO
         END DO
*
         CALL zgemm( 'C', 'N', m-l, n, k, -one, v( 1, mp ), ldv,
     $               work, ldwork, one, b( mp, 1 ), ldb )
         CALL zgemm( 'C', 'N', l, n, k-l, -one, v, ldv,
     $               work, ldwork, one, b, ldb )
         CALL ztrmm( 'L', 'U', 'C', 'N', l, n, one, v( kp, 1 ), ldv,
     $               work( kp, 1 ), ldwork )
         DO j = 1, n
            DO i = 1, l
               b( i, j ) = b( i, j ) - work( k-l+i, j )
            END DO
         END DO
*
* ---------------------------------------------------------------------------
*
      ELSE IF( row .AND. backward .AND. right ) THEN
*
* ---------------------------------------------------------------------------
*
*        Let  W =  [ V I ] ( I is K-by-K, V is K-by-N )
*
*        Form  C H  or  C H**H  where  C = [ B A ] (A is M-by-K, B is M-by-N)
*
*        H = I - W**H T W            or  H**H = I - W**H T**H W
*
*        A = A - (A + B V**H) T      or  A = A - (A + B V**H) T**H
*        B = B - (A + B V**H) T V    or  B = B - (A + B V**H) T**H V
*
* ---------------------------------------------------------------------------
*
         np = min( l+1, n )
         kp = min( k-l+1, k )
*
         DO j = 1, l
            DO i = 1, m
               work( i, k-l+j ) = b( i, j )
            END DO
         END DO
         CALL ztrmm( 'R', 'U', 'C', 'N', m, l, one, v( kp, 1 ), ldv,
     $               work( 1, kp ), ldwork )
         CALL zgemm( 'N', 'C', m, l, n-l, one, b( 1, np ), ldb,
     $               v( kp, np ), ldv, one, work( 1, kp ), ldwork )
         CALL zgemm( 'N', 'C', m, k-l, n, one, b, ldb, v, ldv,
     $               zero, work, ldwork )
*
         DO j = 1, k
            DO i = 1, m
               work( i, j ) = work( i, j ) + a( i, j )
            END DO
         END DO
*
         CALL ztrmm( 'R', 'L', trans, 'N', m, k, one, t, ldt,
     $               work, ldwork )
*
         DO j = 1, k
            DO i = 1, m
               a( i, j ) = a( i, j ) - work( i, j )
            END DO
         END DO
*
         CALL zgemm( 'N', 'N', m, n-l, k, -one, work, ldwork,
     $               v( 1, np ), ldv, one, b( 1, np ), ldb )
         CALL zgemm( 'N', 'N', m, l, k-l , -one, work, ldwork,
     $               v, ldv, one, b, ldb )
         CALL ztrmm( 'R', 'U', 'N', 'N', m, l, one, v( kp, 1 ), ldv,
     $               work( 1, kp ), ldwork )
         DO j = 1, l
            DO i = 1, m
               b( i, j ) = b( i, j ) - work( i, k-l+j )
            END DO
         END DO
*
      END IF
*
      RETURN
*
*     End of ZTPRFB
*

Here is the call graph for this function:

Here is the caller graph for this function: