SUBROUTINE DBQRU_LARFT( N, K, V, LDV, TAU, T, LDT )
      IMPLICIT NONE
*
*     This is a modification of the LAPACK routine DLARFT.
*
*     .. Scalar Arguments ..
      INTEGER            K, LDT, LDV, N
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION   T( LDT, * ), TAU( * ), V( LDV, * )
*     ..
*
*  Purpose
*  =======
*
*  DBQRU_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 DBGRU. Each H(i) has the form
*
*     H(i) = I - tau * v * v'
*
*  where tau is a real scalar, and v is a real 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) DOUBLE PRECISION array, dimension (LDV,K)
*          The matrix V.
*
*  LDV     (input) INTEGER
*          The leading dimension of the array V. LDV >= max(1,N).
*
*  TAU     (input) DOUBLE PRECISION array, dimension (K)
*          TAU(i) must contain the scalar factor of the elementary
*          reflector H(i).
*
*  T       (output) DOUBLE PRECISION 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 ..
      DOUBLE PRECISION   ONE, ZERO
      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
*     ..
*     .. Local Scalars ..
      INTEGER            I, J
*     ..
*     .. External Subroutines ..
      EXTERNAL           DGEMV, DTRMV
*     ..
*     .. 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 DGEMV( '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 DTRMV( '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