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 kspconvergeddefaultdestroy_ KSPCONVERGEDDEFAULTDESTROY
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 kspconvergeddefaultdestroy_ kspconvergeddefaultdestroy
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 *), void *ctx, PetscErrorCode *ierr);
44: PETSC_EXTERN void dmkspsetcomputeinitialguess_(DM *dm, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr);
45: PETSC_EXTERN void dmkspsetcomputeoperators_(DM *dm, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), void *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, void *ctx)
67: {
68: PetscObjectUseFortranCallback(ksp, _cb.monitor, (KSP *, PetscInt *, PetscReal *, void *, PetscErrorCode *), (&ksp, &i, &d, _ctx, &ierr));
69: }
71: static PetscErrorCode ourdestroy(void **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, void *ctx)
79: {
80: PetscObjectUseFortranCallback(ksp, _cb.test, (KSP *, PetscInt *, PetscReal *, KSPConvergedReason *, void *, PetscErrorCode *), (&ksp, &i, &d, reason, _ctx, &ierr));
81: }
83: static PetscErrorCode ourtestdestroy(void **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 kspconvergeddefaultdestroy_(void **ctx, PetscErrorCode *ierr)
116: {
117: *ierr = KSPConvergedDefaultDestroy(ctx);
118: }
120: PETSC_EXTERN void kspsetconvergencetest_(KSP *ksp, void (*converge)(KSP *, PetscInt *, PetscReal *, KSPConvergedReason *, void *, PetscErrorCode *), void **cctx, void (*destroy)(void **, PetscErrorCode *), PetscErrorCode *ierr)
121: {
122: CHKFORTRANNULLFUNCTION(destroy);
124: if (converge == kspconvergeddefault_) {
125: *ierr = KSPSetConvergenceTest(*ksp, KSPConvergedDefault, &cctx, KSPConvergedDefaultDestroy);
126: } else if (converge == kspconvergedskip_) {
127: *ierr = KSPSetConvergenceTest(*ksp, KSPConvergedSkip, NULL, NULL);
128: } else {
129: if (destroy == kspconvergeddefaultdestroy_) cctx = *(void ***)cctx;
130: *ierr = PetscObjectSetFortranCallback((PetscObject)*ksp, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.test, (PetscFortranCallbackFn *)converge, cctx);
131: if (*ierr) return;
132: *ierr = PetscObjectSetFortranCallback((PetscObject)*ksp, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.testdestroy, (PetscFortranCallbackFn *)destroy, cctx);
133: if (*ierr) return;
134: *ierr = KSPSetConvergenceTest(*ksp, ourtest, *ksp, ourtestdestroy);
135: }
136: }
138: PETSC_EXTERN void kspsetcomputerhs_(KSP *ksp, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
139: {
140: DM dm;
141: *ierr = KSPGetDM(*ksp, &dm);
142: if (!*ierr) dmkspsetcomputerhs_(&dm, func, ctx, ierr);
143: }
145: PETSC_EXTERN void kspsetcomputeinitialguess_(KSP *ksp, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
146: {
147: DM dm;
148: *ierr = KSPGetDM(*ksp, &dm);
149: if (!*ierr) dmkspsetcomputeinitialguess_(&dm, func, ctx, ierr);
150: }
152: PETSC_EXTERN void kspsetcomputeoperators_(KSP *ksp, void (*func)(KSP *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
153: {
154: DM dm;
155: *ierr = KSPGetDM(*ksp, &dm);
156: if (!*ierr) dmkspsetcomputeoperators_(&dm, func, ctx, ierr);
157: }
159: PETSC_EXTERN void kspconvergeddefaultcreate_(PetscFortranAddr *ctx, PetscErrorCode *ierr)
160: {
161: *ierr = KSPConvergedDefaultCreate((void **)ctx);
162: }