![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DLARZ 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download DLARZ + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarz.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarz.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarz.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE DLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK ) 00022 * 00023 * .. Scalar Arguments .. 00024 * CHARACTER SIDE 00025 * INTEGER INCV, L, LDC, M, N 00026 * DOUBLE PRECISION TAU 00027 * .. 00028 * .. Array Arguments .. 00029 * DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * ) 00030 * .. 00031 * 00032 * 00033 *> \par Purpose: 00034 * ============= 00035 *> 00036 *> \verbatim 00037 *> 00038 *> DLARZ applies a real elementary reflector H to a real M-by-N 00039 *> matrix C, from either the left or the right. H is represented in the 00040 *> form 00041 *> 00042 *> H = I - tau * v * v**T 00043 *> 00044 *> where tau is a real scalar and v is a real vector. 00045 *> 00046 *> If tau = 0, then H is taken to be the unit matrix. 00047 *> 00048 *> 00049 *> H is a product of k elementary reflectors as returned by DTZRZF. 00050 *> \endverbatim 00051 * 00052 * Arguments: 00053 * ========== 00054 * 00055 *> \param[in] SIDE 00056 *> \verbatim 00057 *> SIDE is CHARACTER*1 00058 *> = 'L': form H * C 00059 *> = 'R': form C * H 00060 *> \endverbatim 00061 *> 00062 *> \param[in] M 00063 *> \verbatim 00064 *> M is INTEGER 00065 *> The number of rows of the matrix C. 00066 *> \endverbatim 00067 *> 00068 *> \param[in] N 00069 *> \verbatim 00070 *> N is INTEGER 00071 *> The number of columns of the matrix C. 00072 *> \endverbatim 00073 *> 00074 *> \param[in] L 00075 *> \verbatim 00076 *> L is INTEGER 00077 *> The number of entries of the vector V containing 00078 *> the meaningful part of the Householder vectors. 00079 *> If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0. 00080 *> \endverbatim 00081 *> 00082 *> \param[in] V 00083 *> \verbatim 00084 *> V is DOUBLE PRECISION array, dimension (1+(L-1)*abs(INCV)) 00085 *> The vector v in the representation of H as returned by 00086 *> DTZRZF. V is not used if TAU = 0. 00087 *> \endverbatim 00088 *> 00089 *> \param[in] INCV 00090 *> \verbatim 00091 *> INCV is INTEGER 00092 *> The increment between elements of v. INCV <> 0. 00093 *> \endverbatim 00094 *> 00095 *> \param[in] TAU 00096 *> \verbatim 00097 *> TAU is DOUBLE PRECISION 00098 *> The value tau in the representation of H. 00099 *> \endverbatim 00100 *> 00101 *> \param[in,out] C 00102 *> \verbatim 00103 *> C is DOUBLE PRECISION array, dimension (LDC,N) 00104 *> On entry, the M-by-N matrix C. 00105 *> On exit, C is overwritten by the matrix H * C if SIDE = 'L', 00106 *> or C * H if SIDE = 'R'. 00107 *> \endverbatim 00108 *> 00109 *> \param[in] LDC 00110 *> \verbatim 00111 *> LDC is INTEGER 00112 *> The leading dimension of the array C. LDC >= max(1,M). 00113 *> \endverbatim 00114 *> 00115 *> \param[out] WORK 00116 *> \verbatim 00117 *> WORK is DOUBLE PRECISION array, dimension 00118 *> (N) if SIDE = 'L' 00119 *> or (M) if SIDE = 'R' 00120 *> \endverbatim 00121 * 00122 * Authors: 00123 * ======== 00124 * 00125 *> \author Univ. of Tennessee 00126 *> \author Univ. of California Berkeley 00127 *> \author Univ. of Colorado Denver 00128 *> \author NAG Ltd. 00129 * 00130 *> \date November 2011 00131 * 00132 *> \ingroup doubleOTHERcomputational 00133 * 00134 *> \par Contributors: 00135 * ================== 00136 *> 00137 *> A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA 00138 * 00139 *> \par Further Details: 00140 * ===================== 00141 *> 00142 *> \verbatim 00143 *> \endverbatim 00144 *> 00145 * ===================================================================== 00146 SUBROUTINE DLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK ) 00147 * 00148 * -- LAPACK computational routine (version 3.4.0) -- 00149 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00150 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00151 * November 2011 00152 * 00153 * .. Scalar Arguments .. 00154 CHARACTER SIDE 00155 INTEGER INCV, L, LDC, M, N 00156 DOUBLE PRECISION TAU 00157 * .. 00158 * .. Array Arguments .. 00159 DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * ) 00160 * .. 00161 * 00162 * ===================================================================== 00163 * 00164 * .. Parameters .. 00165 DOUBLE PRECISION ONE, ZERO 00166 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) 00167 * .. 00168 * .. External Subroutines .. 00169 EXTERNAL DAXPY, DCOPY, DGEMV, DGER 00170 * .. 00171 * .. External Functions .. 00172 LOGICAL LSAME 00173 EXTERNAL LSAME 00174 * .. 00175 * .. Executable Statements .. 00176 * 00177 IF( LSAME( SIDE, 'L' ) ) THEN 00178 * 00179 * Form H * C 00180 * 00181 IF( TAU.NE.ZERO ) THEN 00182 * 00183 * w( 1:n ) = C( 1, 1:n ) 00184 * 00185 CALL DCOPY( N, C, LDC, WORK, 1 ) 00186 * 00187 * w( 1:n ) = w( 1:n ) + C( m-l+1:m, 1:n )**T * v( 1:l ) 00188 * 00189 CALL DGEMV( 'Transpose', L, N, ONE, C( M-L+1, 1 ), LDC, V, 00190 $ INCV, ONE, WORK, 1 ) 00191 * 00192 * C( 1, 1:n ) = C( 1, 1:n ) - tau * w( 1:n ) 00193 * 00194 CALL DAXPY( N, -TAU, WORK, 1, C, LDC ) 00195 * 00196 * C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ... 00197 * tau * v( 1:l ) * w( 1:n )**T 00198 * 00199 CALL DGER( L, N, -TAU, V, INCV, WORK, 1, C( M-L+1, 1 ), 00200 $ LDC ) 00201 END IF 00202 * 00203 ELSE 00204 * 00205 * Form C * H 00206 * 00207 IF( TAU.NE.ZERO ) THEN 00208 * 00209 * w( 1:m ) = C( 1:m, 1 ) 00210 * 00211 CALL DCOPY( M, C, 1, WORK, 1 ) 00212 * 00213 * w( 1:m ) = w( 1:m ) + C( 1:m, n-l+1:n, 1:n ) * v( 1:l ) 00214 * 00215 CALL DGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), LDC, 00216 $ V, INCV, ONE, WORK, 1 ) 00217 * 00218 * C( 1:m, 1 ) = C( 1:m, 1 ) - tau * w( 1:m ) 00219 * 00220 CALL DAXPY( M, -TAU, WORK, 1, C, 1 ) 00221 * 00222 * C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ... 00223 * tau * w( 1:m ) * v( 1:l )**T 00224 * 00225 CALL DGER( M, L, -TAU, WORK, 1, V, INCV, C( 1, N-L+1 ), 00226 $ LDC ) 00227 * 00228 END IF 00229 * 00230 END IF 00231 * 00232 RETURN 00233 * 00234 * End of DLARZ 00235 * 00236 END