LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ 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

Download DLAQZ2 + dependencies [TGZ] [ZIP] [TXT]

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.
Author
Thijs Steel, KU Leuven
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 *
dlartg
subroutine dlartg(f, g, c, s, r)
DLARTG generates a plane rotation with real cosine and real sine.
Definition: dlartg.f90:113
drot
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: