Actual source code: zmfnf.c
slepc-3.21.1 2024-04-26
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 <slepcmfn.h>
14: #if defined(PETSC_HAVE_FORTRAN_CAPS)
15: #define mfndestroy_ MFNDESTROY
16: #define mfnview_ MFNVIEW
17: #define mfnviewfromoptions_ MFNVIEWFROMOPTIONS
18: #define mfnconvergedreasonview_ MFNCONVERGEDREASONVIEW
19: #define mfnsetoptionsprefix_ MFNSETOPTIONSPREFIX
20: #define mfnappendoptionsprefix_ MFNAPPENDOPTIONSPREFIX
21: #define mfngetoptionsprefix_ MFNGETOPTIONSPREFIX
22: #define mfnsettype_ MFNSETTYPE
23: #define mfngettype_ MFNGETTYPE
24: #define mfnmonitordefault_ MFNMONITORDEFAULT
25: #define mfnmonitorset_ MFNMONITORSET
26: #define mfngettolerances00_ MFNGETTOLERANCES00
27: #define mfngettolerances10_ MFNGETTOLERANCES10
28: #define mfngettolerances01_ MFNGETTOLERANCES01
29: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
30: #define mfndestroy_ mfndestroy
31: #define mfnview_ mfnview
32: #define mfnviewfromoptions_ mfnviewfromoptions
33: #define mfnconvergedreasonview_ mfnconvergedreasonview
34: #define mfnsetoptionsprefix_ mfnsetoptionsprefix
35: #define mfnappendoptionsprefix_ mfnappendoptionsprefix
36: #define mfngetoptionsprefix_ mfngetoptionsprefix
37: #define mfnsettype_ mfnsettype
38: #define mfngettype_ mfngettype
39: #define mfnmonitordefault_ mfnmonitordefault
40: #define mfnmonitorset_ mfnmonitorset
41: #define mfngettolerances00_ mfngettolerances00
42: #define mfngettolerances10_ mfngettolerances10
43: #define mfngettolerances01_ mfngettolerances01
44: #endif
46: /*
47: These are not usually called from Fortran but allow Fortran users
48: to transparently set these monitors from .F code
49: */
50: SLEPC_EXTERN void mfnmonitordefault_(MFN *mfn,PetscInt *it,PetscReal *errest,PetscViewerAndFormat **ctx,PetscErrorCode *ierr)
51: {
52: *ierr = MFNMonitorDefault(*mfn,*it,*errest,*ctx);
53: }
55: static struct {
56: PetscFortranCallbackId monitor;
57: PetscFortranCallbackId monitordestroy;
58: } _cb;
60: /* These are not extern C because they are passed into non-extern C user level functions */
61: static PetscErrorCode ourmonitor(MFN mfn,PetscInt i,PetscReal d,void* ctx)
62: {
63: PetscObjectUseFortranCallback(mfn,_cb.monitor,(MFN*,PetscInt*,PetscReal*,void*,PetscErrorCode*),(&mfn,&i,&d,_ctx,&ierr));
64: }
66: static PetscErrorCode ourdestroy(void** ctx)
67: {
68: MFN mfn = (MFN)*ctx;
69: PetscObjectUseFortranCallback(mfn,_cb.monitordestroy,(void*,PetscErrorCode*),(_ctx,&ierr));
70: }
72: SLEPC_EXTERN void mfndestroy_(MFN *mfn,PetscErrorCode *ierr)
73: {
74: PETSC_FORTRAN_OBJECT_F_DESTROYED_TO_C_NULL(mfn);
75: *ierr = MFNDestroy(mfn); if (*ierr) return;
76: PETSC_FORTRAN_OBJECT_C_NULL_TO_F_DESTROYED(mfn);
77: }
79: SLEPC_EXTERN void mfnview_(MFN *mfn,PetscViewer *viewer,PetscErrorCode *ierr)
80: {
81: PetscViewer v;
82: PetscPatchDefaultViewers_Fortran(viewer,v);
83: *ierr = MFNView(*mfn,v);
84: }
86: SLEPC_EXTERN void mfnviewfromoptions_(MFN *mfn,PetscObject obj,char* type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
87: {
88: char *t;
90: FIXCHAR(type,len,t);
91: CHKFORTRANNULLOBJECT(obj);
92: *ierr = MFNViewFromOptions(*mfn,obj,t);if (*ierr) return;
93: FREECHAR(type,t);
94: }
96: SLEPC_EXTERN void mfnconvergedreasonview_(MFN *mfn,PetscViewer *viewer,PetscErrorCode *ierr)
97: {
98: PetscViewer v;
99: PetscPatchDefaultViewers_Fortran(viewer,v);
100: *ierr = MFNConvergedReasonView(*mfn,v);
101: }
103: SLEPC_EXTERN void mfnsettype_(MFN *mfn,char *type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
104: {
105: char *t;
107: FIXCHAR(type,len,t);
108: *ierr = MFNSetType(*mfn,t);if (*ierr) return;
109: FREECHAR(type,t);
110: }
112: SLEPC_EXTERN void mfngettype_(MFN *mfn,char *name,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
113: {
114: MFNType tname;
116: *ierr = MFNGetType(*mfn,&tname);if (*ierr) return;
117: *ierr = PetscStrncpy(name,tname,len);if (*ierr) return;
118: FIXRETURNCHAR(PETSC_TRUE,name,len);
119: }
121: SLEPC_EXTERN void mfnsetoptionsprefix_(MFN *mfn,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
122: {
123: char *t;
125: FIXCHAR(prefix,len,t);
126: *ierr = MFNSetOptionsPrefix(*mfn,t);if (*ierr) return;
127: FREECHAR(prefix,t);
128: }
130: SLEPC_EXTERN void mfnappendoptionsprefix_(MFN *mfn,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
131: {
132: char *t;
134: FIXCHAR(prefix,len,t);
135: *ierr = MFNAppendOptionsPrefix(*mfn,t);if (*ierr) return;
136: FREECHAR(prefix,t);
137: }
139: SLEPC_EXTERN void mfngetoptionsprefix_(MFN *mfn,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
140: {
141: const char *tname;
143: *ierr = MFNGetOptionsPrefix(*mfn,&tname); if (*ierr) return;
144: *ierr = PetscStrncpy(prefix,tname,len);if (*ierr) return;
145: FIXRETURNCHAR(PETSC_TRUE,prefix,len);
146: }
148: SLEPC_EXTERN void mfnmonitorset_(MFN *mfn,void (*monitor)(MFN*,PetscInt*,PetscReal*,void*,PetscErrorCode*),void *mctx,void (*monitordestroy)(void *,PetscErrorCode*),PetscErrorCode *ierr)
149: {
150: CHKFORTRANNULLOBJECT(mctx);
151: CHKFORTRANNULLFUNCTION(monitordestroy);
152: if ((PetscVoidFunction)monitor == (PetscVoidFunction)mfnmonitordefault_) {
153: *ierr = MFNMonitorSet(*mfn,(PetscErrorCode (*)(MFN,PetscInt,PetscReal,void*))MFNMonitorDefault,*(PetscViewerAndFormat**)mctx,(PetscErrorCode (*)(void**))PetscViewerAndFormatDestroy);
154: } else {
155: *ierr = PetscObjectSetFortranCallback((PetscObject)*mfn,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.monitor,(PetscVoidFunction)monitor,mctx); if (*ierr) return;
156: *ierr = PetscObjectSetFortranCallback((PetscObject)*mfn,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.monitordestroy,(PetscVoidFunction)monitordestroy,mctx); if (*ierr) return;
157: *ierr = MFNMonitorSet(*mfn,ourmonitor,*mfn,ourdestroy);
158: }
159: }
161: SLEPC_EXTERN void mfngettolerances_(MFN *mfn,PetscReal *tol,PetscInt *maxits,PetscErrorCode *ierr)
162: {
163: CHKFORTRANNULLREAL(tol);
164: CHKFORTRANNULLINTEGER(maxits);
165: *ierr = MFNGetTolerances(*mfn,tol,maxits);
166: }
168: SLEPC_EXTERN void mfngettolerances00_(MFN *mfn,PetscReal *tol,PetscInt *maxits,PetscErrorCode *ierr)
169: {
170: mfngettolerances_(mfn,tol,maxits,ierr);
171: }
173: SLEPC_EXTERN void mfngettolerances10_(MFN *mfn,PetscReal *tol,PetscInt *maxits,PetscErrorCode *ierr)
174: {
175: mfngettolerances_(mfn,tol,maxits,ierr);
176: }
178: SLEPC_EXTERN void mfngettolerances01_(MFN *mfn,PetscReal *tol,PetscInt *maxits,PetscErrorCode *ierr)
179: {
180: mfngettolerances_(mfn,tol,maxits,ierr);
181: }