Annotation of rpl/lapack/lapack/zlarf.f, revision 1.1
1.1 ! bertrand 1: SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
! 2: IMPLICIT NONE
! 3: *
! 4: * -- LAPACK auxiliary routine (version 3.2) --
! 5: * -- LAPACK is a software package provided by Univ. of Tennessee, --
! 6: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
! 7: * November 2006
! 8: *
! 9: * .. Scalar Arguments ..
! 10: CHARACTER SIDE
! 11: INTEGER INCV, LDC, M, N
! 12: COMPLEX*16 TAU
! 13: * ..
! 14: * .. Array Arguments ..
! 15: COMPLEX*16 C( LDC, * ), V( * ), WORK( * )
! 16: * ..
! 17: *
! 18: * Purpose
! 19: * =======
! 20: *
! 21: * ZLARF applies a complex elementary reflector H to a complex M-by-N
! 22: * matrix C, from either the left or the right. H is represented in the
! 23: * form
! 24: *
! 25: * H = I - tau * v * v'
! 26: *
! 27: * where tau is a complex scalar and v is a complex vector.
! 28: *
! 29: * If tau = 0, then H is taken to be the unit matrix.
! 30: *
! 31: * To apply H' (the conjugate transpose of H), supply conjg(tau) instead
! 32: * tau.
! 33: *
! 34: * Arguments
! 35: * =========
! 36: *
! 37: * SIDE (input) CHARACTER*1
! 38: * = 'L': form H * C
! 39: * = 'R': form C * H
! 40: *
! 41: * M (input) INTEGER
! 42: * The number of rows of the matrix C.
! 43: *
! 44: * N (input) INTEGER
! 45: * The number of columns of the matrix C.
! 46: *
! 47: * V (input) COMPLEX*16 array, dimension
! 48: * (1 + (M-1)*abs(INCV)) if SIDE = 'L'
! 49: * or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
! 50: * The vector v in the representation of H. V is not used if
! 51: * TAU = 0.
! 52: *
! 53: * INCV (input) INTEGER
! 54: * The increment between elements of v. INCV <> 0.
! 55: *
! 56: * TAU (input) COMPLEX*16
! 57: * The value tau in the representation of H.
! 58: *
! 59: * C (input/output) COMPLEX*16 array, dimension (LDC,N)
! 60: * On entry, the M-by-N matrix C.
! 61: * On exit, C is overwritten by the matrix H * C if SIDE = 'L',
! 62: * or C * H if SIDE = 'R'.
! 63: *
! 64: * LDC (input) INTEGER
! 65: * The leading dimension of the array C. LDC >= max(1,M).
! 66: *
! 67: * WORK (workspace) COMPLEX*16 array, dimension
! 68: * (N) if SIDE = 'L'
! 69: * or (M) if SIDE = 'R'
! 70: *
! 71: * =====================================================================
! 72: *
! 73: * .. Parameters ..
! 74: COMPLEX*16 ONE, ZERO
! 75: PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
! 76: $ ZERO = ( 0.0D+0, 0.0D+0 ) )
! 77: * ..
! 78: * .. Local Scalars ..
! 79: LOGICAL APPLYLEFT
! 80: INTEGER I, LASTV, LASTC
! 81: * ..
! 82: * .. External Subroutines ..
! 83: EXTERNAL ZGEMV, ZGERC
! 84: * ..
! 85: * .. External Functions ..
! 86: LOGICAL LSAME
! 87: INTEGER ILAZLR, ILAZLC
! 88: EXTERNAL LSAME, ILAZLR, ILAZLC
! 89: * ..
! 90: * .. Executable Statements ..
! 91: *
! 92: APPLYLEFT = LSAME( SIDE, 'L' )
! 93: LASTV = 0
! 94: LASTC = 0
! 95: IF( TAU.NE.ZERO ) THEN
! 96: ! Set up variables for scanning V. LASTV begins pointing to the end
! 97: ! of V.
! 98: IF( APPLYLEFT ) THEN
! 99: LASTV = M
! 100: ELSE
! 101: LASTV = N
! 102: END IF
! 103: IF( INCV.GT.0 ) THEN
! 104: I = 1 + (LASTV-1) * INCV
! 105: ELSE
! 106: I = 1
! 107: END IF
! 108: ! Look for the last non-zero row in V.
! 109: DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
! 110: LASTV = LASTV - 1
! 111: I = I - INCV
! 112: END DO
! 113: IF( APPLYLEFT ) THEN
! 114: ! Scan for the last non-zero column in C(1:lastv,:).
! 115: LASTC = ILAZLC(LASTV, N, C, LDC)
! 116: ELSE
! 117: ! Scan for the last non-zero row in C(:,1:lastv).
! 118: LASTC = ILAZLR(M, LASTV, C, LDC)
! 119: END IF
! 120: END IF
! 121: ! Note that lastc.eq.0 renders the BLAS operations null; no special
! 122: ! case is needed at this level.
! 123: IF( APPLYLEFT ) THEN
! 124: *
! 125: * Form H * C
! 126: *
! 127: IF( LASTV.GT.0 ) THEN
! 128: *
! 129: * w(1:lastc,1) := C(1:lastv,1:lastc)' * v(1:lastv,1)
! 130: *
! 131: CALL ZGEMV( 'Conjugate transpose', LASTV, LASTC, ONE,
! 132: $ C, LDC, V, INCV, ZERO, WORK, 1 )
! 133: *
! 134: * C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)'
! 135: *
! 136: CALL ZGERC( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
! 137: END IF
! 138: ELSE
! 139: *
! 140: * Form C * H
! 141: *
! 142: IF( LASTV.GT.0 ) THEN
! 143: *
! 144: * w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
! 145: *
! 146: CALL ZGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
! 147: $ V, INCV, ZERO, WORK, 1 )
! 148: *
! 149: * C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)'
! 150: *
! 151: CALL ZGERC( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
! 152: END IF
! 153: END IF
! 154: RETURN
! 155: *
! 156: * End of ZLARF
! 157: *
! 158: END
CVSweb interface <joel.bertrand@systella.fr>