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
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zlaqz1.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack