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