Actual source code: znepf.c
slepc-3.21.2 2024-09-25
1: /*
2: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3: SLEPc - Scalable Library for Eigenvalue Problem Computations
4: Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain
6: This file is part of SLEPc.
7: SLEPc is distributed under a 2-clause BSD license (see LICENSE).
8: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
9: */
11: #include <petsc/private/fortranimpl.h>
12: #include <petsc/private/f90impl.h>
13: #include <slepcnep.h>
15: #if defined(PETSC_HAVE_FORTRAN_CAPS)
16: #define nepdestroy_ NEPDESTROY
17: #define nepview_ NEPVIEW
18: #define nepviewfromoptions_ NEPVIEWFROMOPTIONS
19: #define neperrorview_ NEPERRORVIEW
20: #define nepconvergedreasonview_ NEPCONVERGEDREASONVIEW
21: #define nepvaluesview_ NEPVALUESVIEW
22: #define nepvectorsview_ NEPVECTORSVIEW
23: #define nepsetoptionsprefix_ NEPSETOPTIONSPREFIX
24: #define nepappendoptionsprefix_ NEPAPPENDOPTIONSPREFIX
25: #define nepgetoptionsprefix_ NEPGETOPTIONSPREFIX
26: #define nepsettype_ NEPSETTYPE
27: #define nepgettype_ NEPGETTYPE
28: #define nepmonitorset_ NEPMONITORSET
29: #define nepmonitorall_ NEPMONITORALL
30: #define nepmonitorfirst_ NEPMONITORFIRST
31: #define nepmonitorconverged_ NEPMONITORCONVERGED
32: #define nepmonitorconvergedcreate_ NEPMONITORCONVERGEDCREATE
33: #define nepmonitorconvergeddestroy_ NEPMONITORCONVERGEDDESTROY
34: #define nepconvergedabsolute_ NEPCONVERGEDABSOLUTE
35: #define nepconvergedrelative_ NEPCONVERGEDRELATIVE
36: #define nepsetconvergencetestfunction_ NEPSETCONVERGENCETESTFUNCTION
37: #define nepsetstoppingtestfunction_ NEPSETSTOPPINGTESTFUNCTION
38: #define nepseteigenvaluecomparison_ NEPSETEIGENVALUECOMPARISON
39: #define nepsetfunction_ NEPSETFUNCTION
40: #define nepgetfunction_ NEPGETFUNCTION
41: #define nepsetjacobian_ NEPSETJACOBIAN
42: #define nepgetjacobian_ NEPGETJACOBIAN
43: #define nepgetdimensions000_ NEPGETDIMENSIONS000
44: #define nepgetdimensions100_ NEPGETDIMENSIONS100
45: #define nepgetdimensions010_ NEPGETDIMENSIONS010
46: #define nepgetdimensions001_ NEPGETDIMENSIONS001
47: #define nepgetdimensions110_ NEPGETDIMENSIONS110
48: #define nepgetdimensions011_ NEPGETDIMENSIONS011
49: #define nepgetdimensions101_ NEPGETDIMENSIONS101
50: #define nepgeteigenpair00_ NEPGETEIGENPAIR00
51: #define nepgeteigenpair10_ NEPGETEIGENPAIR10
52: #define nepgeteigenpair01_ NEPGETEIGENPAIR01
53: #define nepgeteigenpair11_ NEPGETEIGENPAIR11
54: #define nepgettolerances00_ NEPGETTOLERANCES00
55: #define nepgettolerances10_ NEPGETTOLERANCES10
56: #define nepgettolerances01_ NEPGETTOLERANCES01
57: #define nepgetrefine000_ NEPGETREFINE000
58: #define nepgetrefine100_ NEPGETREFINE100
59: #define nepgetrefine010_ NEPGETREFINE010
60: #define nepgetrefine001_ NEPGETREFINE001
61: #define nepgetrefine110_ NEPGETREFINE110
62: #define nepgetrefine011_ NEPGETREFINE011
63: #define nepgetrefine101_ NEPGETREFINE101
64: #define nepgetrefine111_ NEPGETREFINE111
65: #define nepsetinitialspace0_ NEPSETINITIALSPACE0
66: #define nepsetinitialspace1_ NEPSETINITIALSPACE1
67: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
68: #define nepdestroy_ nepdestroy
69: #define nepview_ nepview
70: #define nepviewfromoptions_ nepviewfromoptions
71: #define neperrorview_ neperrorview
72: #define nepconvergedreasonview_ nepconvergedreasonview
73: #define nepvaluesview_ nepvaluesview
74: #define nepvectorsview_ nepvectorsview
75: #define nepsetoptionsprefix_ nepsetoptionsprefix
76: #define nepappendoptionsprefix_ nepappendoptionsprefix
77: #define nepgetoptionsprefix_ nepgetoptionsprefix
78: #define nepsettype_ nepsettype
79: #define nepgettype_ nepgettype
80: #define nepmonitorset_ nepmonitorset
81: #define nepmonitorall_ nepmonitorall
82: #define nepmonitorfirst_ nepmonitorfirst
83: #define nepmonitorconverged_ nepmonitorconverged
84: #define nepmonitorconvergedcreate_ nepmonitorconvergedcreate
85: #define nepmonitorconvergeddestroy_ nepmonitorconvergeddestroy
86: #define nepconvergedabsolute_ nepconvergedabsolute
87: #define nepconvergedrelative_ nepconvergedrelative
88: #define nepsetconvergencetestfunction_ nepsetconvergencetestfunction
89: #define nepsetstoppingtestfunction_ nepsetstoppingtestfunction
90: #define nepseteigenvaluecomparison_ nepseteigenvaluecomparison
91: #define nepsetfunction_ nepsetfunction
92: #define nepgetfunction_ nepgetfunction
93: #define nepsetjacobian_ nepsetjacobian
94: #define nepgetjacobian_ nepgetjacobian
95: #define nepgetdimensions000_ nepgetdimensions000
96: #define nepgetdimensions100_ nepgetdimensions100
97: #define nepgetdimensions010_ nepgetdimensions010
98: #define nepgetdimensions001_ nepgetdimensions001
99: #define nepgetdimensions110_ nepgetdimensions110
100: #define nepgetdimensions011_ nepgetdimensions011
101: #define nepgetdimensions101_ nepgetdimensions101
102: #define nepgeteigenpair00_ nepgeteigenpair00
103: #define nepgeteigenpair10_ nepgeteigenpair10
104: #define nepgeteigenpair01_ nepgeteigenpair01
105: #define nepgeteigenpair11_ nepgeteigenpair11
106: #define nepgettolerances00_ nepgettolerances00
107: #define nepgettolerances10_ nepgettolerances10
108: #define nepgettolerances01_ nepgettolerances01
109: #define nepgetrefine000_ nepgetrefine000
110: #define nepgetrefine100_ nepgetrefine100
111: #define nepgetrefine010_ nepgetrefine010
112: #define nepgetrefine001_ nepgetrefine001
113: #define nepgetrefine110_ nepgetrefine110
114: #define nepgetrefine011_ nepgetrefine011
115: #define nepgetrefine101_ nepgetrefine101
116: #define nepgetrefine111_ nepgetrefine111
117: #define nepsetinitialspace0_ nepsetinitialspace0
118: #define nepsetinitialspace1_ nepsetinitialspace1
119: #endif
121: /*
122: These are not usually called from Fortran but allow Fortran users
123: to transparently set these monitors from .F code
124: */
125: SLEPC_EXTERN void nepmonitorall_(NEP *nep,PetscInt *it,PetscInt *nconv,PetscScalar *eigr,PetscScalar *eigi,PetscReal *errest,PetscInt *nest,PetscViewerAndFormat **vf,PetscErrorCode *ierr)
126: {
127: *ierr = NEPMonitorAll(*nep,*it,*nconv,eigr,eigi,errest,*nest,*vf);
128: }
130: SLEPC_EXTERN void nepmonitorfirst_(NEP *nep,PetscInt *it,PetscInt *nconv,PetscScalar *eigr,PetscScalar *eigi,PetscReal *errest,PetscInt *nest,PetscViewerAndFormat **vf,PetscErrorCode *ierr)
131: {
132: *ierr = NEPMonitorFirst(*nep,*it,*nconv,eigr,eigi,errest,*nest,*vf);
133: }
135: SLEPC_EXTERN void nepmonitorconverged_(NEP *nep,PetscInt *it,PetscInt *nconv,PetscScalar *eigr,PetscScalar *eigi,PetscReal *errest,PetscInt *nest,PetscViewerAndFormat **vf,PetscErrorCode *ierr)
136: {
137: *ierr = NEPMonitorConverged(*nep,*it,*nconv,eigr,eigi,errest,*nest,*vf);
138: }
140: SLEPC_EXTERN void nepmonitorconvergedcreate_(PetscViewer *vin,PetscViewerFormat *format,void *ctx,PetscViewerAndFormat **vf,PetscErrorCode *ierr)
141: {
142: PetscViewer v;
143: PetscPatchDefaultViewers_Fortran(vin,v);
144: CHKFORTRANNULLOBJECT(ctx);
145: *ierr = NEPMonitorConvergedCreate(v,*format,ctx,vf);
146: }
148: SLEPC_EXTERN void nepmonitorconvergeddestroy_(PetscViewerAndFormat **vf,PetscErrorCode *ierr)
149: {
150: *ierr = NEPMonitorConvergedDestroy(vf);
151: }
153: static struct {
154: PetscFortranCallbackId monitor;
155: PetscFortranCallbackId monitordestroy;
156: PetscFortranCallbackId convergence;
157: PetscFortranCallbackId convdestroy;
158: PetscFortranCallbackId stopping;
159: PetscFortranCallbackId stopdestroy;
160: PetscFortranCallbackId comparison;
161: PetscFortranCallbackId function;
162: PetscFortranCallbackId jacobian;
163: #if defined(PETSC_HAVE_F90_2PTR_ARG)
164: PetscFortranCallbackId function_pgiptr;
165: PetscFortranCallbackId jacobian_pgiptr;
166: #endif
167: } _cb;
169: /* These are not extern C because they are passed into non-extern C user level functions */
170: static PetscErrorCode ourmonitor(NEP nep,PetscInt i,PetscInt nc,PetscScalar *er,PetscScalar *ei,PetscReal *d,PetscInt l,void* ctx)
171: {
172: PetscObjectUseFortranCallback(nep,_cb.monitor,(NEP*,PetscInt*,PetscInt*,PetscScalar*,PetscScalar*,PetscReal*,PetscInt*,void*,PetscErrorCode*),(&nep,&i,&nc,er,ei,d,&l,_ctx,&ierr));
173: }
175: static PetscErrorCode ourdestroy(void** ctx)
176: {
177: NEP nep = (NEP)*ctx;
178: PetscObjectUseFortranCallback(nep,_cb.monitordestroy,(void*,PetscErrorCode*),(_ctx,&ierr));
179: }
181: static PetscErrorCode ourconvergence(NEP nep,PetscScalar eigr,PetscScalar eigi,PetscReal res,PetscReal *errest,void *ctx)
182: {
183: PetscObjectUseFortranCallback(nep,_cb.convergence,(NEP*,PetscScalar*,PetscScalar*,PetscReal*,PetscReal*,void*,PetscErrorCode*),(&nep,&eigr,&eigi,&res,errest,_ctx,&ierr));
184: }
186: static PetscErrorCode ourconvdestroy(void *ctx)
187: {
188: NEP nep = (NEP)ctx;
189: PetscObjectUseFortranCallback(nep,_cb.convdestroy,(void*,PetscErrorCode*),(_ctx,&ierr));
190: }
192: static PetscErrorCode ourstopping(NEP nep,PetscInt its,PetscInt max_it,PetscInt nconv,PetscInt nev,NEPConvergedReason *reason,void *ctx)
193: {
194: PetscObjectUseFortranCallback(nep,_cb.stopping,(NEP*,PetscInt*,PetscInt*,PetscInt*,PetscInt*,NEPConvergedReason*,void*,PetscErrorCode*),(&nep,&its,&max_it,&nconv,&nev,reason,_ctx,&ierr));
195: }
197: static PetscErrorCode ourstopdestroy(void *ctx)
198: {
199: NEP nep = (NEP)ctx;
200: PetscObjectUseFortranCallback(nep,_cb.stopdestroy,(void*,PetscErrorCode*),(_ctx,&ierr));
201: }
203: static PetscErrorCode oureigenvaluecomparison(PetscScalar ar,PetscScalar ai,PetscScalar br,PetscScalar bi,PetscInt *r,void *ctx)
204: {
205: NEP eps = (NEP)ctx;
206: PetscObjectUseFortranCallback(eps,_cb.comparison,(PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscInt*,void*,PetscErrorCode*),(&ar,&ai,&br,&bi,r,_ctx,&ierr));
207: }
209: static PetscErrorCode ournepfunction(NEP nep,PetscScalar lambda,Mat T,Mat P,void *ctx)
210: {
211: #if defined(PETSC_HAVE_F90_2PTR_ARG)
212: void* ptr;
213: PetscCall(PetscObjectGetFortranCallback((PetscObject)nep,PETSC_FORTRAN_CALLBACK_CLASS,_cb.function_pgiptr,NULL,&ptr));
214: #endif
215: PetscObjectUseFortranCallback(nep,_cb.function,(NEP*,PetscScalar*,Mat*,Mat*,void*,PetscErrorCode* PETSC_F90_2PTR_PROTO_NOVAR),(&nep,&lambda,&T,&P,_ctx,&ierr PETSC_F90_2PTR_PARAM(ptr)));
216: }
218: static PetscErrorCode ournepjacobian(NEP nep,PetscScalar lambda,Mat J,void *ctx)
219: {
220: #if defined(PETSC_HAVE_F90_2PTR_ARG)
221: void* ptr;
222: PetscCall(PetscObjectGetFortranCallback((PetscObject)nep,PETSC_FORTRAN_CALLBACK_CLASS,_cb.jacobian_pgiptr,NULL,&ptr));
223: #endif
224: PetscObjectUseFortranCallback(nep,_cb.jacobian,(NEP*,PetscScalar*,Mat*,void*,PetscErrorCode* PETSC_F90_2PTR_PROTO_NOVAR),(&nep,&lambda,&J,_ctx,&ierr PETSC_F90_2PTR_PARAM(ptr)));
225: }
227: SLEPC_EXTERN void nepdestroy_(NEP *nep,PetscErrorCode *ierr)
228: {
229: PETSC_FORTRAN_OBJECT_F_DESTROYED_TO_C_NULL(nep);
230: *ierr = NEPDestroy(nep); if (*ierr) return;
231: PETSC_FORTRAN_OBJECT_C_NULL_TO_F_DESTROYED(nep);
232: }
234: SLEPC_EXTERN void nepview_(NEP *nep,PetscViewer *viewer,PetscErrorCode *ierr)
235: {
236: PetscViewer v;
237: PetscPatchDefaultViewers_Fortran(viewer,v);
238: *ierr = NEPView(*nep,v);
239: }
241: SLEPC_EXTERN void nepviewfromoptions_(NEP *nep,PetscObject obj,char* type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
242: {
243: char *t;
245: FIXCHAR(type,len,t);
246: CHKFORTRANNULLOBJECT(obj);
247: *ierr = NEPViewFromOptions(*nep,obj,t);if (*ierr) return;
248: FREECHAR(type,t);
249: }
251: SLEPC_EXTERN void nepconvergedreasonview_(NEP *nep,PetscViewer *viewer,PetscErrorCode *ierr)
252: {
253: PetscViewer v;
254: PetscPatchDefaultViewers_Fortran(viewer,v);
255: *ierr = NEPConvergedReasonView(*nep,v);
256: }
258: SLEPC_EXTERN void neperrorview_(NEP *nep,NEPErrorType *etype,PetscViewer *viewer,PetscErrorCode *ierr)
259: {
260: PetscViewer v;
261: PetscPatchDefaultViewers_Fortran(viewer,v);
262: *ierr = NEPErrorView(*nep,*etype,v);
263: }
265: SLEPC_EXTERN void nepvaluesview_(NEP *nep,PetscViewer *viewer,PetscErrorCode *ierr)
266: {
267: PetscViewer v;
268: PetscPatchDefaultViewers_Fortran(viewer,v);
269: *ierr = NEPValuesView(*nep,v);
270: }
272: SLEPC_EXTERN void nepvectorsview_(NEP *nep,PetscViewer *viewer,PetscErrorCode *ierr)
273: {
274: PetscViewer v;
275: PetscPatchDefaultViewers_Fortran(viewer,v);
276: *ierr = NEPVectorsView(*nep,v);
277: }
279: SLEPC_EXTERN void nepsettype_(NEP *nep,char *type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
280: {
281: char *t;
283: FIXCHAR(type,len,t);
284: *ierr = NEPSetType(*nep,t);if (*ierr) return;
285: FREECHAR(type,t);
286: }
288: SLEPC_EXTERN void nepgettype_(NEP *nep,char *name,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
289: {
290: NEPType tname;
292: *ierr = NEPGetType(*nep,&tname);if (*ierr) return;
293: *ierr = PetscStrncpy(name,tname,len);if (*ierr) return;
294: FIXRETURNCHAR(PETSC_TRUE,name,len);
295: }
297: SLEPC_EXTERN void nepsetoptionsprefix_(NEP *nep,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
298: {
299: char *t;
301: FIXCHAR(prefix,len,t);
302: *ierr = NEPSetOptionsPrefix(*nep,t);if (*ierr) return;
303: FREECHAR(prefix,t);
304: }
306: SLEPC_EXTERN void nepappendoptionsprefix_(NEP *nep,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
307: {
308: char *t;
310: FIXCHAR(prefix,len,t);
311: *ierr = NEPAppendOptionsPrefix(*nep,t);if (*ierr) return;
312: FREECHAR(prefix,t);
313: }
315: SLEPC_EXTERN void nepgetoptionsprefix_(NEP *nep,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
316: {
317: const char *tname;
319: *ierr = NEPGetOptionsPrefix(*nep,&tname); if (*ierr) return;
320: *ierr = PetscStrncpy(prefix,tname,len);if (*ierr) return;
321: FIXRETURNCHAR(PETSC_TRUE,prefix,len);
322: }
324: SLEPC_EXTERN void nepmonitorset_(NEP *nep,void (*monitor)(NEP*,PetscInt*,PetscInt*,PetscScalar*,PetscScalar*,PetscReal*,PetscInt*,void*,PetscErrorCode*),void *mctx,void (*monitordestroy)(void *,PetscErrorCode*),PetscErrorCode *ierr)
325: {
326: CHKFORTRANNULLOBJECT(mctx);
327: CHKFORTRANNULLFUNCTION(monitordestroy);
328: if ((PetscVoidFunction)monitor == (PetscVoidFunction)nepmonitorall_) {
329: *ierr = NEPMonitorSet(*nep,(PetscErrorCode (*)(NEP,PetscInt,PetscInt,PetscScalar*,PetscScalar*,PetscReal*,PetscInt,void*))NEPMonitorAll,*(PetscViewerAndFormat**)mctx,(PetscErrorCode (*)(void**))PetscViewerAndFormatDestroy);
330: } else if ((PetscVoidFunction)monitor == (PetscVoidFunction)nepmonitorconverged_) {
331: *ierr = NEPMonitorSet(*nep,(PetscErrorCode (*)(NEP,PetscInt,PetscInt,PetscScalar*,PetscScalar*,PetscReal*,PetscInt,void*))NEPMonitorConverged,*(PetscViewerAndFormat**)mctx,(PetscErrorCode (*)(void**))NEPMonitorConvergedDestroy);
332: } else if ((PetscVoidFunction)monitor == (PetscVoidFunction)nepmonitorfirst_) {
333: *ierr = NEPMonitorSet(*nep,(PetscErrorCode (*)(NEP,PetscInt,PetscInt,PetscScalar*,PetscScalar*,PetscReal*,PetscInt,void*))NEPMonitorFirst,*(PetscViewerAndFormat**)mctx,(PetscErrorCode (*)(void**))PetscViewerAndFormatDestroy);
334: } else {
335: *ierr = PetscObjectSetFortranCallback((PetscObject)*nep,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.monitor,(PetscVoidFunction)monitor,mctx); if (*ierr) return;
336: *ierr = PetscObjectSetFortranCallback((PetscObject)*nep,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.monitordestroy,(PetscVoidFunction)monitordestroy,mctx); if (*ierr) return;
337: *ierr = NEPMonitorSet(*nep,ourmonitor,*nep,ourdestroy);
338: }
339: }
341: SLEPC_EXTERN void nepconvergedabsolute_(NEP *nep,PetscScalar *eigr,PetscScalar *eigi,PetscReal *res,PetscReal *errest,void *ctx,PetscErrorCode *ierr)
342: {
343: *ierr = NEPConvergedAbsolute(*nep,*eigr,*eigi,*res,errest,ctx);
344: }
346: SLEPC_EXTERN void nepconvergedrelative_(NEP *nep,PetscScalar *eigr,PetscScalar *eigi,PetscReal *res,PetscReal *errest,void *ctx,PetscErrorCode *ierr)
347: {
348: *ierr = NEPConvergedRelative(*nep,*eigr,*eigi,*res,errest,ctx);
349: }
351: SLEPC_EXTERN void nepsetconvergencetestfunction_(NEP *nep,void (*func)(NEP*,PetscScalar*,PetscScalar*,PetscReal*,PetscReal*,void*,PetscErrorCode*),void* ctx,void (*destroy)(void*,PetscErrorCode*),PetscErrorCode *ierr)
352: {
353: CHKFORTRANNULLOBJECT(ctx);
354: CHKFORTRANNULLFUNCTION(destroy);
355: if ((PetscVoidFunction)func == (PetscVoidFunction)nepconvergedabsolute_) {
356: *ierr = NEPSetConvergenceTest(*nep,NEP_CONV_ABS);
357: } else if ((PetscVoidFunction)func == (PetscVoidFunction)nepconvergedrelative_) {
358: *ierr = NEPSetConvergenceTest(*nep,NEP_CONV_REL);
359: } else {
360: *ierr = PetscObjectSetFortranCallback((PetscObject)*nep,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.convergence,(PetscVoidFunction)func,ctx); if (*ierr) return;
361: *ierr = PetscObjectSetFortranCallback((PetscObject)*nep,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.convdestroy,(PetscVoidFunction)destroy,ctx); if (*ierr) return;
362: *ierr = NEPSetConvergenceTestFunction(*nep,ourconvergence,*nep,ourconvdestroy);
363: }
364: }
366: SLEPC_EXTERN void nepstoppingbasic_(NEP *nep,PetscInt *its,PetscInt *max_it,PetscInt *nconv,PetscInt *nev,NEPConvergedReason *reason,void *ctx,PetscErrorCode *ierr)
367: {
368: *ierr = NEPStoppingBasic(*nep,*its,*max_it,*nconv,*nev,reason,ctx);
369: }
371: SLEPC_EXTERN void nepsetstoppingtestfunction_(NEP *nep,void (*func)(NEP*,PetscInt,PetscInt,PetscInt,PetscInt,NEPConvergedReason*,void*,PetscErrorCode*),void* ctx,void (*destroy)(void*,PetscErrorCode*),PetscErrorCode *ierr)
372: {
373: CHKFORTRANNULLOBJECT(ctx);
374: CHKFORTRANNULLFUNCTION(destroy);
375: if ((PetscVoidFunction)func == (PetscVoidFunction)nepstoppingbasic_) {
376: *ierr = NEPSetStoppingTest(*nep,NEP_STOP_BASIC);
377: } else {
378: *ierr = PetscObjectSetFortranCallback((PetscObject)*nep,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.stopping,(PetscVoidFunction)func,ctx); if (*ierr) return;
379: *ierr = PetscObjectSetFortranCallback((PetscObject)*nep,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.stopdestroy,(PetscVoidFunction)destroy,ctx); if (*ierr) return;
380: *ierr = NEPSetStoppingTestFunction(*nep,ourstopping,*nep,ourstopdestroy);
381: }
382: }
384: SLEPC_EXTERN void nepseteigenvaluecomparison_(NEP *nep,void (*func)(PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscInt*,void*),void* ctx,PetscErrorCode *ierr)
385: {
386: CHKFORTRANNULLOBJECT(ctx);
387: *ierr = PetscObjectSetFortranCallback((PetscObject)*nep,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.comparison,(PetscVoidFunction)func,ctx); if (*ierr) return;
388: *ierr = NEPSetEigenvalueComparison(*nep,oureigenvaluecomparison,*nep);
389: }
391: SLEPC_EXTERN void nepsetfunction_(NEP *nep,Mat *A,Mat *B,void (*func)(NEP*,PetscScalar*,Mat*,Mat*,void*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
392: {
393: *ierr = PetscObjectSetFortranCallback((PetscObject)*nep,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.function,(PetscVoidFunction)func,ctx);if (*ierr) return;
394: #if defined(PETSC_HAVE_F90_2PTR_ARG)
395: *ierr = PetscObjectSetFortranCallback((PetscObject)*nep,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.function_pgiptr,NULL,ptr);if (*ierr) return;
396: #endif
397: *ierr = NEPSetFunction(*nep,*A,*B,ournepfunction,NULL);
398: }
400: /* func is currently ignored from Fortran */
401: SLEPC_EXTERN void nepgetfunction_(NEP *nep,Mat *A,Mat *B,void *func,void **ctx,PetscErrorCode *ierr)
402: {
403: CHKFORTRANNULLINTEGER(ctx);
404: CHKFORTRANNULLOBJECT(A);
405: CHKFORTRANNULLOBJECT(B);
406: *ierr = NEPGetFunction(*nep,A,B,NULL,NULL); if (*ierr) return;
407: *ierr = PetscObjectGetFortranCallback((PetscObject)*nep,PETSC_FORTRAN_CALLBACK_CLASS,_cb.function,NULL,ctx);
408: }
410: SLEPC_EXTERN void nepsetjacobian_(NEP *nep,Mat *J,void (*func)(NEP*,PetscScalar*,Mat*,void*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr PETSC_F90_2PTR_PROTO(ptr))
411: {
412: *ierr = PetscObjectSetFortranCallback((PetscObject)*nep,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jacobian,(PetscVoidFunction)func,ctx);if (*ierr) return;
413: #if defined(PETSC_HAVE_F90_2PTR_ARG)
414: *ierr = PetscObjectSetFortranCallback((PetscObject)*nep,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jacobian_pgiptr,NULL,ptr);if (*ierr) return;
415: #endif
416: *ierr = NEPSetJacobian(*nep,*J,ournepjacobian,NULL);
417: }
419: /* func is currently ignored from Fortran */
420: SLEPC_EXTERN void nepgetjacobian_(NEP *nep,Mat *J,void *func,void **ctx,PetscErrorCode *ierr)
421: {
422: CHKFORTRANNULLINTEGER(ctx);
423: CHKFORTRANNULLOBJECT(J);
424: *ierr = NEPGetJacobian(*nep,J,NULL,NULL); if (*ierr) return;
425: *ierr = PetscObjectGetFortranCallback((PetscObject)*nep,PETSC_FORTRAN_CALLBACK_CLASS,_cb.jacobian,NULL,ctx);
426: }
428: SLEPC_EXTERN void nepgetdimensions_(NEP *nep,PetscInt *nev,PetscInt *ncv,PetscInt *mpd,PetscErrorCode *ierr)
429: {
430: CHKFORTRANNULLINTEGER(nev);
431: CHKFORTRANNULLINTEGER(ncv);
432: CHKFORTRANNULLINTEGER(mpd);
433: *ierr = NEPGetDimensions(*nep,nev,ncv,mpd);
434: }
436: SLEPC_EXTERN void nepgetdimensions000_(NEP *nep,PetscInt *nev,PetscInt *ncv,PetscInt *mpd,PetscErrorCode *ierr)
437: {
438: nepgetdimensions_(nep,nev,ncv,mpd,ierr);
439: }
441: SLEPC_EXTERN void nepgetdimensions100_(NEP *nep,PetscInt *nev,PetscInt *ncv,PetscInt *mpd,PetscErrorCode *ierr)
442: {
443: nepgetdimensions_(nep,nev,ncv,mpd,ierr);
444: }
446: SLEPC_EXTERN void nepgetdimensions010_(NEP *nep,PetscInt *nev,PetscInt *ncv,PetscInt *mpd,PetscErrorCode *ierr)
447: {
448: nepgetdimensions_(nep,nev,ncv,mpd,ierr);
449: }
451: SLEPC_EXTERN void nepgetdimensions001_(NEP *nep,PetscInt *nev,PetscInt *ncv,PetscInt *mpd,PetscErrorCode *ierr)
452: {
453: nepgetdimensions_(nep,nev,ncv,mpd,ierr);
454: }
456: SLEPC_EXTERN void nepgetdimensions110_(NEP *nep,PetscInt *nev,PetscInt *ncv,PetscInt *mpd,PetscErrorCode *ierr)
457: {
458: nepgetdimensions_(nep,nev,ncv,mpd,ierr);
459: }
461: SLEPC_EXTERN void nepgetdimensions011_(NEP *nep,PetscInt *nev,PetscInt *ncv,PetscInt *mpd,PetscErrorCode *ierr)
462: {
463: nepgetdimensions_(nep,nev,ncv,mpd,ierr);
464: }
466: SLEPC_EXTERN void nepgeteigenpair_(NEP *nep,PetscInt *i,PetscScalar *eigr,PetscScalar *eigi,Vec *Vr,Vec *Vi,PetscErrorCode *ierr)
467: {
468: CHKFORTRANNULLSCALAR(eigr);
469: CHKFORTRANNULLSCALAR(eigi);
470: *ierr = NEPGetEigenpair(*nep,*i,eigr,eigi,*Vr,*Vi);
471: }
473: SLEPC_EXTERN void nepgeteigenpair00_(NEP *nep,PetscInt *i,PetscScalar *eigr,PetscScalar *eigi,Vec *Vr,Vec *Vi,PetscErrorCode *ierr)
474: {
475: nepgeteigenpair_(nep,i,eigr,eigi,Vr,Vi,ierr);
476: }
478: SLEPC_EXTERN void nepgeteigenpair10_(NEP *nep,PetscInt *i,PetscScalar *eigr,PetscScalar *eigi,Vec *Vr,Vec *Vi,PetscErrorCode *ierr)
479: {
480: nepgeteigenpair_(nep,i,eigr,eigi,Vr,Vi,ierr);
481: }
483: SLEPC_EXTERN void nepgeteigenpair01_(NEP *nep,PetscInt *i,PetscScalar *eigr,PetscScalar *eigi,Vec *Vr,Vec *Vi,PetscErrorCode *ierr)
484: {
485: nepgeteigenpair_(nep,i,eigr,eigi,Vr,Vi,ierr);
486: }
488: SLEPC_EXTERN void nepgeteigenpair11_(NEP *nep,PetscInt *i,PetscScalar *eigr,PetscScalar *eigi,Vec *Vr,Vec *Vi,PetscErrorCode *ierr)
489: {
490: nepgeteigenpair_(nep,i,eigr,eigi,Vr,Vi,ierr);
491: }
493: SLEPC_EXTERN void nepgettolerances_(NEP *nep,PetscReal *tol,PetscInt *maxits,PetscErrorCode *ierr)
494: {
495: CHKFORTRANNULLREAL(tol);
496: CHKFORTRANNULLINTEGER(maxits);
497: *ierr = NEPGetTolerances(*nep,tol,maxits);
498: }
500: SLEPC_EXTERN void nepgettolerances00_(NEP *nep,PetscReal *tol,PetscInt *maxits,PetscErrorCode *ierr)
501: {
502: nepgettolerances_(nep,tol,maxits,ierr);
503: }
505: SLEPC_EXTERN void nepgettolerances10_(NEP *nep,PetscReal *tol,PetscInt *maxits,PetscErrorCode *ierr)
506: {
507: nepgettolerances_(nep,tol,maxits,ierr);
508: }
510: SLEPC_EXTERN void nepgettolerances01_(NEP *nep,PetscReal *tol,PetscInt *maxits,PetscErrorCode *ierr)
511: {
512: nepgettolerances_(nep,tol,maxits,ierr);
513: }
515: SLEPC_EXTERN void nepgetrefine_(NEP *nep,NEPRefine *refine,PetscInt *npart,PetscReal *tol,PetscInt *its,NEPRefineScheme *scheme,PetscErrorCode *ierr)
516: {
517: CHKFORTRANNULLINTEGER(npart);
518: CHKFORTRANNULLREAL(tol);
519: CHKFORTRANNULLINTEGER(its);
520: *ierr = NEPGetRefine(*nep,refine,npart,tol,its,scheme);
521: }
523: SLEPC_EXTERN void nepgetrefine000_(NEP *nep,NEPRefine *refine,PetscInt *npart,PetscReal *tol,PetscInt *its,NEPRefineScheme *scheme,PetscErrorCode *ierr)
524: {
525: nepgetrefine_(nep,refine,npart,tol,its,scheme,ierr);
526: }
528: SLEPC_EXTERN void nepgetrefine100_(NEP *nep,NEPRefine *refine,PetscInt *npart,PetscReal *tol,PetscInt *its,NEPRefineScheme *scheme,PetscErrorCode *ierr)
529: {
530: nepgetrefine_(nep,refine,npart,tol,its,scheme,ierr);
531: }
533: SLEPC_EXTERN void nepgetrefine010_(NEP *nep,NEPRefine *refine,PetscInt *npart,PetscReal *tol,PetscInt *its,NEPRefineScheme *scheme,PetscErrorCode *ierr)
534: {
535: nepgetrefine_(nep,refine,npart,tol,its,scheme,ierr);
536: }
538: SLEPC_EXTERN void nepgetrefine001_(NEP *nep,NEPRefine *refine,PetscInt *npart,PetscReal *tol,PetscInt *its,NEPRefineScheme *scheme,PetscErrorCode *ierr)
539: {
540: nepgetrefine_(nep,refine,npart,tol,its,scheme,ierr);
541: }
543: SLEPC_EXTERN void nepgetrefine110_(NEP *nep,NEPRefine *refine,PetscInt *npart,PetscReal *tol,PetscInt *its,NEPRefineScheme *scheme,PetscErrorCode *ierr)
544: {
545: nepgetrefine_(nep,refine,npart,tol,its,scheme,ierr);
546: }
548: SLEPC_EXTERN void nepgetrefine011_(NEP *nep,NEPRefine *refine,PetscInt *npart,PetscReal *tol,PetscInt *its,NEPRefineScheme *scheme,PetscErrorCode *ierr)
549: {
550: nepgetrefine_(nep,refine,npart,tol,its,scheme,ierr);
551: }
553: SLEPC_EXTERN void nepgetrefine101_(NEP *nep,NEPRefine *refine,PetscInt *npart,PetscReal *tol,PetscInt *its,NEPRefineScheme *scheme,PetscErrorCode *ierr)
554: {
555: nepgetrefine_(nep,refine,npart,tol,its,scheme,ierr);
556: }
558: SLEPC_EXTERN void nepgetrefine111_(NEP *nep,NEPRefine *refine,PetscInt *npart,PetscReal *tol,PetscInt *its,NEPRefineScheme *scheme,PetscErrorCode *ierr)
559: {
560: nepgetrefine_(nep,refine,npart,tol,its,scheme,ierr);
561: }
563: SLEPC_EXTERN void nepsetinitialspace0_(NEP *nep,PetscInt *n,Vec *is,PetscErrorCode *ierr)
564: {
565: CHKFORTRANNULLOBJECT(is);
566: *ierr = NEPSetInitialSpace(*nep,*n,is);
567: }
569: SLEPC_EXTERN void nepsetinitialspace1_(NEP *nep,PetscInt *n,Vec *is,PetscErrorCode *ierr)
570: {
571: CHKFORTRANNULLOBJECT(is);
572: *ierr = NEPSetInitialSpace(*nep,*n,is);
573: }