1*> \brief \b CLAQZ1
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CLAQZ1 + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/CLAQZ1.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/CLAQZ1.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/CLAQZ1.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*      SUBROUTINE CLAQZ1( 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 :: A( LDA, * ), B( LDB, * ), Q( LDQ, * ), Z( LDZ, * )
30*       ..
31*
32*
33*> \par Purpose:
34*  =============
35*>
36*> \verbatim
37*>
38*>      CLAQZ1 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 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 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 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 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 complexGEcomputational
169*>
170*  =====================================================================
171      SUBROUTINE CLAQZ1( 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 :: A( LDA, * ), B( LDB, * ), Q( LDQ, * ), Z( LDZ, * )
180*
181*     Parameters
182      COMPLEX         CZERO, CONE
183      PARAMETER          ( CZERO = ( 0.0, 0.0 ), CONE = ( 1.0, 0.0 ) )
184      REAL :: ZERO, ONE, HALF
185      PARAMETER( ZERO = 0.0, ONE = 1.0, HALF = 0.5 )
186*
187*     Local variables
188      REAL :: C
189      COMPLEX :: S, TEMP
190*
191*     External Functions
192      EXTERNAL :: CLARTG, CROT
193*
194      IF( K+1 .EQ. IHI ) THEN
195*
196*        Shift is located on the edge of the matrix, remove it
197*
198         CALL CLARTG( B( IHI, IHI ), B( IHI, IHI-1 ), C, S, TEMP )
199         B( IHI, IHI ) = TEMP
200         B( IHI, IHI-1 ) = CZERO
201         CALL CROT( IHI-ISTARTM, B( ISTARTM, IHI ), 1, B( ISTARTM,
202     $              IHI-1 ), 1, C, S )
203         CALL CROT( IHI-ISTARTM+1, A( ISTARTM, IHI ), 1, A( ISTARTM,
204     $              IHI-1 ), 1, C, S )
205         IF ( ILZ ) THEN
206            CALL CROT( NZ, Z( 1, IHI-ZSTART+1 ), 1, Z( 1, IHI-1-ZSTART+
207     $                 1 ), 1, C, S )
208         END IF
209*
210      ELSE
211*
212*        Normal operation, move bulge down
213*
214*
215*        Apply transformation from the right
216*
217         CALL CLARTG( B( K+1, K+1 ), B( K+1, K ), C, S, TEMP )
218         B( K+1, K+1 ) = TEMP
219         B( K+1, K ) = CZERO
220         CALL CROT( K+2-ISTARTM+1, A( ISTARTM, K+1 ), 1, A( ISTARTM,
221     $              K ), 1, C, S )
222         CALL CROT( K-ISTARTM+1, B( ISTARTM, K+1 ), 1, B( ISTARTM, K ),
223     $              1, C, S )
224         IF ( ILZ ) THEN
225            CALL CROT( NZ, Z( 1, K+1-ZSTART+1 ), 1, Z( 1, K-ZSTART+1 ),
226     $                 1, C, S )
227         END IF
228*
229*        Apply transformation from the left
230*
231         CALL CLARTG( A( K+1, K ), A( K+2, K ), C, S, TEMP )
232         A( K+1, K ) = TEMP
233         A( K+2, K ) = CZERO
234         CALL CROT( ISTOPM-K, A( K+1, K+1 ), LDA, A( K+2, K+1 ), LDA, C,
235     $              S )
236         CALL CROT( ISTOPM-K, B( K+1, K+1 ), LDB, B( K+2, K+1 ), LDB, C,
237     $              S )
238         IF ( ILQ ) THEN
239            CALL CROT( NQ, Q( 1, K+1-QSTART+1 ), 1, Q( 1, K+2-QSTART+
240     $                 1 ), 1, C, CONJG( S ) )
241         END IF
242*
243      END IF
244*
245*     End of CLAQZ1
246*
247      END SUBROUTINE