Actual source code: zsles.c

 2:  #include src/fortran/custom/zpetsc.h
 3:  #include petscksp.h
 4:  #include petscda.h

  6: #ifdef PETSC_HAVE_FORTRAN_CAPS
  7: #define dmmgcreate_              DMMGCREATE
  8: #define dmmgdestroy_             DMMGDESTROY
  9: #define dmmgsetup_               DMMGSETUP
 10: #define dmmgsetdm_               DMMGSETDM
 11: #define dmmgview_                DMMGVIEW
 12: #define dmmgsolve_               DMMGSOLVE
 13: #define dmmggetda_               DMMGGETDA
 14: #define dmmgsetksp_              DMMGSETKSP
 15: #define dmmggetx_                DMMGGETX
 16: #define dmmggetj_                DMMGGETJ
 17: #define dmmggetb_                DMMGGETB
 18: #define dmmggetksp_              DMMGGETKSP
 19: #define dmmggetlevels_           DMMGGETLEVELS
 20: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 21: #define dmmggetx_                dmmggetx
 22: #define dmmggetj_                dmmggetj
 23: #define dmmggetb_                dmmggetb
 24: #define dmmggetksp_              dmmggetksp
 25: #define dmmggetda_               dmmggetda
 26: #define dmmggetlevels_           dmmggetlevels
 27: #define dmmgsetksp_              dmmgsetksp
 28: #define dmmgdestroy_             dmmgdestroy
 29: #define dmmgcreate_              dmmgcreate
 30: #define dmmgsetup_               dmmgsetup
 31: #define dmmgsetdm_               dmmgsetdm
 32: #define dmmgview_                dmmgview
 33: #define dmmgsolve_               dmmgsolve
 34: #endif

 37: static void (PETSC_STDCALL *theirmat)(DMMG*,Mat*,PetscErrorCode*);

 40: static PetscErrorCode ourrhs(DMMG dmmg,Vec vec)
 41: {
 42:   PetscErrorCode 0;
 43:   (*(void (PETSC_STDCALL *)(DMMG*,Vec*,PetscErrorCode*))(((PetscObject)dmmg->dm)->fortran_func_pointers[0]))(&dmmg,&vec,&ierr);
 44:   return ierr;
 45: }

 47: /*
 48:    Since DMMGSetKSP() immediately calls the matrix functions for each level we do not need to store
 49:   the mat() function inside the DMMG object
 50: */
 51: static PetscErrorCode ourmat(DMMG dmmg,Mat mat)
 52: {
 53:   PetscErrorCode 0;
 54:   (*theirmat)(&dmmg,&mat,&ierr);
 55:   return ierr;
 56: }


 60: void PETSC_STDCALL dmmggetx_(DMMG **dmmg,Vec *x,PetscErrorCode *ierr)
 61: {
 62:   *0;
 63:   *x    = DMMGGetx(*dmmg);
 64: }

 66: void PETSC_STDCALL dmmggetj_(DMMG **dmmg,Mat *x,PetscErrorCode *ierr)
 67: {
 68:   *0;
 69:   *x    = DMMGGetJ(*dmmg);
 70: }

 72: void PETSC_STDCALL dmmggetB_(DMMG **dmmg,Mat *x,PetscErrorCode *ierr)
 73: {
 74:   *0;
 75:   *x    = DMMGGetB(*dmmg);
 76: }

 78: void PETSC_STDCALL dmmggetksp_(DMMG **dmmg,KSP *x,PetscErrorCode *ierr)
 79: {
 80:   *0;
 81:   *x    = DMMGGetKSP(*dmmg);
 82: }

 84: void PETSC_STDCALL dmmggetlevels_(DMMG **dmmg,PetscInt *x,PetscErrorCode *ierr)
 85: {
 86:   *0;
 87:   *x    = DMMGGetLevels(*dmmg);
 88: }

 90: /* ----------------------------------------------------------------------------------------------------------*/

 92: void PETSC_STDCALL dmmgsetksp_(DMMG **dmmg,void (PETSC_STDCALL *rhs)(DMMG*,Vec*,PetscErrorCode*),void (PETSC_STDCALL *mat)(DMMG*,Mat*,PetscErrorCode*),PetscErrorCode *ierr)
 93: {
 94:   PetscInt i;
 95:   theirmat = mat;
 96:   *DMMGSetKSP(*dmmg,ourrhs,ourmat);
 97:   /*
 98:     Save the fortran rhs function in the DM on each level; ourrhs() pulls it out when needed
 99:   */
100:   for (i=0; i<(**dmmg)->nlevels; i++) {
101:     ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[0] = (FCNVOID)rhs;
102:   }
103: }

105: /* ----------------------------------------------------------------------------------------------------------*/

107: void PETSC_STDCALL dmmggetda_(DMMG *dmmg,DA *da,PetscErrorCode *ierr)
108: {
109:   *da   = (DA)(*dmmg)->dm;
110:   *0;
111: }

113: void PETSC_STDCALL dmmgsetdm_(DMMG **dmmg,DM *dm,PetscErrorCode *ierr)
114: {
115:   PetscInt i;
116:   *DMMGSetDM(*dmmg,*dm);if (*ierr) return;
117:   /* loop over the levels added a place to hang the function pointers in the DM for each level*/
118:   for (i=0; i<(**dmmg)->nlevels; i++) {
119:     *PetscMalloc(3*sizeof(FCNVOID),&((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers);if (*ierr) return;
120:   }
121: }

123: void PETSC_STDCALL dmmgview_(DMMG **dmmg,PetscViewer *viewer,PetscErrorCode *ierr)
124: {
125:   *DMMGView(*dmmg,*viewer);
126: }

128: void PETSC_STDCALL dmmgsolve_(DMMG **dmmg,PetscErrorCode *ierr)
129: {
130:   *DMMGSolve(*dmmg);
131: }

133: void PETSC_STDCALL dmmgcreate_(MPI_Comm *comm,PetscInt *nlevels,void *user,DMMG **dmmg,PetscErrorCode *ierr)
134: {
135:   *DMMGCreate((MPI_Comm)PetscToPointerComm(*comm),*nlevels,user,dmmg);
136: }

138: void PETSC_STDCALL dmmgdestroy_(DMMG **dmmg,PetscErrorCode *ierr)
139: {
140:   *DMMGDestroy(*dmmg);
141: }

143: void PETSC_STDCALL dmmgsetup_(DMMG **dmmg,PetscErrorCode *ierr)
144: {
145:   *DMMGSetUp(*dmmg);
146: }