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

## ◆ slaqz2()

 subroutine slaqz2 ( logical, intent(in) ilq, logical, intent(in) ilz, integer, intent(in) k, integer, intent(in) istartm, integer, intent(in) istopm, integer, intent(in) ihi, real, dimension( lda, * ) a, integer, intent(in) lda, real, dimension( ldb, * ) b, integer, intent(in) ldb, integer, intent(in) nq, integer, intent(in) qstart, real, dimension( ldq, * ) q, integer, intent(in) ldq, integer, intent(in) nz, integer, intent(in) zstart, real, dimension( ldz, * ) z, integer, intent(in) ldz )

SLAQZ2

Purpose:
`      SLAQZ2 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 REAL 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 REAL 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 REAL 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 REAL 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 171 of file slaqz2.f.

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