/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 | | |