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/dsimpl.h>
12 : #include <slepcblaslapack.h>
13 :
14 58 : static PetscErrorCode DSAllocate_GHIEP(DS ds,PetscInt ld)
15 : {
16 58 : PetscFunctionBegin;
17 58 : PetscCall(DSAllocateMat_Private(ds,DS_MAT_A));
18 58 : PetscCall(DSAllocateMat_Private(ds,DS_MAT_B));
19 58 : PetscCall(DSAllocateMat_Private(ds,DS_MAT_Q));
20 58 : PetscCall(DSAllocateMat_Private(ds,DS_MAT_T));
21 58 : PetscCall(DSAllocateMat_Private(ds,DS_MAT_D));
22 58 : PetscCall(PetscFree(ds->perm));
23 58 : PetscCall(PetscMalloc1(ld,&ds->perm));
24 58 : PetscFunctionReturn(PETSC_SUCCESS);
25 : }
26 :
27 3267 : PetscErrorCode DSSwitchFormat_GHIEP(DS ds,PetscBool tocompact)
28 : {
29 3267 : PetscReal *T,*S;
30 3267 : PetscScalar *A,*B;
31 3267 : PetscInt i,n,ld;
32 :
33 3267 : PetscFunctionBegin;
34 3267 : PetscCall(MatDenseGetArray(ds->omat[DS_MAT_A],&A));
35 3267 : PetscCall(MatDenseGetArray(ds->omat[DS_MAT_B],&B));
36 3267 : PetscCall(DSGetArrayReal(ds,DS_MAT_T,&T));
37 3267 : PetscCall(DSGetArrayReal(ds,DS_MAT_D,&S));
38 3267 : n = ds->n;
39 3267 : ld = ds->ld;
40 3267 : if (tocompact) { /* switch from dense (arrow) to compact storage */
41 6 : PetscCall(PetscArrayzero(T,n));
42 6 : PetscCall(PetscArrayzero(T+ld,n));
43 6 : PetscCall(PetscArrayzero(T+2*ld,n));
44 6 : PetscCall(PetscArrayzero(S,n));
45 60 : for (i=0;i<n-1;i++) {
46 54 : T[i] = PetscRealPart(A[i+i*ld]);
47 54 : T[ld+i] = PetscRealPart(A[i+1+i*ld]);
48 54 : S[i] = PetscRealPart(B[i+i*ld]);
49 : }
50 6 : T[n-1] = PetscRealPart(A[n-1+(n-1)*ld]);
51 6 : S[n-1] = PetscRealPart(B[n-1+(n-1)*ld]);
52 6 : for (i=ds->l;i<ds->k;i++) T[2*ld+i] = PetscRealPart(A[ds->k+i*ld]);
53 : } else { /* switch from compact (arrow) to dense storage */
54 100649 : for (i=0;i<n;i++) {
55 97388 : PetscCall(PetscArrayzero(A+i*ld,n));
56 97388 : PetscCall(PetscArrayzero(B+i*ld,n));
57 : }
58 97388 : for (i=0;i<n-1;i++) {
59 94127 : A[i+i*ld] = T[i];
60 94127 : A[i+1+i*ld] = T[ld+i];
61 94127 : A[i+(i+1)*ld] = T[ld+i];
62 94127 : B[i+i*ld] = S[i];
63 : }
64 3261 : A[n-1+(n-1)*ld] = T[n-1];
65 3261 : B[n-1+(n-1)*ld] = S[n-1];
66 53677 : for (i=ds->l;i<ds->k;i++) {
67 50416 : A[ds->k+i*ld] = T[2*ld+i];
68 50416 : A[i+ds->k*ld] = T[2*ld+i];
69 : }
70 : }
71 3267 : PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_A],&A));
72 3267 : PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_B],&B));
73 3267 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_T,&T));
74 3267 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_D,&S));
75 3267 : PetscFunctionReturn(PETSC_SUCCESS);
76 : }
77 :
78 18 : static PetscErrorCode DSView_GHIEP(DS ds,PetscViewer viewer)
79 : {
80 18 : PetscViewerFormat format;
81 18 : PetscInt i,j;
82 18 : PetscReal *T,*S,value;
83 18 : const char *methodname[] = {
84 : "QR + Inverse Iteration",
85 : "HZ method",
86 : "QR"
87 : };
88 18 : const int nmeth=PETSC_STATIC_ARRAY_LENGTH(methodname);
89 :
90 18 : PetscFunctionBegin;
91 18 : PetscCall(PetscViewerGetFormat(viewer,&format));
92 18 : if (format == PETSC_VIEWER_ASCII_INFO || format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
93 12 : if (ds->method<nmeth) PetscCall(PetscViewerASCIIPrintf(viewer,"solving the problem with: %s\n",methodname[ds->method]));
94 12 : PetscFunctionReturn(PETSC_SUCCESS);
95 : }
96 6 : if (ds->compact) {
97 6 : PetscCall(DSGetArrayReal(ds,DS_MAT_T,&T));
98 6 : PetscCall(DSGetArrayReal(ds,DS_MAT_D,&S));
99 6 : PetscCall(PetscViewerASCIIUseTabs(viewer,PETSC_FALSE));
100 6 : if (format == PETSC_VIEWER_ASCII_MATLAB) {
101 6 : PetscCall(PetscViewerASCIIPrintf(viewer,"%% Size = %" PetscInt_FMT " %" PetscInt_FMT "\n",ds->n,ds->n));
102 6 : PetscCall(PetscViewerASCIIPrintf(viewer,"zzz = zeros(%" PetscInt_FMT ",3);\n",3*ds->n));
103 6 : PetscCall(PetscViewerASCIIPrintf(viewer,"zzz = [\n"));
104 51 : for (i=0;i<ds->n;i++) PetscCall(PetscViewerASCIIPrintf(viewer,"%" PetscInt_FMT " %" PetscInt_FMT " %18.16e\n",i+1,i+1,(double)T[i]));
105 45 : for (i=0;i<ds->n-1;i++) {
106 39 : if (T[i+ds->ld] !=0 && i!=ds->k-1) {
107 12 : PetscCall(PetscViewerASCIIPrintf(viewer,"%" PetscInt_FMT " %" PetscInt_FMT " %18.16e\n",i+2,i+1,(double)T[i+ds->ld]));
108 39 : PetscCall(PetscViewerASCIIPrintf(viewer,"%" PetscInt_FMT " %" PetscInt_FMT " %18.16e\n",i+1,i+2,(double)T[i+ds->ld]));
109 : }
110 : }
111 15 : for (i = ds->l;i<ds->k;i++) {
112 9 : if (T[i+2*ds->ld]) {
113 9 : PetscCall(PetscViewerASCIIPrintf(viewer,"%" PetscInt_FMT " %" PetscInt_FMT " %18.16e\n",ds->k+1,i+1,(double)T[i+2*ds->ld]));
114 9 : PetscCall(PetscViewerASCIIPrintf(viewer,"%" PetscInt_FMT " %" PetscInt_FMT " %18.16e\n",i+1,ds->k+1,(double)T[i+2*ds->ld]));
115 : }
116 : }
117 6 : PetscCall(PetscViewerASCIIPrintf(viewer,"];\n%s = spconvert(zzz);\n",DSMatName[DS_MAT_A]));
118 :
119 6 : PetscCall(PetscViewerASCIIPrintf(viewer,"%% Size = %" PetscInt_FMT " %" PetscInt_FMT "\n",ds->n,ds->n));
120 6 : PetscCall(PetscViewerASCIIPrintf(viewer,"omega = zeros(%" PetscInt_FMT ",3);\n",3*ds->n));
121 6 : PetscCall(PetscViewerASCIIPrintf(viewer,"omega = [\n"));
122 51 : for (i=0;i<ds->n;i++) PetscCall(PetscViewerASCIIPrintf(viewer,"%" PetscInt_FMT " %" PetscInt_FMT " %18.16e\n",i+1,i+1,(double)S[i]));
123 6 : PetscCall(PetscViewerASCIIPrintf(viewer,"];\n%s = spconvert(omega);\n",DSMatName[DS_MAT_B]));
124 :
125 : } else {
126 0 : PetscCall(PetscViewerASCIIPrintf(viewer,"T\n"));
127 0 : for (i=0;i<ds->n;i++) {
128 0 : for (j=0;j<ds->n;j++) {
129 0 : if (i==j) value = T[i];
130 0 : else if (i==j+1 || j==i+1) value = T[PetscMin(i,j)+ds->ld];
131 0 : else if ((i<ds->k && j==ds->k) || (i==ds->k && j<ds->k)) value = T[PetscMin(i,j)+2*ds->ld];
132 : else value = 0.0;
133 0 : PetscCall(PetscViewerASCIIPrintf(viewer," %18.16e ",(double)value));
134 : }
135 0 : PetscCall(PetscViewerASCIIPrintf(viewer,"\n"));
136 : }
137 0 : PetscCall(PetscViewerASCIIPrintf(viewer,"omega\n"));
138 0 : for (i=0;i<ds->n;i++) {
139 0 : for (j=0;j<ds->n;j++) {
140 0 : if (i==j) value = S[i];
141 : else value = 0.0;
142 0 : PetscCall(PetscViewerASCIIPrintf(viewer," %18.16e ",(double)value));
143 : }
144 0 : PetscCall(PetscViewerASCIIPrintf(viewer,"\n"));
145 : }
146 : }
147 6 : PetscCall(PetscViewerASCIIUseTabs(viewer,PETSC_TRUE));
148 6 : PetscCall(PetscViewerFlush(viewer));
149 6 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_T,&T));
150 6 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_D,&S));
151 : } else {
152 0 : PetscCall(DSViewMat(ds,viewer,DS_MAT_A));
153 0 : PetscCall(DSViewMat(ds,viewer,DS_MAT_B));
154 : }
155 6 : if (ds->state>DS_STATE_INTERMEDIATE) PetscCall(DSViewMat(ds,viewer,DS_MAT_Q));
156 6 : PetscFunctionReturn(PETSC_SUCCESS);
157 : }
158 :
159 4236 : static PetscErrorCode DSVectors_GHIEP_Eigen_Some(DS ds,PetscInt *idx,PetscReal *rnorm)
160 : {
161 4236 : PetscReal b[4],M[4],*T,*S,d1,d2,s1,s2,e,scal1,scal2,wr1,wr2,wi,ep,norm;
162 4236 : PetscScalar *X,Y[4],alpha,szero=0.0;
163 4236 : const PetscScalar *A,*B,*Q;
164 4236 : PetscInt k;
165 4236 : PetscBLASInt two=2,n_,ld,one=1;
166 : #if !defined(PETSC_USE_COMPLEX)
167 4236 : PetscBLASInt four=4;
168 : #endif
169 :
170 4236 : PetscFunctionBegin;
171 4236 : PetscCall(MatDenseGetArrayRead(ds->omat[DS_MAT_A],&A));
172 4236 : PetscCall(MatDenseGetArrayRead(ds->omat[DS_MAT_B],&B));
173 4236 : PetscCall(MatDenseGetArrayRead(ds->omat[DS_MAT_Q],&Q));
174 4236 : PetscCall(MatDenseGetArray(ds->omat[DS_MAT_X],&X));
175 4236 : PetscCall(DSGetArrayReal(ds,DS_MAT_T,&T));
176 4236 : PetscCall(DSGetArrayReal(ds,DS_MAT_D,&S));
177 4236 : k = *idx;
178 4236 : PetscCall(PetscBLASIntCast(ds->n,&n_));
179 4236 : PetscCall(PetscBLASIntCast(ds->ld,&ld));
180 4236 : if (k < ds->n-1) e = (ds->compact)?T[k+ld]:PetscRealPart(A[(k+1)+ld*k]);
181 : else e = 0.0;
182 4236 : if (e == 0.0) { /* Real */
183 4188 : if (ds->state>=DS_STATE_CONDENSED) PetscCall(PetscArraycpy(X+k*ld,Q+k*ld,ld));
184 : else {
185 0 : PetscCall(PetscArrayzero(X+k*ds->ld,ds->ld));
186 0 : X[k+k*ds->ld] = 1.0;
187 : }
188 4188 : if (rnorm) *rnorm = PetscAbsScalar(X[ds->n-1+k*ld]);
189 : } else { /* 2x2 block */
190 48 : if (ds->compact) {
191 48 : s1 = S[k];
192 48 : d1 = T[k];
193 48 : s2 = S[k+1];
194 48 : d2 = T[k+1];
195 : } else {
196 0 : s1 = PetscRealPart(B[k*ld+k]);
197 0 : d1 = PetscRealPart(A[k+k*ld]);
198 0 : s2 = PetscRealPart(B[(k+1)*ld+k+1]);
199 0 : d2 = PetscRealPart(A[k+1+(k+1)*ld]);
200 : }
201 48 : M[0] = d1; M[1] = e; M[2] = e; M[3]= d2;
202 48 : b[0] = s1; b[1] = 0.0; b[2] = 0.0; b[3] = s2;
203 48 : ep = LAPACKlamch_("S");
204 : /* Compute eigenvalues of the block */
205 48 : PetscCallBLAS("LAPACKlag2",LAPACKlag2_(M,&two,b,&two,&ep,&scal1,&scal2,&wr1,&wr2,&wi));
206 48 : PetscCheck(wi!=0.0,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Real block in DSVectors_GHIEP");
207 : /* Complex eigenvalues */
208 48 : PetscCheck(scal1>=ep,PETSC_COMM_SELF,PETSC_ERR_FP,"Nearly infinite eigenvalue");
209 48 : wr1 /= scal1;
210 48 : wi /= scal1;
211 : #if !defined(PETSC_USE_COMPLEX)
212 48 : if (SlepcAbs(s1*d1-wr1,wi)<SlepcAbs(s2*d2-wr1,wi)) {
213 7 : Y[0] = wr1-s2*d2; Y[1] = s2*e; Y[2] = wi; Y[3] = 0.0;
214 : } else {
215 41 : Y[0] = s1*e; Y[1] = wr1-s1*d1; Y[2] = 0.0; Y[3] = wi;
216 : }
217 48 : norm = BLASnrm2_(&four,Y,&one);
218 48 : norm = 1.0/norm;
219 48 : if (ds->state >= DS_STATE_CONDENSED) {
220 32 : alpha = norm;
221 32 : PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&n_,&two,&two,&alpha,Q+k*ld,&ld,Y,&two,&szero,X+k*ld,&ld));
222 32 : if (rnorm) *rnorm = SlepcAbsEigenvalue(X[ds->n-1+k*ld],X[ds->n-1+(k+1)*ld]);
223 : } else {
224 16 : PetscCall(PetscArrayzero(X+k*ld,2*ld));
225 16 : X[k*ld+k] = Y[0]*norm;
226 16 : X[k*ld+k+1] = Y[1]*norm;
227 16 : X[(k+1)*ld+k] = Y[2]*norm;
228 16 : X[(k+1)*ld+k+1] = Y[3]*norm;
229 : }
230 : #else
231 : if (SlepcAbs(s1*d1-wr1,wi)<SlepcAbs(s2*d2-wr1,wi)) {
232 : Y[0] = PetscCMPLX(wr1-s2*d2,wi);
233 : Y[1] = s2*e;
234 : } else {
235 : Y[0] = s1*e;
236 : Y[1] = PetscCMPLX(wr1-s1*d1,wi);
237 : }
238 : norm = BLASnrm2_(&two,Y,&one);
239 : norm = 1.0/norm;
240 : if (ds->state >= DS_STATE_CONDENSED) {
241 : alpha = norm;
242 : PetscCallBLAS("BLASgemv",BLASgemv_("N",&n_,&two,&alpha,Q+k*ld,&ld,Y,&one,&szero,X+k*ld,&one));
243 : if (rnorm) *rnorm = PetscAbsScalar(X[ds->n-1+k*ld]);
244 : } else {
245 : PetscCall(PetscArrayzero(X+k*ld,2*ld));
246 : X[k*ld+k] = Y[0]*norm;
247 : X[k*ld+k+1] = Y[1]*norm;
248 : }
249 : X[(k+1)*ld+k] = PetscConj(X[k*ld+k]);
250 : X[(k+1)*ld+k+1] = PetscConj(X[k*ld+k+1]);
251 : #endif
252 48 : (*idx)++;
253 : }
254 4236 : PetscCall(MatDenseRestoreArrayRead(ds->omat[DS_MAT_A],&A));
255 4236 : PetscCall(MatDenseRestoreArrayRead(ds->omat[DS_MAT_B],&B));
256 4236 : PetscCall(MatDenseRestoreArrayRead(ds->omat[DS_MAT_Q],&Q));
257 4236 : PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_X],&X));
258 4236 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_T,&T));
259 4236 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_D,&S));
260 4236 : PetscFunctionReturn(PETSC_SUCCESS);
261 : }
262 :
263 4249 : static PetscErrorCode DSVectors_GHIEP(DS ds,DSMatType mat,PetscInt *k,PetscReal *rnorm)
264 : {
265 4249 : PetscScalar *Z;
266 4249 : const PetscScalar *A,*Q;
267 4249 : PetscInt i;
268 4249 : PetscReal e,*T;
269 :
270 4249 : PetscFunctionBegin;
271 4249 : switch (mat) {
272 4249 : case DS_MAT_X:
273 : case DS_MAT_Y:
274 4249 : if (k) PetscCall(DSVectors_GHIEP_Eigen_Some(ds,k,rnorm));
275 : else {
276 29 : PetscCall(MatDenseGetArrayRead(ds->omat[DS_MAT_A],&A));
277 29 : PetscCall(MatDenseGetArrayRead(ds->omat[DS_MAT_Q],&Q));
278 29 : PetscCall(MatDenseGetArray(ds->omat[mat],&Z));
279 29 : PetscCall(DSGetArrayReal(ds,DS_MAT_T,&T));
280 640 : for (i=0; i<ds->n; i++) {
281 611 : e = (ds->compact)?T[i+ds->ld]:PetscRealPart(A[(i+1)+ds->ld*i]);
282 611 : if (e == 0.0) { /* real */
283 595 : if (ds->state >= DS_STATE_CONDENSED) PetscCall(PetscArraycpy(Z+i*ds->ld,Q+i*ds->ld,ds->ld));
284 : else {
285 595 : PetscCall(PetscArrayzero(Z+i*ds->ld,ds->ld));
286 595 : Z[i+i*ds->ld] = 1.0;
287 : }
288 611 : } else PetscCall(DSVectors_GHIEP_Eigen_Some(ds,&i,rnorm));
289 : }
290 29 : PetscCall(MatDenseRestoreArrayRead(ds->omat[DS_MAT_A],&A));
291 29 : PetscCall(MatDenseRestoreArrayRead(ds->omat[DS_MAT_Q],&Q));
292 29 : PetscCall(MatDenseRestoreArray(ds->omat[mat],&Z));
293 29 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_T,&T));
294 : }
295 4249 : break;
296 0 : case DS_MAT_U:
297 : case DS_MAT_V:
298 0 : SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_SUP,"Not implemented yet");
299 0 : default:
300 0 : SETERRQ(PetscObjectComm((PetscObject)ds),PETSC_ERR_ARG_OUTOFRANGE,"Invalid mat parameter");
301 : }
302 4249 : PetscFunctionReturn(PETSC_SUCCESS);
303 : }
304 :
305 : /*
306 : Extract the eigenvalues contained in the block-diagonal of the indefinite problem.
307 : Only the index range n0..n1 is processed.
308 : */
309 3305 : PetscErrorCode DSGHIEPComplexEigs(DS ds,PetscInt n0,PetscInt n1,PetscScalar *wr,PetscScalar *wi)
310 : {
311 3305 : PetscInt k,ld;
312 3305 : PetscBLASInt two=2;
313 3305 : const PetscScalar *A,*B;
314 3305 : PetscReal *D,*T,b[4],M[4],d1,d2,s1,s2,e,scal1,scal2,ep,wr1,wr2,wi1;
315 :
316 3305 : PetscFunctionBegin;
317 3305 : ld = ds->ld;
318 3305 : PetscCall(MatDenseGetArrayRead(ds->omat[DS_MAT_A],&A));
319 3305 : PetscCall(MatDenseGetArrayRead(ds->omat[DS_MAT_B],&B));
320 3305 : PetscCall(DSGetArrayReal(ds,DS_MAT_T,&T));
321 3305 : PetscCall(DSGetArrayReal(ds,DS_MAT_D,&D));
322 5029 : for (k=n0;k<n1;k++) {
323 1724 : if (k < n1-1) e = (ds->compact)?T[ld+k]:PetscRealPart(A[(k+1)+ld*k]);
324 : else e = 0.0;
325 1724 : if (e==0.0) { /* real eigenvalue */
326 1719 : wr[k] = (ds->compact)?T[k]/D[k]:A[k+k*ld]/B[k+k*ld];
327 : #if !defined(PETSC_USE_COMPLEX)
328 1719 : wi[k] = 0.0 ;
329 : #endif
330 : } else { /* diagonal block */
331 5 : if (ds->compact) {
332 3 : s1 = D[k];
333 3 : d1 = T[k];
334 3 : s2 = D[k+1];
335 3 : d2 = T[k+1];
336 : } else {
337 2 : s1 = PetscRealPart(B[k*ld+k]);
338 2 : d1 = PetscRealPart(A[k+k*ld]);
339 2 : s2 = PetscRealPart(B[(k+1)*ld+k+1]);
340 2 : d2 = PetscRealPart(A[k+1+(k+1)*ld]);
341 : }
342 5 : M[0] = d1; M[1] = e; M[2] = e; M[3]= d2;
343 5 : b[0] = s1; b[1] = 0.0; b[2] = 0.0; b[3] = s2;
344 5 : ep = LAPACKlamch_("S");
345 : /* Compute eigenvalues of the block */
346 5 : PetscCallBLAS("LAPACKlag2",LAPACKlag2_(M,&two,b,&two,&ep,&scal1,&scal2,&wr1,&wr2,&wi1));
347 5 : PetscCheck(scal1>=ep,PETSC_COMM_SELF,PETSC_ERR_FP,"Nearly infinite eigenvalue");
348 5 : if (wi1==0.0) { /* Real eigenvalues */
349 0 : PetscCheck(scal2>=ep,PETSC_COMM_SELF,PETSC_ERR_FP,"Nearly infinite eigenvalue");
350 0 : wr[k] = wr1/scal1; wr[k+1] = wr2/scal2;
351 : #if !defined(PETSC_USE_COMPLEX)
352 0 : wi[k] = wi[k+1] = 0.0;
353 : #endif
354 : } else { /* Complex eigenvalues */
355 : #if !defined(PETSC_USE_COMPLEX)
356 5 : wr[k] = wr1/scal1;
357 5 : wr[k+1] = wr[k];
358 5 : wi[k] = wi1/scal1;
359 5 : wi[k+1] = -wi[k];
360 : #else
361 : wr[k] = PetscCMPLX(wr1,wi1)/scal1;
362 : wr[k+1] = PetscConj(wr[k]);
363 : #endif
364 : }
365 5 : k++;
366 : }
367 : }
368 : #if defined(PETSC_USE_COMPLEX)
369 : if (wi) {
370 : for (k=n0;k<n1;k++) wi[k] = 0.0;
371 : }
372 : #endif
373 3305 : PetscCall(MatDenseRestoreArrayRead(ds->omat[DS_MAT_A],&A));
374 3305 : PetscCall(MatDenseRestoreArrayRead(ds->omat[DS_MAT_B],&B));
375 3305 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_T,&T));
376 3305 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_D,&D));
377 3305 : PetscFunctionReturn(PETSC_SUCCESS);
378 : }
379 :
380 3305 : static PetscErrorCode DSSort_GHIEP(DS ds,PetscScalar *wr,PetscScalar *wi,PetscScalar *rr,PetscScalar *ri,PetscInt *k)
381 : {
382 3305 : PetscInt n,i,*perm;
383 3305 : PetscReal *d,*e,*s;
384 :
385 3305 : PetscFunctionBegin;
386 : #if !defined(PETSC_USE_COMPLEX)
387 3305 : PetscAssertPointer(wi,3);
388 : #endif
389 3305 : n = ds->n;
390 3305 : PetscCall(DSGetArrayReal(ds,DS_MAT_T,&d));
391 3305 : e = d + ds->ld;
392 3305 : PetscCall(DSGetArrayReal(ds,DS_MAT_D,&s));
393 3305 : PetscCall(DSAllocateWork_Private(ds,ds->ld,ds->ld,0));
394 3305 : perm = ds->perm;
395 3305 : if (!rr) {
396 3305 : rr = wr;
397 3305 : ri = wi;
398 : }
399 3305 : PetscCall(DSSortEigenvalues_Private(ds,rr,ri,perm,PETSC_TRUE));
400 3305 : if (!ds->compact) PetscCall(DSSwitchFormat_GHIEP(ds,PETSC_TRUE));
401 3305 : PetscCall(PetscArraycpy(ds->work,wr,n));
402 101241 : for (i=ds->l;i<n;i++) wr[i] = *(ds->work+perm[i]);
403 : #if !defined(PETSC_USE_COMPLEX)
404 3305 : PetscCall(PetscArraycpy(ds->work,wi,n));
405 101241 : for (i=ds->l;i<n;i++) wi[i] = *(ds->work+perm[i]);
406 : #endif
407 3305 : PetscCall(PetscArraycpy(ds->rwork,s,n));
408 101241 : for (i=ds->l;i<n;i++) s[i] = *(ds->rwork+perm[i]);
409 3305 : PetscCall(PetscArraycpy(ds->rwork,d,n));
410 101241 : for (i=ds->l;i<n;i++) d[i] = *(ds->rwork+perm[i]);
411 3305 : PetscCall(PetscArraycpy(ds->rwork,e,n-1));
412 3305 : PetscCall(PetscArrayzero(e+ds->l,n-1-ds->l));
413 97936 : for (i=ds->l;i<n-1;i++) {
414 94631 : if (perm[i]<n-1) e[i] = *(ds->rwork+perm[i]);
415 : }
416 3305 : if (!ds->compact) PetscCall(DSSwitchFormat_GHIEP(ds,PETSC_FALSE));
417 3305 : PetscCall(DSPermuteColumns_Private(ds,ds->l,n,n,DS_MAT_Q,perm));
418 3305 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_T,&d));
419 3305 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_D,&s));
420 3305 : PetscFunctionReturn(PETSC_SUCCESS);
421 : }
422 :
423 3296 : static PetscErrorCode DSUpdateExtraRow_GHIEP(DS ds)
424 : {
425 3296 : PetscInt i;
426 3296 : PetscBLASInt n,ld,incx=1;
427 3296 : PetscScalar *A,*x,*y,one=1.0,zero=0.0;
428 3296 : const PetscScalar *Q;
429 3296 : PetscReal *T,*b,*r,beta;
430 :
431 3296 : PetscFunctionBegin;
432 3296 : PetscCall(PetscBLASIntCast(ds->n,&n));
433 3296 : PetscCall(PetscBLASIntCast(ds->ld,&ld));
434 3296 : PetscCall(MatDenseGetArrayRead(ds->omat[DS_MAT_Q],&Q));
435 3296 : if (ds->compact) {
436 3293 : PetscCall(DSGetArrayReal(ds,DS_MAT_T,&T));
437 3293 : b = T+ld;
438 3293 : r = T+2*ld;
439 3293 : beta = b[n-1]; /* in compact, we assume all entries are zero except the last one */
440 102825 : for (i=0;i<n;i++) r[i] = PetscRealPart(beta*Q[n-1+i*ld]);
441 3293 : ds->k = n;
442 3293 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_T,&T));
443 : } else {
444 3 : PetscCall(MatDenseGetArray(ds->omat[DS_MAT_A],&A));
445 3 : PetscCall(DSAllocateWork_Private(ds,2*ld,0,0));
446 3 : x = ds->work;
447 3 : y = ds->work+ld;
448 33 : for (i=0;i<n;i++) x[i] = PetscConj(A[n+i*ld]);
449 3 : PetscCallBLAS("BLASgemv",BLASgemv_("C",&n,&n,&one,Q,&ld,x,&incx,&zero,y,&incx));
450 33 : for (i=0;i<n;i++) A[n+i*ld] = PetscConj(y[i]);
451 3 : ds->k = n;
452 3 : PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_A],&A));
453 : }
454 3296 : PetscCall(MatDenseRestoreArrayRead(ds->omat[DS_MAT_Q],&Q));
455 3296 : PetscFunctionReturn(PETSC_SUCCESS);
456 : }
457 :
458 : /*
459 : Get eigenvectors with inverse iteration.
460 : The system matrix is in Hessenberg form.
461 : */
462 3296 : PetscErrorCode DSGHIEPInverseIteration(DS ds,PetscScalar *wr,PetscScalar *wi)
463 : {
464 3296 : PetscInt i,off;
465 3296 : PetscBLASInt *select,*infoC,ld,n1,mout,info;
466 3296 : const PetscScalar *A,*B;
467 3296 : PetscScalar *H,*X;
468 3296 : PetscReal *s,*d,*e;
469 : #if defined(PETSC_USE_COMPLEX)
470 : PetscInt j;
471 : #endif
472 :
473 3296 : PetscFunctionBegin;
474 3296 : PetscCall(PetscBLASIntCast(ds->ld,&ld));
475 3296 : PetscCall(PetscBLASIntCast(ds->n-ds->l,&n1));
476 3296 : PetscCall(DSAllocateWork_Private(ds,ld*ld+2*ld,ld,2*ld));
477 3296 : PetscCall(DSAllocateMat_Private(ds,DS_MAT_W));
478 3296 : PetscCall(MatDenseGetArrayRead(ds->omat[DS_MAT_A],&A));
479 3296 : PetscCall(MatDenseGetArrayRead(ds->omat[DS_MAT_B],&B));
480 3296 : PetscCall(MatDenseGetArrayWrite(ds->omat[DS_MAT_W],&H));
481 3296 : PetscCall(DSGetArrayReal(ds,DS_MAT_T,&d));
482 3296 : PetscCall(DSGetArrayReal(ds,DS_MAT_D,&s));
483 3296 : e = d + ld;
484 3296 : select = ds->iwork;
485 3296 : infoC = ds->iwork + ld;
486 3296 : off = ds->l+ds->l*ld;
487 3296 : if (ds->compact) {
488 3294 : H[off] = d[ds->l]*s[ds->l];
489 3294 : H[off+ld] = e[ds->l]*s[ds->l];
490 94563 : for (i=ds->l+1;i<ds->n-1;i++) {
491 91269 : H[i+(i-1)*ld] = e[i-1]*s[i];
492 91269 : H[i+i*ld] = d[i]*s[i];
493 91269 : H[i+(i+1)*ld] = e[i]*s[i];
494 : }
495 3294 : H[ds->n-1+(ds->n-2)*ld] = e[ds->n-2]*s[ds->n-1];
496 3294 : H[ds->n-1+(ds->n-1)*ld] = d[ds->n-1]*s[ds->n-1];
497 : } else {
498 2 : s[ds->l] = PetscRealPart(B[off]);
499 2 : H[off] = A[off]*s[ds->l];
500 2 : H[off+ld] = A[off+ld]*s[ds->l];
501 18 : for (i=ds->l+1;i<ds->n-1;i++) {
502 16 : s[i] = PetscRealPart(B[i+i*ld]);
503 16 : H[i+(i-1)*ld] = A[i+(i-1)*ld]*s[i];
504 16 : H[i+i*ld] = A[i+i*ld]*s[i];
505 16 : H[i+(i+1)*ld] = A[i+(i+1)*ld]*s[i];
506 : }
507 2 : s[ds->n-1] = PetscRealPart(B[ds->n-1+(ds->n-1)*ld]);
508 2 : H[ds->n-1+(ds->n-2)*ld] = A[ds->n-1+(ds->n-2)*ld]*s[ds->n-1];
509 2 : H[ds->n-1+(ds->n-1)*ld] = A[ds->n-1+(ds->n-1)*ld]*s[ds->n-1];
510 : }
511 3296 : PetscCall(DSAllocateMat_Private(ds,DS_MAT_X));
512 3296 : PetscCall(MatDenseGetArray(ds->omat[DS_MAT_X],&X));
513 101173 : for (i=0;i<n1;i++) select[i] = 1;
514 : #if !defined(PETSC_USE_COMPLEX)
515 3296 : PetscCallBLAS("LAPACKhsein",LAPACKhsein_("R","N","N",select,&n1,H+off,&ld,wr+ds->l,wi+ds->l,NULL,&ld,X+off,&ld,&n1,&mout,ds->work,NULL,infoC,&info));
516 : #else
517 : PetscCallBLAS("LAPACKhsein",LAPACKhsein_("R","N","N",select,&n1,H+off,&ld,wr+ds->l,NULL,&ld,X+off,&ld,&n1,&mout,ds->work,ds->rwork,NULL,infoC,&info));
518 :
519 : /* Separate real and imaginary part of complex eigenvectors */
520 : for (j=ds->l;j<ds->n;j++) {
521 : if (PetscAbsReal(PetscImaginaryPart(wr[j])) > PetscAbsScalar(wr[j])*PETSC_SQRT_MACHINE_EPSILON) {
522 : for (i=ds->l;i<ds->n;i++) {
523 : X[i+(j+1)*ds->ld] = PetscImaginaryPart(X[i+j*ds->ld]);
524 : X[i+j*ds->ld] = PetscRealPart(X[i+j*ds->ld]);
525 : }
526 : j++;
527 : }
528 : }
529 : #endif
530 3296 : SlepcCheckLapackInfo("hsein",info);
531 3296 : PetscCall(MatDenseRestoreArrayRead(ds->omat[DS_MAT_A],&A));
532 3296 : PetscCall(MatDenseRestoreArrayRead(ds->omat[DS_MAT_B],&B));
533 3296 : PetscCall(MatDenseRestoreArrayWrite(ds->omat[DS_MAT_W],&H));
534 3296 : PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_X],&X));
535 3296 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_T,&d));
536 3296 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_D,&s));
537 3296 : PetscCall(DSGHIEPOrthogEigenv(ds,DS_MAT_X,wr,wi,PETSC_TRUE));
538 3296 : PetscFunctionReturn(PETSC_SUCCESS);
539 : }
540 :
541 : /*
542 : Undo 2x2 blocks that have real eigenvalues.
543 : */
544 3 : PetscErrorCode DSGHIEPRealBlocks(DS ds)
545 : {
546 3 : PetscInt i;
547 3 : PetscReal e,d1,d2,s1,s2,ss1,ss2,t,dd,ss;
548 3 : PetscReal maxy,ep,scal1,scal2,snorm;
549 3 : PetscReal *T,*D,b[4],M[4],wr1,wr2,wi;
550 3 : PetscScalar *A,*B,*Q,Y[4],sone=1.0,szero=0.0;
551 3 : PetscBLASInt m,two=2,ld;
552 3 : PetscBool isreal;
553 :
554 3 : PetscFunctionBegin;
555 3 : PetscCall(PetscBLASIntCast(ds->ld,&ld));
556 3 : PetscCall(PetscBLASIntCast(ds->n-ds->l,&m));
557 3 : PetscCall(MatDenseGetArray(ds->omat[DS_MAT_A],&A));
558 3 : PetscCall(MatDenseGetArray(ds->omat[DS_MAT_B],&B));
559 3 : PetscCall(MatDenseGetArray(ds->omat[DS_MAT_Q],&Q));
560 3 : PetscCall(DSGetArrayReal(ds,DS_MAT_T,&T));
561 3 : PetscCall(DSGetArrayReal(ds,DS_MAT_D,&D));
562 3 : PetscCall(DSAllocateWork_Private(ds,2*m,0,0));
563 23 : for (i=ds->l;i<ds->n-1;i++) {
564 20 : e = (ds->compact)?T[ld+i]:PetscRealPart(A[(i+1)+ld*i]);
565 20 : if (e != 0.0) { /* 2x2 block */
566 5 : if (ds->compact) {
567 1 : s1 = D[i];
568 1 : d1 = T[i];
569 1 : s2 = D[i+1];
570 1 : d2 = T[i+1];
571 : } else {
572 4 : s1 = PetscRealPart(B[i*ld+i]);
573 4 : d1 = PetscRealPart(A[i*ld+i]);
574 4 : s2 = PetscRealPart(B[(i+1)*ld+i+1]);
575 4 : d2 = PetscRealPart(A[(i+1)*ld+i+1]);
576 : }
577 5 : isreal = PETSC_FALSE;
578 5 : if (s1==s2) { /* apply a Jacobi rotation to compute the eigendecomposition */
579 0 : dd = d1-d2;
580 0 : if (2*PetscAbsReal(e) <= dd) {
581 0 : t = 2*e/dd;
582 0 : t = t/(1 + PetscSqrtReal(1+t*t));
583 : } else {
584 0 : t = dd/(2*e);
585 0 : ss = (t>=0)?1.0:-1.0;
586 0 : t = ss/(PetscAbsReal(t)+PetscSqrtReal(1+t*t));
587 : }
588 0 : Y[0] = 1/PetscSqrtReal(1 + t*t); Y[3] = Y[0]; /* c */
589 0 : Y[1] = Y[0]*t; Y[2] = -Y[1]; /* s */
590 0 : wr1 = d1+t*e; wr2 = d2-t*e;
591 0 : ss1 = s1; ss2 = s2;
592 0 : isreal = PETSC_TRUE;
593 : } else {
594 5 : ss1 = 1.0; ss2 = 1.0,
595 5 : M[0] = d1; M[1] = e; M[2] = e; M[3]= d2;
596 5 : b[0] = s1; b[1] = 0.0; b[2] = 0.0; b[3] = s2;
597 5 : ep = LAPACKlamch_("S");
598 :
599 : /* Compute eigenvalues of the block */
600 5 : PetscCallBLAS("LAPACKlag2",LAPACKlag2_(M,&two,b,&two,&ep,&scal1,&scal2,&wr1,&wr2,&wi));
601 5 : if (wi==0.0) { /* Real eigenvalues */
602 2 : isreal = PETSC_TRUE;
603 2 : PetscCheck(scal1>=ep && scal2>=ep,PETSC_COMM_SELF,PETSC_ERR_FP,"Nearly infinite eigenvalue");
604 2 : wr1 /= scal1;
605 2 : wr2 /= scal2;
606 2 : if (PetscAbsReal(s1*d1-wr1)<PetscAbsReal(s2*d2-wr1)) {
607 0 : Y[0] = wr1-s2*d2;
608 0 : Y[1] = s2*e;
609 : } else {
610 2 : Y[0] = s1*e;
611 2 : Y[1] = wr1-s1*d1;
612 : }
613 : /* normalize with a signature*/
614 2 : maxy = PetscMax(PetscAbsScalar(Y[0]),PetscAbsScalar(Y[1]));
615 2 : scal1 = PetscRealPart(Y[0])/maxy;
616 2 : scal2 = PetscRealPart(Y[1])/maxy;
617 2 : snorm = scal1*scal1*s1 + scal2*scal2*s2;
618 2 : if (snorm<0) { ss1 = -1.0; snorm = -snorm; }
619 2 : snorm = maxy*PetscSqrtReal(snorm);
620 2 : Y[0] = Y[0]/snorm;
621 2 : Y[1] = Y[1]/snorm;
622 2 : if (PetscAbsReal(s1*d1-wr2)<PetscAbsReal(s2*d2-wr2)) {
623 2 : Y[2] = wr2-s2*d2;
624 2 : Y[3] = s2*e;
625 : } else {
626 0 : Y[2] = s1*e;
627 0 : Y[3] = wr2-s1*d1;
628 : }
629 2 : maxy = PetscMax(PetscAbsScalar(Y[2]),PetscAbsScalar(Y[3]));
630 2 : scal1 = PetscRealPart(Y[2])/maxy;
631 2 : scal2 = PetscRealPart(Y[3])/maxy;
632 2 : snorm = scal1*scal1*s1 + scal2*scal2*s2;
633 2 : if (snorm<0) { ss2 = -1.0; snorm = -snorm; }
634 2 : snorm = maxy*PetscSqrtReal(snorm); Y[2] = Y[2]/snorm; Y[3] = Y[3]/snorm;
635 : }
636 5 : wr1 *= ss1; wr2 *= ss2;
637 : }
638 5 : if (isreal) {
639 2 : if (ds->compact) {
640 0 : D[i] = ss1;
641 0 : T[i] = wr1;
642 0 : D[i+1] = ss2;
643 0 : T[i+1] = wr2;
644 0 : T[ld+i] = 0.0;
645 : } else {
646 2 : B[i*ld+i] = ss1;
647 2 : A[i*ld+i] = wr1;
648 2 : B[(i+1)*ld+i+1] = ss2;
649 2 : A[(i+1)*ld+i+1] = wr2;
650 2 : A[(i+1)+ld*i] = 0.0;
651 2 : A[i+ld*(i+1)] = 0.0;
652 : }
653 2 : PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&m,&two,&two,&sone,Q+ds->l+i*ld,&ld,Y,&two,&szero,ds->work,&m));
654 2 : PetscCall(PetscArraycpy(Q+ds->l+i*ld,ds->work,m));
655 2 : PetscCall(PetscArraycpy(Q+ds->l+(i+1)*ld,ds->work+m,m));
656 : }
657 5 : i++;
658 : }
659 : }
660 3 : PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_A],&A));
661 3 : PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_B],&B));
662 3 : PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_Q],&Q));
663 3 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_T,&T));
664 3 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_D,&D));
665 3 : PetscFunctionReturn(PETSC_SUCCESS);
666 : }
667 :
668 3297 : static PetscErrorCode DSSolve_GHIEP_QR_II(DS ds,PetscScalar *wr,PetscScalar *wi)
669 : {
670 3297 : PetscInt i,off;
671 3297 : PetscBLASInt n1,ld,one=1,info,lwork;
672 3297 : const PetscScalar *A,*B;
673 3297 : PetscScalar *H,*Q;
674 3297 : PetscReal *d,*e,*s;
675 : #if defined(PETSC_USE_COMPLEX)
676 : PetscInt j;
677 : #endif
678 :
679 3297 : PetscFunctionBegin;
680 : #if !defined(PETSC_USE_COMPLEX)
681 3297 : PetscAssertPointer(wi,3);
682 : #endif
683 3297 : PetscCall(PetscBLASIntCast(ds->n-ds->l,&n1));
684 3297 : PetscCall(PetscBLASIntCast(ds->ld,&ld));
685 3297 : off = ds->l + ds->l*ld;
686 3297 : PetscCall(MatDenseGetArrayRead(ds->omat[DS_MAT_A],&A));
687 3297 : PetscCall(MatDenseGetArrayRead(ds->omat[DS_MAT_B],&B));
688 3297 : PetscCall(DSGetArrayReal(ds,DS_MAT_T,&d));
689 3297 : PetscCall(DSGetArrayReal(ds,DS_MAT_D,&s));
690 3297 : e = d + ld;
691 : #if defined(PETSC_USE_DEBUG)
692 : /* Check signature */
693 102864 : for (i=0;i<ds->n;i++) {
694 99567 : PetscReal de = (ds->compact)?s[i]:PetscRealPart(B[i*ld+i]);
695 99567 : PetscCheck(de==1.0 || de==-1.0,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Diagonal elements of the signature matrix must be 1 or -1");
696 : }
697 : #endif
698 :
699 : /* Quick return if possible */
700 3297 : if (n1 == 1) {
701 1 : PetscCall(MatDenseGetArray(ds->omat[DS_MAT_Q],&Q));
702 6 : for (i=0;i<=ds->l;i++) Q[i+i*ld] = 1.0;
703 1 : PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_Q],&Q));
704 1 : PetscCall(DSGHIEPComplexEigs(ds,0,ds->l,wr,wi));
705 1 : if (!ds->compact) {
706 0 : d[ds->l] = PetscRealPart(A[off]);
707 0 : s[ds->l] = PetscRealPart(B[off]);
708 : }
709 1 : PetscCall(MatDenseRestoreArrayRead(ds->omat[DS_MAT_A],&A));
710 1 : PetscCall(MatDenseRestoreArrayRead(ds->omat[DS_MAT_B],&B));
711 1 : wr[ds->l] = d[ds->l]/s[ds->l];
712 1 : if (wi) wi[ds->l] = 0.0;
713 1 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_T,&d));
714 1 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_D,&s));
715 1 : PetscFunctionReturn(PETSC_SUCCESS);
716 : }
717 :
718 3296 : PetscCall(DSAllocateWork_Private(ds,ld*ld,2*ld,ld*2));
719 3296 : lwork = ld*ld;
720 :
721 : /* Reduce to pseudotriadiagonal form */
722 3296 : PetscCall(DSIntermediate_GHIEP(ds));
723 :
724 : /* Compute Eigenvalues (QR) */
725 3296 : PetscCall(DSAllocateMat_Private(ds,DS_MAT_W));
726 3296 : PetscCall(MatDenseGetArrayWrite(ds->omat[DS_MAT_W],&H));
727 3296 : if (ds->compact) {
728 3294 : H[off] = d[ds->l]*s[ds->l];
729 3294 : H[off+ld] = e[ds->l]*s[ds->l];
730 94563 : for (i=ds->l+1;i<ds->n-1;i++) {
731 91269 : H[i+(i-1)*ld] = e[i-1]*s[i];
732 91269 : H[i+i*ld] = d[i]*s[i];
733 91269 : H[i+(i+1)*ld] = e[i]*s[i];
734 : }
735 3294 : H[ds->n-1+(ds->n-2)*ld] = e[ds->n-2]*s[ds->n-1];
736 3294 : H[ds->n-1+(ds->n-1)*ld] = d[ds->n-1]*s[ds->n-1];
737 : } else {
738 2 : s[ds->l] = PetscRealPart(B[off]);
739 2 : H[off] = A[off]*s[ds->l];
740 2 : H[off+ld] = A[off+ld]*s[ds->l];
741 18 : for (i=ds->l+1;i<ds->n-1;i++) {
742 16 : s[i] = PetscRealPart(B[i+i*ld]);
743 16 : H[i+(i-1)*ld] = A[i+(i-1)*ld]*s[i];
744 16 : H[i+i*ld] = A[i+i*ld]*s[i];
745 16 : H[i+(i+1)*ld] = A[i+(i+1)*ld]*s[i];
746 : }
747 2 : s[ds->n-1] = PetscRealPart(B[ds->n-1+(ds->n-1)*ld]);
748 2 : H[ds->n-1+(ds->n-2)*ld] = A[ds->n-1+(ds->n-2)*ld]*s[ds->n-1];
749 2 : H[ds->n-1+(ds->n-1)*ld] = A[ds->n-1+(ds->n-1)*ld]*s[ds->n-1];
750 : }
751 :
752 : #if !defined(PETSC_USE_COMPLEX)
753 3296 : PetscCallBLAS("LAPACKhseqr",LAPACKhseqr_("E","N",&n1,&one,&n1,H+off,&ld,wr+ds->l,wi+ds->l,NULL,&ld,ds->work,&lwork,&info));
754 : #else
755 : PetscCallBLAS("LAPACKhseqr",LAPACKhseqr_("E","N",&n1,&one,&n1,H+off,&ld,wr+ds->l,NULL,&ld,ds->work,&lwork,&info));
756 : for (i=ds->l;i<ds->n;i++) if (PetscAbsReal(PetscImaginaryPart(wr[i]))<10*PETSC_MACHINE_EPSILON) wr[i] = PetscRealPart(wr[i]);
757 : /* Sort to have consecutive conjugate pairs */
758 : for (i=ds->l;i<ds->n;i++) {
759 : j=i+1;
760 : while (j<ds->n && (PetscAbsScalar(wr[i]-PetscConj(wr[j]))>PetscAbsScalar(wr[i])*PETSC_SQRT_MACHINE_EPSILON)) j++;
761 : if (j==ds->n) {
762 : PetscCheck(PetscAbsReal(PetscImaginaryPart(wr[i]))<PetscAbsScalar(wr[i])*PETSC_SQRT_MACHINE_EPSILON,PETSC_COMM_SELF,PETSC_ERR_LIB,"Found complex without conjugate pair");
763 : wr[i] = PetscRealPart(wr[i]);
764 : } else { /* complex eigenvalue */
765 : wr[j] = wr[i+1];
766 : if (PetscImaginaryPart(wr[i])<0) wr[i] = PetscConj(wr[i]);
767 : wr[i+1] = PetscConj(wr[i]);
768 : i++;
769 : }
770 : }
771 : #endif
772 3296 : SlepcCheckLapackInfo("hseqr",info);
773 3296 : PetscCall(MatDenseRestoreArrayWrite(ds->omat[DS_MAT_W],&H));
774 3296 : PetscCall(MatDenseRestoreArrayRead(ds->omat[DS_MAT_A],&A));
775 3296 : PetscCall(MatDenseRestoreArrayRead(ds->omat[DS_MAT_B],&B));
776 3296 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_T,&d));
777 3296 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_D,&s));
778 :
779 : /* Compute Eigenvectors with Inverse Iteration */
780 3296 : PetscCall(DSGHIEPInverseIteration(ds,wr,wi));
781 :
782 : /* Recover eigenvalues from diagonal */
783 3296 : PetscCall(DSGHIEPComplexEigs(ds,0,ds->l,wr,wi));
784 : #if defined(PETSC_USE_COMPLEX)
785 : if (wi) {
786 : for (i=ds->l;i<ds->n;i++) wi[i] = 0.0;
787 : }
788 : #endif
789 3296 : PetscFunctionReturn(PETSC_SUCCESS);
790 : }
791 :
792 4 : static PetscErrorCode DSSolve_GHIEP_QR(DS ds,PetscScalar *wr,PetscScalar *wi)
793 : {
794 4 : PetscInt i,j,off,nwu=0,n,lw,lwr,nwru=0;
795 4 : PetscBLASInt n_,ld,info,lwork,ilo,ihi;
796 4 : const PetscScalar *A,*B;
797 4 : PetscScalar *H,*Q,*X;
798 4 : PetscReal *d,*s,*scale,nrm,*rcde,*rcdv;
799 : #if defined(PETSC_USE_COMPLEX)
800 : PetscInt k;
801 : #endif
802 :
803 4 : PetscFunctionBegin;
804 : #if !defined(PETSC_USE_COMPLEX)
805 4 : PetscAssertPointer(wi,3);
806 : #endif
807 4 : n = ds->n-ds->l;
808 4 : PetscCall(PetscBLASIntCast(n,&n_));
809 4 : PetscCall(PetscBLASIntCast(ds->ld,&ld));
810 4 : off = ds->l + ds->l*ld;
811 4 : PetscCall(MatDenseGetArrayRead(ds->omat[DS_MAT_A],&A));
812 4 : PetscCall(MatDenseGetArrayRead(ds->omat[DS_MAT_B],&B));
813 4 : PetscCall(DSGetArrayReal(ds,DS_MAT_T,&d));
814 4 : PetscCall(DSGetArrayReal(ds,DS_MAT_D,&s));
815 : #if defined(PETSC_USE_DEBUG)
816 : /* Check signature */
817 39 : for (i=0;i<ds->n;i++) {
818 35 : PetscReal de = (ds->compact)?s[i]:PetscRealPart(B[i*ld+i]);
819 35 : PetscCheck(de==1.0 || de==-1.0,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Diagonal elements of the signature matrix must be 1 or -1");
820 : }
821 : #endif
822 :
823 : /* Quick return if possible */
824 4 : if (n_ == 1) {
825 1 : PetscCall(MatDenseGetArray(ds->omat[DS_MAT_Q],&Q));
826 6 : for (i=0;i<=ds->l;i++) Q[i+i*ld] = 1.0;
827 1 : PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_Q],&Q));
828 1 : PetscCall(DSGHIEPComplexEigs(ds,0,ds->l,wr,wi));
829 1 : if (!ds->compact) {
830 0 : d[ds->l] = PetscRealPart(A[off]);
831 0 : s[ds->l] = PetscRealPart(B[off]);
832 : }
833 1 : PetscCall(MatDenseRestoreArrayRead(ds->omat[DS_MAT_A],&A));
834 1 : PetscCall(MatDenseRestoreArrayRead(ds->omat[DS_MAT_B],&B));
835 1 : wr[ds->l] = d[ds->l]/s[ds->l];
836 1 : if (wi) wi[ds->l] = 0.0;
837 1 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_T,&d));
838 1 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_D,&s));
839 1 : PetscFunctionReturn(PETSC_SUCCESS);
840 : }
841 :
842 3 : lw = 14*ld+ld*ld;
843 3 : lwr = 7*ld;
844 3 : PetscCall(DSAllocateWork_Private(ds,lw,lwr,0));
845 3 : scale = ds->rwork+nwru;
846 3 : nwru += ld;
847 3 : rcde = ds->rwork+nwru;
848 3 : nwru += ld;
849 3 : rcdv = ds->rwork+nwru;
850 :
851 : /* Form pseudo-symmetric matrix */
852 3 : H = ds->work+nwu;
853 3 : nwu += n*n;
854 3 : PetscCall(PetscArrayzero(H,n*n));
855 3 : if (ds->compact) {
856 8 : for (i=0;i<n-1;i++) {
857 7 : H[i+i*n] = s[ds->l+i]*d[ds->l+i];
858 7 : H[i+1+i*n] = s[ds->l+i+1]*d[ld+ds->l+i];
859 7 : H[i+(i+1)*n] = s[ds->l+i]*d[ld+ds->l+i];
860 : }
861 1 : H[n-1+(n-1)*n] = s[ds->l+n-1]*d[ds->l+n-1];
862 4 : for (i=0;i<ds->k-ds->l;i++) {
863 3 : H[ds->k-ds->l+i*n] = s[ds->k]*d[2*ld+ds->l+i];
864 3 : H[i+(ds->k-ds->l)*n] = s[i+ds->l]*d[2*ld+ds->l+i];
865 : }
866 : } else {
867 22 : for (j=0;j<n;j++) {
868 220 : for (i=0;i<n;i++) H[i+j*n] = B[off+i+i*ld]*A[off+i+j*ld];
869 : }
870 : }
871 :
872 : /* Compute eigenpairs */
873 3 : PetscCall(PetscBLASIntCast(lw-nwu,&lwork));
874 3 : PetscCall(DSAllocateMat_Private(ds,DS_MAT_X));
875 3 : PetscCall(MatDenseGetArrayWrite(ds->omat[DS_MAT_X],&X));
876 : #if !defined(PETSC_USE_COMPLEX)
877 3 : PetscCallBLAS("LAPACKgeevx",LAPACKgeevx_("B","N","V","N",&n_,H,&n_,wr+ds->l,wi+ds->l,NULL,&ld,X+off,&ld,&ilo,&ihi,scale,&nrm,rcde,rcdv,ds->work+nwu,&lwork,NULL,&info));
878 : #else
879 : PetscCallBLAS("LAPACKgeevx",LAPACKgeevx_("B","N","V","N",&n_,H,&n_,wr+ds->l,NULL,&ld,X+off,&ld,&ilo,&ihi,scale,&nrm,rcde,rcdv,ds->work+nwu,&lwork,ds->rwork+nwru,&info));
880 :
881 : /* Sort to have consecutive conjugate pairs
882 : Separate real and imaginary part of complex eigenvectors*/
883 : for (i=ds->l;i<ds->n;i++) {
884 : j=i+1;
885 : while (j<ds->n && (PetscAbsScalar(wr[i]-PetscConj(wr[j]))>PetscAbsScalar(wr[i])*PETSC_SQRT_MACHINE_EPSILON)) j++;
886 : if (j==ds->n) {
887 : PetscCheck(PetscAbsReal(PetscImaginaryPart(wr[i]))<PetscAbsScalar(wr[i])*PETSC_SQRT_MACHINE_EPSILON,PETSC_COMM_SELF,PETSC_ERR_LIB,"Found complex without conjugate pair");
888 : wr[i]=PetscRealPart(wr[i]); /* real eigenvalue */
889 : for (k=ds->l;k<ds->n;k++) {
890 : X[k+i*ds->ld] = PetscRealPart(X[k+i*ds->ld]);
891 : }
892 : } else { /* complex eigenvalue */
893 : if (j!=i+1) {
894 : wr[j] = wr[i+1];
895 : PetscCall(PetscArraycpy(X+j*ds->ld,X+(i+1)*ds->ld,ds->ld));
896 : }
897 : if (PetscImaginaryPart(wr[i])<0) {
898 : wr[i] = PetscConj(wr[i]);
899 : for (k=ds->l;k<ds->n;k++) {
900 : X[k+(i+1)*ds->ld] = -PetscImaginaryPart(X[k+i*ds->ld]);
901 : X[k+i*ds->ld] = PetscRealPart(X[k+i*ds->ld]);
902 : }
903 : } else {
904 : for (k=ds->l;k<ds->n;k++) {
905 : X[k+(i+1)*ds->ld] = PetscImaginaryPart(X[k+i*ds->ld]);
906 : X[k+i*ds->ld] = PetscRealPart(X[k+i*ds->ld]);
907 : }
908 : }
909 : wr[i+1] = PetscConj(wr[i]);
910 : i++;
911 : }
912 : }
913 : #endif
914 3 : SlepcCheckLapackInfo("geevx",info);
915 3 : PetscCall(MatDenseRestoreArrayWrite(ds->omat[DS_MAT_X],&X));
916 3 : PetscCall(MatDenseRestoreArrayRead(ds->omat[DS_MAT_A],&A));
917 3 : PetscCall(MatDenseRestoreArrayRead(ds->omat[DS_MAT_B],&B));
918 3 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_T,&d));
919 3 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_D,&s));
920 :
921 : /* Compute real s-orthonormal basis */
922 3 : PetscCall(DSGHIEPOrthogEigenv(ds,DS_MAT_X,wr,wi,PETSC_FALSE));
923 :
924 : /* Recover eigenvalues from diagonal */
925 3 : PetscCall(DSGHIEPComplexEigs(ds,0,ds->l,wr,wi));
926 : #if defined(PETSC_USE_COMPLEX)
927 : if (wi) {
928 : for (i=ds->l;i<ds->n;i++) wi[i] = 0.0;
929 : }
930 : #endif
931 3 : PetscFunctionReturn(PETSC_SUCCESS);
932 : }
933 :
934 3243 : static PetscErrorCode DSGetTruncateSize_GHIEP(DS ds,PetscInt l,PetscInt n,PetscInt *k)
935 : {
936 3243 : PetscReal *T;
937 :
938 3243 : PetscFunctionBegin;
939 3243 : PetscCall(DSGetArrayReal(ds,DS_MAT_T,&T));
940 3243 : if (T[l+(*k)-1+ds->ld] !=0.0) {
941 2732 : if (l+(*k)<n-1) (*k)++;
942 0 : else (*k)--;
943 : }
944 3243 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_T,&T));
945 3243 : PetscFunctionReturn(PETSC_SUCCESS);
946 : }
947 :
948 3293 : static PetscErrorCode DSTruncate_GHIEP(DS ds,PetscInt n,PetscBool trim)
949 : {
950 3293 : PetscInt i,ld=ds->ld,l=ds->l;
951 3293 : PetscScalar *A;
952 3293 : PetscReal *T,*b,*r,*omega;
953 :
954 3293 : PetscFunctionBegin;
955 3293 : if (ds->compact) {
956 3293 : PetscCall(DSGetArrayReal(ds,DS_MAT_T,&T));
957 3293 : PetscCall(DSGetArrayReal(ds,DS_MAT_D,&omega));
958 : #if defined(PETSC_USE_DEBUG)
959 : /* make sure diagonal 2x2 block is not broken */
960 3293 : PetscCheck(ds->state<DS_STATE_CONDENSED || n==0 || n==ds->n || T[n-1+ld]==0.0,PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"The given size would break a 2x2 block, call DSGetTruncateSize() first");
961 : #endif
962 : }
963 3293 : if (trim) {
964 50 : if (!ds->compact && ds->extrarow) { /* clean extra row */
965 0 : PetscCall(MatDenseGetArray(ds->omat[DS_MAT_A],&A));
966 0 : for (i=l;i<ds->n;i++) A[ds->n+i*ld] = 0.0;
967 0 : PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_A],&A));
968 : }
969 50 : ds->l = 0;
970 50 : ds->k = 0;
971 50 : ds->n = n;
972 50 : ds->t = ds->n; /* truncated length equal to the new dimension */
973 : } else {
974 3243 : if (!ds->compact && ds->extrarow && ds->k==ds->n) {
975 : /* copy entries of extra row to the new position, then clean last row */
976 0 : PetscCall(MatDenseGetArray(ds->omat[DS_MAT_A],&A));
977 0 : for (i=l;i<n;i++) A[n+i*ld] = A[ds->n+i*ld];
978 0 : for (i=l;i<ds->n;i++) A[ds->n+i*ld] = 0.0;
979 0 : PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_A],&A));
980 : }
981 3243 : if (ds->compact) {
982 3243 : b = T+ld;
983 3243 : r = T+2*ld;
984 3243 : b[n-1] = r[n-1];
985 3243 : b[n] = b[ds->n];
986 3243 : omega[n] = omega[ds->n];
987 : }
988 3243 : ds->k = (ds->extrarow)? n: 0;
989 3243 : ds->t = ds->n; /* truncated length equal to previous dimension */
990 3243 : ds->n = n;
991 : }
992 3293 : if (ds->compact) {
993 3293 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_T,&T));
994 3293 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_D,&omega));
995 : }
996 3293 : PetscFunctionReturn(PETSC_SUCCESS);
997 : }
998 :
999 : #if !defined(PETSC_HAVE_MPIUNI)
1000 2 : static PetscErrorCode DSSynchronize_GHIEP(DS ds,PetscScalar eigr[],PetscScalar eigi[])
1001 : {
1002 2 : PetscScalar *A,*B,*Q;
1003 2 : PetscReal *T,*D;
1004 2 : PetscInt ld=ds->ld,l=ds->l,k=0,kr=0;
1005 2 : PetscMPIInt n,rank,off=0,size,ldn,ld3,ld_;
1006 :
1007 2 : PetscFunctionBegin;
1008 2 : if (ds->compact) kr = 4*ld;
1009 0 : else k = 2*(ds->n-l)*ld;
1010 2 : if (ds->state>DS_STATE_RAW) k += (ds->n-l)*ld;
1011 2 : if (eigr) k += (ds->n-l);
1012 2 : if (eigi) k += (ds->n-l);
1013 2 : PetscCall(DSAllocateWork_Private(ds,k+kr,0,0));
1014 2 : PetscCall(PetscMPIIntCast(k*sizeof(PetscScalar)+kr*sizeof(PetscReal),&size));
1015 2 : PetscCall(PetscMPIIntCast(ds->n-l,&n));
1016 2 : PetscCall(PetscMPIIntCast(ld*(ds->n-l),&ldn));
1017 2 : PetscCall(PetscMPIIntCast(ld*3,&ld3));
1018 2 : PetscCall(PetscMPIIntCast(ld,&ld_));
1019 2 : if (ds->compact) {
1020 2 : PetscCall(DSGetArrayReal(ds,DS_MAT_T,&T));
1021 2 : PetscCall(DSGetArrayReal(ds,DS_MAT_D,&D));
1022 : } else {
1023 0 : PetscCall(MatDenseGetArray(ds->omat[DS_MAT_A],&A));
1024 0 : PetscCall(MatDenseGetArray(ds->omat[DS_MAT_B],&B));
1025 : }
1026 2 : if (ds->state>DS_STATE_RAW) PetscCall(MatDenseGetArray(ds->omat[DS_MAT_Q],&Q));
1027 2 : PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)ds),&rank));
1028 2 : if (!rank) {
1029 1 : if (ds->compact) {
1030 1 : PetscCallMPI(MPI_Pack(T,ld3,MPIU_REAL,ds->work,size,&off,PetscObjectComm((PetscObject)ds)));
1031 1 : PetscCallMPI(MPI_Pack(D,ld_,MPIU_REAL,ds->work,size,&off,PetscObjectComm((PetscObject)ds)));
1032 : } else {
1033 0 : PetscCallMPI(MPI_Pack(A+l*ld,ldn,MPIU_SCALAR,ds->work,size,&off,PetscObjectComm((PetscObject)ds)));
1034 0 : PetscCallMPI(MPI_Pack(B+l*ld,ldn,MPIU_SCALAR,ds->work,size,&off,PetscObjectComm((PetscObject)ds)));
1035 : }
1036 1 : if (ds->state>DS_STATE_RAW) PetscCallMPI(MPI_Pack(Q+l*ld,ldn,MPIU_SCALAR,ds->work,size,&off,PetscObjectComm((PetscObject)ds)));
1037 1 : if (eigr) PetscCallMPI(MPI_Pack(eigr+l,n,MPIU_SCALAR,ds->work,size,&off,PetscObjectComm((PetscObject)ds)));
1038 : #if !defined(PETSC_USE_COMPLEX)
1039 1 : if (eigi) PetscCallMPI(MPI_Pack(eigi+l,n,MPIU_SCALAR,ds->work,size,&off,PetscObjectComm((PetscObject)ds)));
1040 : #endif
1041 : }
1042 4 : PetscCallMPI(MPI_Bcast(ds->work,size,MPI_BYTE,0,PetscObjectComm((PetscObject)ds)));
1043 2 : if (rank) {
1044 1 : if (ds->compact) {
1045 1 : PetscCallMPI(MPI_Unpack(ds->work,size,&off,T,ld3,MPIU_REAL,PetscObjectComm((PetscObject)ds)));
1046 1 : PetscCallMPI(MPI_Unpack(ds->work,size,&off,D,ld_,MPIU_REAL,PetscObjectComm((PetscObject)ds)));
1047 : } else {
1048 0 : PetscCallMPI(MPI_Unpack(ds->work,size,&off,A+l*ld,ldn,MPIU_SCALAR,PetscObjectComm((PetscObject)ds)));
1049 0 : PetscCallMPI(MPI_Unpack(ds->work,size,&off,B+l*ld,ldn,MPIU_SCALAR,PetscObjectComm((PetscObject)ds)));
1050 : }
1051 1 : if (ds->state>DS_STATE_RAW) PetscCallMPI(MPI_Unpack(ds->work,size,&off,Q+l*ld,ldn,MPIU_SCALAR,PetscObjectComm((PetscObject)ds)));
1052 1 : if (eigr) PetscCallMPI(MPI_Unpack(ds->work,size,&off,eigr+l,n,MPIU_SCALAR,PetscObjectComm((PetscObject)ds)));
1053 : #if !defined(PETSC_USE_COMPLEX)
1054 1 : if (eigi) PetscCallMPI(MPI_Unpack(ds->work,size,&off,eigi+l,n,MPIU_SCALAR,PetscObjectComm((PetscObject)ds)));
1055 : #endif
1056 : }
1057 2 : if (ds->compact) {
1058 2 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_T,&T));
1059 2 : PetscCall(DSRestoreArrayReal(ds,DS_MAT_D,&D));
1060 : } else {
1061 0 : PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_A],&A));
1062 0 : PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_B],&B));
1063 : }
1064 2 : if (ds->state>DS_STATE_RAW) PetscCall(MatDenseRestoreArray(ds->omat[DS_MAT_Q],&Q));
1065 2 : PetscFunctionReturn(PETSC_SUCCESS);
1066 : }
1067 : #endif
1068 :
1069 6635 : static PetscErrorCode DSHermitian_GHIEP(DS ds,DSMatType m,PetscBool *flg)
1070 : {
1071 6635 : PetscFunctionBegin;
1072 6635 : if ((m==DS_MAT_A && !ds->extrarow) || m==DS_MAT_B) *flg = PETSC_TRUE;
1073 6635 : else *flg = PETSC_FALSE;
1074 6635 : PetscFunctionReturn(PETSC_SUCCESS);
1075 : }
1076 :
1077 : /*MC
1078 : DSGHIEP - Dense Generalized Hermitian Indefinite Eigenvalue Problem.
1079 :
1080 : Level: beginner
1081 :
1082 : Notes:
1083 : The problem is expressed as A*X = B*X*Lambda, where both A and B are
1084 : real symmetric (or complex Hermitian) and possibly indefinite. Lambda
1085 : is a diagonal matrix whose diagonal elements are the arguments of DSSolve().
1086 : After solve, A is overwritten with Lambda. Note that in the case of real
1087 : scalars, A is overwritten with a real representation of Lambda, i.e.,
1088 : complex conjugate eigenvalue pairs are stored as a 2x2 block in the
1089 : quasi-diagonal matrix.
1090 :
1091 : In the intermediate state A is reduced to tridiagonal form and B is
1092 : transformed into a signature matrix. In compact storage format, these
1093 : matrices are stored in T and D, respectively.
1094 :
1095 : Used DS matrices:
1096 : + DS_MAT_A - first problem matrix
1097 : . DS_MAT_B - second problem matrix
1098 : . DS_MAT_T - symmetric tridiagonal matrix of the reduced pencil
1099 : . DS_MAT_D - diagonal matrix (signature) of the reduced pencil
1100 : - DS_MAT_Q - pseudo-orthogonal transformation that reduces (A,B) to
1101 : tridiagonal-diagonal form (intermediate step) or a real basis of eigenvectors
1102 :
1103 : Implemented methods:
1104 : + 0 - QR iteration plus inverse iteration for the eigenvectors
1105 : . 1 - HZ iteration
1106 : - 2 - QR iteration plus pseudo-orthogonalization for the eigenvectors
1107 :
1108 : References:
1109 : . 1. - C. Campos and J. E. Roman, "Restarted Q-Arnoldi-type methods exploiting
1110 : symmetry in quadratic eigenvalue problems", BIT Numer. Math. 56(4):1213-1236, 2016.
1111 :
1112 : .seealso: DSCreate(), DSSetType(), DSType
1113 : M*/
1114 48 : SLEPC_EXTERN PetscErrorCode DSCreate_GHIEP(DS ds)
1115 : {
1116 48 : PetscFunctionBegin;
1117 48 : ds->ops->allocate = DSAllocate_GHIEP;
1118 48 : ds->ops->view = DSView_GHIEP;
1119 48 : ds->ops->vectors = DSVectors_GHIEP;
1120 48 : ds->ops->solve[0] = DSSolve_GHIEP_QR_II;
1121 48 : ds->ops->solve[1] = DSSolve_GHIEP_HZ;
1122 48 : ds->ops->solve[2] = DSSolve_GHIEP_QR;
1123 48 : ds->ops->sort = DSSort_GHIEP;
1124 : #if !defined(PETSC_HAVE_MPIUNI)
1125 48 : ds->ops->synchronize = DSSynchronize_GHIEP;
1126 : #endif
1127 48 : ds->ops->gettruncatesize = DSGetTruncateSize_GHIEP;
1128 48 : ds->ops->truncate = DSTruncate_GHIEP;
1129 48 : ds->ops->update = DSUpdateExtraRow_GHIEP;
1130 48 : ds->ops->hermitian = DSHermitian_GHIEP;
1131 48 : PetscFunctionReturn(PETSC_SUCCESS);
1132 : }
|
