1* 2* This is ODLTZM, a version of the deprecated LAPACK routine 3* DLATZM for the Octave Control Package. 4* There are no modifications compared to the original routine. 5* The routine ODLTZM is just maintained for backward 6* compatibility for the Slicot routines used by the Control package. 7* 8* Aug 2020, Torsten Lilge 9* 10* The original routine can be found at 11* https://github.com/Reference-LAPACK/lapack/blob/master/SRC/DEPRECATED/dlatzm.f 12* 13* The comment of the original routine follows. 14* 15* 16*> \brief \b DLATZM 17* 18* =========== DOCUMENTATION =========== 19* 20* Online html documentation available at 21* http://www.netlib.org/lapack/explore-html/ 22* 23*> \htmlonly 24*> Download DLATZM + dependencies 25*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlatzm.f"> 26*> [TGZ]</a> 27*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlatzm.f"> 28*> [ZIP]</a> 29*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlatzm.f"> 30*> [TXT]</a> 31*> \endhtmlonly 32* 33* Definition: 34* =========== 35* 36* SUBROUTINE DLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) 37* 38* .. Scalar Arguments .. 39* CHARACTER SIDE 40* INTEGER INCV, LDC, M, N 41* DOUBLE PRECISION TAU 42* .. 43* .. Array Arguments .. 44* DOUBLE PRECISION C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * ) 45* .. 46* 47* 48*> \par Purpose: 49* ============= 50*> 51*> \verbatim 52*> 53*> This routine is deprecated and has been replaced by routine DORMRZ. 54*> 55*> DLATZM applies a Householder matrix generated by DTZRQF to a matrix. 56*> 57*> Let P = I - tau*u*u**T, u = ( 1 ), 58*> ( v ) 59*> where v is an (m-1) vector if SIDE = 'L', or a (n-1) vector if 60*> SIDE = 'R'. 61*> 62*> If SIDE equals 'L', let 63*> C = [ C1 ] 1 64*> [ C2 ] m-1 65*> n 66*> Then C is overwritten by P*C. 67*> 68*> If SIDE equals 'R', let 69*> C = [ C1, C2 ] m 70*> 1 n-1 71*> Then C is overwritten by C*P. 72*> \endverbatim 73* 74* Arguments: 75* ========== 76* 77*> \param[in] SIDE 78*> \verbatim 79*> SIDE is CHARACTER*1 80*> = 'L': form P * C 81*> = 'R': form C * P 82*> \endverbatim 83*> 84*> \param[in] M 85*> \verbatim 86*> M is INTEGER 87*> The number of rows of the matrix C. 88*> \endverbatim 89*> 90*> \param[in] N 91*> \verbatim 92*> N is INTEGER 93*> The number of columns of the matrix C. 94*> \endverbatim 95*> 96*> \param[in] V 97*> \verbatim 98*> V is DOUBLE PRECISION array, dimension 99*> (1 + (M-1)*abs(INCV)) if SIDE = 'L' 100*> (1 + (N-1)*abs(INCV)) if SIDE = 'R' 101*> The vector v in the representation of P. V is not used 102*> if TAU = 0. 103*> \endverbatim 104*> 105*> \param[in] INCV 106*> \verbatim 107*> INCV is INTEGER 108*> The increment between elements of v. INCV <> 0 109*> \endverbatim 110*> 111*> \param[in] TAU 112*> \verbatim 113*> TAU is DOUBLE PRECISION 114*> The value tau in the representation of P. 115*> \endverbatim 116*> 117*> \param[in,out] C1 118*> \verbatim 119*> C1 is DOUBLE PRECISION array, dimension 120*> (LDC,N) if SIDE = 'L' 121*> (M,1) if SIDE = 'R' 122*> On entry, the n-vector C1 if SIDE = 'L', or the m-vector C1 123*> if SIDE = 'R'. 124*> 125*> On exit, the first row of P*C if SIDE = 'L', or the first 126*> column of C*P if SIDE = 'R'. 127*> \endverbatim 128*> 129*> \param[in,out] C2 130*> \verbatim 131*> C2 is DOUBLE PRECISION array, dimension 132*> (LDC, N) if SIDE = 'L' 133*> (LDC, N-1) if SIDE = 'R' 134*> On entry, the (m - 1) x n matrix C2 if SIDE = 'L', or the 135*> m x (n - 1) matrix C2 if SIDE = 'R'. 136*> 137*> On exit, rows 2:m of P*C if SIDE = 'L', or columns 2:m of C*P 138*> if SIDE = 'R'. 139*> \endverbatim 140*> 141*> \param[in] LDC 142*> \verbatim 143*> LDC is INTEGER 144*> The leading dimension of the arrays C1 and C2. LDC >= (1,M). 145*> \endverbatim 146*> 147*> \param[out] WORK 148*> \verbatim 149*> WORK is DOUBLE PRECISION array, dimension 150*> (N) if SIDE = 'L' 151*> (M) if SIDE = 'R' 152*> \endverbatim 153* 154* Authors: 155* ======== 156* 157*> \author Univ. of Tennessee 158*> \author Univ. of California Berkeley 159*> \author Univ. of Colorado Denver 160*> \author NAG Ltd. 161* 162*> \date December 2016 163* 164*> \ingroup doubleOTHERcomputational 165* 166* ===================================================================== 167 SUBROUTINE ODLTZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) 168* 169* -- LAPACK computational routine (version 3.7.0) -- 170* -- LAPACK is a software package provided by Univ. of Tennessee, -- 171* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 172* December 2016 173* 174* .. Scalar Arguments .. 175 CHARACTER SIDE 176 INTEGER INCV, LDC, M, N 177 DOUBLE PRECISION TAU 178* .. 179* .. Array Arguments .. 180 DOUBLE PRECISION C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * ) 181* .. 182* 183* ===================================================================== 184* 185* .. Parameters .. 186 DOUBLE PRECISION ONE, ZERO 187 parameter( one = 1.0d+0, zero = 0.0d+0 ) 188* .. 189* .. External Subroutines .. 190 EXTERNAL daxpy, dcopy, dgemv, dger 191* .. 192* .. External Functions .. 193 LOGICAL LSAME 194 EXTERNAL lsame 195* .. 196* .. Intrinsic Functions .. 197 INTRINSIC min 198* .. 199* .. Executable Statements .. 200* 201 IF( ( min( m, n ).EQ.0 ) .OR. ( tau.EQ.zero ) ) 202 $ RETURN 203* 204 IF( lsame( side, 'L' ) ) THEN 205* 206* w := (C1 + v**T * C2)**T 207* 208 CALL dcopy( n, c1, ldc, work, 1 ) 209 CALL dgemv( 'Transpose', m-1, n, one, c2, ldc, v, incv, one, 210 $ work, 1 ) 211* 212* [ C1 ] := [ C1 ] - tau* [ 1 ] * w**T 213* [ C2 ] [ C2 ] [ v ] 214* 215 CALL daxpy( n, -tau, work, 1, c1, ldc ) 216 CALL dger( m-1, n, -tau, v, incv, work, 1, c2, ldc ) 217* 218 ELSE IF( lsame( side, 'R' ) ) THEN 219* 220* w := C1 + C2 * v 221* 222 CALL dcopy( m, c1, 1, work, 1 ) 223 CALL dgemv( 'No transpose', m, n-1, one, c2, ldc, v, incv, one, 224 $ work, 1 ) 225* 226* [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**T] 227* 228 CALL daxpy( m, -tau, work, 1, c1, 1 ) 229 CALL dger( m, n-1, -tau, work, 1, v, incv, c2, ldc ) 230 END IF 231* 232 RETURN 233* 234* End of DLATZM 235* 236 END 237