7
8
9
10
11
12 IMPLICIT NONE
13
14
15 CHARACTER JOBZ
16 INTEGER DOL, DOU, INDWLC, INFO, LDZ, LIWORK, LWORK, M,
17 $ MAXCLS, N, NDEPTH, NEEDIL, NEEDIU, NZC, PARITY,
18 $ ZOFFSET
19
20 DOUBLE PRECISION PIVMIN, SCALE, WL, WU
21 LOGICAL VSTART, FINISH
22
23
24
25 INTEGER ISUPPZ( * ), IWORK( * )
26 DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * )
27 DOUBLE PRECISION Z( LDZ, * )
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205 DOUBLE PRECISION ONE, FOUR, MINRGP
206 parameter( one = 1.0d0,
207 $ four = 4.0d0,
208 $ minrgp = 1.0d-3 )
209
210
211 LOGICAL LQUERY, WANTZ, ZQUERY
212 INTEGER IINDBL, IINDW, IINDWK, IINFO, IINSPL, INDERR,
213 $ INDGP, INDGRS, INDSDM, INDWRK, ITMP, J, LIWMIN,
214 $ LWMIN
215 DOUBLE PRECISION EPS, RTOL1, RTOL2
216
217
218 LOGICAL LSAME
219 DOUBLE PRECISION DLAMCH, DLANST
221
222
224
225
226 INTRINSIC dble,
max,
min, sqrt
227
228
229
230
231
232 wantz =
lsame( jobz,
'V' )
233
234 lquery = ( ( lwork.EQ.-1 ).OR.( liwork.EQ.-1 ) )
235 zquery = ( nzc.EQ.-1 )
236
237
238
239
240
241 IF( wantz ) THEN
242 lwmin = 18*n
243 liwmin = 10*n
244 ELSE
245
246 lwmin = 12*n
247 liwmin = 8*n
248 ENDIF
249
250 info = 0
251
252
253
254 eps =
dlamch(
'Precision' )
255
256 IF( (n.EQ.0).OR.(n.EQ.1) ) THEN
257 finish = .true.
258 RETURN
259 ENDIF
260
261 IF(zquery.OR.lquery)
262 $ RETURN
263
264 indgrs = 1
265 inderr = 2*n + 1
266 indgp = 3*n + 1
267 indsdm = 4*n + 1
268 indwrk = 6*n + 1
269 indwlc = indwrk
270
271 iinspl = 1
272 iindbl = n + 1
273 iindw = 2*n + 1
274 iindwk = 3*n + 1
275
276
277 rtol1 = four*sqrt(eps)
278 rtol2 =
max( sqrt(eps)*5.0d-3, four * eps )
279
280
281 IF( wantz ) THEN
282
283
284
285
287 $ pivmin, iwork( iinspl ), m,
288 $ dol, dou, needil, neediu, minrgp, rtol1, rtol2,
289 $ w, work( inderr ), work( indgp ), iwork( iindbl ),
290 $ iwork( iindw ), work( indgrs ),
291 $ work( indsdm ), z, ldz,
292 $ isuppz, work( indwrk ), iwork( iindwk ),
293 $ vstart, finish,
294 $ maxcls, ndepth, parity, zoffset, iinfo )
295 IF( iinfo.NE.0 ) THEN
296 info = 200 + abs( iinfo )
297 RETURN
298 END IF
299
300 ELSE
301
302
303
304
305
306 DO 30 j = 1, m
307 itmp = iwork( iindbl+j-1 )
308 w( j ) = w( j ) + e( iwork( iinspl+itmp-1 ) )
309 30 CONTINUE
310
311 finish = .true.
312
313 END IF
314
315
316 IF(finish) THEN
317
318
319
320
321
322 IF( scale.NE.one ) THEN
323 CALL dscal( m, one / scale, w, 1 )
324 END IF
325
326
327
328 IF ( wantz ) THEN
329 IF( dol.NE.1 .OR. dou.NE.m ) THEN
330 m = dou - dol +1
331 ENDIF
332 ENDIF
333
334
335
336
337 work( 1 ) = lwmin
338 iwork( 1 ) = liwmin
339 ENDIF
340
341 RETURN
342
343
344
subroutine dlarrv2(n, vl, vu, d, l, pivmin, isplit, m, dol, dou, needil, neediu, minrgp, rtol1, rtol2, w, werr, wgap, iblock, indexw, gers, sdiam, z, ldz, isuppz, work, iwork, vstart, finish, maxcls, ndepth, parity, zoffset, info)