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

NAME

SYNOPSIS

7       SUBROUTINE CLAQR2( 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        H( LDH, * ), SH( * ), T( LDT, *  ),  V(  LDV,  *  ),
17                          WORK( * ), WV( LDWV, * ), Z( LDZ, * )
18
19           COMPLEX        ZERO, ONE
20
21           PARAMETER      ( ZERO = ( 0.0e0, 0.0e0 ), ONE = ( 1.0e0, 0.0e0 ) )
22
23           REAL           RZERO, RONE
24
25           PARAMETER      ( RZERO = 0.0e0, RONE = 1.0e0 )
26
27           COMPLEX        BETA, CDUM, S, TAU
28
29           REAL           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           REAL           SLAMCH
35
36           EXTERNAL       SLAMCH
37
38           EXTERNAL       CCOPY, CGEHRD, CGEMM, CLACPY, CLAHQR, CLARF, CLARFG,
39                          CLASET, CTREXC, CUNMHR, SLABAD
40
41           INTRINSIC      ABS, AIMAG, CMPLX, CONJG, INT, MAX, MIN, REAL
42
43           REAL           CABS1
44
45           CABS1(         CDUM ) = ABS( REAL( CDUM ) ) + ABS( AIMAG( 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           CGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
56
57           LWK1           = INT( WORK( 1 ) )
58
59           CALL           CUNMHR(  '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 ) = CMPLX( 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         = SLAMCH( 'SAFE MINIMUM' )
87
88           SAFMAX         = RONE / SAFMIN
89
90           CALL           SLABAD( SAFMIN, SAFMAX )
91
92           ULP            = SLAMCH( 'PRECISION' )
93
94           SMLNUM         = SAFMIN*( REAL( 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           CLACPY(  'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT
136                          )
137
138           CALL           CCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1  ),
139                          LDT+1 )
140
141           CALL           CLASET( 'A', JW, JW, ZERO, ONE, V, LDV )
142
143           CALL           CLAHQR( .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           CTREXC( '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 CTREXC( '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           CCOPY( NS, V, LDV, WORK, 1 )
208
209           DO             50 I = 1, NS
210
211           WORK(          I ) = CONJG( WORK( I ) )
212
213           50             CONTINUE
214
215           BETA           = WORK( 1 )
216
217           CALL           CLARFG( NS, BETA, WORK( 2 ), 1, TAU )
218
219           WORK(          1 ) = ONE
220
221           CALL           CLASET(  'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT
222                          )
223
224           CALL           CLARF( 'L', NS, JW, WORK, 1, CONJG( TAU ),  T,  LDT,
225                          WORK( JW+1 ) )
226
227           CALL           CLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT, WORK( JW+1
228                          ) )
229
230           CALL           CLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV, WORK( JW+1
231                          ) )
232
233           CALL           CGEHRD(  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*CONJG( V( 1,  1
239                          ) )
240
241           CALL           CLACPY(  'U', JW, JW, T, LDT, H( KWTOP, KWTOP ), LDH
242                          )
243
244           CALL           CCOPY( 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 CUNMHR( '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           CGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ),
266                          LDH, V, LDV, ZERO, WV, LDWV )
267
268           CALL           CLACPY( '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           CGEMM( 'C', 'N', JW, KLN, JW, ONE, V, LDV, H( KWTOP,
280                          KCOL ), LDH, ZERO, T, LDT )
281
282           CALL           CLACPY( '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           CGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ),
296                          LDZ, V, LDV, ZERO, WV, LDWV )
297
298           CALL           CLACPY( '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 ) = CMPLX( LWKOPT, 0 )
312
313           END
314

PURPOSE

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