Coverage Report

Created: 2023-09-25 06:04

/src/igraph/vendor/lapack/dsgets.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 logical c_true = TRUE_;
18
static integer c__1 = 1;
19
20
/* -----------------------------------------------------------------------   
21
   \BeginDoc   
22
23
   \Name: dsgets   
24
25
   \Description:   
26
    Given the eigenvalues of the symmetric tridiagonal matrix H,   
27
    computes the NP shifts AMU that are zeros of the polynomial of   
28
    degree NP which filters out components of the unwanted eigenvectors   
29
    corresponding to the AMU's based on some given criteria.   
30
31
    NOTE: This is called even in the case of user specified shifts in   
32
    order to sort the eigenvalues, and error bounds of H for later use.   
33
34
   \Usage:   
35
    call dsgets   
36
       ( ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS, SHIFTS )   
37
38
   \Arguments   
39
    ISHIFT  Integer.  (INPUT)   
40
            Method for selecting the implicit shifts at each iteration.   
41
            ISHIFT = 0: user specified shifts   
42
            ISHIFT = 1: exact shift with respect to the matrix H.   
43
44
    WHICH   Character*2.  (INPUT)   
45
            Shift selection criteria.   
46
            'LM' -> KEV eigenvalues of largest magnitude are retained.   
47
            'SM' -> KEV eigenvalues of smallest magnitude are retained.   
48
            'LA' -> KEV eigenvalues of largest value are retained.   
49
            'SA' -> KEV eigenvalues of smallest value are retained.   
50
            'BE' -> KEV eigenvalues, half from each end of the spectrum.   
51
                    If KEV is odd, compute one more from the high end.   
52
53
    KEV      Integer.  (INPUT)   
54
            KEV+NP is the size of the matrix H.   
55
56
    NP      Integer.  (INPUT)   
57
            Number of implicit shifts to be computed.   
58
59
    RITZ    Double precision array of length KEV+NP.  (INPUT/OUTPUT)   
60
            On INPUT, RITZ contains the eigenvalues of H.   
61
            On OUTPUT, RITZ are sorted so that the unwanted eigenvalues   
62
            are in the first NP locations and the wanted part is in   
63
            the last KEV locations.  When exact shifts are selected, the   
64
            unwanted part corresponds to the shifts to be applied.   
65
66
    BOUNDS  Double precision array of length KEV+NP.  (INPUT/OUTPUT)   
67
            Error bounds corresponding to the ordering in RITZ.   
68
69
    SHIFTS  Double precision array of length NP.  (INPUT/OUTPUT)   
70
            On INPUT:  contains the user specified shifts if ISHIFT = 0.   
71
            On OUTPUT: contains the shifts sorted into decreasing order   
72
            of magnitude with respect to the Ritz estimates contained in   
73
            BOUNDS. If ISHIFT = 0, SHIFTS is not modified on exit.   
74
75
   \EndDoc   
76
77
   -----------------------------------------------------------------------   
78
79
   \BeginLib   
80
81
   \Local variables:   
82
       xxxxxx  real   
83
84
   \Routines called:   
85
       dsortr  ARPACK utility sorting routine.   
86
       ivout   ARPACK utility routine that prints integers.   
87
       second  ARPACK utility routine for timing.   
88
       dvout   ARPACK utility routine that prints vectors.   
89
       dcopy   Level 1 BLAS that copies one vector to another.   
90
       dswap   Level 1 BLAS that swaps the contents of two vectors.   
91
92
   \Author   
93
       Danny Sorensen               Phuong Vu   
94
       Richard Lehoucq              CRPC / Rice University   
95
       Dept. of Computational &     Houston, Texas   
96
       Applied Mathematics   
97
       Rice University   
98
       Houston, Texas   
99
100
   \Revision history:   
101
       xx/xx/93: Version ' 2.1'   
102
103
   \SCCS Information: @(#)   
104
   FILE: sgets.F   SID: 2.4   DATE OF SID: 4/19/96   RELEASE: 2   
105
106
   \Remarks   
107
108
   \EndLib   
109
110
   -----------------------------------------------------------------------   
111
112
   Subroutine */ int igraphdsgets_(integer *ishift, char *which, integer *kev, 
113
  integer *np, doublereal *ritz, doublereal *bounds, doublereal *shifts)
