Actual source code: zshellpcf.c
1: #include <petsc/private/fortranimpl.h>
2: #include <petscpc.h>
3: #include <petscksp.h>
5: #if defined(PETSC_HAVE_FORTRAN_CAPS)
6: #define pcshellsetapply_ PCSHELLSETAPPLY
7: #define pcshellsetapplysymmetricleft_ PCSHELLSETAPPLYSYMMETRICLEFT
8: #define pcshellsetapplysymmetricright_ PCSHELLSETAPPLYSYMMETRICRIGHT
9: #define pcshellsetapplyba_ PCSHELLSETAPPLYBA
10: #define pcshellsetapplyrichardson_ PCSHELLSETAPPLYRICHARDSON
11: #define pcshellsetapplytranspose_ PCSHELLSETAPPLYTRANSPOSE
12: #define pcshellsetsetup_ PCSHELLSETSETUP
13: #define pcshellsetdestroy_ PCSHELLSETDESTROY
14: #define pcshellsetpresolve_ PCSHELLSETPRESOLVE
15: #define pcshellsetpostsolve_ PCSHELLSETPOSTSOLVE
16: #define pcshellsetview_ PCSHELLSETVIEW
17: #define pcshellsetname_ PCSHELLSETNAME
18: #define pcshellgetname_ PCSHELLGETNAME
19: #define pcshellsetcontext_ PCSHELLSETCONTEXT
20: #define pcshellgetcontext_ PCSHELLGETCONTEXT
21: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
22: #define pcshellsetapply_ pcshellsetapply
23: #define pcshellsetapplyba_ pcshellsetapplyba
24: #define pcshellsetapplyrichardson_ pcshellsetapplyrichardson
25: #define pcshellsetapplytranspose_ pcshellsetapplytranspose
26: #define pcshellsetsetup_ pcshellsetsetup
27: #define pcshellsetdestroy_ pcshellsetdestroy
28: #define pcshellsetpresolve_ pcshellsetpresolve
29: #define pcshellsetpostsolve_ pcshellsetpostsolve
30: #define pcshellsetview_ pcshellsetview
31: #define pcshellsetname_ pcshellsetname
32: #define pcshellgetname_ pcshellgetname
33: #define pcshellsetcontext_ pcshellsetcontext
34: #define pcshellgetcontext_ pcshellgetcontext
35: #endif
37: /* These are not extern C because they are passed into non-extern C user level functions */
38: static PetscErrorCode ourshellapply(PC pc, Vec x, Vec y)
39: {
40: PetscCallFortranVoidFunction((*(void (*)(PC *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[0]))(&pc, &x, &y, &ierr));
41: return PETSC_SUCCESS;
42: }
44: static PetscErrorCode ourshellapplysymmetricleft(PC pc, Vec x, Vec y)
45: {
46: PetscCallFortranVoidFunction((*(void (*)(PC *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[9]))(&pc, &x, &y, &ierr));
47: return PETSC_SUCCESS;
48: }
50: static PetscErrorCode ourshellapplysymmetricright(PC pc, Vec x, Vec y)
51: {
52: PetscCallFortranVoidFunction((*(void (*)(PC *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[10]))(&pc, &x, &y, &ierr));
53: return PETSC_SUCCESS;
54: }
56: static PetscErrorCode ourshellapplyctx(PC pc, Vec x, Vec y)
57: {
58: void *ctx;
59: PetscCall(PCShellGetContext(pc, &ctx));
60: PetscCallFortranVoidFunction((*(void (*)(PC *, void *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[0]))(&pc, ctx, &x, &y, &ierr));
61: return PETSC_SUCCESS;
62: }
64: static PetscErrorCode ourshellapplyba(PC pc, PCSide side, Vec x, Vec y, Vec work)
65: {
66: PetscCallFortranVoidFunction((*(void (*)(PC *, PCSide *, Vec *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[1]))(&pc, &side, &x, &y, &work, &ierr));
67: return PETSC_SUCCESS;
68: }
70: static PetscErrorCode ourapplyrichardson(PC pc, Vec x, Vec y, Vec w, PetscReal rtol, PetscReal abstol, PetscReal dtol, PetscInt m, PetscBool guesszero, PetscInt *outits, PCRichardsonConvergedReason *reason)
71: {
72: PetscCallFortranVoidFunction((*(void (*)(PC *, Vec *, Vec *, Vec *, PetscReal *, PetscReal *, PetscReal *, PetscInt *, PetscBool *, PetscInt *, PCRichardsonConvergedReason *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[2]))(&pc, &x, &y, &w, &rtol, &abstol, &dtol, &m, &guesszero, outits, reason, &ierr));
73: return PETSC_SUCCESS;
74: }
76: static PetscErrorCode ourshellapplytranspose(PC pc, Vec x, Vec y)
77: {
78: PetscCallFortranVoidFunction((*(void (*)(void *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[3]))(&pc, &x, &y, &ierr));
79: return PETSC_SUCCESS;
80: }
82: static PetscErrorCode ourshellsetup(PC pc)
83: {
84: PetscCallFortranVoidFunction((*(void (*)(PC *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[4]))(&pc, &ierr));
85: return PETSC_SUCCESS;
86: }
88: static PetscErrorCode ourshellsetupctx(PC pc)
89: {
90: void *ctx;
91: PetscCall(PCShellGetContext(pc, &ctx));
92: PetscCallFortranVoidFunction((*(void (*)(PC *, void *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[4]))(&pc, ctx, &ierr));
93: return PETSC_SUCCESS;
94: }
96: static PetscErrorCode ourshelldestroy(PC pc)
97: {
98: PetscCallFortranVoidFunction((*(void (*)(void *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[5]))(&pc, &ierr));
99: return PETSC_SUCCESS;
100: }
102: static PetscErrorCode ourshellpresolve(PC pc, KSP ksp, Vec x, Vec y)
103: {
104: PetscCallFortranVoidFunction((*(void (*)(PC *, KSP *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[6]))(&pc, &ksp, &x, &y, &ierr));
105: return PETSC_SUCCESS;
106: }
108: static PetscErrorCode ourshellpostsolve(PC pc, KSP ksp, Vec x, Vec y)
109: {
110: PetscCallFortranVoidFunction((*(void (*)(PC *, KSP *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[7]))(&pc, &ksp, &x, &y, &ierr));
111: return PETSC_SUCCESS;
112: }
114: static PetscErrorCode ourshellview(PC pc, PetscViewer view)
115: {
116: PetscCallFortranVoidFunction((*(void (*)(PC *, PetscViewer *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[8]))(&pc, &view, &ierr));
117: return PETSC_SUCCESS;
118: }
120: PETSC_EXTERN void pcshellgetcontext_(PC *pc, void **ctx, PetscErrorCode *ierr)
121: {
122: *ierr = PCShellGetContext(*pc, ctx);
123: }
125: PETSC_EXTERN void pcshellsetapply_(PC *pc, void (*apply)(void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
126: {
127: PetscObjectAllocateFortranPointers(*pc, 11);
128: ((PetscObject)*pc)->fortran_func_pointers[0] = (PetscVoidFn *)apply;
130: *ierr = PCShellSetApply(*pc, ourshellapply);
131: }
133: PETSC_EXTERN void pcshellsetapplysymmetricleft_(PC *pc, void (*apply)(void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
134: {
135: PetscObjectAllocateFortranPointers(*pc, 11);
136: ((PetscObject)*pc)->fortran_func_pointers[9] = (PetscVoidFn *)apply;
138: *ierr = PCShellSetApplySymmetricLeft(*pc, ourshellapplysymmetricleft);
139: }
141: PETSC_EXTERN void pcshellsetapplysymmetricright_(PC *pc, void (*apply)(void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
142: {
143: PetscObjectAllocateFortranPointers(*pc, 11);
144: ((PetscObject)*pc)->fortran_func_pointers[10] = (PetscVoidFn *)apply;
146: *ierr = PCShellSetApplySymmetricRight(*pc, ourshellapplysymmetricright);
147: }
149: PETSC_EXTERN void pcshellsetapplyctx_(PC *pc, void (*apply)(void *, void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
150: {
151: PetscObjectAllocateFortranPointers(*pc, 11);
152: ((PetscObject)*pc)->fortran_func_pointers[0] = (PetscVoidFn *)apply;
154: *ierr = PCShellSetApply(*pc, ourshellapplyctx);
155: }
157: PETSC_EXTERN void pcshellsetapplyba_(PC *pc, void (*apply)(void *, PCSide *, Vec *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
158: {
159: PetscObjectAllocateFortranPointers(*pc, 11);
160: ((PetscObject)*pc)->fortran_func_pointers[1] = (PetscVoidFn *)apply;
162: *ierr = PCShellSetApplyBA(*pc, ourshellapplyba);
163: }
165: PETSC_EXTERN void pcshellsetapplyrichardson_(PC *pc, void (*apply)(void *, Vec *, Vec *, Vec *, PetscReal *, PetscReal *, PetscReal *, PetscInt *, PetscBool *, PetscInt *, PCRichardsonConvergedReason *, PetscErrorCode *), PetscErrorCode *ierr)
166: {
167: PetscObjectAllocateFortranPointers(*pc, 11);
168: ((PetscObject)*pc)->fortran_func_pointers[2] = (PetscVoidFn *)apply;
169: *ierr = PCShellSetApplyRichardson(*pc, ourapplyrichardson);
170: }
172: PETSC_EXTERN void pcshellsetapplytranspose_(PC *pc, void (*applytranspose)(void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
173: {
174: PetscObjectAllocateFortranPointers(*pc, 11);
175: ((PetscObject)*pc)->fortran_func_pointers[3] = (PetscVoidFn *)applytranspose;
177: *ierr = PCShellSetApplyTranspose(*pc, ourshellapplytranspose);
178: }
180: PETSC_EXTERN void pcshellsetsetupctx_(PC *pc, void (*setup)(void *, void *, PetscErrorCode *), PetscErrorCode *ierr)
181: {
182: PetscObjectAllocateFortranPointers(*pc, 11);
183: ((PetscObject)*pc)->fortran_func_pointers[4] = (PetscVoidFn *)setup;
185: *ierr = PCShellSetSetUp(*pc, ourshellsetupctx);
186: }
188: PETSC_EXTERN void pcshellsetsetup_(PC *pc, void (*setup)(void *, PetscErrorCode *), PetscErrorCode *ierr)
189: {
190: PetscObjectAllocateFortranPointers(*pc, 11);
191: ((PetscObject)*pc)->fortran_func_pointers[4] = (PetscVoidFn *)setup;
193: *ierr = PCShellSetSetUp(*pc, ourshellsetup);
194: }
196: PETSC_EXTERN void pcshellsetdestroy_(PC *pc, void (*setup)(void *, PetscErrorCode *), PetscErrorCode *ierr)
197: {
198: PetscObjectAllocateFortranPointers(*pc, 11);
199: ((PetscObject)*pc)->fortran_func_pointers[5] = (PetscVoidFn *)setup;
201: *ierr = PCShellSetDestroy(*pc, ourshelldestroy);
202: }
204: PETSC_EXTERN void pcshellsetpresolve_(PC *pc, void (*presolve)(void *, void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
205: {
206: PetscObjectAllocateFortranPointers(*pc, 11);
207: ((PetscObject)*pc)->fortran_func_pointers[6] = (PetscVoidFn *)presolve;
209: *ierr = PCShellSetPreSolve(*pc, ourshellpresolve);
210: }
212: PETSC_EXTERN void pcshellsetpostsolve_(PC *pc, void (*postsolve)(void *, void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
213: {
214: PetscObjectAllocateFortranPointers(*pc, 11);
215: ((PetscObject)*pc)->fortran_func_pointers[7] = (PetscVoidFn *)postsolve;
217: *ierr = PCShellSetPostSolve(*pc, ourshellpostsolve);
218: }
220: PETSC_EXTERN void pcshellsetview_(PC *pc, void (*view)(void *, PetscViewer *, PetscErrorCode *), PetscErrorCode *ierr)
221: {
222: PetscObjectAllocateFortranPointers(*pc, 11);
223: ((PetscObject)*pc)->fortran_func_pointers[8] = (PetscVoidFn *)view;
225: *ierr = PCShellSetView(*pc, ourshellview);
226: }
228: PETSC_EXTERN void pcshellsetname_(PC *pc, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
229: {
230: char *c;
231: FIXCHAR(name, len, c);
232: *ierr = PCShellSetName(*pc, c);
233: if (*ierr) return;
234: FREECHAR(name, c);
235: }
237: PETSC_EXTERN void pcshellgetname_(PC *pc, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
238: {
239: const char *c;
241: *ierr = PCShellGetName(*pc, &c);
242: if (*ierr) return;
243: *ierr = PetscStrncpy(name, c, len);
244: if (*ierr) return;
245: FIXRETURNCHAR(PETSC_TRUE, name, len);
246: }