Annotation of rpl/lapack/lapack/dlarf.f, revision 1.9
1.9 ! bertrand 1: *> \brief \b DLARF
! 2: *
! 3: * =========== DOCUMENTATION ===========
! 4: *
! 5: * Online html documentation available at
! 6: * http://www.netlib.org/lapack/explore-html/
! 7: *
! 8: *> \htmlonly
! 9: *> Download DLARF + dependencies
! 10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarf.f">
! 11: *> [TGZ]</a>
! 12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarf.f">
! 13: *> [ZIP]</a>
! 14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarf.f">
! 15: *> [TXT]</a>
! 16: *> \endhtmlonly
! 17: *
! 18: * Definition:
! 19: * ===========
! 20: *
! 21: * SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
! 22: *
! 23: * .. Scalar Arguments ..
! 24: * CHARACTER SIDE
! 25: * INTEGER INCV, LDC, M, N
! 26: * DOUBLE PRECISION TAU
! 27: * ..
! 28: * .. Array Arguments ..
! 29: * DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
! 30: * ..
! 31: *
! 32: *
! 33: *> \par Purpose:
! 34: * =============
! 35: *>
! 36: *> \verbatim
! 37: *>
! 38: *> DLARF applies a real elementary reflector H to a real m by n matrix
! 39: *> C, from either the left or the right. H is represented in the form
! 40: *>
! 41: *> H = I - tau * v * v**T
! 42: *>
! 43: *> where tau is a real scalar and v is a real vector.
! 44: *>
! 45: *> If tau = 0, then H is taken to be the unit matrix.
! 46: *> \endverbatim
! 47: *
! 48: * Arguments:
! 49: * ==========
! 50: *
! 51: *> \param[in] SIDE
! 52: *> \verbatim
! 53: *> SIDE is CHARACTER*1
! 54: *> = 'L': form H * C
! 55: *> = 'R': form C * H
! 56: *> \endverbatim
! 57: *>
! 58: *> \param[in] M
! 59: *> \verbatim
! 60: *> M is INTEGER
! 61: *> The number of rows of the matrix C.
! 62: *> \endverbatim
! 63: *>
! 64: *> \param[in] N
! 65: *> \verbatim
! 66: *> N is INTEGER
! 67: *> The number of columns of the matrix C.
! 68: *> \endverbatim
! 69: *>
! 70: *> \param[in] V
! 71: *> \verbatim
! 72: *> V is DOUBLE PRECISION array, dimension
! 73: *> (1 + (M-1)*abs(INCV)) if SIDE = 'L'
! 74: *> or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
! 75: *> The vector v in the representation of H. V is not used if
! 76: *> TAU = 0.
! 77: *> \endverbatim
! 78: *>
! 79: *> \param[in] INCV
! 80: *> \verbatim
! 81: *> INCV is INTEGER
! 82: *> The increment between elements of v. INCV <> 0.
! 83: *> \endverbatim
! 84: *>
! 85: *> \param[in] TAU
! 86: *> \verbatim
! 87: *> TAU is DOUBLE PRECISION
! 88: *> The value tau in the representation of H.
! 89: *> \endverbatim
! 90: *>
! 91: *> \param[in,out] C
! 92: *> \verbatim
! 93: *> C is DOUBLE PRECISION array, dimension (LDC,N)
! 94: *> On entry, the m by n matrix C.
! 95: *> On exit, C is overwritten by the matrix H * C if SIDE = 'L',
! 96: *> or C * H if SIDE = 'R'.
! 97: *> \endverbatim
! 98: *>
! 99: *> \param[in] LDC
! 100: *> \verbatim
! 101: *> LDC is INTEGER
! 102: *> The leading dimension of the array C. LDC >= max(1,M).
! 103: *> \endverbatim
! 104: *>
! 105: *> \param[out] WORK
! 106: *> \verbatim
! 107: *> WORK is DOUBLE PRECISION array, dimension
! 108: *> (N) if SIDE = 'L'
! 109: *> or (M) if SIDE = 'R'
! 110: *> \endverbatim
! 111: *
! 112: * Authors:
! 113: * ========
! 114: *
! 115: *> \author Univ. of Tennessee
! 116: *> \author Univ. of California Berkeley
! 117: *> \author Univ. of Colorado Denver
! 118: *> \author NAG Ltd.
! 119: *
! 120: *> \date November 2011
! 121: *
! 122: *> \ingroup doubleOTHERauxiliary
! 123: *
! 124: * =====================================================================
1.1 bertrand 125: SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
126: *
1.9 ! bertrand 127: * -- LAPACK auxiliary routine (version 3.4.0) --
1.1 bertrand 128: * -- LAPACK is a software package provided by Univ. of Tennessee, --
129: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.9 ! bertrand 130: * November 2011
1.1 bertrand 131: *
132: * .. Scalar Arguments ..
133: CHARACTER SIDE
134: INTEGER INCV, LDC, M, N
135: DOUBLE PRECISION TAU
136: * ..
137: * .. Array Arguments ..
138: DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
139: * ..
140: *
141: * =====================================================================
142: *
143: * .. Parameters ..
144: DOUBLE PRECISION ONE, ZERO
145: PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
146: * ..
147: * .. Local Scalars ..
148: LOGICAL APPLYLEFT
149: INTEGER I, LASTV, LASTC
150: * ..
151: * .. External Subroutines ..
152: EXTERNAL DGEMV, DGER
153: * ..
154: * .. External Functions ..
155: LOGICAL LSAME
156: INTEGER ILADLR, ILADLC
157: EXTERNAL LSAME, ILADLR, ILADLC
158: * ..
159: * .. Executable Statements ..
160: *
161: APPLYLEFT = LSAME( SIDE, 'L' )
162: LASTV = 0
163: LASTC = 0
164: IF( TAU.NE.ZERO ) THEN
165: ! Set up variables for scanning V. LASTV begins pointing to the end
166: ! of V.
167: IF( APPLYLEFT ) THEN
168: LASTV = M
169: ELSE
170: LASTV = N
171: END IF
172: IF( INCV.GT.0 ) THEN
173: I = 1 + (LASTV-1) * INCV
174: ELSE
175: I = 1
176: END IF
177: ! Look for the last non-zero row in V.
178: DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
179: LASTV = LASTV - 1
180: I = I - INCV
181: END DO
182: IF( APPLYLEFT ) THEN
183: ! Scan for the last non-zero column in C(1:lastv,:).
184: LASTC = ILADLC(LASTV, N, C, LDC)
185: ELSE
186: ! Scan for the last non-zero row in C(:,1:lastv).
187: LASTC = ILADLR(M, LASTV, C, LDC)
188: END IF
189: END IF
190: ! Note that lastc.eq.0 renders the BLAS operations null; no special
191: ! case is needed at this level.
192: IF( APPLYLEFT ) THEN
193: *
194: * Form H * C
195: *
196: IF( LASTV.GT.0 ) THEN
197: *
1.8 bertrand 198: * w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1)
1.1 bertrand 199: *
200: CALL DGEMV( 'Transpose', LASTV, LASTC, ONE, C, LDC, V, INCV,
201: $ ZERO, WORK, 1 )
202: *
1.8 bertrand 203: * C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T
1.1 bertrand 204: *
205: CALL DGER( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
206: END IF
207: ELSE
208: *
209: * Form C * H
210: *
211: IF( LASTV.GT.0 ) THEN
212: *
213: * w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
214: *
215: CALL DGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
216: $ V, INCV, ZERO, WORK, 1 )
217: *
1.8 bertrand 218: * C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**T
1.1 bertrand 219: *
220: CALL DGER( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
221: END IF
222: END IF
223: RETURN
224: *
225: * End of DLARF
226: *
227: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dlarf.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack