 LAPACK 3.11.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ dlaqz2()

 subroutine dlaqz2 ( logical, intent(in) ILQ, logical, intent(in) ILZ, integer, intent(in) K, integer, intent(in) ISTARTM, integer, intent(in) ISTOPM, integer, intent(in) IHI, double precision, dimension( lda, * ) A, integer, intent(in) LDA, double precision, dimension( ldb, * ) B, integer, intent(in) LDB, integer, intent(in) NQ, integer, intent(in) QSTART, double precision, dimension( ldq, * ) Q, integer, intent(in) LDQ, integer, intent(in) NZ, integer, intent(in) ZSTART, double precision, dimension( ldz, * ) Z, integer, intent(in) LDZ )

DLAQZ2

Purpose:
`      DLAQZ2 chases a 2x2 shift bulge in a matrix pencil down a single position`
Parameters
 [in] ILQ ``` ILQ is LOGICAL Determines whether or not to update the matrix Q``` [in] ILZ ``` ILZ is LOGICAL Determines whether or not to update the matrix Z``` [in] K ``` K is INTEGER Index indicating the position of the bulge. On entry, the bulge is located in (A(k+1:k+2,k:k+1),B(k+1:k+2,k:k+1)). On exit, the bulge is located in (A(k+2:k+3,k+1:k+2),B(k+2:k+3,k+1:k+2)).``` [in] ISTARTM ` ISTARTM is INTEGER` [in] ISTOPM ``` ISTOPM is INTEGER Updates to (A,B) are restricted to (istartm:k+3,k:istopm). It is assumed without checking that istartm <= k+1 and k+2 <= istopm``` [in] IHI ` IHI is INTEGER` [in,out] A ` A is DOUBLE PRECISION array, dimension (LDA,N)` [in] LDA ``` LDA is INTEGER The leading dimension of A as declared in the calling procedure.``` [in,out] B ` B is DOUBLE PRECISION array, dimension (LDB,N)` [in] LDB ``` LDB is INTEGER The leading dimension of B as declared in the calling procedure.``` [in] NQ ``` NQ is INTEGER The order of the matrix Q``` [in] QSTART ``` QSTART is INTEGER Start index of the matrix Q. Rotations are applied To columns k+2-qStart:k+4-qStart of Q.``` [in,out] Q ` Q is DOUBLE PRECISION array, dimension (LDQ,NQ)` [in] LDQ ``` LDQ is INTEGER The leading dimension of Q as declared in the calling procedure.``` [in] NZ ``` NZ is INTEGER The order of the matrix Z``` [in] ZSTART ``` ZSTART is INTEGER Start index of the matrix Z. Rotations are applied To columns k+1-qStart:k+3-qStart of Z.``` [in,out] Z ` Z is DOUBLE PRECISION array, dimension (LDZ,NZ)` [in] LDZ ``` LDZ is INTEGER The leading dimension of Q as declared in the calling procedure.```
Date
May 2020

Definition at line 172 of file dlaqz2.f.

