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