1 /* ./src_f77/zngets.f -- translated by f2c (version 20030320).
2 You must link the resulting object file with the libraries:
3 -lf2c -lm (in that order)
4 */
5
6 #include <punc/vf2c.h>
7
8 /* Common Block Declarations */
9
10 struct {
11 integer logfil, ndigit, mgetv0, msaupd, msaup2, msaitr, mseigt, msapps,
12 msgets, mseupd, mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets,
13 mneupd, mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd;
14 } debug_ZNGETS;
15
16 #define debug_1 debug_ZNGETS
17
18 struct {
19 integer nopx, nbx, nrorth, nitref, nrstrt;
20 real tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv, tnaupd,
21 tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv, tcaupd, tcaup2,
22 tcaitr, tceigh, tcgets, tcapps, tcconv, tmvopx, tmvbx, tgetv0,
23 titref, trvec;
24 } timing_ZNGETS;
25
26 #define timing_1 timing_ZNGETS
27
28 /* Table of constant values */
29
30 static logical c_true = TRUE_;
31 static integer c__1 = 1;
32
33 /* \BeginDoc */
34
35 /* \Name: zngets */
36
37 /* \Description: */
38 /* Given the eigenvalues of the upper Hessenberg matrix H, */
39 /* computes the NP shifts AMU that are zeros of the polynomial of */
40 /* degree NP which filters out components of the unwanted eigenvectors */
41 /* corresponding to the AMU's based on some given criteria. */
42
43 /* NOTE: call this even in the case of user specified shifts in order */
44 /* to sort the eigenvalues, and error bounds of H for later use. */
45
46 /* \Usage: */
47 /* call zngets */
48 /* ( ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS ) */
49
50 /* \Arguments */
51 /* ISHIFT Integer. (INPUT) */
52 /* Method for selecting the implicit shifts at each iteration. */
53 /* ISHIFT = 0: user specified shifts */
54 /* ISHIFT = 1: exact shift with respect to the matrix H. */
55
56 /* WHICH Character*2. (INPUT) */
57 /* Shift selection criteria. */
58 /* 'LM' -> want the KEV eigenvalues of largest magnitude. */
59 /* 'SM' -> want the KEV eigenvalues of smallest magnitude. */
60 /* 'LR' -> want the KEV eigenvalues of largest REAL part. */
61 /* 'SR' -> want the KEV eigenvalues of smallest REAL part. */
62 /* 'LI' -> want the KEV eigenvalues of largest imaginary part. */
63 /* 'SI' -> want the KEV eigenvalues of smallest imaginary part. */
64
65 /* KEV Integer. (INPUT) */
66 /* The number of desired eigenvalues. */
67
68 /* NP Integer. (INPUT) */
69 /* The number of shifts to compute. */
70
71 /* RITZ Complex*16 array of length KEV+NP. (INPUT/OUTPUT) */
72 /* On INPUT, RITZ contains the the eigenvalues of H. */
73 /* On OUTPUT, RITZ are sorted so that the unwanted */
74 /* eigenvalues are in the first NP locations and the wanted */
75 /* portion is in the last KEV locations. When exact shifts are */
76 /* selected, the unwanted part corresponds to the shifts to */
77 /* be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues */
78 /* are further sorted so that the ones with largest Ritz values */
79 /* are first. */
80
81 /* BOUNDS Complex*16 array of length KEV+NP. (INPUT/OUTPUT) */
82 /* Error bounds corresponding to the ordering in RITZ. */
83
84
85
86 /* \EndDoc */
87
88 /* ----------------------------------------------------------------------- */
89
90 /* \BeginLib */
91
92 /* \Local variables: */
93 /* xxxxxx Complex*16 */
94
95 /* \Routines called: */
96 /* zsortc ARPACK sorting routine. */
97 /* ivout ARPACK utility routine that prints integers. */
98 /* second ARPACK utility routine for timing. */
99 /* zvout ARPACK utility routine that prints vectors. */
100
101 /* \Author */
102 /* Danny Sorensen Phuong Vu */
103 /* Richard Lehoucq CRPC / Rice University */
104 /* Dept. of Computational & Houston, Texas */
105 /* Applied Mathematics */
106 /* Rice University */
107 /* Houston, Texas */
108
109 /* \SCCS Information: @(#) */
110 /* FILE: ngets.F SID: 2.2 DATE OF SID: 4/20/96 RELEASE: 2 */
111
112 /* \Remarks */
113 /* 1. This routine does not keep complex conjugate pairs of */
114 /* eigenvalues together. */
115
116 /* \EndLib */
117
118 /* ----------------------------------------------------------------------- */
119
zngets_(integer * ishift,char * which,integer * kev,integer * np,doublecomplex * ritz,doublecomplex * bounds,ftnlen which_len)120 /* Subroutine */ int zngets_(integer *ishift, char *which, integer *kev,
121 integer *np, doublecomplex *ritz, doublecomplex *bounds, ftnlen
122 which_len)
123 {
124 /* System generated locals */
125 integer i__1;
126
127 /* Local variables */
128 static real t0, t1;
129 extern /* Subroutine */ int ivout_(integer *, integer *, integer *,
130 integer *, char *, ftnlen), zvout_(integer *, integer *,
131 doublecomplex *, integer *, char *, ftnlen), second_(real *);
132 static integer msglvl;
133 extern /* Subroutine */ int zsortc_(char *, logical *, integer *,
134 doublecomplex *, doublecomplex *, ftnlen);
135
136
137 /* %----------------------------------------------------% */
138 /* | Include files for debugging and timing information | */
139 /* %----------------------------------------------------% */
140
141
142 /* \SCCS Information: @(#) */
143 /* FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2 */
144
145 /* %---------------------------------% */
146 /* | See debug.doc for documentation | */
147 /* %---------------------------------% */
148
149 /* %------------------% */
150 /* | Scalar Arguments | */
151 /* %------------------% */
152
153 /* %--------------------------------% */
154 /* | See stat.doc for documentation | */
155 /* %--------------------------------% */
156
157 /* \SCCS Information: @(#) */
158 /* FILE: stat.h SID: 2.2 DATE OF SID: 11/16/95 RELEASE: 2 */
159
160
161
162 /* %-----------------% */
163 /* | Array Arguments | */
164 /* %-----------------% */
165
166
167 /* %------------% */
168 /* | Parameters | */
169 /* %------------% */
170
171
172 /* %---------------% */
173 /* | Local Scalars | */
174 /* %---------------% */
175
176
177 /* %----------------------% */
178 /* | External Subroutines | */
179 /* %----------------------% */
180
181
182 /* %-----------------------% */
183 /* | Executable Statements | */
184 /* %-----------------------% */
185
186 /* %-------------------------------% */
187 /* | Initialize timing statistics | */
188 /* | & message level for debugging | */
189 /* %-------------------------------% */
190
191 /* Parameter adjustments */
192 --bounds;
193 --ritz;
194
195 /* Function Body */
196 second_(&t0);
197 msglvl = debug_1.mcgets;
198
199 i__1 = *kev + *np;
200 zsortc_(which, &c_true, &i__1, &ritz[1], &bounds[1], (ftnlen)2);
201
202 if (*ishift == 1) {
203
204 /* %-------------------------------------------------------% */
205 /* | Sort the unwanted Ritz values used as shifts so that | */
206 /* | the ones with largest Ritz estimates are first | */
207 /* | This will tend to minimize the effects of the | */
208 /* | forward instability of the iteration when the shifts | */
209 /* | are applied in subroutine znapps. | */
210 /* | Be careful and use 'SM' since we want to sort BOUNDS! | */
211 /* %-------------------------------------------------------% */
212
213 zsortc_("SM", &c_true, np, &bounds[1], &ritz[1], (ftnlen)2);
214
215 }
216
217 second_(&t1);
218 timing_1.tcgets += t1 - t0;
219
220 if (msglvl > 0) {
221 ivout_(&debug_1.logfil, &c__1, kev, &debug_1.ndigit, "_ngets: KEV is",
222 (ftnlen)14);
223 ivout_(&debug_1.logfil, &c__1, np, &debug_1.ndigit, "_ngets: NP is", (
224 ftnlen)13);
225 i__1 = *kev + *np;
226 zvout_(&debug_1.logfil, &i__1, &ritz[1], &debug_1.ndigit, "_ngets: E"
227 "igenvalues of current H matrix ", (ftnlen)40);
228 i__1 = *kev + *np;
229 zvout_(&debug_1.logfil, &i__1, &bounds[1], &debug_1.ndigit, "_ngets:"
230 " Ritz estimates of the current KEV+NP Ritz values", (ftnlen)
231 56);
232 }
233
234 return 0;
235
236 /* %---------------% */
237 /* | End of zngets | */
238 /* %---------------% */
239
240 } /* zngets_ */
241
242