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