xref: /petsc/src/dm/interface/ftn-custom/zdmf.c (revision b45d2f2cb7e031d9c0de5873eca80614ca7b863b)
1*b45d2f2cSJed Brown #include <petsc-private/fortranimpl.h>
2c6db04a5SJed Brown #include <petscdm.h>
39a42bb27SBarry Smith 
49a42bb27SBarry Smith #if defined(PETSC_HAVE_FORTRAN_CAPS)
524e7ded0SBarry Smith #define dmview_                      DMVIEW
6e727c939SJed Brown #define dmcreatecoloring_            DMCREATECOLORING
77e833e3aSBarry Smith #define dmsetinitialguess_           DMSETINITIALGUESS
87e833e3aSBarry Smith #define dmsetfunction_               DMSETFUNCTION
97e833e3aSBarry Smith #define dmsetjacobian_               DMSETJACOBIAN
10950540a4SJed Brown #define dmcreatematrix_              DMCREATEMATRIX
119a42bb27SBarry Smith #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
1224e7ded0SBarry Smith #define dmview_                      dmview
13e727c939SJed Brown #define dmcreatecoloring_            dmcreatecoloring
147e833e3aSBarry Smith #define dmsetinitialguess_           dmsetinitialguess
157e833e3aSBarry Smith #define dmsetfunction_               dmsetfunction
167e833e3aSBarry Smith #define dmsetjacobian_               dmsetjacobian
17950540a4SJed Brown #define dmcreatematrix_              dmcreatematrix
189a42bb27SBarry Smith #endif
199a42bb27SBarry Smith 
207e833e3aSBarry Smith static PetscErrorCode ourdminitialguess(DM dm,Vec x)
217e833e3aSBarry Smith {
227e833e3aSBarry Smith   PetscErrorCode ierr = 0;
237e833e3aSBarry Smith   (*(void (PETSC_STDCALL *)(DM*,Vec*,PetscErrorCode*))(((PetscObject)dm)->fortran_func_pointers[0]))(&dm,&x,&ierr);CHKERRQ(ierr);
247e833e3aSBarry Smith   return 0;
257e833e3aSBarry Smith }
267e833e3aSBarry Smith 
277e833e3aSBarry Smith static PetscErrorCode ourdmfunction(DM dm,Vec x,Vec b)
287e833e3aSBarry Smith {
297e833e3aSBarry Smith   PetscErrorCode ierr = 0;
307e833e3aSBarry Smith   (*(void (PETSC_STDCALL *)(DM*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)dm)->fortran_func_pointers[1]))(&dm,&x,&b,&ierr);CHKERRQ(ierr);
317e833e3aSBarry Smith   return 0;
327e833e3aSBarry Smith }
337e833e3aSBarry Smith 
347e833e3aSBarry Smith static PetscErrorCode ourdmjacobian(DM dm,Vec x,Mat A,Mat B,MatStructure *str)
357e833e3aSBarry Smith {
367e833e3aSBarry Smith   PetscErrorCode ierr = 0;
377e833e3aSBarry Smith   (*(void (PETSC_STDCALL *)(DM*,Vec*,Mat*,Mat*,MatStructure*,PetscErrorCode*))(((PetscObject)dm)->fortran_func_pointers[2]))(&dm,&x,&A,&B,str,&ierr);CHKERRQ(ierr);
387e833e3aSBarry Smith   return 0;
397e833e3aSBarry Smith }
407e833e3aSBarry Smith 
417e833e3aSBarry Smith EXTERN_C_BEGIN
427e833e3aSBarry Smith void PETSC_STDCALL  dmsetinitialguess_(DM *dm,PetscErrorCode (*f)(DM*,Vec*,PetscErrorCode*), int *ierr )
437e833e3aSBarry Smith {
447e833e3aSBarry Smith   PetscObjectAllocateFortranPointers(*dm,12);
457e833e3aSBarry Smith   ((PetscObject)*dm)->fortran_func_pointers[0] = (PetscVoidFunction)f;
467e833e3aSBarry Smith   *ierr = DMSetInitialGuess(*dm,ourdminitialguess);
477e833e3aSBarry Smith }
487e833e3aSBarry Smith EXTERN_C_END
497e833e3aSBarry Smith 
507e833e3aSBarry Smith EXTERN_C_BEGIN
517e833e3aSBarry Smith void PETSC_STDCALL  dmsetfunction_(DM *dm,PetscErrorCode (*f)(DM*,Vec*,Vec*,PetscErrorCode*), int *ierr )
527e833e3aSBarry Smith {
537e833e3aSBarry Smith   PetscObjectAllocateFortranPointers(*dm,12);
547e833e3aSBarry Smith   ((PetscObject)*dm)->fortran_func_pointers[1] = (PetscVoidFunction)f;
557e833e3aSBarry Smith   *ierr = DMSetFunction(*dm,ourdmfunction);
567e833e3aSBarry Smith }
577e833e3aSBarry Smith EXTERN_C_END
587e833e3aSBarry Smith 
597e833e3aSBarry Smith EXTERN_C_BEGIN
607e833e3aSBarry Smith void PETSC_STDCALL  dmsetjacobian_(DM *dm,PetscErrorCode (*f)(DM*,Vec*,Mat*,Mat*,MatStructure*,PetscErrorCode*), int *ierr )
617e833e3aSBarry Smith {
627e833e3aSBarry Smith   PetscObjectAllocateFortranPointers(*dm,12);
637e833e3aSBarry Smith   ((PetscObject)*dm)->fortran_func_pointers[2] = (PetscVoidFunction)f;
647e833e3aSBarry Smith   *ierr = DMSetJacobian(*dm,ourdmjacobian);
657e833e3aSBarry Smith }
667e833e3aSBarry Smith EXTERN_C_END
677e833e3aSBarry Smith 
689a42bb27SBarry Smith EXTERN_C_BEGIN
69e727c939SJed Brown void PETSC_STDCALL  dmcreatecoloring_(DM *dm,ISColoringType *ctype, CHAR mtype PETSC_MIXED_LEN(len),ISColoring *coloring, int *ierr PETSC_END_LEN(len))
70d1e2c406SBarry Smith {
71d1e2c406SBarry Smith   char *t;
72d1e2c406SBarry Smith 
73d1e2c406SBarry Smith   FIXCHAR(mtype,len,t);
74e727c939SJed Brown   *ierr = DMCreateColoring(*dm,*ctype,t,coloring);
75d1e2c406SBarry Smith   FREECHAR(mtype,t);
76d1e2c406SBarry Smith }
77d1e2c406SBarry Smith EXTERN_C_END
78d1e2c406SBarry Smith 
79d1e2c406SBarry Smith EXTERN_C_BEGIN
8024e7ded0SBarry Smith void PETSC_STDCALL dmview_(DM *da,PetscViewer *vin,PetscErrorCode *ierr)
819a42bb27SBarry Smith {
829a42bb27SBarry Smith   PetscViewer v;
839a42bb27SBarry Smith   PetscPatchDefaultViewers_Fortran(vin,v);
849a42bb27SBarry Smith   *ierr = DMView(*da,v);
859a42bb27SBarry Smith }
86564755cdSBarry Smith EXTERN_C_END
87950540a4SJed Brown 
88950540a4SJed Brown EXTERN_C_BEGIN
89950540a4SJed Brown void PETSC_STDCALL dmcreatematrix_(DM *dm,CHAR mat_type PETSC_MIXED_LEN(len),Mat *J,PetscErrorCode *ierr PETSC_END_LEN(len))
90950540a4SJed Brown {
91950540a4SJed Brown   char *t;
92950540a4SJed Brown   FIXCHAR(mat_type,len,t);
93950540a4SJed Brown   *ierr = DMCreateMatrix(*dm,t,J);
94950540a4SJed Brown   FREECHAR(mat_type,t);
95950540a4SJed Brown }
96950540a4SJed Brown EXTERN_C_END
97