![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZLATZM 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download ZLATZM + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlatzm.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlatzm.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlatzm.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE ZLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) 00022 * 00023 * .. Scalar Arguments .. 00024 * CHARACTER SIDE 00025 * INTEGER INCV, LDC, M, N 00026 * COMPLEX*16 TAU 00027 * .. 00028 * .. Array Arguments .. 00029 * COMPLEX*16 C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * ) 00030 * .. 00031 * 00032 * 00033 *> \par Purpose: 00034 * ============= 00035 *> 00036 *> \verbatim 00037 *> 00038 *> This routine is deprecated and has been replaced by routine ZUNMRZ. 00039 *> 00040 *> ZLATZM applies a Householder matrix generated by ZTZRQF to a matrix. 00041 *> 00042 *> Let P = I - tau*u*u**H, u = ( 1 ), 00043 *> ( v ) 00044 *> where v is an (m-1) vector if SIDE = 'L', or a (n-1) vector if 00045 *> SIDE = 'R'. 00046 *> 00047 *> If SIDE equals 'L', let 00048 *> C = [ C1 ] 1 00049 *> [ C2 ] m-1 00050 *> n 00051 *> Then C is overwritten by P*C. 00052 *> 00053 *> If SIDE equals 'R', let 00054 *> C = [ C1, C2 ] m 00055 *> 1 n-1 00056 *> Then C is overwritten by C*P. 00057 *> \endverbatim 00058 * 00059 * Arguments: 00060 * ========== 00061 * 00062 *> \param[in] SIDE 00063 *> \verbatim 00064 *> SIDE is CHARACTER*1 00065 *> = 'L': form P * C 00066 *> = 'R': form C * P 00067 *> \endverbatim 00068 *> 00069 *> \param[in] M 00070 *> \verbatim 00071 *> M is INTEGER 00072 *> The number of rows of the matrix C. 00073 *> \endverbatim 00074 *> 00075 *> \param[in] N 00076 *> \verbatim 00077 *> N is INTEGER 00078 *> The number of columns of the matrix C. 00079 *> \endverbatim 00080 *> 00081 *> \param[in] V 00082 *> \verbatim 00083 *> V is COMPLEX*16 array, dimension 00084 *> (1 + (M-1)*abs(INCV)) if SIDE = 'L' 00085 *> (1 + (N-1)*abs(INCV)) if SIDE = 'R' 00086 *> The vector v in the representation of P. V is not used 00087 *> if TAU = 0. 00088 *> \endverbatim 00089 *> 00090 *> \param[in] INCV 00091 *> \verbatim 00092 *> INCV is INTEGER 00093 *> The increment between elements of v. INCV <> 0 00094 *> \endverbatim 00095 *> 00096 *> \param[in] TAU 00097 *> \verbatim 00098 *> TAU is COMPLEX*16 00099 *> The value tau in the representation of P. 00100 *> \endverbatim 00101 *> 00102 *> \param[in,out] C1 00103 *> \verbatim 00104 *> C1 is COMPLEX*16 array, dimension 00105 *> (LDC,N) if SIDE = 'L' 00106 *> (M,1) if SIDE = 'R' 00107 *> On entry, the n-vector C1 if SIDE = 'L', or the m-vector C1 00108 *> if SIDE = 'R'. 00109 *> 00110 *> On exit, the first row of P*C if SIDE = 'L', or the first 00111 *> column of C*P if SIDE = 'R'. 00112 *> \endverbatim 00113 *> 00114 *> \param[in,out] C2 00115 *> \verbatim 00116 *> C2 is COMPLEX*16 array, dimension 00117 *> (LDC, N) if SIDE = 'L' 00118 *> (LDC, N-1) if SIDE = 'R' 00119 *> On entry, the (m - 1) x n matrix C2 if SIDE = 'L', or the 00120 *> m x (n - 1) matrix C2 if SIDE = 'R'. 00121 *> 00122 *> On exit, rows 2:m of P*C if SIDE = 'L', or columns 2:m of C*P 00123 *> if SIDE = 'R'. 00124 *> \endverbatim 00125 *> 00126 *> \param[in] LDC 00127 *> \verbatim 00128 *> LDC is INTEGER 00129 *> The leading dimension of the arrays C1 and C2. 00130 *> LDC >= max(1,M). 00131 *> \endverbatim 00132 *> 00133 *> \param[out] WORK 00134 *> \verbatim 00135 *> WORK is COMPLEX*16 array, dimension 00136 *> (N) if SIDE = 'L' 00137 *> (M) if SIDE = 'R' 00138 *> \endverbatim 00139 * 00140 * Authors: 00141 * ======== 00142 * 00143 *> \author Univ. of Tennessee 00144 *> \author Univ. of California Berkeley 00145 *> \author Univ. of Colorado Denver 00146 *> \author NAG Ltd. 00147 * 00148 *> \date November 2011 00149 * 00150 *> \ingroup complex16OTHERcomputational 00151 * 00152 * ===================================================================== 00153 SUBROUTINE ZLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) 00154 * 00155 * -- LAPACK computational routine (version 3.4.0) -- 00156 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00157 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00158 * November 2011 00159 * 00160 * .. Scalar Arguments .. 00161 CHARACTER SIDE 00162 INTEGER INCV, LDC, M, N 00163 COMPLEX*16 TAU 00164 * .. 00165 * .. Array Arguments .. 00166 COMPLEX*16 C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * ) 00167 * .. 00168 * 00169 * ===================================================================== 00170 * 00171 * .. Parameters .. 00172 COMPLEX*16 ONE, ZERO 00173 PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ), 00174 $ ZERO = ( 0.0D+0, 0.0D+0 ) ) 00175 * .. 00176 * .. External Subroutines .. 00177 EXTERNAL ZAXPY, ZCOPY, ZGEMV, ZGERC, ZGERU, ZLACGV 00178 * .. 00179 * .. External Functions .. 00180 LOGICAL LSAME 00181 EXTERNAL LSAME 00182 * .. 00183 * .. Intrinsic Functions .. 00184 INTRINSIC MIN 00185 * .. 00186 * .. Executable Statements .. 00187 * 00188 IF( ( MIN( M, N ).EQ.0 ) .OR. ( TAU.EQ.ZERO ) ) 00189 $ RETURN 00190 * 00191 IF( LSAME( SIDE, 'L' ) ) THEN 00192 * 00193 * w := ( C1 + v**H * C2 )**H 00194 * 00195 CALL ZCOPY( N, C1, LDC, WORK, 1 ) 00196 CALL ZLACGV( N, WORK, 1 ) 00197 CALL ZGEMV( 'Conjugate transpose', M-1, N, ONE, C2, LDC, V, 00198 $ INCV, ONE, WORK, 1 ) 00199 * 00200 * [ C1 ] := [ C1 ] - tau* [ 1 ] * w**H 00201 * [ C2 ] [ C2 ] [ v ] 00202 * 00203 CALL ZLACGV( N, WORK, 1 ) 00204 CALL ZAXPY( N, -TAU, WORK, 1, C1, LDC ) 00205 CALL ZGERU( M-1, N, -TAU, V, INCV, WORK, 1, C2, LDC ) 00206 * 00207 ELSE IF( LSAME( SIDE, 'R' ) ) THEN 00208 * 00209 * w := C1 + C2 * v 00210 * 00211 CALL ZCOPY( M, C1, 1, WORK, 1 ) 00212 CALL ZGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE, 00213 $ WORK, 1 ) 00214 * 00215 * [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**H] 00216 * 00217 CALL ZAXPY( M, -TAU, WORK, 1, C1, 1 ) 00218 CALL ZGERC( M, N-1, -TAU, WORK, 1, V, INCV, C2, LDC ) 00219 END IF 00220 * 00221 RETURN 00222 * 00223 * End of ZLATZM 00224 * 00225 END