SUBROUTINE ZBQRU_LARFB( SIDE, TRANS, M, N, K, V, LDV, T, LDT, \$ C, LDC, D, LDD, WORK, LDWORK ) IMPLICIT NONE * * This is a modification of the LAPACK routine ZLARFB. * * .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER K, LDC, LDD, LDT, LDV, LDWORK, M, N * .. * .. Array Arguments .. COMPLEX*16 C( LDC, * ), D( LDD, * ), T( LDT, * ), \$ V( LDV, * ), WORK( LDWORK, * ) * .. * * Purpose * ======= * * ZBQRU_LARFB applies a complex block reflector H or its transpose H', * as generated by the routine ZBQRU_LARFT to an (k+m) by n matrix * [C] (if SIDE = 'L') or to an m by k+n matrix [C D] (if SIDE = 'R'). * [D] * * Arguments * ========= * * SIDE (input) CHARACTER*1 * = 'L': apply H or H' from the Left * = 'R': apply H or H' from the Right * * TRANS (input) CHARACTER*1 * = 'N': apply H (No transpose) * = 'C': apply H' (Conjugate transpose) * * M (input) INTEGER * The number of rows of the matrix D. * * N (input) INTEGER * The number of columns of the matrix D. * * K (input) INTEGER * The order of the matrix T (= the number of elementary * reflectors whose product defines the block reflector). * * V (input) COMPLEX*16 array, dimension (LDV,K) * The matrix V. * * LDV (input) INTEGER * The leading dimension of the array V. * If SIDE = 'L', LDV >= max(1,M); * if SIDE = 'R', LDV >= max(1,N). * * T (input) COMPLEX*16 array, dimension (LDT,K) * The triangular k by k matrix T in the representation of the * block reflector. * * LDT (input) INTEGER * The leading dimension of the array T. LDT >= max(1,K). * * C (input/output) COMPLEX*16 array, dimension * (LDC,N) if SIDE = 'L' or (LDC,K) if SIDE = 'R'. * On entry, the k by n (if SIDE = 'L') or m by k * (if SIDE = 'R') matrix C. * On exit, C is updated by the block Householder reflector. * * LDC (input) INTEGER * The leading dimension of the array C. * If SIDE = 'L', LDC >= max(1,K); * if SIDE = 'R', LDC >= max(1,M). * * D (input/output) COMPLEX*16 array, dimension (LDD,N) * On entry, the m by n matrix D. * On exit, D is updated by the block Householder reflector. * * LDD (input) INTEGER * The leading dimension of the array D. LDD >= max(1,M); * * WORK (workspace) COMPLEX*16 array, dimension (LDWORK,K) * * LDWORK (input) INTEGER * The leading dimension of the array WORK. * If SIDE = 'L', LDWORK >= max(1,N); * if SIDE = 'R', LDWORK >= max(1,M). * * ===================================================================== * * .. Parameters .. COMPLEX*16 ONE PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) ) * .. * .. Local Scalars .. CHARACTER TRANST INTEGER I, J * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. EXTERNAL ZCOPY, ZGEMM, ZLACGV, ZTRMM * .. * .. Intrinsic Functions .. INTRINSIC DCONJG * .. * .. Executable Statements .. * * Quick return if possible * IF( M.LE.0 .OR. N.LE.0 ) \$ RETURN * IF( LSAME( TRANS, 'N' ) ) THEN TRANST = 'T' ELSE TRANST = 'N' END IF * IF( LSAME( SIDE, 'L' ) ) THEN * * Form H * [C] or H' * [C]. * [D] [D] * * W := C' + D' * V. (stored in WORK) * DO 10 J = 1, K CALL ZCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 ) CALL ZLACGV( N, WORK( 1, J ), 1 ) 10 CONTINUE * CALL ZGEMM( 'Conjugate transpose', 'No transpose', N, K, M, \$ ONE, D, LDD, V, LDV, ONE, WORK, LDWORK ) * * W := W * T' or W * T * CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K, \$ ONE, T, LDT, WORK, LDWORK ) * * C := C - W' * DO 30 J = 1, K DO 20 I = 1, N C( J, I ) = C( J, I ) - DCONJG( WORK( I, J ) ) 20 CONTINUE 30 CONTINUE * * D := D - V * W' * CALL ZGEMM( 'No transpose', 'Conjugate transpose', M, N, K, \$ -ONE, V, LDV, WORK, LDWORK, ONE, D, LDD ) * ELSE IF( LSAME( SIDE, 'R' ) ) THEN * * W := C + D * V (stored in WORK) DO 40 J = 1, K CALL ZCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 ) 40 CONTINUE CALL ZGEMM( 'No transpose', 'No transpose', M, K, N, ONE, D, \$ LDD, V, LDV, ONE, WORK, LDWORK ) * * W := W * T or W * T' * CALL ZTRMM( 'Right', 'Upper', TRANS, 'Non-unit', M, K, ONE, T, \$ LDT, WORK, LDWORK ) * * C := C - W * DO 60 J = 1, K DO 50 I = 1, M C( I, J ) = C( I, J ) - WORK( I, J ) 50 CONTINUE 60 CONTINUE * * D := D - W * V' * CALL ZGEMM( 'No transpose', 'Conjugate Transpose', M, N, K, \$ -ONE, WORK, LDWORK, V, LDV, ONE, D, LDD ) END IF * RETURN * * End of ZBQRU_LARFB * END