Actual source code: zshellpcf.c

  1: #include <petsc/private/ftnimpl.h>
  2: #include <petscpc.h>
  3: #include <petscksp.h>

  5: #if PetscDefined(HAVE_FORTRAN_CAPS)
  6:   #define pcshellsetapply_               PCSHELLSETAPPLY
  7:   #define pcshellsetmatapply_            PCSHELLSETMATAPPLY
  8:   #define pcshellsetapplysymmetricleft_  PCSHELLSETAPPLYSYMMETRICLEFT
  9:   #define pcshellsetapplysymmetricright_ PCSHELLSETAPPLYSYMMETRICRIGHT
 10:   #define pcshellsetapplyba_             PCSHELLSETAPPLYBA
 11:   #define pcshellsetapplyrichardson_     PCSHELLSETAPPLYRICHARDSON
 12:   #define pcshellsetmatapplyrichardson_  PCSHELLSETMATAPPLYRICHARDSON
 13:   #define pcshellsetapplytranspose_      PCSHELLSETAPPLYTRANSPOSE
 14:   #define pcshellsetsetup_               PCSHELLSETSETUP
 15:   #define pcshellsetdestroy_             PCSHELLSETDESTROY
 16:   #define pcshellsetpresolve_            PCSHELLSETPRESOLVE
 17:   #define pcshellsetpostsolve_           PCSHELLSETPOSTSOLVE
 18:   #define pcshellsetview_                PCSHELLSETVIEW
 19: #elif !PetscDefined(HAVE_FORTRAN_UNDERSCORE)
 20:   #define pcshellsetapply_               pcshellsetapply
 21:   #define pcshellsetmatapply_            pcshellsetmatapply
 22:   #define pcshellsetapplysymmetricleft_  pcshellsetapplysymmetricleft
 23:   #define pcshellsetapplysymmetricright_ pcshellsetapplysymmetricright
 24:   #define pcshellsetapplyba_             pcshellsetapplyba
 25:   #define pcshellsetapplyrichardson_     pcshellsetapplyrichardson
 26:   #define pcshellsetmatapplyrichardson_  pcshellsetmatapplyrichardson
 27:   #define pcshellsetapplytranspose_      pcshellsetapplytranspose
 28:   #define pcshellsetsetup_               pcshellsetsetup
 29:   #define pcshellsetdestroy_             pcshellsetdestroy
 30:   #define pcshellsetpresolve_            pcshellsetpresolve
 31:   #define pcshellsetpostsolve_           pcshellsetpostsolve
 32:   #define pcshellsetview_                pcshellsetview
 33: #endif

 35: /* These are not extern C because they are passed into non-extern C user level functions */
 36: static PetscErrorCode ourshellapply(PC pc, Vec x, Vec y)
 37: {
 38:   PetscCallFortranVoidFunction((*(void (*)(PC *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[0]))(&pc, &x, &y, &ierr));
 39:   return PETSC_SUCCESS;
 40: }

 42: static PetscErrorCode ourshellmatapply(PC pc, Mat X, Mat Y)
 43: {
 44:   PetscCallFortranVoidFunction((*(void (*)(PC *, Mat *, Mat *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[11]))(&pc, &X, &Y, &ierr));
 45:   return PETSC_SUCCESS;
 46: }

 48: static PetscErrorCode ourshellapplysymmetricleft(PC pc, Vec x, Vec y)
 49: {
 50:   PetscCallFortranVoidFunction((*(void (*)(PC *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[9]))(&pc, &x, &y, &ierr));
 51:   return PETSC_SUCCESS;
 52: }

 54: static PetscErrorCode ourshellapplysymmetricright(PC pc, Vec x, Vec y)
 55: {
 56:   PetscCallFortranVoidFunction((*(void (*)(PC *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[10]))(&pc, &x, &y, &ierr));
 57:   return PETSC_SUCCESS;
 58: }

 60: static PetscErrorCode ourshellapplyctx(PC pc, Vec x, Vec y)
 61: {
 62:   PetscCtx ctx;
 63:   PetscCall(PCShellGetContext(pc, &ctx));
 64:   PetscCallFortranVoidFunction((*(void (*)(PC *, void *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[0]))(&pc, ctx, &x, &y, &ierr));
 65:   return PETSC_SUCCESS;
 66: }

 68: static PetscErrorCode ourshellapplyba(PC pc, PCSide side, Vec x, Vec y, Vec work)
 69: {
 70:   PetscCallFortranVoidFunction((*(void (*)(PC *, PCSide *, Vec *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[1]))(&pc, &side, &x, &y, &work, &ierr));
 71:   return PETSC_SUCCESS;
 72: }

 74: 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)
 75: {
 76:   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));
 77:   return PETSC_SUCCESS;
 78: }

 80: static PetscErrorCode ourmatapplyrichardson(PC pc, Mat B, Mat Y, Mat W, PetscReal rtol, PetscReal abstol, PetscReal dtol, PetscInt m, PetscBool guesszero, PetscInt *outits, PCRichardsonConvergedReason *reason)
 81: {
 82:   PetscCallFortranVoidFunction((*(void (*)(PC *, Mat *, Mat *, Mat *, PetscReal *, PetscReal *, PetscReal *, PetscInt *, PetscBool *, PetscInt *, PCRichardsonConvergedReason *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[12]))(&pc, &B, &Y, &W, &rtol, &abstol, &dtol, &m, &guesszero, outits, reason, &ierr));
 83:   return PETSC_SUCCESS;
 84: }

 86: static PetscErrorCode ourshellapplytranspose(PC pc, Vec x, Vec y)
 87: {
 88:   PetscCallFortranVoidFunction((*(void (*)(void *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[3]))(&pc, &x, &y, &ierr));
 89:   return PETSC_SUCCESS;
 90: }

 92: static PetscErrorCode ourshellsetup(PC pc)
 93: {
 94:   PetscCallFortranVoidFunction((*(void (*)(PC *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[4]))(&pc, &ierr));
 95:   return PETSC_SUCCESS;
 96: }

 98: static PetscErrorCode ourshellsetupctx(PC pc)
 99: {
100:   PetscCtx ctx;
101:   PetscCall(PCShellGetContext(pc, &ctx));
102:   PetscCallFortranVoidFunction((*(void (*)(PC *, void *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[4]))(&pc, ctx, &ierr));
103:   return PETSC_SUCCESS;
104: }

106: static PetscErrorCode ourshelldestroy(PC pc)
107: {
108:   PetscCallFortranVoidFunction((*(void (*)(void *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[5]))(&pc, &ierr));
109:   return PETSC_SUCCESS;
110: }

112: static PetscErrorCode ourshellpresolve(PC pc, KSP ksp, Vec x, Vec y)
113: {
114:   PetscCallFortranVoidFunction((*(void (*)(PC *, KSP *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[6]))(&pc, &ksp, &x, &y, &ierr));
115:   return PETSC_SUCCESS;
116: }

118: static PetscErrorCode ourshellpostsolve(PC pc, KSP ksp, Vec x, Vec y)
119: {
120:   PetscCallFortranVoidFunction((*(void (*)(PC *, KSP *, Vec *, Vec *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[7]))(&pc, &ksp, &x, &y, &ierr));
121:   return PETSC_SUCCESS;
122: }

124: static PetscErrorCode ourshellview(PC pc, PetscViewer view)
125: {
126:   PetscCallFortranVoidFunction((*(void (*)(PC *, PetscViewer *, PetscErrorCode *))(((PetscObject)pc)->fortran_func_pointers[8]))(&pc, &view, &ierr));
127:   return PETSC_SUCCESS;
128: }

130: PETSC_EXTERN void pcshellsetapply_(PC *pc, void (*apply)(void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
131: {
132:   PetscObjectAllocateFortranPointers(*pc, 13);
133:   ((PetscObject)*pc)->fortran_func_pointers[0] = (PetscFortranCallbackFn *)apply;

135:   *ierr = PCShellSetApply(*pc, ourshellapply);
136: }

138: PETSC_EXTERN void pcshellsetmatapply_(PC *pc, void (*matapply)(void *, Mat *, Mat *, PetscErrorCode *), PetscErrorCode *ierr)
139: {
140:   PetscObjectAllocateFortranPointers(*pc, 13);
141:   ((PetscObject)*pc)->fortran_func_pointers[11] = (PetscFortranCallbackFn *)matapply;

143:   *ierr = PCShellSetMatApply(*pc, ourshellmatapply);
144: }

146: PETSC_EXTERN void pcshellsetapplysymmetricleft_(PC *pc, void (*apply)(void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
147: {
148:   PetscObjectAllocateFortranPointers(*pc, 13);
149:   ((PetscObject)*pc)->fortran_func_pointers[9] = (PetscFortranCallbackFn *)apply;

151:   *ierr = PCShellSetApplySymmetricLeft(*pc, ourshellapplysymmetricleft);
152: }

154: PETSC_EXTERN void pcshellsetapplysymmetricright_(PC *pc, void (*apply)(void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
155: {
156:   PetscObjectAllocateFortranPointers(*pc, 13);
157:   ((PetscObject)*pc)->fortran_func_pointers[10] = (PetscFortranCallbackFn *)apply;

159:   *ierr = PCShellSetApplySymmetricRight(*pc, ourshellapplysymmetricright);
160: }

162: PETSC_EXTERN void pcshellsetapplyctx_(PC *pc, void (*apply)(void *, void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
163: {
164:   PetscObjectAllocateFortranPointers(*pc, 13);
165:   ((PetscObject)*pc)->fortran_func_pointers[0] = (PetscFortranCallbackFn *)apply;

167:   *ierr = PCShellSetApply(*pc, ourshellapplyctx);
168: }

170: PETSC_EXTERN void pcshellsetapplyba_(PC *pc, void (*apply)(void *, PCSide *, Vec *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
171: {
172:   PetscObjectAllocateFortranPointers(*pc, 13);
173:   ((PetscObject)*pc)->fortran_func_pointers[1] = (PetscFortranCallbackFn *)apply;

175:   *ierr = PCShellSetApplyBA(*pc, ourshellapplyba);
176: }

178: PETSC_EXTERN void pcshellsetapplyrichardson_(PC *pc, void (*apply)(void *, Vec *, Vec *, Vec *, PetscReal *, PetscReal *, PetscReal *, PetscInt *, PetscBool *, PetscInt *, PCRichardsonConvergedReason *, PetscErrorCode *), PetscErrorCode *ierr)
179: {
180:   PetscObjectAllocateFortranPointers(*pc, 13);
181:   ((PetscObject)*pc)->fortran_func_pointers[2] = (PetscFortranCallbackFn *)apply;
182:   *ierr                                        = PCShellSetApplyRichardson(*pc, ourapplyrichardson);
183: }

185: PETSC_EXTERN void pcshellsetmatapplyrichardson_(PC *pc, void (*matapply)(void *, Mat *, Mat *, Mat *, PetscReal *, PetscReal *, PetscReal *, PetscInt *, PetscBool *, PetscInt *, PCRichardsonConvergedReason *, PetscErrorCode *), PetscErrorCode *ierr)
186: {
187:   PetscObjectAllocateFortranPointers(*pc, 13);
188:   ((PetscObject)*pc)->fortran_func_pointers[12] = (PetscFortranCallbackFn *)matapply;
189:   *ierr                                         = PCShellSetMatApplyRichardson(*pc, ourmatapplyrichardson);
190: }

192: PETSC_EXTERN void pcshellsetapplytranspose_(PC *pc, void (*applytranspose)(void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
193: {
194:   PetscObjectAllocateFortranPointers(*pc, 13);
195:   ((PetscObject)*pc)->fortran_func_pointers[3] = (PetscFortranCallbackFn *)applytranspose;

197:   *ierr = PCShellSetApplyTranspose(*pc, ourshellapplytranspose);
198: }

200: PETSC_EXTERN void pcshellsetsetupctx_(PC *pc, void (*setup)(void *, void *, PetscErrorCode *), PetscErrorCode *ierr)
201: {
202:   PetscObjectAllocateFortranPointers(*pc, 13);
203:   ((PetscObject)*pc)->fortran_func_pointers[4] = (PetscFortranCallbackFn *)setup;

205:   *ierr = PCShellSetSetUp(*pc, ourshellsetupctx);
206: }

208: PETSC_EXTERN void pcshellsetsetup_(PC *pc, void (*setup)(void *, PetscErrorCode *), PetscErrorCode *ierr)
209: {
210:   PetscObjectAllocateFortranPointers(*pc, 13);
211:   ((PetscObject)*pc)->fortran_func_pointers[4] = (PetscFortranCallbackFn *)setup;

213:   *ierr = PCShellSetSetUp(*pc, ourshellsetup);
214: }

216: PETSC_EXTERN void pcshellsetdestroy_(PC *pc, void (*setup)(void *, PetscErrorCode *), PetscErrorCode *ierr)
217: {
218:   PetscObjectAllocateFortranPointers(*pc, 13);
219:   ((PetscObject)*pc)->fortran_func_pointers[5] = (PetscFortranCallbackFn *)setup;

221:   *ierr = PCShellSetDestroy(*pc, ourshelldestroy);
222: }

224: PETSC_EXTERN void pcshellsetpresolve_(PC *pc, void (*presolve)(void *, void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
225: {
226:   PetscObjectAllocateFortranPointers(*pc, 13);
227:   ((PetscObject)*pc)->fortran_func_pointers[6] = (PetscFortranCallbackFn *)presolve;

229:   *ierr = PCShellSetPreSolve(*pc, ourshellpresolve);
230: }

232: PETSC_EXTERN void pcshellsetpostsolve_(PC *pc, void (*postsolve)(void *, void *, Vec *, Vec *, PetscErrorCode *), PetscErrorCode *ierr)
233: {
234:   PetscObjectAllocateFortranPointers(*pc, 13);
235:   ((PetscObject)*pc)->fortran_func_pointers[7] = (PetscFortranCallbackFn *)postsolve;

237:   *ierr = PCShellSetPostSolve(*pc, ourshellpostsolve);
238: }

240: PETSC_EXTERN void pcshellsetview_(PC *pc, void (*view)(void *, PetscViewer *, PetscErrorCode *), PetscErrorCode *ierr)
241: {
242:   PetscObjectAllocateFortranPointers(*pc, 13);
243:   ((PetscObject)*pc)->fortran_func_pointers[8] = (PetscFortranCallbackFn *)view;

245:   *ierr = PCShellSetView(*pc, ourshellview);
246: }