![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CLARF 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download CLARF + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clarf.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clarf.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clarf.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE CLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) 00022 * 00023 * .. Scalar Arguments .. 00024 * CHARACTER SIDE 00025 * INTEGER INCV, 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 *> CLARF applies a complex elementary reflector H to a complex 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**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 *> \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] V 00075 *> \verbatim 00076 *> V is COMPLEX array, dimension 00077 *> (1 + (M-1)*abs(INCV)) if SIDE = 'L' 00078 *> or (1 + (N-1)*abs(INCV)) if SIDE = 'R' 00079 *> The vector v in the representation of H. V is not used if 00080 *> TAU = 0. 00081 *> \endverbatim 00082 *> 00083 *> \param[in] INCV 00084 *> \verbatim 00085 *> INCV is INTEGER 00086 *> The increment between elements of v. INCV <> 0. 00087 *> \endverbatim 00088 *> 00089 *> \param[in] TAU 00090 *> \verbatim 00091 *> TAU is COMPLEX 00092 *> The value tau in the representation of H. 00093 *> \endverbatim 00094 *> 00095 *> \param[in,out] C 00096 *> \verbatim 00097 *> C is COMPLEX array, dimension (LDC,N) 00098 *> On entry, the M-by-N matrix C. 00099 *> On exit, C is overwritten by the matrix H * C if SIDE = 'L', 00100 *> or C * H if SIDE = 'R'. 00101 *> \endverbatim 00102 *> 00103 *> \param[in] LDC 00104 *> \verbatim 00105 *> LDC is INTEGER 00106 *> The leading dimension of the array C. LDC >= max(1,M). 00107 *> \endverbatim 00108 *> 00109 *> \param[out] WORK 00110 *> \verbatim 00111 *> WORK is COMPLEX array, dimension 00112 *> (N) if SIDE = 'L' 00113 *> or (M) if SIDE = 'R' 00114 *> \endverbatim 00115 * 00116 * Authors: 00117 * ======== 00118 * 00119 *> \author Univ. of Tennessee 00120 *> \author Univ. of California Berkeley 00121 *> \author Univ. of Colorado Denver 00122 *> \author NAG Ltd. 00123 * 00124 *> \date November 2011 00125 * 00126 *> \ingroup complexOTHERauxiliary 00127 * 00128 * ===================================================================== 00129 SUBROUTINE CLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) 00130 * 00131 * -- LAPACK auxiliary routine (version 3.4.0) -- 00132 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00133 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00134 * November 2011 00135 * 00136 * .. Scalar Arguments .. 00137 CHARACTER SIDE 00138 INTEGER INCV, LDC, M, N 00139 COMPLEX TAU 00140 * .. 00141 * .. Array Arguments .. 00142 COMPLEX C( LDC, * ), V( * ), WORK( * ) 00143 * .. 00144 * 00145 * ===================================================================== 00146 * 00147 * .. Parameters .. 00148 COMPLEX ONE, ZERO 00149 PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ), 00150 $ ZERO = ( 0.0E+0, 0.0E+0 ) ) 00151 * .. 00152 * .. Local Scalars .. 00153 LOGICAL APPLYLEFT 00154 INTEGER I, LASTV, LASTC 00155 * .. 00156 * .. External Subroutines .. 00157 EXTERNAL CGEMV, CGERC 00158 * .. 00159 * .. External Functions .. 00160 LOGICAL LSAME 00161 INTEGER ILACLR, ILACLC 00162 EXTERNAL LSAME, ILACLR, ILACLC 00163 * .. 00164 * .. Executable Statements .. 00165 * 00166 APPLYLEFT = LSAME( SIDE, 'L' ) 00167 LASTV = 0 00168 LASTC = 0 00169 IF( TAU.NE.ZERO ) THEN 00170 ! Set up variables for scanning V. LASTV begins pointing to the end 00171 ! of V. 00172 IF( APPLYLEFT ) THEN 00173 LASTV = M 00174 ELSE 00175 LASTV = N 00176 END IF 00177 IF( INCV.GT.0 ) THEN 00178 I = 1 + (LASTV-1) * INCV 00179 ELSE 00180 I = 1 00181 END IF 00182 ! Look for the last non-zero row in V. 00183 DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO ) 00184 LASTV = LASTV - 1 00185 I = I - INCV 00186 END DO 00187 IF( APPLYLEFT ) THEN 00188 ! Scan for the last non-zero column in C(1:lastv,:). 00189 LASTC = ILACLC(LASTV, N, C, LDC) 00190 ELSE 00191 ! Scan for the last non-zero row in C(:,1:lastv). 00192 LASTC = ILACLR(M, LASTV, C, LDC) 00193 END IF 00194 END IF 00195 ! Note that lastc.eq.0 renders the BLAS operations null; no special 00196 ! case is needed at this level. 00197 IF( APPLYLEFT ) THEN 00198 * 00199 * Form H * C 00200 * 00201 IF( LASTV.GT.0 ) THEN 00202 * 00203 * w(1:lastc,1) := C(1:lastv,1:lastc)**H * v(1:lastv,1) 00204 * 00205 CALL CGEMV( 'Conjugate transpose', LASTV, LASTC, ONE, 00206 $ C, LDC, V, INCV, ZERO, WORK, 1 ) 00207 * 00208 * C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**H 00209 * 00210 CALL CGERC( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC ) 00211 END IF 00212 ELSE 00213 * 00214 * Form C * H 00215 * 00216 IF( LASTV.GT.0 ) THEN 00217 * 00218 * w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1) 00219 * 00220 CALL CGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC, 00221 $ V, INCV, ZERO, WORK, 1 ) 00222 * 00223 * C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**H 00224 * 00225 CALL CGERC( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC ) 00226 END IF 00227 END IF 00228 RETURN 00229 * 00230 * End of CLARF 00231 * 00232 END