Annotation of rpl/lapack/lapack/zlarz.f, revision 1.1
1.1 ! bertrand 1: SUBROUTINE ZLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK )
! 2: *
! 3: * -- LAPACK routine (version 3.2) --
! 4: * -- LAPACK is a software package provided by Univ. of Tennessee, --
! 5: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
! 6: * November 2006
! 7: *
! 8: * .. Scalar Arguments ..
! 9: CHARACTER SIDE
! 10: INTEGER INCV, L, LDC, M, N
! 11: COMPLEX*16 TAU
! 12: * ..
! 13: * .. Array Arguments ..
! 14: COMPLEX*16 C( LDC, * ), V( * ), WORK( * )
! 15: * ..
! 16: *
! 17: * Purpose
! 18: * =======
! 19: *
! 20: * ZLARZ applies a complex elementary reflector H to a complex
! 21: * M-by-N matrix C, from either the left or the right. H is represented
! 22: * in the form
! 23: *
! 24: * H = I - tau * v * v'
! 25: *
! 26: * where tau is a complex scalar and v is a complex vector.
! 27: *
! 28: * If tau = 0, then H is taken to be the unit matrix.
! 29: *
! 30: * To apply H' (the conjugate transpose of H), supply conjg(tau) instead
! 31: * tau.
! 32: *
! 33: * H is a product of k elementary reflectors as returned by ZTZRZF.
! 34: *
! 35: * Arguments
! 36: * =========
! 37: *
! 38: * SIDE (input) CHARACTER*1
! 39: * = 'L': form H * C
! 40: * = 'R': form C * H
! 41: *
! 42: * M (input) INTEGER
! 43: * The number of rows of the matrix C.
! 44: *
! 45: * N (input) INTEGER
! 46: * The number of columns of the matrix C.
! 47: *
! 48: * L (input) INTEGER
! 49: * The number of entries of the vector V containing
! 50: * the meaningful part of the Householder vectors.
! 51: * If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
! 52: *
! 53: * V (input) COMPLEX*16 array, dimension (1+(L-1)*abs(INCV))
! 54: * The vector v in the representation of H as returned by
! 55: * ZTZRZF. V is not used if TAU = 0.
! 56: *
! 57: * INCV (input) INTEGER
! 58: * The increment between elements of v. INCV <> 0.
! 59: *
! 60: * TAU (input) COMPLEX*16
! 61: * The value tau in the representation of H.
! 62: *
! 63: * C (input/output) COMPLEX*16 array, dimension (LDC,N)
! 64: * On entry, the M-by-N matrix C.
! 65: * On exit, C is overwritten by the matrix H * C if SIDE = 'L',
! 66: * or C * H if SIDE = 'R'.
! 67: *
! 68: * LDC (input) INTEGER
! 69: * The leading dimension of the array C. LDC >= max(1,M).
! 70: *
! 71: * WORK (workspace) COMPLEX*16 array, dimension
! 72: * (N) if SIDE = 'L'
! 73: * or (M) if SIDE = 'R'
! 74: *
! 75: * Further Details
! 76: * ===============
! 77: *
! 78: * Based on contributions by
! 79: * A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
! 80: *
! 81: * =====================================================================
! 82: *
! 83: * .. Parameters ..
! 84: COMPLEX*16 ONE, ZERO
! 85: PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ),
! 86: $ ZERO = ( 0.0D+0, 0.0D+0 ) )
! 87: * ..
! 88: * .. External Subroutines ..
! 89: EXTERNAL ZAXPY, ZCOPY, ZGEMV, ZGERC, ZGERU, ZLACGV
! 90: * ..
! 91: * .. External Functions ..
! 92: LOGICAL LSAME
! 93: EXTERNAL LSAME
! 94: * ..
! 95: * .. Executable Statements ..
! 96: *
! 97: IF( LSAME( SIDE, 'L' ) ) THEN
! 98: *
! 99: * Form H * C
! 100: *
! 101: IF( TAU.NE.ZERO ) THEN
! 102: *
! 103: * w( 1:n ) = conjg( C( 1, 1:n ) )
! 104: *
! 105: CALL ZCOPY( N, C, LDC, WORK, 1 )
! 106: CALL ZLACGV( N, WORK, 1 )
! 107: *
! 108: * w( 1:n ) = conjg( w( 1:n ) + C( m-l+1:m, 1:n )' * v( 1:l ) )
! 109: *
! 110: CALL ZGEMV( 'Conjugate transpose', L, N, ONE, C( M-L+1, 1 ),
! 111: $ LDC, V, INCV, ONE, WORK, 1 )
! 112: CALL ZLACGV( N, WORK, 1 )
! 113: *
! 114: * C( 1, 1:n ) = C( 1, 1:n ) - tau * w( 1:n )
! 115: *
! 116: CALL ZAXPY( N, -TAU, WORK, 1, C, LDC )
! 117: *
! 118: * C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...
! 119: * tau * v( 1:l ) * conjg( w( 1:n )' )
! 120: *
! 121: CALL ZGERU( L, N, -TAU, V, INCV, WORK, 1, C( M-L+1, 1 ),
! 122: $ LDC )
! 123: END IF
! 124: *
! 125: ELSE
! 126: *
! 127: * Form C * H
! 128: *
! 129: IF( TAU.NE.ZERO ) THEN
! 130: *
! 131: * w( 1:m ) = C( 1:m, 1 )
! 132: *
! 133: CALL ZCOPY( M, C, 1, WORK, 1 )
! 134: *
! 135: * w( 1:m ) = w( 1:m ) + C( 1:m, n-l+1:n, 1:n ) * v( 1:l )
! 136: *
! 137: CALL ZGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), LDC,
! 138: $ V, INCV, ONE, WORK, 1 )
! 139: *
! 140: * C( 1:m, 1 ) = C( 1:m, 1 ) - tau * w( 1:m )
! 141: *
! 142: CALL ZAXPY( M, -TAU, WORK, 1, C, 1 )
! 143: *
! 144: * C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ...
! 145: * tau * w( 1:m ) * v( 1:l )'
! 146: *
! 147: CALL ZGERC( M, L, -TAU, WORK, 1, V, INCV, C( 1, N-L+1 ),
! 148: $ LDC )
! 149: *
! 150: END IF
! 151: *
! 152: END IF
! 153: *
! 154: RETURN
! 155: *
! 156: * End of ZLARZ
! 157: *
! 158: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zlarz.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack