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