1ZLAQR2(1)           LAPACK auxiliary routine (version 3.2)           ZLAQR2(1)
2
3
4

NAME

SYNOPSIS

7       SUBROUTINE ZLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ, IHIZ,
8                          Z, LDZ, NS, ND, SH, V, LDV,  NH,  T,  LDT,  NV,  WV,
9                          LDWV, WORK, LWORK )
10
11           INTEGER        IHIZ,  ILOZ,  KBOT,  KTOP, LDH, LDT, LDV, LDWV, LDZ,
12                          LWORK, N, ND, NH, NS, NV, NW
13
14           LOGICAL        WANTT, WANTZ
15
16           COMPLEX*16     H( LDH, * ), SH( * ), T( LDT, *  ),  V(  LDV,  *  ),
17                          WORK( * ), WV( LDWV, * ), Z( LDZ, * )
18
19           COMPLEX*16     ZERO, ONE
20
21           PARAMETER      ( ZERO = ( 0.0d0, 0.0d0 ), ONE = ( 1.0d0, 0.0d0 ) )
22
23           DOUBLE         PRECISION RZERO, RONE
24
25           PARAMETER      ( RZERO = 0.0d0, RONE = 1.0d0 )
26
27           COMPLEX*16     BETA, CDUM, S, TAU
28
29           DOUBLE         PRECISION FOO, SAFMAX, SAFMIN, SMLNUM, ULP
30
31           INTEGER        I,  IFST,  ILST, INFO, INFQR, J, JW, KCOL, KLN, KNT,
32                          KROW, KWTOP, LTOP, LWK1, LWK2, LWKOPT
33
34           DOUBLE         PRECISION DLAMCH
35
36           EXTERNAL       DLAMCH
37
38           EXTERNAL       DLABAD, ZCOPY, ZGEHRD, ZGEMM, ZLACPY, ZLAHQR, ZLARF,
39                          ZLARFG, ZLASET, ZTREXC, ZUNMHR
40
41           INTRINSIC      ABS, DBLE, DCMPLX, DCONJG, DIMAG, INT, MAX, MIN
42
43           DOUBLE         PRECISION CABS1
44
45           CABS1(         CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
46
47           JW             = MIN( NW, KBOT-KTOP+1 )
48
49           IF(            JW.LE.2 ) THEN
50
51           LWKOPT         = 1
52
53           ELSE
54
55           CALL           ZGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
56
57           LWK1           = INT( WORK( 1 ) )
58
59           CALL           ZUNMHR(  'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V,
60                          LDV, WORK, -1, INFO )
61
62           LWK2           = INT( WORK( 1 ) )
63
64           LWKOPT         = JW + MAX( LWK1, LWK2 )
65
66           END            IF
67
68           IF(            LWORK.EQ.-1 ) THEN
69
70           WORK(          1 ) = DCMPLX( LWKOPT, 0 )
71
72           RETURN
73
74           END            IF
75
76           NS             = 0
77
78           ND             = 0
79
80           WORK(          1 ) = ONE
81
82           IF(            KTOP.GT.KBOT ) RETURN
83
84           IF(            NW.LT.1 ) RETURN
85
86           SAFMIN         = DLAMCH( 'SAFE MINIMUM' )
87
88           SAFMAX         = RONE / SAFMIN
89
90           CALL           DLABAD( SAFMIN, SAFMAX )
91
92           ULP            = DLAMCH( 'PRECISION' )
93
94           SMLNUM         = SAFMIN*( DBLE( N ) / ULP )
95
96           JW             = MIN( NW, KBOT-KTOP+1 )
97
98           KWTOP          = KBOT - JW + 1
99
100           IF(            KWTOP.EQ.KTOP ) THEN
101
102           S              = ZERO
103
104           ELSE
105
106           S              = H( KWTOP, KWTOP-1 )
107
108           END            IF
109
110           IF(            KBOT.EQ.KWTOP ) THEN
111
112           SH(            KWTOP ) = H( KWTOP, KWTOP )
113
114           NS             = 1
115
116           ND             = 0
117
118           IF(            CABS1( S  ).LE.MAX(  SMLNUM,  ULP*CABS1(  H(  KWTOP,
119                          KWTOP ) ) ) ) THEN
120
121           NS             = 0
122
123           ND             = 1
124
125           IF(            KWTOP.GT.KTOP ) H( KWTOP, KWTOP-1 ) = ZERO
126
127           END            IF
128
129           WORK(          1 ) = ONE
130
131           RETURN
132
133           END            IF
134
135           CALL           ZLACPY(  'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT
136                          )
137
138           CALL           ZCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1  ),
139                          LDT+1 )
140
141           CALL           ZLASET( 'A', JW, JW, ZERO, ONE, V, LDV )
142
143           CALL           ZLAHQR( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP
144                          ), 1, JW, V, LDV, INFQR )
145
146           NS             = JW
147
148           ILST           = INFQR + 1
149
150           DO             10 KNT = INFQR + 1, JW
151
152           FOO            = CABS1( T( NS, NS ) )
153
154           IF(            FOO.EQ.RZERO ) FOO = CABS1( S )
155
156           IF(            CABS1( S )*CABS1(  V(  1,  NS  )  ).LE.MAX(  SMLNUM,
157                          ULP*FOO ) ) THEN
158
159           NS             = NS - 1
160
161           ELSE
162
163           IFST           = NS
164
165           CALL           ZTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO )
166
167           ILST           = ILST + 1
168
169           END            IF
170
171           10             CONTINUE
172
173           IF(            NS.EQ.0 ) S = ZERO
174
175           IF(            NS.LT.JW ) THEN
176
177           DO             30 I = INFQR + 1, NS
178
179           IFST           = I
180
181           DO             20 J = I + 1, NS
182
183           IF(            CABS1(  T(  J,  J  ) ).GT.CABS1( T( IFST, IFST ) ) )
184                          IFST = J
185
186           20             CONTINUE
187
188           ILST           = I
189
190           IF(            IFST.NE.ILST ) CALL ZTREXC( 'V', JW, T, LDT, V, LDV,
191                          IFST, ILST, INFO )
192
193           30             CONTINUE
194
195           END            IF
196
197           DO             40 I = INFQR + 1, JW
198
199           SH(            KWTOP+I-1 ) = T( I, I )
200
201           40             CONTINUE
202
203           IF(            NS.LT.JW .OR. S.EQ.ZERO ) THEN
204
205           IF(            NS.GT.1 .AND. S.NE.ZERO ) THEN
206
207           CALL           ZCOPY( NS, V, LDV, WORK, 1 )
208
209           DO             50 I = 1, NS
210
211           WORK(          I ) = DCONJG( WORK( I ) )
212
213           50             CONTINUE
214
215           BETA           = WORK( 1 )
216
217           CALL           ZLARFG( NS, BETA, WORK( 2 ), 1, TAU )
218
219           WORK(          1 ) = ONE
220
221           CALL           ZLASET(  'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT
222                          )
223
224           CALL           ZLARF( 'L', NS, JW, WORK, 1, DCONJG( TAU ), T,  LDT,
225                          WORK( JW+1 ) )
226
227           CALL           ZLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT, WORK( JW+1
228                          ) )
229
230           CALL           ZLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV, WORK( JW+1
231                          ) )
232
233           CALL           ZGEHRD(  JW,  1,  NS,  T,  LDT,  WORK, WORK( JW+1 ),
234                          LWORK-JW, INFO )
235
236           END            IF
237
238           IF(            KWTOP.GT.1 ) H( KWTOP, KWTOP-1 ) = S*DCONJG( V( 1, 1
239                          ) )
240
241           CALL           ZLACPY(  'U', JW, JW, T, LDT, H( KWTOP, KWTOP ), LDH
242                          )
243
244           CALL           ZCOPY( JW-1, T( 2, 1 ), LDT+1, H( KWTOP+1, KWTOP  ),
245                          LDH+1 )
246
247           IF(            NS.GT.1 .AND. S.NE.ZERO ) CALL ZUNMHR( 'R', 'N', JW,
248                          NS, 1, NS, T, LDT,  WORK,  V,  LDV,  WORK(  JW+1  ),
249                          LWORK-JW, INFO )
250
251           IF(            WANTT ) THEN
252
253           LTOP           = 1
254
255           ELSE
256
257           LTOP           = KTOP
258
259           END            IF
260
261           DO             60 KROW = LTOP, KWTOP - 1, NV
262
263           KLN            = MIN( NV, KWTOP-KROW )
264
265           CALL           ZGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ),
266                          LDH, V, LDV, ZERO, WV, LDWV )
267
268           CALL           ZLACPY( 'A', KLN, JW, WV, LDWV, H(  KROW,  KWTOP  ),
269                          LDH )
270
271           60             CONTINUE
272
273           IF(            WANTT ) THEN
274
275           DO             70 KCOL = KBOT + 1, N, NH
276
277           KLN            = MIN( NH, N-KCOL+1 )
278
279           CALL           ZGEMM( 'C', 'N', JW, KLN, JW, ONE, V, LDV, H( KWTOP,
280                          KCOL ), LDH, ZERO, T, LDT )
281
282           CALL           ZLACPY( 'A', JW, KLN, T, LDT, H( KWTOP, KCOL ),  LDH
283                          )
284
285           70             CONTINUE
286
287           END            IF
288
289           IF(            WANTZ ) THEN
290
291           DO             80 KROW = ILOZ, IHIZ, NV
292
293           KLN            = MIN( NV, IHIZ-KROW+1 )
294
295           CALL           ZGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ),
296                          LDZ, V, LDV, ZERO, WV, LDWV )
297
298           CALL           ZLACPY( 'A', KLN, JW, WV, LDWV, Z(  KROW,  KWTOP  ),
299                          LDZ )
300
301           80             CONTINUE
302
303           END            IF
304
305           END            IF
306
307           ND             = JW - NS
308
309           NS             = NS - INFQR
310
311           WORK(          1 ) = DCMPLX( LWKOPT, 0 )
312
313           END
314

PURPOSE

316 LAPACK auxiliary routine (versionNo3v.e2m)ber 2008                       ZLAQR2(1)