/src/igraph/vendor/lapack/dnaupd.c
Line | Count | Source (jump to first uncovered line) |
1 | | /* -- translated by f2c (version 20191129). |
2 | | You must link the resulting object file with libf2c: |
3 | | on Microsoft Windows system, link with libf2c.lib; |
4 | | on Linux or Unix systems, link with .../path/to/libf2c.a -lm |
5 | | or, if you install libf2c.a in a standard place, with -lf2c -lm |
6 | | -- in that order, at the end of the command line, as in |
7 | | cc *.o -lf2c -lm |
8 | | Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., |
9 | | |
10 | | http://www.netlib.org/f2c/libf2c.zip |
11 | | */ |
12 | | |
13 | | #include "f2c.h" |
14 | | |
15 | | /* Table of constant values */ |
16 | | |
17 | | static integer c__1 = 1; |
18 | | |
19 | | /* \BeginDoc |
20 | | |
21 | | \Name: dnaupd |
22 | | |
23 | | \Description: |
24 | | Reverse communication interface for the Implicitly Restarted Arnoldi |
25 | | iteration. This subroutine computes approximations to a few eigenpairs |
26 | | of a linear operator "OP" with respect to a semi-inner product defined by |
27 | | a symmetric positive semi-definite real matrix B. B may be the identity |
28 | | matrix. NOTE: If the linear operator "OP" is real and symmetric |
29 | | with respect to the real positive semi-definite symmetric matrix B, |
30 | | i.e. B*OP = (OP')*B, then subroutine ssaupd should be used instead. |
31 | | |
32 | | The computed approximate eigenvalues are called Ritz values and |
33 | | the corresponding approximate eigenvectors are called Ritz vectors. |
34 | | |
35 | | dnaupd is usually called iteratively to solve one of the |
36 | | following problems: |
37 | | |
38 | | Mode 1: A*x = lambda*x. |
39 | | ===> OP = A and B = I. |
40 | | |
41 | | Mode 2: A*x = lambda*M*x, M symmetric positive definite |
42 | | ===> OP = inv[M]*A and B = M. |
43 | | ===> (If M can be factored see remark 3 below) |
44 | | |
45 | | Mode 3: A*x = lambda*M*x, M symmetric semi-definite |
46 | | ===> OP = Real_Part{ inv[A - sigma*M]*M } and B = M. |
47 | | ===> shift-and-invert mode (in real arithmetic) |
48 | | If OP*x = amu*x, then |
49 | | amu = 1/2 * [ 1/(lambda-sigma) + 1/(lambda-conjg(sigma)) ]. |
50 | | Note: If sigma is real, i.e. imaginary part of sigma is zero; |
51 | | Real_Part{ inv[A - sigma*M]*M } == inv[A - sigma*M]*M |
52 | | amu == 1/(lambda-sigma). |
53 | | |
54 | | Mode 4: A*x = lambda*M*x, M symmetric semi-definite |
55 | | ===> OP = Imaginary_Part{ inv[A - sigma*M]*M } and B = M. |
56 | | ===> shift-and-invert mode (in real arithmetic) |
57 | | If OP*x = amu*x, then |
58 | | amu = 1/2i * [ 1/(lambda-sigma) - 1/(lambda-conjg(sigma)) ]. |
59 | | |
60 | | Both mode 3 and 4 give the same enhancement to eigenvalues close to |
61 | | the (complex) shift sigma. However, as lambda goes to infinity, |
62 | | the operator OP in mode 4 dampens the eigenvalues more strongly than |
63 | | does OP defined in mode 3. |
64 | | |
65 | | NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v |
66 | | should be accomplished either by a direct method |
67 | | using a sparse matrix factorization and solving |
68 | | |
69 | | [A - sigma*M]*w = v or M*w = v, |
70 | | |
71 | | or through an iterative method for solving these |
72 | | systems. If an iterative method is used, the |
73 | | convergence test must be more stringent than |
74 | | the accuracy requirements for the eigenvalue |
75 | | approximations. |
76 | | |
77 | | \Usage: |
78 | | call dnaupd |
79 | | ( IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, |
80 | | IPNTR, WORKD, WORKL, LWORKL, INFO ) |
81 | | |
82 | | \Arguments |
83 | | IDO Integer. (INPUT/OUTPUT) |
84 | | Reverse communication flag. IDO must be zero on the first |
85 | | call to dnaupd. IDO will be set internally to |
86 | | indicate the type of operation to be performed. Control is |
87 | | then given back to the calling routine which has the |
88 | | responsibility to carry out the requested operation and call |
89 | | dnaupd with the result. The operand is given in |
90 | | WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)). |
91 | | ------------------------------------------------------------- |
92 | | IDO = 0: first call to the reverse communication interface |
93 | | IDO = -1: compute Y = OP * X where |
94 | | IPNTR(1) is the pointer into WORKD for X, |
95 | | IPNTR(2) is the pointer into WORKD for Y. |
96 | | This is for the initialization phase to force the |
97 | | starting vector into the range of OP. |
98 | | IDO = 1: compute Y = OP * X where |
99 | | IPNTR(1) is the pointer into WORKD for X, |
100 | | IPNTR(2) is the pointer into WORKD for Y. |
101 | | In mode 3 and 4, the vector B * X is already |
102 | | available in WORKD(ipntr(3)). It does not |
103 | | need to be recomputed in forming OP * X. |
104 | | IDO = 2: compute Y = B * X where |
105 | | IPNTR(1) is the pointer into WORKD for X, |
106 | | IPNTR(2) is the pointer into WORKD for Y. |
107 | | IDO = 3: compute the IPARAM(8) real and imaginary parts |
108 | | of the shifts where INPTR(14) is the pointer |
109 | | into WORKL for placing the shifts. See Remark |
110 | | 5 below. |
111 | | IDO = 99: done |
112 | | ------------------------------------------------------------- |
113 | | |
114 | | BMAT Character*1. (INPUT) |
115 | | BMAT specifies the type of the matrix B that defines the |
116 | | semi-inner product for the operator OP. |
117 | | BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x |
118 | | BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*B*x |
119 | | |
120 | | N Integer. (INPUT) |
121 | | Dimension of the eigenproblem. |
122 | | |
123 | | WHICH Character*2. (INPUT) |
124 | | 'LM' -> want the NEV eigenvalues of largest magnitude. |
125 | | 'SM' -> want the NEV eigenvalues of smallest magnitude. |
126 | | 'LR' -> want the NEV eigenvalues of largest real part. |
127 | | 'SR' -> want the NEV eigenvalues of smallest real part. |
128 | | 'LI' -> want the NEV eigenvalues of largest imaginary part. |
129 | | 'SI' -> want the NEV eigenvalues of smallest imaginary part. |
130 | | |
131 | | NEV Integer. (INPUT) |
132 | | Number of eigenvalues of OP to be computed. 0 < NEV < N-1. |
133 | | |
134 | | TOL Double precision scalar. (INPUT) |
135 | | Stopping criterion: the relative accuracy of the Ritz value |
136 | | is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)) |
137 | | where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex. |
138 | | DEFAULT = DLAMCH('EPS') (machine precision as computed |
139 | | by the LAPACK auxiliary subroutine DLAMCH). |
140 | | |
141 | | RESID Double precision array of length N. (INPUT/OUTPUT) |
142 | | On INPUT: |
143 | | If INFO .EQ. 0, a random initial residual vector is used. |
144 | | If INFO .NE. 0, RESID contains the initial residual vector, |
145 | | possibly from a previous run. |
146 | | On OUTPUT: |
147 | | RESID contains the final residual vector. |
148 | | |
149 | | NCV Integer. (INPUT) |
150 | | Number of columns of the matrix V. NCV must satisfy the two |
151 | | inequalities 2 <= NCV-NEV and NCV <= N. |
152 | | This will indicate how many Arnoldi vectors are generated |
153 | | at each iteration. After the startup phase in which NEV |
154 | | Arnoldi vectors are generated, the algorithm generates |
155 | | approximately NCV-NEV Arnoldi vectors at each subsequent update |
156 | | iteration. Most of the cost in generating each Arnoldi vector is |
157 | | in the matrix-vector operation OP*x. |
158 | | NOTE: 2 <= NCV-NEV in order that complex conjugate pairs of Ritz |
159 | | values are kept together. (See remark 4 below) |
160 | | |
161 | | V Double precision array N by NCV. (OUTPUT) |
162 | | Contains the final set of Arnoldi basis vectors. |
163 | | |
164 | | LDV Integer. (INPUT) |
165 | | Leading dimension of V exactly as declared in the calling program. |
166 | | |
167 | | IPARAM Integer array of length 11. (INPUT/OUTPUT) |
168 | | IPARAM(1) = ISHIFT: method for selecting the implicit shifts. |
169 | | The shifts selected at each iteration are used to restart |
170 | | the Arnoldi iteration in an implicit fashion. |
171 | | ------------------------------------------------------------- |
172 | | ISHIFT = 0: the shifts are provided by the user via |
173 | | reverse communication. The real and imaginary |
174 | | parts of the NCV eigenvalues of the Hessenberg |
175 | | matrix H are returned in the part of the WORKL |
176 | | array corresponding to RITZR and RITZI. See remark |
177 | | 5 below. |
178 | | ISHIFT = 1: exact shifts with respect to the current |
179 | | Hessenberg matrix H. This is equivalent to |
180 | | restarting the iteration with a starting vector |
181 | | that is a linear combination of approximate Schur |
182 | | vectors associated with the "wanted" Ritz values. |
183 | | ------------------------------------------------------------- |
184 | | |
185 | | IPARAM(2) = No longer referenced. |
186 | | |
187 | | IPARAM(3) = MXITER |
188 | | On INPUT: maximum number of Arnoldi update iterations allowed. |
189 | | On OUTPUT: actual number of Arnoldi update iterations taken. |
190 | | |
191 | | IPARAM(4) = NB: blocksize to be used in the recurrence. |
192 | | The code currently works only for NB = 1. |
193 | | |
194 | | IPARAM(5) = NCONV: number of "converged" Ritz values. |
195 | | This represents the number of Ritz values that satisfy |
196 | | the convergence criterion. |
197 | | |
198 | | IPARAM(6) = IUPD |
199 | | No longer referenced. Implicit restarting is ALWAYS used. |
200 | | |
201 | | IPARAM(7) = MODE |
202 | | On INPUT determines what type of eigenproblem is being solved. |
203 | | Must be 1,2,3,4; See under \Description of dnaupd for the |
204 | | four modes available. |
205 | | |
206 | | IPARAM(8) = NP |
207 | | When ido = 3 and the user provides shifts through reverse |
208 | | communication (IPARAM(1)=0), dnaupd returns NP, the number |
209 | | of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark |
210 | | 5 below. |
211 | | |
212 | | IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO, |
213 | | OUTPUT: NUMOP = total number of OP*x operations, |
214 | | NUMOPB = total number of B*x operations if BMAT='G', |
215 | | NUMREO = total number of steps of re-orthogonalization. |
216 | | |
217 | | IPNTR Integer array of length 14. (OUTPUT) |
218 | | Pointer to mark the starting locations in the WORKD and WORKL |
219 | | arrays for matrices/vectors used by the Arnoldi iteration. |
220 | | ------------------------------------------------------------- |
221 | | IPNTR(1): pointer to the current operand vector X in WORKD. |
222 | | IPNTR(2): pointer to the current result vector Y in WORKD. |
223 | | IPNTR(3): pointer to the vector B * X in WORKD when used in |
224 | | the shift-and-invert mode. |
225 | | IPNTR(4): pointer to the next available location in WORKL |
226 | | that is untouched by the program. |
227 | | IPNTR(5): pointer to the NCV by NCV upper Hessenberg matrix |
228 | | H in WORKL. |
229 | | IPNTR(6): pointer to the real part of the ritz value array |
230 | | RITZR in WORKL. |
231 | | IPNTR(7): pointer to the imaginary part of the ritz value array |
232 | | RITZI in WORKL. |
233 | | IPNTR(8): pointer to the Ritz estimates in array WORKL associated |
234 | | with the Ritz values located in RITZR and RITZI in WORKL. |
235 | | |
236 | | IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below. |
237 | | |
238 | | Note: IPNTR(9:13) is only referenced by dneupd. See Remark 2 below. |
239 | | |
240 | | IPNTR(9): pointer to the real part of the NCV RITZ values of the |
241 | | original system. |
242 | | IPNTR(10): pointer to the imaginary part of the NCV RITZ values of |
243 | | the original system. |
244 | | IPNTR(11): pointer to the NCV corresponding error bounds. |
245 | | IPNTR(12): pointer to the NCV by NCV upper quasi-triangular |
246 | | Schur matrix for H. |
247 | | IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors |
248 | | of the upper Hessenberg matrix H. Only referenced by |
249 | | dneupd if RVEC = .TRUE. See Remark 2 below. |
250 | | ------------------------------------------------------------- |
251 | | |
252 | | WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION) |
253 | | Distributed array to be used in the basic Arnoldi iteration |
254 | | for reverse communication. The user should not use WORKD |
255 | | as temporary workspace during the iteration. Upon termination |
256 | | WORKD(1:N) contains B*RESID(1:N). If an invariant subspace |
257 | | associated with the converged Ritz values is desired, see remark |
258 | | 2 below, subroutine dneupd uses this output. |
259 | | See Data Distribution Note below. |
260 | | |
261 | | WORKL Double precision work array of length LWORKL. (OUTPUT/WORKSPACE) |
262 | | Private (replicated) array on each PE or array allocated on |
263 | | the front end. See Data Distribution Note below. |
264 | | |
265 | | LWORKL Integer. (INPUT) |
266 | | LWORKL must be at least 3*NCV**2 + 6*NCV. |
267 | | |
268 | | INFO Integer. (INPUT/OUTPUT) |
269 | | If INFO .EQ. 0, a randomly initial residual vector is used. |
270 | | If INFO .NE. 0, RESID contains the initial residual vector, |
271 | | possibly from a previous run. |
272 | | Error flag on output. |
273 | | = 0: Normal exit. |
274 | | = 1: Maximum number of iterations taken. |
275 | | All possible eigenvalues of OP has been found. IPARAM(5) |
276 | | returns the number of wanted converged Ritz values. |
277 | | = 2: No longer an informational error. Deprecated starting |
278 | | with release 2 of ARPACK. |
279 | | = 3: No shifts could be applied during a cycle of the |
280 | | Implicitly restarted Arnoldi iteration. One possibility |
281 | | is to increase the size of NCV relative to NEV. |
282 | | See remark 4 below. |
283 | | = -1: N must be positive. |
284 | | = -2: NEV must be positive. |
285 | | = -3: NCV-NEV >= 2 and less than or equal to N. |
286 | | = -4: The maximum number of Arnoldi update iteration |
287 | | must be greater than zero. |
288 | | = -5: WHICH must be one of 'LM', 'SM', 'LR', 'SR', 'LI', 'SI' |
289 | | = -6: BMAT must be one of 'I' or 'G'. |
290 | | = -7: Length of private work array is not sufficient. |
291 | | = -8: Error return from LAPACK eigenvalue calculation; |
292 | | = -9: Starting vector is zero. |
293 | | = -10: IPARAM(7) must be 1,2,3,4. |
294 | | = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable. |
295 | | = -12: IPARAM(1) must be equal to 0 or 1. |
296 | | = -9999: Could not build an Arnoldi factorization. |
297 | | IPARAM(5) returns the size of the current Arnoldi |
298 | | factorization. |
299 | | |
300 | | \Remarks |
301 | | 1. The computed Ritz values are approximate eigenvalues of OP. The |
302 | | selection of WHICH should be made with this in mind when |
303 | | Mode = 3 and 4. After convergence, approximate eigenvalues of the |
304 | | original problem may be obtained with the ARPACK subroutine dneupd. |
305 | | |
306 | | 2. If a basis for the invariant subspace corresponding to the converged Ritz |
307 | | values is needed, the user must call dneupd immediately following |
308 | | completion of dnaupd. This is new starting with release 2 of ARPACK. |
309 | | |
310 | | 3. If M can be factored into a Cholesky factorization M = LL' |
311 | | then Mode = 2 should not be selected. Instead one should use |
312 | | Mode = 1 with OP = inv(L)*A*inv(L'). Appropriate triangular |
313 | | linear systems should be solved with L and L' rather |
314 | | than computing inverses. After convergence, an approximate |
315 | | eigenvector z of the original problem is recovered by solving |
316 | | L'z = x where x is a Ritz vector of OP. |
317 | | |
318 | | 4. At present there is no a-priori analysis to guide the selection |
319 | | of NCV relative to NEV. The only formal requrement is that NCV > NEV + 2. |
320 | | However, it is recommended that NCV .ge. 2*NEV+1. If many problems of |
321 | | the same type are to be solved, one should experiment with increasing |
322 | | NCV while keeping NEV fixed for a given test problem. This will |
323 | | usually decrease the required number of OP*x operations but it |
324 | | also increases the work and storage required to maintain the orthogonal |
325 | | basis vectors. The optimal "cross-over" with respect to CPU time |
326 | | is problem dependent and must be determined empirically. |
327 | | See Chapter 8 of Reference 2 for further information. |
328 | | |
329 | | 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the |
330 | | NP = IPARAM(8) real and imaginary parts of the shifts in locations |
331 | | real part imaginary part |
332 | | ----------------------- -------------- |
333 | | 1 WORKL(IPNTR(14)) WORKL(IPNTR(14)+NP) |
334 | | 2 WORKL(IPNTR(14)+1) WORKL(IPNTR(14)+NP+1) |
335 | | . . |
336 | | . . |
337 | | . . |
338 | | NP WORKL(IPNTR(14)+NP-1) WORKL(IPNTR(14)+2*NP-1). |
339 | | |
340 | | Only complex conjugate pairs of shifts may be applied and the pairs |
341 | | must be placed in consecutive locations. The real part of the |
342 | | eigenvalues of the current upper Hessenberg matrix are located in |
343 | | WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1) and the imaginary part |
344 | | in WORKL(IPNTR(7)) through WORKL(IPNTR(7)+NCV-1). They are ordered |
345 | | according to the order defined by WHICH. The complex conjugate |
346 | | pairs are kept together and the associated Ritz estimates are located in |
347 | | WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1). |
348 | | |
349 | | ----------------------------------------------------------------------- |
350 | | |
351 | | \Data Distribution Note: |
352 | | |
353 | | Fortran-D syntax: |
354 | | ================ |
355 | | Double precision resid(n), v(ldv,ncv), workd(3*n), workl(lworkl) |
356 | | decompose d1(n), d2(n,ncv) |
357 | | align resid(i) with d1(i) |
358 | | align v(i,j) with d2(i,j) |
359 | | align workd(i) with d1(i) range (1:n) |
360 | | align workd(i) with d1(i-n) range (n+1:2*n) |
361 | | align workd(i) with d1(i-2*n) range (2*n+1:3*n) |
362 | | distribute d1(block), d2(block,:) |
363 | | replicated workl(lworkl) |
364 | | |
365 | | Cray MPP syntax: |
366 | | =============== |
367 | | Double precision resid(n), v(ldv,ncv), workd(n,3), workl(lworkl) |
368 | | shared resid(block), v(block,:), workd(block,:) |
369 | | replicated workl(lworkl) |
370 | | |
371 | | CM2/CM5 syntax: |
372 | | ============== |
373 | | |
374 | | ----------------------------------------------------------------------- |
375 | | |
376 | | include 'ex-nonsym.doc' |
377 | | |
378 | | ----------------------------------------------------------------------- |
379 | | |
380 | | \BeginLib |
381 | | |
382 | | \Local variables: |
383 | | xxxxxx real |
384 | | |
385 | | \References: |
386 | | 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in |
387 | | a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992), |
388 | | pp 357-385. |
389 | | 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly |
390 | | Restarted Arnoldi Iteration", Rice University Technical Report |
391 | | TR95-13, Department of Computational and Applied Mathematics. |
392 | | 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for |
393 | | Real Matrices", Linear Algebra and its Applications, vol 88/89, |
394 | | pp 575-595, (1987). |
395 | | |
396 | | \Routines called: |
397 | | dnaup2 ARPACK routine that implements the Implicitly Restarted |
398 | | Arnoldi Iteration. |
399 | | ivout ARPACK utility routine that prints integers. |
400 | | second ARPACK utility routine for timing. |
401 | | dvout ARPACK utility routine that prints vectors. |
402 | | dlamch LAPACK routine that determines machine constants. |
403 | | |
404 | | \Author |
405 | | Danny Sorensen Phuong Vu |
406 | | Richard Lehoucq CRPC / Rice University |
407 | | Dept. of Computational & Houston, Texas |
408 | | Applied Mathematics |
409 | | Rice University |
410 | | Houston, Texas |
411 | | |
412 | | \Revision history: |
413 | | 12/16/93: Version '1.1' |
414 | | |
415 | | \SCCS Information: @(#) |
416 | | FILE: naupd.F SID: 2.5 DATE OF SID: 8/27/96 RELEASE: 2 |
417 | | |
418 | | \Remarks |
419 | | |
420 | | \EndLib |
421 | | |
422 | | ----------------------------------------------------------------------- |
423 | | |
424 | | Subroutine */ int igraphdnaupd_(integer *ido, char *bmat, integer *n, char * |
425 | | which, integer *nev, doublereal *tol, doublereal *resid, integer *ncv, |
426 | | doublereal *v, integer *ldv, integer *iparam, integer *ipntr, |
427 | | doublereal *workd, doublereal *workl, integer *lworkl, integer *info) |
428 | 0 | { |
429 | | /* Format strings */ |
430 | 0 | static char fmt_1000[] = "(//,5x,\002===================================" |
431 | 0 | "==========\002,/5x,\002= Nonsymmetric implicit Arnoldi update co" |
432 | 0 | "de =\002,/5x,\002= Version Number: \002,\002 2.4\002,21x,\002 " |
433 | 0 | "=\002,/5x,\002= Version Date: \002,\002 07/31/96\002,16x,\002 =" |
434 | 0 | "\002,/5x,\002=============================================\002,/" |
435 | 0 | "5x,\002= Summary of timing statistics =\002,/5x," |
436 | 0 | "\002=============================================\002,//)"; |
437 | 0 | static char fmt_1100[] = "(5x,\002Total number update iterations " |
438 | 0 | " = \002,i5,/5x,\002Total number of OP*x operations " |
439 | 0 | " = \002,i5,/5x,\002Total number of B*x operations = " |
440 | 0 | "\002,i5,/5x,\002Total number of reorthogonalization steps = " |
441 | 0 | "\002,i5,/5x,\002Total number of iterative refinement steps = " |
442 | 0 | "\002,i5,/5x,\002Total number of restart steps = " |
443 | 0 | "\002,i5,/5x,\002Total time in user OP*x operation = " |
444 | 0 | "\002,f12.6,/5x,\002Total time in user B*x operation =" |
445 | 0 | " \002,f12.6,/5x,\002Total time in Arnoldi update routine = " |
446 | 0 | "\002,f12.6,/5x,\002Total time in naup2 routine =" |
447 | 0 | " \002,f12.6,/5x,\002Total time in basic Arnoldi iteration loop = " |
448 | 0 | "\002,f12.6,/5x,\002Total time in reorthogonalization phase =" |
449 | 0 | " \002,f12.6,/5x,\002Total time in (re)start vector generation = " |
450 | 0 | "\002,f12.6,/5x,\002Total time in Hessenberg eig. subproblem =" |
451 | 0 | " \002,f12.6,/5x,\002Total time in getting the shifts = " |
452 | 0 | "\002,f12.6,/5x,\002Total time in applying the shifts =" |
453 | 0 | " \002,f12.6,/5x,\002Total time in convergence testing = " |
454 | 0 | "\002,f12.6,/5x,\002Total time in computing final Ritz vectors =" |
455 | 0 | " \002,f12.6/)"; |
456 | | |
457 | | /* System generated locals */ |
458 | 0 | integer v_dim1, v_offset, i__1, i__2; |
459 | | |
460 | | /* Builtin functions */ |
461 | 0 | integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsfe(cilist *), e_wsfe( |
462 | 0 | void), do_fio(integer *, char *, ftnlen); |
463 | | |
464 | | /* Local variables */ |
465 | 0 | integer j; |
466 | 0 | IGRAPH_F77_SAVE real t0, t1; |
467 | 0 | IGRAPH_F77_SAVE integer nb, ih, iq, np, iw, ldh, ldq; |
468 | 0 | integer nbx = 0; |
469 | 0 | IGRAPH_F77_SAVE integer nev0, mode; |
470 | 0 | integer ierr; |
471 | 0 | IGRAPH_F77_SAVE integer iupd, next; |
472 | 0 | integer nopx = 0; |
473 | 0 | IGRAPH_F77_SAVE integer levec; |
474 | 0 | real trvec, tmvbx; |
475 | 0 | IGRAPH_F77_SAVE integer ritzi; |
476 | 0 | extern /* Subroutine */ int igraphdvout_(integer *, integer *, doublereal *, |
477 | 0 | integer *, char *, ftnlen), igraphivout_(integer *, integer *, integer * |
478 | 0 | , integer *, char *, ftnlen); |
479 | 0 | IGRAPH_F77_SAVE integer ritzr; |
480 | 0 | extern /* Subroutine */ int igraphdnaup2_(integer *, char *, integer *, char *, |
481 | 0 | integer *, integer *, doublereal *, doublereal *, integer *, |
482 | 0 | integer *, integer *, integer *, doublereal *, integer *, |
483 | 0 | doublereal *, integer *, doublereal *, doublereal *, doublereal *, |
484 | 0 | doublereal *, integer *, doublereal *, integer *, doublereal *, |
485 | 0 | integer *); |
486 | 0 | real tnaup2, tgetv0; |
487 | 0 | extern doublereal igraphdlamch_(char *); |
488 | 0 | extern /* Subroutine */ int igraphsecond_(real *); |
489 | 0 | integer logfil, ndigit; |
490 | 0 | real tneigh; |
491 | 0 | integer mnaupd = 0; |
492 | 0 | IGRAPH_F77_SAVE integer ishift; |
493 | 0 | integer nitref; |
494 | 0 | IGRAPH_F77_SAVE integer bounds; |
495 | 0 | real tnaupd; |
496 | 0 | extern /* Subroutine */ int igraphdstatn_(void); |
497 | 0 | real titref, tnaitr; |
498 | 0 | IGRAPH_F77_SAVE integer msglvl; |
499 | 0 | real tngets, tnapps, tnconv; |
500 | 0 | IGRAPH_F77_SAVE integer mxiter; |
501 | 0 | integer nrorth = 0, nrstrt = 0; |
502 | 0 | real tmvopx; |
503 | | |
504 | | /* Fortran I/O blocks */ |
505 | 0 | static cilist io___30 = { 0, 6, 0, fmt_1000, 0 }; |
506 | 0 | static cilist io___31 = { 0, 6, 0, fmt_1100, 0 }; |
507 | | |
508 | | |
509 | | |
510 | | /* %----------------------------------------------------% |
511 | | | Include files for debugging and timing information | |
512 | | %----------------------------------------------------% |
513 | | |
514 | | |
515 | | %------------------% |
516 | | | Scalar Arguments | |
517 | | %------------------% |
518 | | |
519 | | |
520 | | %-----------------% |
521 | | | Array Arguments | |
522 | | %-----------------% |
523 | | |
524 | | |
525 | | %------------% |
526 | | | Parameters | |
527 | | %------------% |
528 | | |
529 | | |
530 | | %---------------% |
531 | | | Local Scalars | |
532 | | %---------------% |
533 | | |
534 | | |
535 | | %----------------------% |
536 | | | External Subroutines | |
537 | | %----------------------% |
538 | | |
539 | | |
540 | | %--------------------% |
541 | | | External Functions | |
542 | | %--------------------% |
543 | | |
544 | | |
545 | | %-----------------------% |
546 | | | Executable Statements | |
547 | | %-----------------------% |
548 | | |
549 | | Parameter adjustments */ |
550 | 0 | --workd; |
551 | 0 | --resid; |
552 | 0 | v_dim1 = *ldv; |
553 | 0 | v_offset = 1 + v_dim1; |
554 | 0 | v -= v_offset; |
555 | 0 | --iparam; |
556 | 0 | --ipntr; |
557 | 0 | --workl; |
558 | | |
559 | | /* Function Body */ |
560 | 0 | if (*ido == 0) { |
561 | | |
562 | | /* %-------------------------------% |
563 | | | Initialize timing statistics | |
564 | | | & message level for debugging | |
565 | | %-------------------------------% */ |
566 | |
|
567 | 0 | igraphdstatn_(); |
568 | 0 | igraphsecond_(&t0); |
569 | 0 | msglvl = mnaupd; |
570 | | |
571 | | /* %----------------% |
572 | | | Error checking | |
573 | | %----------------% */ |
574 | |
|
575 | 0 | ierr = 0; |
576 | 0 | ishift = iparam[1]; |
577 | 0 | levec = iparam[2]; |
578 | 0 | mxiter = iparam[3]; |
579 | 0 | nb = iparam[4]; |
580 | | |
581 | | /* %--------------------------------------------% |
582 | | | Revision 2 performs only implicit restart. | |
583 | | %--------------------------------------------% */ |
584 | |
|
585 | 0 | iupd = 1; |
586 | 0 | mode = iparam[7]; |
587 | |
|
588 | 0 | if (*n <= 0) { |
589 | 0 | ierr = -1; |
590 | 0 | } else if (*nev <= 0) { |
591 | 0 | ierr = -2; |
592 | 0 | } else if (*ncv <= *nev + 1 || *ncv > *n) { |
593 | 0 | ierr = -3; |
594 | 0 | } else if (mxiter <= 0) { |
595 | 0 | ierr = -4; |
596 | 0 | } else if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) != 0 && s_cmp( |
597 | 0 | which, "SM", (ftnlen)2, (ftnlen)2) != 0 && s_cmp(which, "LR", |
598 | 0 | (ftnlen)2, (ftnlen)2) != 0 && s_cmp(which, "SR", (ftnlen)2, ( |
599 | 0 | ftnlen)2) != 0 && s_cmp(which, "LI", (ftnlen)2, (ftnlen)2) != |
600 | 0 | 0 && s_cmp(which, "SI", (ftnlen)2, (ftnlen)2) != 0) { |
601 | 0 | ierr = -5; |
602 | 0 | } else if (*(unsigned char *)bmat != 'I' && *(unsigned char *)bmat != |
603 | 0 | 'G') { |
604 | 0 | ierr = -6; |
605 | 0 | } else /* if(complicated condition) */ { |
606 | | /* Computing 2nd power */ |
607 | 0 | i__1 = *ncv; |
608 | 0 | if (*lworkl < i__1 * i__1 * 3 + *ncv * 6) { |
609 | 0 | ierr = -7; |
610 | 0 | } else if (mode < 1 || mode > 5) { |
611 | 0 | ierr = -10; |
612 | 0 | } else if (mode == 1 && *(unsigned char *)bmat == 'G') { |
613 | 0 | ierr = -11; |
614 | 0 | } else if (ishift < 0 || ishift > 1) { |
615 | 0 | ierr = -12; |
616 | 0 | } |
617 | 0 | } |
618 | | |
619 | | /* %------------% |
620 | | | Error Exit | |
621 | | %------------% */ |
622 | |
|
623 | 0 | if (ierr != 0) { |
624 | 0 | *info = ierr; |
625 | 0 | *ido = 99; |
626 | 0 | goto L9000; |
627 | 0 | } |
628 | | |
629 | | /* %------------------------% |
630 | | | Set default parameters | |
631 | | %------------------------% */ |
632 | | |
633 | 0 | if (nb <= 0) { |
634 | 0 | nb = 1; |
635 | 0 | } |
636 | 0 | if (*tol <= 0.) { |
637 | 0 | *tol = igraphdlamch_("EpsMach"); |
638 | 0 | } |
639 | | |
640 | | /* %----------------------------------------------% |
641 | | | NP is the number of additional steps to | |
642 | | | extend the length NEV Lanczos factorization. | |
643 | | | NEV0 is the local variable designating the | |
644 | | | size of the invariant subspace desired. | |
645 | | %----------------------------------------------% */ |
646 | |
|
647 | 0 | np = *ncv - *nev; |
648 | 0 | nev0 = *nev; |
649 | | |
650 | | /* %-----------------------------% |
651 | | | Zero out internal workspace | |
652 | | %-----------------------------% |
653 | | |
654 | | Computing 2nd power */ |
655 | 0 | i__2 = *ncv; |
656 | 0 | i__1 = i__2 * i__2 * 3 + *ncv * 6; |
657 | 0 | for (j = 1; j <= i__1; ++j) { |
658 | 0 | workl[j] = 0.; |
659 | | /* L10: */ |
660 | 0 | } |
661 | | |
662 | | /* %-------------------------------------------------------------% |
663 | | | Pointer into WORKL for address of H, RITZ, BOUNDS, Q | |
664 | | | etc... and the remaining workspace. | |
665 | | | Also update pointer to be used on output. | |
666 | | | Memory is laid out as follows: | |
667 | | | workl(1:ncv*ncv) := generated Hessenberg matrix | |
668 | | | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary | |
669 | | | parts of ritz values | |
670 | | | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds | |
671 | | | workl(ncv*ncv+3*ncv+1:2*ncv*ncv+3*ncv) := rotation matrix Q | |
672 | | | workl(2*ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) := workspace | |
673 | | | The final workspace is needed by subroutine dneigh called | |
674 | | | by dnaup2. Subroutine dneigh calls LAPACK routines for | |
675 | | | calculating eigenvalues and the last row of the eigenvector | |
676 | | | matrix. | |
677 | | %-------------------------------------------------------------% */ |
678 | |
|
679 | 0 | ldh = *ncv; |
680 | 0 | ldq = *ncv; |
681 | 0 | ih = 1; |
682 | 0 | ritzr = ih + ldh * *ncv; |
683 | 0 | ritzi = ritzr + *ncv; |
684 | 0 | bounds = ritzi + *ncv; |
685 | 0 | iq = bounds + *ncv; |
686 | 0 | iw = iq + ldq * *ncv; |
687 | | /* Computing 2nd power */ |
688 | 0 | i__1 = *ncv; |
689 | 0 | next = iw + i__1 * i__1 + *ncv * 3; |
690 | |
|
691 | 0 | ipntr[4] = next; |
692 | 0 | ipntr[5] = ih; |
693 | 0 | ipntr[6] = ritzr; |
694 | 0 | ipntr[7] = ritzi; |
695 | 0 | ipntr[8] = bounds; |
696 | 0 | ipntr[14] = iw; |
697 | |
|
698 | 0 | } |
699 | | |
700 | | /* %-------------------------------------------------------% |
701 | | | Carry out the Implicitly restarted Arnoldi Iteration. | |
702 | | %-------------------------------------------------------% */ |
703 | | |
704 | 0 | igraphdnaup2_(ido, bmat, n, which, &nev0, &np, tol, &resid[1], &mode, &iupd, & |
705 | 0 | ishift, &mxiter, &v[v_offset], ldv, &workl[ih], &ldh, &workl[ |
706 | 0 | ritzr], &workl[ritzi], &workl[bounds], &workl[iq], &ldq, &workl[ |
707 | 0 | iw], &ipntr[1], &workd[1], info); |
708 | | |
709 | | /* %--------------------------------------------------% |
710 | | | ido .ne. 99 implies use of reverse communication | |
711 | | | to compute operations involving OP or shifts. | |
712 | | %--------------------------------------------------% */ |
713 | |
|
714 | 0 | if (*ido == 3) { |
715 | 0 | iparam[8] = np; |
716 | 0 | } |
717 | 0 | if (*ido != 99) { |
718 | 0 | goto L9000; |
719 | 0 | } |
720 | | |
721 | 0 | iparam[3] = mxiter; |
722 | 0 | iparam[5] = np; |
723 | 0 | iparam[9] = nopx; |
724 | 0 | iparam[10] = nbx; |
725 | 0 | iparam[11] = nrorth; |
726 | | |
727 | | /* %------------------------------------% |
728 | | | Exit if there was an informational | |
729 | | | error within dnaup2. | |
730 | | %------------------------------------% */ |
731 | |
|
732 | 0 | if (*info < 0) { |
733 | 0 | goto L9000; |
734 | 0 | } |
735 | 0 | if (*info == 2) { |
736 | 0 | *info = 3; |
737 | 0 | } |
738 | |
|
739 | 0 | if (msglvl > 0) { |
740 | 0 | igraphivout_(&logfil, &c__1, &mxiter, &ndigit, "_naupd: Number of update i" |
741 | 0 | "terations taken", (ftnlen)41); |
742 | 0 | igraphivout_(&logfil, &c__1, &np, &ndigit, "_naupd: Number of wanted \"con" |
743 | 0 | "verged\" Ritz values", (ftnlen)48); |
744 | 0 | igraphdvout_(&logfil, &np, &workl[ritzr], &ndigit, "_naupd: Real part of t" |
745 | 0 | "he final Ritz values", (ftnlen)42); |
746 | 0 | igraphdvout_(&logfil, &np, &workl[ritzi], &ndigit, "_naupd: Imaginary part" |
747 | 0 | " of the final Ritz values", (ftnlen)47); |
748 | 0 | igraphdvout_(&logfil, &np, &workl[bounds], &ndigit, "_naupd: Associated Ri" |
749 | 0 | "tz estimates", (ftnlen)33); |
750 | 0 | } |
751 | |
|
752 | 0 | igraphsecond_(&t1); |
753 | 0 | tnaupd = t1 - t0; |
754 | |
|
755 | 0 | if (msglvl > 0) { |
756 | | |
757 | | /* %--------------------------------------------------------% |
758 | | | Version Number & Version Date are defined in version.h | |
759 | | %--------------------------------------------------------% */ |
760 | |
|
761 | 0 | s_wsfe(&io___30); |
762 | 0 | e_wsfe(); |
763 | 0 | s_wsfe(&io___31); |
764 | 0 | do_fio(&c__1, (char *)&mxiter, (ftnlen)sizeof(integer)); |
765 | 0 | do_fio(&c__1, (char *)&nopx, (ftnlen)sizeof(integer)); |
766 | 0 | do_fio(&c__1, (char *)&nbx, (ftnlen)sizeof(integer)); |
767 | 0 | do_fio(&c__1, (char *)&nrorth, (ftnlen)sizeof(integer)); |
768 | 0 | do_fio(&c__1, (char *)&nitref, (ftnlen)sizeof(integer)); |
769 | 0 | do_fio(&c__1, (char *)&nrstrt, (ftnlen)sizeof(integer)); |
770 | 0 | do_fio(&c__1, (char *)&tmvopx, (ftnlen)sizeof(real)); |
771 | 0 | do_fio(&c__1, (char *)&tmvbx, (ftnlen)sizeof(real)); |
772 | 0 | do_fio(&c__1, (char *)&tnaupd, (ftnlen)sizeof(real)); |
773 | 0 | do_fio(&c__1, (char *)&tnaup2, (ftnlen)sizeof(real)); |
774 | 0 | do_fio(&c__1, (char *)&tnaitr, (ftnlen)sizeof(real)); |
775 | 0 | do_fio(&c__1, (char *)&titref, (ftnlen)sizeof(real)); |
776 | 0 | do_fio(&c__1, (char *)&tgetv0, (ftnlen)sizeof(real)); |
777 | 0 | do_fio(&c__1, (char *)&tneigh, (ftnlen)sizeof(real)); |
778 | 0 | do_fio(&c__1, (char *)&tngets, (ftnlen)sizeof(real)); |
779 | 0 | do_fio(&c__1, (char *)&tnapps, (ftnlen)sizeof(real)); |
780 | 0 | do_fio(&c__1, (char *)&tnconv, (ftnlen)sizeof(real)); |
781 | 0 | do_fio(&c__1, (char *)&trvec, (ftnlen)sizeof(real)); |
782 | 0 | e_wsfe(); |
783 | 0 | } |
784 | |
|
785 | 0 | L9000: |
786 | |
|
787 | 0 | return 0; |
788 | | |
789 | | /* %---------------% |
790 | | | End of dnaupd | |
791 | | %---------------% */ |
792 | |
|
793 | 0 | } /* igraphdnaupd_ */ |
794 | | |