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