LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
zlaqz1.f
Go to the documentation of this file.
1 *> \brief \b ZLAQZ1
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download ZLAQZ1 + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ZLAQZ1.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ZLAQZ1.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ZLAQZ1.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE ZLAQZ1( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B,
22 * $ LDB, NQ, QSTART, Q, LDQ, NZ, ZSTART, Z, LDZ )
23 * IMPLICIT NONE
24 *
25 * Arguments
26 * LOGICAL, INTENT( IN ) :: ILQ, ILZ
27 * INTEGER, INTENT( IN ) :: K, LDA, LDB, LDQ, LDZ, ISTARTM, ISTOPM,
28 * $ NQ, NZ, QSTART, ZSTART, IHI
29 * COMPLEX*16 :: A( LDA, * ), B( LDB, * ), Q( LDQ, * ), Z( LDZ, * )
30 * ..
31 *
32 *
33 *> \par Purpose:
34 * =============
35 *>
36 *> \verbatim
37 *>
38 *> ZLAQZ1 chases a 1x1 shift bulge in a matrix pencil down a single position
39 *> \endverbatim
40 *
41 *
42 * Arguments:
43 * ==========
44 *
45 *>
46 *> \param[in] ILQ
47 *> \verbatim
48 *> ILQ is LOGICAL
49 *> Determines whether or not to update the matrix Q
50 *> \endverbatim
51 *>
52 *> \param[in] ILZ
53 *> \verbatim
54 *> ILZ is LOGICAL
55 *> Determines whether or not to update the matrix Z
56 *> \endverbatim
57 *>
58 *> \param[in] K
59 *> \verbatim
60 *> K is INTEGER
61 *> Index indicating the position of the bulge.
62 *> On entry, the bulge is located in
63 *> (A(k+1,k),B(k+1,k)).
64 *> On exit, the bulge is located in
65 *> (A(k+2,k+1),B(k+2,k+1)).
66 *> \endverbatim
67 *>
68 *> \param[in] ISTARTM
69 *> \verbatim
70 *> ISTARTM is INTEGER
71 *> \endverbatim
72 *>
73 *> \param[in] ISTOPM
74 *> \verbatim
75 *> ISTOPM is INTEGER
76 *> Updates to (A,B) are restricted to
77 *> (istartm:k+2,k:istopm). It is assumed
78 *> without checking that istartm <= k+1 and
79 *> k+2 <= istopm
80 *> \endverbatim
81 *>
82 *> \param[in] IHI
83 *> \verbatim
84 *> IHI is INTEGER
85 *> \endverbatim
86 *>
87 *> \param[inout] A
88 *> \verbatim
89 *> A is COMPLEX*16 array, dimension (LDA,N)
90 *> \endverbatim
91 *>
92 *> \param[in] LDA
93 *> \verbatim
94 *> LDA is INTEGER
95 *> The leading dimension of A as declared in
96 *> the calling procedure.
97 *> \endverbatim
98 *
99 *> \param[inout] B
100 *> \verbatim
101 *> B is COMPLEX*16 array, dimension (LDB,N)
102 *> \endverbatim
103 *>
104 *> \param[in] LDB
105 *> \verbatim
106 *> LDB is INTEGER
107 *> The leading dimension of B as declared in
108 *> the calling procedure.
109 *> \endverbatim
110 *>
111 *> \param[in] NQ
112 *> \verbatim
113 *> NQ is INTEGER
114 *> The order of the matrix Q
115 *> \endverbatim
116 *>
117 *> \param[in] QSTART
118 *> \verbatim
119 *> QSTART is INTEGER
120 *> Start index of the matrix Q. Rotations are applied
121 *> To columns k+2-qStart:k+3-qStart of Q.
122 *> \endverbatim
123 *
124 *> \param[inout] Q
125 *> \verbatim
126 *> Q is COMPLEX*16 array, dimension (LDQ,NQ)
127 *> \endverbatim
128 *>
129 *> \param[in] LDQ
130 *> \verbatim
131 *> LDQ is INTEGER
132 *> The leading dimension of Q as declared in
133 *> the calling procedure.
134 *> \endverbatim
135 *>
136 *> \param[in] NZ
137 *> \verbatim
138 *> NZ is INTEGER
139 *> The order of the matrix Z
140 *> \endverbatim
141 *>
142 *> \param[in] ZSTART
143 *> \verbatim
144 *> ZSTART is INTEGER
145 *> Start index of the matrix Z. Rotations are applied
146 *> To columns k+1-qStart:k+2-qStart of Z.
147 *> \endverbatim
148 *
149 *> \param[inout] Z
150 *> \verbatim
151 *> Z is COMPLEX*16 array, dimension (LDZ,NZ)
152 *> \endverbatim
153 *>
154 *> \param[in] LDZ
155 *> \verbatim
156 *> LDZ is INTEGER
157 *> The leading dimension of Q as declared in
158 *> the calling procedure.
159 *> \endverbatim
160 *
161 * Authors:
162 * ========
163 *
164 *> \author Thijs Steel, KU Leuven
165 *
166 *> \date May 2020
167 *
168 *> \ingroup complex16GEcomputational
169 *>
170 * =====================================================================
171  SUBROUTINE zlaqz1( ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B,
172  $ LDB, NQ, QSTART, Q, LDQ, NZ, ZSTART, Z, LDZ )
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  COMPLEX*16 :: A( LDA, * ), B( LDB, * ), Q( LDQ, * ), Z( LDZ, * )
180 *
181 * Parameters
182  COMPLEX*16 CZERO, CONE
183  parameter( czero = ( 0.0d+0, 0.0d+0 ), cone = ( 1.0d+0,
184  $ 0.0d+0 ) )
185  DOUBLE PRECISION :: ZERO, ONE, HALF
186  parameter( zero = 0.0d0, one = 1.0d0, half = 0.5d0 )
187 *
188 * Local variables
189  DOUBLE PRECISION :: C
190  COMPLEX*16 :: S, TEMP
191 *
192 * External Functions
193  EXTERNAL :: zlartg, zrot
194 *
195  IF( k+1 .EQ. ihi ) THEN
196 *
197 * Shift is located on the edge of the matrix, remove it
198 *
199  CALL zlartg( b( ihi, ihi ), b( ihi, ihi-1 ), c, s, temp )
200  b( ihi, ihi ) = temp
201  b( ihi, ihi-1 ) = czero
202  CALL zrot( ihi-istartm, b( istartm, ihi ), 1, b( istartm,
203  $ ihi-1 ), 1, c, s )
204  CALL zrot( ihi-istartm+1, a( istartm, ihi ), 1, a( istartm,
205  $ ihi-1 ), 1, c, s )
206  IF ( ilz ) THEN
207  CALL zrot( nz, z( 1, ihi-zstart+1 ), 1, z( 1, ihi-1-zstart+
208  $ 1 ), 1, c, s )
209  END IF
210 *
211  ELSE
212 *
213 * Normal operation, move bulge down
214 *
215 *
216 * Apply transformation from the right
217 *
218  CALL zlartg( b( k+1, k+1 ), b( k+1, k ), c, s, temp )
219  b( k+1, k+1 ) = temp
220  b( k+1, k ) = czero
221  CALL zrot( k+2-istartm+1, a( istartm, k+1 ), 1, a( istartm,
222  $ k ), 1, c, s )
223  CALL zrot( k-istartm+1, b( istartm, k+1 ), 1, b( istartm, k ),
224  $ 1, c, s )
225  IF ( ilz ) THEN
226  CALL zrot( nz, z( 1, k+1-zstart+1 ), 1, z( 1, k-zstart+1 ),
227  $ 1, c, s )
228  END IF
229 *
230 * Apply transformation from the left
231 *
232  CALL zlartg( a( k+1, k ), a( k+2, k ), c, s, temp )
233  a( k+1, k ) = temp
234  a( k+2, k ) = czero
235  CALL zrot( istopm-k, a( k+1, k+1 ), lda, a( k+2, k+1 ), lda, c,
236  $ s )
237  CALL zrot( istopm-k, b( k+1, k+1 ), ldb, b( k+2, k+1 ), ldb, c,
238  $ s )
239  IF ( ilq ) THEN
240  CALL zrot( nq, q( 1, k+1-qstart+1 ), 1, q( 1, k+2-qstart+
241  $ 1 ), 1, c, dconjg( s ) )
242  END IF
243 *
244  END IF
245 *
246 * End of ZLAQZ1
247 *
248  END SUBROUTINE
subroutine zlartg(f, g, c, s, r)
ZLARTG generates a plane rotation with real cosine and complex sine.
Definition: zlartg.f90:118
subroutine zlaqz1(ILQ, ILZ, K, ISTARTM, ISTOPM, IHI, A, LDA, B, LDB, NQ, QSTART, Q, LDQ, NZ, ZSTART, Z, LDZ)
ZLAQZ1
Definition: zlaqz1.f:173
subroutine zrot(N, CX, INCX, CY, INCY, C, S)
ZROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors.
Definition: zrot.f:103