SUBROUTINE ZBQRU_LARFT( N, K, V, LDV, TAU, T, LDT )
      IMPLICIT NONE
*
*     This is a modification of the LAPACK routine ZLARFT.
*
*     .. Scalar Arguments ..
      INTEGER            K, LDT, LDV, N
*     ..
*     .. Array Arguments ..
      COMPLEX*16         T( LDT, * ), TAU( * ), V( LDV, * )
*     ..
*
*  Purpose
*  =======
*
*  ZBQRU_LARFT forms the triangular factor T of a real block reflector H
*  of order n+k, as a product of k elementary reflectors.
*
*  H = H(1) H(2) . . . H(k),
*
*  as generated by the routine ZBGRU. Each H(i) has the form
*
*     H(i) = I - tau * v * v'
*
*  where tau is a complex scalar, and v is a complex vector with
*  v(1:i-1) = 0, v(i) = 1, v(i+1:n) = 0; v(k+1:n+k) is stored in V(:,i),
*  and tau in TAU(i).
*
*  Arguments
*  =========
*
*  N       (input) INTEGER
*          The number of rows in V. N >= 0.
*
*  K       (input) INTEGER
*          The number of columns in V. K >= 1.
*
*  V       (input) COMPLEX*16 array, dimension (LDV,K)
*          The matrix V.
*
*  LDV     (input) INTEGER
*          The leading dimension of the array V. LDV >= max(1,N).
*
*  TAU     (input) COMPLEX*16 array, dimension (K)
*          TAU(i) must contain the scalar factor of the elementary
*          reflector H(i).
*
*  T       (output) COMPLEX*16 array, dimension (LDT,K)
*          The k by k triangular factor T of the block reflector.
*          T is upper triangular and the rest of the array is not used.
*
*  LDT     (input) INTEGER
*          The leading dimension of the array T. LDT >= K.
*
*  =====================================================================
*
*     .. Parameters ..
      COMPLEX*16         ONE, ZERO
      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
     $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
*     ..
*     .. Local Scalars ..
      INTEGER            I, J
*     ..
*     .. External Subroutines ..
      EXTERNAL           ZGEMV, ZTRMV
*     ..
*     .. Executable Statements ..
*
*     Quick return if possible
*
      IF( N.EQ.0 )
     $   RETURN
*
      DO 20 I = 1, K
         IF( TAU( I ).EQ.ZERO ) THEN
*
*           H(i)  =  I
*
            DO 10 J = 1, I
               T( J, I ) = ZERO
   10       CONTINUE
         ELSE
*
*           T(1:i-1,i) := - tau(i) * V(:,1:i-1)' * V(:,i)
*
            CALL ZGEMV( 'Conjugate transpose', N, I-1, -TAU( I ), V,
     $                  LDV, V( 1, I ), 1, ZERO, T( 1, I ), 1 )
*
*           T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i)
*
            CALL ZTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T,
     $                  LDT, T( 1, I ), 1 )
            T( I, I ) = TAU( I )
         END IF
   20 CONTINUE
      RETURN
*
*     End of DBQRU_DLARFT
*
      END