114
0
{
115
    /* System generated locals */
116
0
    integer i__1;
117
118
    /* Builtin functions */
119
0
    integer s_cmp(char *, char *, ftnlen, ftnlen);
120
121
    /* Local variables */
122
0
    IGRAPH_F77_SAVE real t0, t1;
123
0
    integer kevd2;
124
0
    extern /* Subroutine */ int igraphdswap_(integer *, doublereal *, integer *, 
125
0
      doublereal *, integer *), igraphdcopy_(integer *, doublereal *, integer 
126
0
      *, doublereal *, integer *), igraphdvout_(integer *, integer *, 
127
0
      doublereal *, integer *, char *, ftnlen), igraphivout_(integer *, 
128
0
      integer *, integer *, integer *, char *, ftnlen), igraphsecond_(real *);
129
0
    integer logfil, ndigit, msgets = 0, msglvl;
130
0
    real tsgets = 0.0;
131
0
    extern /* Subroutine */ int igraphdsortr_(char *, logical *, integer *, 
132
0
      doublereal *, doublereal *);
133
134
135
/*     %----------------------------------------------------%   
136
       | Include files for debugging and timing information |   
137
       %----------------------------------------------------%   
138
139
140
       %------------------%   
141
       | Scalar Arguments |   
142
       %------------------%   
143
144
145
       %-----------------%   
146
       | Array Arguments |   
147
       %-----------------%   
148
149
150
       %------------%   
151
       | Parameters |   
152
       %------------%   
153
154
155
       %---------------%   
156
       | Local Scalars |   
157
       %---------------%   
158
159
160
       %----------------------%   
161
       | External Subroutines |   
162
       %----------------------%   
163
164
165
       %---------------------%   
166
       | Intrinsic Functions |   
167
       %---------------------%   
168
169
170
       %-----------------------%   
171
       | Executable Statements |   
172
       %-----------------------%   
173
174
       %-------------------------------%   
175
       | Initialize timing statistics  |   
176
       | & message level for debugging |   
177
       %-------------------------------%   
178
179
       Parameter adjustments */
180
0
    --shifts;
181
0
    --bounds;
182
0
    --ritz;
183
184
    /* Function Body */
185
0
    igraphsecond_(&t0);
186
0
    msglvl = msgets;
187
188
0
    if (s_cmp(which, "BE", (ftnlen)2, (ftnlen)2) == 0) {
189
190
/*        %-----------------------------------------------------%   
191
          | Both ends of the spectrum are requested.            |   
192
          | Sort the eigenvalues into algebraically increasing  |   
193
          | order first then swap high end of the spectrum next |   
194
          | to low end in appropriate locations.                |   
195
          | NOTE: when np < floor(kev/2) be careful not to swap |   
196
          | overlapping locations.                              |   
197
          %-----------------------------------------------------% */
198
199
0
  i__1 = *kev + *np;
200
0
  igraphdsortr_("LA", &c_true, &i__1, &ritz[1], &bounds[1]);
201
0
  kevd2 = *kev / 2;
202
0
  if (*kev > 1) {
203
0
      i__1 = min(kevd2,*np);
204
0
      igraphdswap_(&i__1, &ritz[1], &c__1, &ritz[max(kevd2,*np) + 1], &c__1);
205
0
      i__1 = min(kevd2,*np);
206
0
      igraphdswap_(&i__1, &bounds[1], &c__1, &bounds[max(kevd2,*np) + 1], &
207
0
        c__1);
208
0
  }
209
210
0
    } else {
211
212
/*        %----------------------------------------------------%   
213
          | LM, SM, LA, SA case.                               |   
214
          | Sort the eigenvalues of H into the desired order   |   
215
          | and apply the resulting order to BOUNDS.           |   
216
          | The eigenvalues are sorted so that the wanted part |   
217
          | are always in the last KEV locations.               |   
218
          %----------------------------------------------------% */
219
220
0
  i__1 = *kev + *np;
221
0
  igraphdsortr_(which, &c_true, &i__1, &ritz[1], &bounds[1]);
222
0
    }
223
224
0
    if (*ishift == 1 && *np > 0) {
225
226
/*        %-------------------------------------------------------%   
227
          | Sort the unwanted Ritz values used as shifts so that  |   
228
          | the ones with largest Ritz estimates are first.       |   
229
          | This will tend to minimize the effects of the         |   
230
          | forward instability of the iteration when the shifts  |   
231
          | are applied in subroutine dsapps.                     |   
232
          %-------------------------------------------------------% */
233
234
0
  igraphdsortr_("SM", &c_true, np, &bounds[1], &ritz[1]);
235
0
  igraphdcopy_(np, &ritz[1], &c__1, &shifts[1], &c__1);
236
0
    }
237
238
0
    igraphsecond_(&t1);
239
0
    tsgets += t1 - t0;
240
241
0
    if (msglvl > 0) {
242
0
  igraphivout_(&logfil, &c__1, kev, &ndigit, "_sgets: KEV is", (ftnlen)14);
243
0
  igraphivout_(&logfil, &c__1, np, &ndigit, "_sgets: NP is", (ftnlen)13);
244
0
  i__1 = *kev + *np;
245
0
  igraphdvout_(&logfil, &i__1, &ritz[1], &ndigit, "_sgets: Eigenvalues of cu"
246
0
    "rrent H matrix", (ftnlen)39);
247
0
  i__1 = *kev + *np;
248
0
  igraphdvout_(&logfil, &i__1, &bounds[1], &ndigit, "_sgets: Associated Ritz"
249
0
    " estimates", (ftnlen)33);
250
0
    }
251
252
0
    return 0;
253
254
/*     %---------------%   
255
       | End of dsgets |   
256
       %---------------% */
257
258
0
} /* igraphdsgets_ */
259