Actual source code: zitfuncf.c
1: #include <petsc/private/ftnimpl.h>
2: #include <petscksp.h>
4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
5: #define kspmonitorset_ KSPMONITORSET
6: #define kspconvergeddefaultcreate_ KSPCONVERGEDDEFAULTCREATE
7: #define kspconvergeddefaultdestroycptr_ KSPCONVERGEDDEFAULTDESTROYCPTR
8: #define kspsetconvergencetest_ KSPSETCONVERGENCETEST
9: #define kspconvergeddefault_ KSPCONVERGEDDEFAULT
10: #define kspconvergedskip_ KSPCONVERGEDSKIP
11: #define kspgmresmonitorkrylov_ KSPGMRESMONITORKRYLOV
12: #define kspmonitorresidual_ KSPMONITORRESIDUAL
13: #define kspmonitortrueresidual_ KSPMONITORTRUERESIDUAL
14: #define kspmonitorsolution_ KSPMONITORSOLUTION
15: #define kspmonitorsingularvalue_ KSPMONITORSINGULARVALUE
16: #define kspsetcomputerhs_ KSPSETCOMPUTERHS
17: #define kspsetcomputeinitialguess_ KSPSETCOMPUTEINITIALGUESS
18: #define kspsetcomputeoperators_ KSPSETCOMPUTEOPERATORS
19: #define dmkspsetcomputerhs_ DMKSPSETCOMPUTERHS
20: #define dmkspsetcomputeinitialguess_ DMKSPSETCOMPUTEINITIALGUESS
21: #define dmkspsetcomputeoperators_ DMKSPSETCOMPUTEOPERATORS
22: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
23: #define kspmonitorset_ kspmonitorset
24: #define kspconvergeddefaultcreate_ kspconvergeddefaultcreate
25: #define kspconvergeddefaultdestroycptr_ kspconvergeddefaultdestroycptr
26: #define kspsetconvergencetest_ kspsetconvergencetest
27: #define kspconvergeddefault_ kspconvergeddefault
28: #define kspconvergedskip_ kspconvergedskip
29: #define kspgmresmonitorkrylov_ kspgmresmonitorkrylov
30: #define kspmonitorresidual_ kspmonitorresidual
31: #define kspmonitortrueresidual_ kspmonitortrueresidual
32: #define kspmonitorsolution_ kspmonitorsolution
33: #define kspmonitorsingularvalue_ kspmonitorsingularvalue
34: #define kspsetcomputerhs_ kspsetcomputerhs
35: #define kspsetcomputeinitialguess_ kspsetcomputeinitialguess
36: #define kspsetcomputeoperators_ kspsetcomputeoperators
37: #define dmkspsetcomputerhs_ dmkspsetcomputerhs
38: #define dmkspsetcomputeinitialguess_ dmkspsetcomputeinitialguess
39: #define dmkspsetcomputeoperators_ dmkspsetcomputeoperators
40: #endif
42: /* These are defined in zdmkspf.c */
43: PETSC_EXTERN void dmkspsetcomputerhs_(DM *dm, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr);
44: PETSC_EXTERN void dmkspsetcomputeinitialguess_(DM *dm, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr);
45: PETSC_EXTERN void dmkspsetcomputeoperators_(DM *dm, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr);
47: /*
48: These cannot be called from Fortran but allow Fortran users to transparently set these monitors from .F code
49: */
51: PETSC_EXTERN void kspconvergeddefault_(KSP *, PetscInt *, PetscReal *, KSPConvergedReason *, void *, PetscErrorCode *);
52: PETSC_EXTERN void kspconvergedskip_(KSP *, PetscInt *, PetscReal *, KSPConvergedReason *, void *, PetscErrorCode *);
53: PETSC_EXTERN void kspgmresmonitorkrylov_(KSP *, PetscInt *, PetscReal *, PetscViewerAndFormat *, PetscErrorCode *);
54: PETSC_EXTERN void kspmonitorresidual_(KSP *, PetscInt *, PetscReal *, PetscViewerAndFormat *, PetscErrorCode *);
55: PETSC_EXTERN void kspmonitorsingularvalue_(KSP *, PetscInt *, PetscReal *, PetscViewerAndFormat *, PetscErrorCode *);
56: PETSC_EXTERN void kspmonitortrueresidual_(KSP *, PetscInt *, PetscReal *, PetscViewerAndFormat *, PetscErrorCode *);
57: PETSC_EXTERN void kspmonitorsolution_(KSP *, PetscInt *, PetscReal *, PetscViewerAndFormat *, PetscErrorCode *);
59: static struct {
60: PetscFortranCallbackId monitor;
61: PetscFortranCallbackId monitordestroy;
62: PetscFortranCallbackId test;
63: PetscFortranCallbackId testdestroy;
64: } _cb;
66: static PetscErrorCode ourmonitor(KSP ksp, PetscInt i, PetscReal d, PetscCtx ctx)
67: {
68: PetscObjectUseFortranCallback(ksp, _cb.monitor, (KSP *, PetscInt *, PetscReal *, void *, PetscErrorCode *), (&ksp, &i, &d, _ctx, &ierr));
69: }
71: static PetscErrorCode ourdestroy(PetscCtxRt ctx)
72: {
73: KSP ksp = *(KSP *)ctx;
74: PetscObjectUseFortranCallback(ksp, _cb.monitordestroy, (void *, PetscErrorCode *), (_ctx, &ierr));
75: }
77: /* These are not extern C because they are passed into non-extern C user level functions */
78: static PetscErrorCode ourtest(KSP ksp, PetscInt i, PetscReal d, KSPConvergedReason *reason, PetscCtx ctx)
79: {
80: PetscObjectUseFortranCallback(ksp, _cb.test, (KSP *, PetscInt *, PetscReal *, KSPConvergedReason *, void *, PetscErrorCode *), (&ksp, &i, &d, reason, _ctx, &ierr));
81: }
83: static PetscErrorCode ourtestdestroy(PetscCtxRt ctx)
84: {
85: KSP ksp = *(KSP *)ctx;
86: PetscObjectUseFortranCallback(ksp, _cb.testdestroy, (void **, PetscErrorCode *), (&_ctx, &ierr));
87: }
89: /*
90: For the built in monitors we ignore the monitordestroy that is passed in and use PetscViewerAndFormatDestroy()
91: */
92: PETSC_EXTERN void kspmonitorset_(KSP *ksp, void (*monitor)(KSP *, PetscInt *, PetscReal *, void *, PetscErrorCode *), void *mctx, void (*monitordestroy)(void *, PetscErrorCode *), PetscErrorCode *ierr)
93: {
94: CHKFORTRANNULLFUNCTION(monitordestroy);
96: if ((PetscFortranCallbackFn *)monitor == (PetscFortranCallbackFn *)kspmonitorresidual_) {
97: *ierr = KSPMonitorSet(*ksp, (KSPMonitorFn *)KSPMonitorResidual, *(PetscViewerAndFormat **)mctx, (PetscCtxDestroyFn *)PetscViewerAndFormatDestroy);
98: } else if ((PetscFortranCallbackFn *)monitor == (PetscFortranCallbackFn *)kspmonitorsolution_) {
99: *ierr = KSPMonitorSet(*ksp, (KSPMonitorFn *)KSPMonitorSolution, *(PetscViewerAndFormat **)mctx, (PetscCtxDestroyFn *)PetscViewerAndFormatDestroy);
100: } else if ((PetscFortranCallbackFn *)monitor == (PetscFortranCallbackFn *)kspmonitortrueresidual_) {
101: *ierr = KSPMonitorSet(*ksp, (KSPMonitorFn *)KSPMonitorTrueResidual, *(PetscViewerAndFormat **)mctx, (PetscCtxDestroyFn *)PetscViewerAndFormatDestroy);
102: } else if ((PetscFortranCallbackFn *)monitor == (PetscFortranCallbackFn *)kspmonitorsingularvalue_) {
103: *ierr = KSPMonitorSet(*ksp, (KSPMonitorFn *)KSPMonitorSingularValue, *(PetscViewerAndFormat **)mctx, (PetscCtxDestroyFn *)PetscViewerAndFormatDestroy);
104: } else if ((PetscFortranCallbackFn *)monitor == (PetscFortranCallbackFn *)kspgmresmonitorkrylov_) {
105: *ierr = KSPMonitorSet(*ksp, (KSPMonitorFn *)KSPGMRESMonitorKrylov, *(PetscViewerAndFormat **)mctx, (PetscCtxDestroyFn *)PetscViewerAndFormatDestroy);
106: } else {
107: *ierr = PetscObjectSetFortranCallback((PetscObject)*ksp, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.monitor, (PetscFortranCallbackFn *)monitor, mctx);
108: if (*ierr) return;
109: *ierr = PetscObjectSetFortranCallback((PetscObject)*ksp, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.monitordestroy, (PetscFortranCallbackFn *)monitordestroy, mctx);
110: if (*ierr) return;
111: *ierr = KSPMonitorSet(*ksp, ourmonitor, *ksp, ourdestroy);
112: }
113: }
115: PETSC_EXTERN void kspconvergeddefaultdestroycptr_(PetscCtxRt, PetscErrorCode *);
117: PETSC_EXTERN void kspsetconvergencetest_(KSP *ksp, void (*converge)(KSP *, PetscInt *, PetscReal *, KSPConvergedReason *, void *, PetscErrorCode *), void **cctx, void (*destroy)(PetscCtxRt, PetscErrorCode *), PetscErrorCode *ierr)
118: {
119: CHKFORTRANNULLFUNCTION(destroy);
121: if (converge == kspconvergeddefault_) {
122: *ierr = KSPSetConvergenceTest(*ksp, KSPConvergedDefault, &cctx, KSPConvergedDefaultDestroy);
123: } else if (converge == kspconvergedskip_) {
124: *ierr = KSPSetConvergenceTest(*ksp, KSPConvergedSkip, NULL, NULL);
125: } else {
126: if (destroy == kspconvergeddefaultdestroycptr_) cctx = *(void ***)cctx;
127: *ierr = PetscObjectSetFortranCallback((PetscObject)*ksp, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.test, (PetscFortranCallbackFn *)converge, cctx);
128: if (*ierr) return;
129: *ierr = PetscObjectSetFortranCallback((PetscObject)*ksp, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.testdestroy, (PetscFortranCallbackFn *)destroy, cctx);
130: if (*ierr) return;
131: *ierr = KSPSetConvergenceTest(*ksp, ourtest, *ksp, ourtestdestroy);
132: }
133: }
135: PETSC_EXTERN void kspsetcomputerhs_(KSP *ksp, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr)
136: {
137: DM dm;
138: *ierr = KSPGetDM(*ksp, &dm);
139: if (!*ierr) dmkspsetcomputerhs_(&dm, func, ctx, ierr);
140: }
142: PETSC_EXTERN void kspsetcomputeinitialguess_(KSP *ksp, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr)
143: {
144: DM dm;
145: *ierr = KSPGetDM(*ksp, &dm);
146: if (!*ierr) dmkspsetcomputeinitialguess_(&dm, func, ctx, ierr);
147: }
149: PETSC_EXTERN void kspsetcomputeoperators_(KSP *ksp, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), PetscCtx ctx, PetscErrorCode *ierr)
150: {
151: DM dm;
152: *ierr = KSPGetDM(*ksp, &dm);
153: if (!*ierr) dmkspsetcomputeoperators_(&dm, func, ctx, ierr);
154: }
156: PETSC_EXTERN void kspconvergeddefaultcreate_(PetscFortranAddr *ctx, PetscErrorCode *ierr)
157: {
158: *ierr = KSPConvergedDefaultCreate((void **)ctx);
159: }