Coverage Report

Created: 2023-09-25 06:04

/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