Line data Source code
1 : /*
2 : - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3 : SLEPc - Scalable Library for Eigenvalue Problem Computations
4 : Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain
5 :
6 : This file is part of SLEPc.
7 : SLEPc is distributed under a 2-clause BSD license (see LICENSE).
8 : - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
9 : */
10 :
11 : #include <slepc/private/slepcimpl.h> /*I "slepcsys.h" I*/
12 : #include <slepcrg.h>
13 : #include <slepcst.h>
14 :
15 : /*@
16 : SlepcSCCompare - Compares two (possibly complex) values according
17 : to a certain criterion.
18 :
19 : Not Collective
20 :
21 : Input Parameters:
22 : + sc - the sorting criterion context
23 : . ar - real part of the 1st value
24 : . ai - imaginary part of the 1st value
25 : . br - real part of the 2nd value
26 : - bi - imaginary part of the 2nd value
27 :
28 : Output Parameter:
29 : . res - result of comparison
30 :
31 : Notes:
32 : Returns an integer less than, equal to, or greater than zero if the first
33 : value is considered to be respectively less than, equal to, or greater
34 : than the second one.
35 :
36 : Level: developer
37 :
38 : .seealso: SlepcSortEigenvalues(), SlepcSC
39 : @*/
40 1993619 : PetscErrorCode SlepcSCCompare(SlepcSC sc,PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *res)
41 : {
42 1993619 : PetscScalar re[2],im[2];
43 1993619 : PetscInt cin[2];
44 1993619 : PetscBool inside[2];
45 :
46 1993619 : PetscFunctionBegin;
47 1993619 : PetscAssertPointer(res,6);
48 : #if defined(PETSC_USE_DEBUG)
49 1993619 : PetscCheck(sc->comparison,PETSC_COMM_SELF,PETSC_ERR_USER,"Undefined comparison function");
50 : #endif
51 1993619 : re[0] = ar; re[1] = br;
52 1993619 : im[0] = ai; im[1] = bi;
53 1993619 : if (sc->map) PetscCall((*sc->map)(sc->mapobj,2,re,im));
54 1993619 : if (sc->rg) {
55 113565 : PetscCall(RGCheckInside(sc->rg,2,re,im,cin));
56 113565 : inside[0] = PetscNot(cin[0]<0);
57 113565 : inside[1] = PetscNot(cin[1]<0);
58 113565 : if (inside[0] && !inside[1]) *res = -1;
59 101231 : else if (!inside[0] && inside[1]) *res = 1;
60 99822 : else PetscCall((*sc->comparison)(re[0],im[0],re[1],im[1],res,sc->comparisonctx));
61 1880054 : } else PetscCall((*sc->comparison)(re[0],im[0],re[1],im[1],res,sc->comparisonctx));
62 1993619 : PetscFunctionReturn(PETSC_SUCCESS);
63 : }
64 :
65 : /*@
66 : SlepcSortEigenvalues - Sorts a list of eigenvalues according to the
67 : sorting criterion specified in a SlepcSC context.
68 :
69 : Not Collective
70 :
71 : Input Parameters:
72 : + sc - the sorting criterion context
73 : . n - number of eigenvalues in the list
74 : . eigr - pointer to the array containing the eigenvalues
75 : - eigi - imaginary part of the eigenvalues (only when using real numbers)
76 :
77 : Output Parameter:
78 : . perm - permutation array. Must be initialized to 0:n-1 on input.
79 :
80 : Note:
81 : The result is a list of indices in the original eigenvalue array
82 : corresponding to the first n eigenvalues sorted in the specified
83 : criterion.
84 :
85 : Level: developer
86 :
87 : .seealso: SlepcSCCompare(), SlepcSC
88 : @*/
89 1178 : PetscErrorCode SlepcSortEigenvalues(SlepcSC sc,PetscInt n,PetscScalar *eigr,PetscScalar *eigi,PetscInt *perm)
90 : {
91 1178 : PetscScalar re,im;
92 1178 : PetscInt i,j,result,tmp;
93 :
94 1178 : PetscFunctionBegin;
95 1178 : PetscAssertPointer(sc,1);
96 1178 : PetscAssertPointer(eigr,3);
97 1178 : PetscAssertPointer(eigi,4);
98 1178 : PetscAssertPointer(perm,5);
99 : /* insertion sort */
100 12179 : for (i=n-1;i>=0;i--) {
101 11001 : re = eigr[perm[i]];
102 11001 : im = eigi[perm[i]];
103 11001 : j = i+1;
104 : #if !defined(PETSC_USE_COMPLEX)
105 : if (im!=0) {
106 : /* complex eigenvalue */
107 : i--;
108 : im = eigi[perm[i]];
109 : }
110 : #endif
111 12298 : while (j<n) {
112 10835 : PetscCall(SlepcSCCompare(sc,re,im,eigr[perm[j]],eigi[perm[j]],&result));
113 10835 : if (result<=0) break;
114 : #if !defined(PETSC_USE_COMPLEX)
115 : /* keep together every complex conjugated eigenpair */
116 : if (!im) {
117 : if (eigi[perm[j]] == 0.0) {
118 : #endif
119 1297 : tmp = perm[j-1]; perm[j-1] = perm[j]; perm[j] = tmp;
120 1297 : j++;
121 : #if !defined(PETSC_USE_COMPLEX)
122 : } else {
123 : tmp = perm[j-1]; perm[j-1] = perm[j]; perm[j] = perm[j+1]; perm[j+1] = tmp;
124 : j+=2;
125 : }
126 : } else {
127 : if (eigi[perm[j]] == 0.0) {
128 : tmp = perm[j-2]; perm[j-2] = perm[j]; perm[j] = perm[j-1]; perm[j-1] = tmp;
129 : j++;
130 : } else {
131 : tmp = perm[j-2]; perm[j-2] = perm[j]; perm[j] = tmp;
132 : tmp = perm[j-1]; perm[j-1] = perm[j+1]; perm[j+1] = tmp;
133 : j+=2;
134 : }
135 : }
136 : #endif
137 : }
138 : }
139 1178 : PetscFunctionReturn(PETSC_SUCCESS);
140 : }
141 :
142 : /*
143 : SlepcMap_ST - Gateway function to call STBackTransform from outside ST.
144 : */
145 1672627 : PetscErrorCode SlepcMap_ST(PetscObject obj,PetscInt n,PetscScalar* eigr,PetscScalar* eigi)
146 : {
147 1672627 : PetscFunctionBegin;
148 1672627 : PetscCall(STBackTransform((ST)obj,n,eigr,eigi));
149 1672627 : PetscFunctionReturn(PETSC_SUCCESS);
150 : }
151 :
152 924064 : PetscErrorCode SlepcCompareLargestMagnitude(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
153 : {
154 924064 : PetscReal a,b;
155 :
156 924064 : PetscFunctionBegin;
157 924064 : a = SlepcAbsEigenvalue(ar,ai);
158 924064 : b = SlepcAbsEigenvalue(br,bi);
159 924064 : if (a<b) *result = 1;
160 784784 : else if (a>b) *result = -1;
161 2644 : else *result = 0;
162 924064 : PetscFunctionReturn(PETSC_SUCCESS);
163 : }
164 :
165 12849 : PetscErrorCode SlepcCompareSmallestMagnitude(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
166 : {
167 12849 : PetscReal a,b;
168 :
169 12849 : PetscFunctionBegin;
170 12849 : a = SlepcAbsEigenvalue(ar,ai);
171 12849 : b = SlepcAbsEigenvalue(br,bi);
172 12849 : if (a>b) *result = 1;
173 11099 : else if (a<b) *result = -1;
174 0 : else *result = 0;
175 12849 : PetscFunctionReturn(PETSC_SUCCESS);
176 : }
177 :
178 320266 : PetscErrorCode SlepcCompareLargestReal(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
179 : {
180 320266 : PetscReal a,b;
181 :
182 320266 : PetscFunctionBegin;
183 320266 : a = PetscRealPart(ar);
184 320266 : b = PetscRealPart(br);
185 320266 : if (a<b) *result = 1;
186 257972 : else if (a>b) *result = -1;
187 789 : else *result = 0;
188 320266 : PetscFunctionReturn(PETSC_SUCCESS);
189 : }
190 :
191 166422 : PetscErrorCode SlepcCompareSmallestReal(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
192 : {
193 166422 : PetscReal a,b;
194 :
195 166422 : PetscFunctionBegin;
196 166422 : a = PetscRealPart(ar);
197 166422 : b = PetscRealPart(br);
198 166422 : if (a>b) *result = 1;
199 92484 : else if (a<b) *result = -1;
200 56 : else *result = 0;
201 166422 : PetscFunctionReturn(PETSC_SUCCESS);
202 : }
203 :
204 4218 : PetscErrorCode SlepcCompareLargestImaginary(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
205 : {
206 4218 : PetscReal a,b;
207 :
208 4218 : PetscFunctionBegin;
209 : #if defined(PETSC_USE_COMPLEX)
210 4218 : a = PetscImaginaryPart(ar);
211 4218 : b = PetscImaginaryPart(br);
212 : #else
213 : a = PetscAbsReal(ai);
214 : b = PetscAbsReal(bi);
215 : #endif
216 4218 : if (a<b) *result = 1;
217 3258 : else if (a>b) *result = -1;
218 0 : else *result = 0;
219 4218 : PetscFunctionReturn(PETSC_SUCCESS);
220 : }
221 :
222 4417 : PetscErrorCode SlepcCompareSmallestImaginary(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
223 : {
224 4417 : PetscReal a,b;
225 :
226 4417 : PetscFunctionBegin;
227 : #if defined(PETSC_USE_COMPLEX)
228 4417 : a = PetscImaginaryPart(ar);
229 4417 : b = PetscImaginaryPart(br);
230 : #else
231 : a = PetscAbsReal(ai);
232 : b = PetscAbsReal(bi);
233 : #endif
234 4417 : if (a>b) *result = 1;
235 3489 : else if (a<b) *result = -1;
236 0 : else *result = 0;
237 4417 : PetscFunctionReturn(PETSC_SUCCESS);
238 : }
239 :
240 396785 : PetscErrorCode SlepcCompareTargetMagnitude(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
241 : {
242 396785 : PetscReal a,b;
243 396785 : PetscScalar *target = (PetscScalar*)ctx;
244 :
245 396785 : PetscFunctionBegin;
246 : /* complex target only allowed if scalartype=complex */
247 396785 : a = SlepcAbsEigenvalue(ar-(*target),ai);
248 396785 : b = SlepcAbsEigenvalue(br-(*target),bi);
249 396785 : if (a>b) *result = 1;
250 263465 : else if (a<b) *result = -1;
251 10 : else *result = 0;
252 396785 : PetscFunctionReturn(PETSC_SUCCESS);
253 : }
254 :
255 3301 : PetscErrorCode SlepcCompareTargetReal(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
256 : {
257 3301 : PetscReal a,b;
258 3301 : PetscScalar *target = (PetscScalar*)ctx;
259 :
260 3301 : PetscFunctionBegin;
261 3301 : a = PetscAbsReal(PetscRealPart(ar-(*target)));
262 3301 : b = PetscAbsReal(PetscRealPart(br-(*target)));
263 3301 : if (a>b) *result = 1;
264 896 : else if (a<b) *result = -1;
265 0 : else *result = 0;
266 3301 : PetscFunctionReturn(PETSC_SUCCESS);
267 : }
268 :
269 : #if defined(PETSC_USE_COMPLEX)
270 2841 : PetscErrorCode SlepcCompareTargetImaginary(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
271 : {
272 2841 : PetscReal a,b;
273 2841 : PetscScalar *target = (PetscScalar*)ctx;
274 :
275 2841 : PetscFunctionBegin;
276 2841 : a = PetscAbsReal(PetscImaginaryPart(ar-(*target)));
277 2841 : b = PetscAbsReal(PetscImaginaryPart(br-(*target)));
278 2841 : if (a>b) *result = 1;
279 2118 : else if (a<b) *result = -1;
280 0 : else *result = 0;
281 2841 : PetscFunctionReturn(PETSC_SUCCESS);
282 : }
283 : #endif
284 :
285 : /*
286 : Used in the SVD for computing smallest singular values
287 : from the cyclic matrix.
288 : */
289 9542 : PetscErrorCode SlepcCompareSmallestPosReal(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *result,void *ctx)
290 : {
291 9542 : PetscReal a,b;
292 9542 : PetscBool aisright,bisright;
293 :
294 9542 : PetscFunctionBegin;
295 9542 : if (PetscRealPart(ar)>0.0) aisright = PETSC_TRUE;
296 1543 : else aisright = PETSC_FALSE;
297 9542 : if (PetscRealPart(br)>0.0) bisright = PETSC_TRUE;
298 6874 : else bisright = PETSC_FALSE;
299 9542 : if (aisright == bisright) { /* same sign */
300 3913 : a = SlepcAbsEigenvalue(ar,ai);
301 3913 : b = SlepcAbsEigenvalue(br,bi);
302 3913 : if (a>b) *result = 1;
303 1032 : else if (a<b) *result = -1;
304 0 : else *result = 0;
305 5629 : } else if (aisright && !bisright) *result = -1; /* 'a' is on the right */
306 149 : else *result = 1; /* 'b' is on the right */
307 9542 : PetscFunctionReturn(PETSC_SUCCESS);
308 : }
|