174 IMPLICIT NONE
175*
176* Arguments
177 LOGICAL, INTENT( IN ) :: ILQ, ILZ
178 INTEGER, INTENT( IN ) :: K, LDA, LDB, LDQ, LDZ, ISTARTM, ISTOPM,
179 \$ NQ, NZ, QSTART, ZSTART, IHI
180 DOUBLE PRECISION :: A( LDA, * ), B( LDB, * ), Q( LDQ, * ), Z( LDZ,
181 \$ * )
182*
183* Parameters
184 DOUBLE PRECISION :: ZERO, ONE, HALF
185 parameter( zero = 0.0d0, one = 1.0d0, half = 0.5d0 )
186*
187* Local variables
188 DOUBLE PRECISION :: H( 2, 3 ), C1, S1, C2, S2, TEMP
189*
190* External functions
191 EXTERNAL :: dlartg, drot
192*
193 IF( k+2 .EQ. ihi ) THEN
194* Shift is located on the edge of the matrix, remove it
195 h = b( ihi-1:ihi, ihi-2:ihi )
196* Make H upper triangular
197 CALL dlartg( h( 1, 1 ), h( 2, 1 ), c1, s1, temp )
198 h( 2, 1 ) = zero
199 h( 1, 1 ) = temp
200 CALL drot( 2, h( 1, 2 ), 2, h( 2, 2 ), 2, c1, s1 )
201*
202 CALL dlartg( h( 2, 3 ), h( 2, 2 ), c1, s1, temp )
203 CALL drot( 1, h( 1, 3 ), 1, h( 1, 2 ), 1, c1, s1 )
204 CALL dlartg( h( 1, 2 ), h( 1, 1 ), c2, s2, temp )
205*
206 CALL drot( ihi-istartm+1, b( istartm, ihi ), 1, b( istartm,
207 \$ ihi-1 ), 1, c1, s1 )
208 CALL drot( ihi-istartm+1, b( istartm, ihi-1 ), 1, b( istartm,
209 \$ ihi-2 ), 1, c2, s2 )
210 b( ihi-1, ihi-2 ) = zero
211 b( ihi, ihi-2 ) = zero
212 CALL drot( ihi-istartm+1, a( istartm, ihi ), 1, a( istartm,
213 \$ ihi-1 ), 1, c1, s1 )
214 CALL drot( ihi-istartm+1, a( istartm, ihi-1 ), 1, a( istartm,
215 \$ ihi-2 ), 1, c2, s2 )
216 IF ( ilz ) THEN
217 CALL drot( nz, z( 1, ihi-zstart+1 ), 1, z( 1, ihi-1-zstart+
218 \$ 1 ), 1, c1, s1 )
219 CALL drot( nz, z( 1, ihi-1-zstart+1 ), 1, z( 1,
220 \$ ihi-2-zstart+1 ), 1, c2, s2 )
221 END IF
222*
223 CALL dlartg( a( ihi-1, ihi-2 ), a( ihi, ihi-2 ), c1, s1,
224 \$ temp )
225 a( ihi-1, ihi-2 ) = temp
226 a( ihi, ihi-2 ) = zero
227 CALL drot( istopm-ihi+2, a( ihi-1, ihi-1 ), lda, a( ihi,
228 \$ ihi-1 ), lda, c1, s1 )
229 CALL drot( istopm-ihi+2, b( ihi-1, ihi-1 ), ldb, b( ihi,
230 \$ ihi-1 ), ldb, c1, s1 )
231 IF ( ilq ) THEN
232 CALL drot( nq, q( 1, ihi-1-qstart+1 ), 1, q( 1, ihi-qstart+
233 \$ 1 ), 1, c1, s1 )
234 END IF
235*
236 CALL dlartg( b( ihi, ihi ), b( ihi, ihi-1 ), c1, s1, temp )
237 b( ihi, ihi ) = temp
238 b( ihi, ihi-1 ) = zero
239 CALL drot( ihi-istartm, b( istartm, ihi ), 1, b( istartm,
240 \$ ihi-1 ), 1, c1, s1 )
241 CALL drot( ihi-istartm+1, a( istartm, ihi ), 1, a( istartm,
242 \$ ihi-1 ), 1, c1, s1 )
243 IF ( ilz ) THEN
244 CALL drot( nz, z( 1, ihi-zstart+1 ), 1, z( 1, ihi-1-zstart+
245 \$ 1 ), 1, c1, s1 )
246 END IF
247*
248 ELSE
249*
250* Normal operation, move bulge down
251*
252 h = b( k+1:k+2, k:k+2 )
253*
254* Make H upper triangular
255*
256 CALL dlartg( h( 1, 1 ), h( 2, 1 ), c1, s1, temp )
257 h( 2, 1 ) = zero
258 h( 1, 1 ) = temp
259 CALL drot( 2, h( 1, 2 ), 2, h( 2, 2 ), 2, c1, s1 )
260*
261* Calculate Z1 and Z2
262*
263 CALL dlartg( h( 2, 3 ), h( 2, 2 ), c1, s1, temp )
264 CALL drot( 1, h( 1, 3 ), 1, h( 1, 2 ), 1, c1, s1 )
265 CALL dlartg( h( 1, 2 ), h( 1, 1 ), c2, s2, temp )
266*
267* Apply transformations from the right
268*
269 CALL drot( k+3-istartm+1, a( istartm, k+2 ), 1, a( istartm,
270 \$ k+1 ), 1, c1, s1 )
271 CALL drot( k+3-istartm+1, a( istartm, k+1 ), 1, a( istartm,
272 \$ k ), 1, c2, s2 )
273 CALL drot( k+2-istartm+1, b( istartm, k+2 ), 1, b( istartm,
274 \$ k+1 ), 1, c1, s1 )
275 CALL drot( k+2-istartm+1, b( istartm, k+1 ), 1, b( istartm,
276 \$ k ), 1, c2, s2 )
277 IF ( ilz ) THEN
278 CALL drot( nz, z( 1, k+2-zstart+1 ), 1, z( 1, k+1-zstart+
279 \$ 1 ), 1, c1, s1 )
280 CALL drot( nz, z( 1, k+1-zstart+1 ), 1, z( 1, k-zstart+1 ),
281 \$ 1, c2, s2 )
282 END IF
283 b( k+1, k ) = zero
284 b( k+2, k ) = zero
285*
286* Calculate Q1 and Q2
287*
288 CALL dlartg( a( k+2, k ), a( k+3, k ), c1, s1, temp )
289 a( k+2, k ) = temp
290 a( k+3, k ) = zero
291 CALL dlartg( a( k+1, k ), a( k+2, k ), c2, s2, temp )
292 a( k+1, k ) = temp
293 a( k+2, k ) = zero
294*
295* Apply transformations from the left
296*
297 CALL drot( istopm-k, a( k+2, k+1 ), lda, a( k+3, k+1 ), lda,
298 \$ c1, s1 )
299 CALL drot( istopm-k, a( k+1, k+1 ), lda, a( k+2, k+1 ), lda,
300 \$ c2, s2 )
301*
302 CALL drot( istopm-k, b( k+2, k+1 ), ldb, b( k+3, k+1 ), ldb,
303 \$ c1, s1 )
304 CALL drot( istopm-k, b( k+1, k+1 ), ldb, b( k+2, k+1 ), ldb,
305 \$ c2, s2 )
306 IF ( ilq ) THEN
307 CALL drot( nq, q( 1, k+2-qstart+1 ), 1, q( 1, k+3-qstart+
308 \$ 1 ), 1, c1, s1 )
309 CALL drot( nq, q( 1, k+1-qstart+1 ), 1, q( 1, k+2-qstart+
310 \$ 1 ), 1, c2, s2 )
311 END IF
312*
313 END IF
314*
315* End of DLAQZ2
316*
subroutine dlartg(f, g, c, s, r)
DLARTG generates a plane rotation with real cosine and real sine.
Definition: dlartg.f90:111
subroutine drot(N, DX, INCX, DY, INCY, C, S)
DROT
Definition: drot.f:92
Here is the call graph for this function:
Here is the caller graph for this function: