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: }