Actual source code: zsles.c

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

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

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

 45: static PetscErrorCode ourrhs(DMMG dmmg,Vec vec)
 46: {
 47:   PetscErrorCode 0;
 48:   (*(void (PETSC_STDCALL *)(DMMG*,Vec*,PetscErrorCode*))(((PetscObject)dmmg->dm)->fortran_func_pointers[0]))(&dmmg,&vec,&ierr);
 49:   return ierr;
 50: }

 52: static PetscErrorCode ourinitialguess(DMMG dmmg,Vec vec)
 53: {
 54:   PetscErrorCode 0;
 55:   (*(void (PETSC_STDCALL *)(DMMG*,Vec*,PetscErrorCode*))(((PetscObject)dmmg->dm)->fortran_func_pointers[1]))(&dmmg,&vec,&ierr);
 56:   return ierr;
 57: }

 59: /*
 60:    Since DMMGSetKSP() immediately calls the matrix functions for each level we do not need to store
 61:   the mat() function inside the DMMG object
 62: */
 63: static PetscErrorCode ourmat(DMMG dmmg,Mat mat)
 64: {
 65:   PetscErrorCode 0;
 66:   (*theirmat)(&dmmg,&mat,&ierr);
 67:   return ierr;
 68: }


 72: void PETSC_STDCALL dmmggetx_(DMMG **dmmg,Vec *x,PetscErrorCode *ierr)
 73: {
 74:   *0;
 75:   *x    = DMMGGetx(*dmmg);
 76: }

 78: void PETSC_STDCALL dmmggetj_(DMMG **dmmg,Mat *x,PetscErrorCode *ierr)
 79: {
 80:   *0;
 81:   *x    = DMMGGetJ(*dmmg);
 82: }

 84: void PETSC_STDCALL dmmggetb_(DMMG **dmmg,Mat *x,PetscErrorCode *ierr)
 85: {
 86:   *0;
 87:   *x    = DMMGGetB(*dmmg);
 88: }

 90: void PETSC_STDCALL dmmggetrhs_(DMMG **dmmg,Vec *x,PetscErrorCode *ierr)
 91: {
 92:   *0;
 93:   *x    = DMMGGetRHS(*dmmg);
 94: }

 96: void PETSC_STDCALL dmmggetksp_(DMMG **dmmg,KSP *x,PetscErrorCode *ierr)
 97: {
 98:   *0;
 99:   *x    = DMMGGetKSP(*dmmg);
100: }

102: void PETSC_STDCALL dmmggetlevels_(DMMG **dmmg,PetscInt *x,PetscErrorCode *ierr)
103: {
104:   *0;
105:   *x    = DMMGGetLevels(*dmmg);
106: }

108: /* ----------------------------------------------------------------------------------------------------------*/
109: void PETSC_STDCALL dmmgsetinitialguess_(DMMG **dmmg,void (PETSC_STDCALL *initialguess)(DMMG*,Vec*,PetscErrorCode*),PetscErrorCode *ierr)
110: {
111:   PetscInt i;

113:   *DMMGSetInitialGuess(*dmmg,ourinitialguess);
114:   /*
115:     Save the fortran initial guess function in the DM on each level; ourinitialguess() pulls it out when needed
116:   */
117:   for (i=0; i<(**dmmg)->nlevels; i++) {
118:     ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[1] = (FCNVOID)initialguess;
119:   }
120: }

122: void PETSC_STDCALL dmmgsetksp_(DMMG **dmmg,void (PETSC_STDCALL *rhs)(DMMG*,Vec*,PetscErrorCode*),void (PETSC_STDCALL *mat)(DMMG*,Mat*,PetscErrorCode*),PetscErrorCode *ierr)
123: {
124:   PetscInt i;
125:   theirmat = mat;
126:   *DMMGSetKSP(*dmmg,ourrhs,ourmat);
127:   /*
128:     Save the fortran rhs function in the DM on each level; ourrhs() pulls it out when needed
129:   */
130:   for (i=0; i<(**dmmg)->nlevels; i++) {
131:     ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[0] = (FCNVOID)rhs;
132:   }
133: }

135: /* ----------------------------------------------------------------------------------------------------------*/

137: void PETSC_STDCALL dmmggetda_(DMMG *dmmg,DA *da,PetscErrorCode *ierr)
138: {
139:   *da   = (DA)(*dmmg)->dm;
140:   *0;
141: }

143: void PETSC_STDCALL dmmgsetdm_(DMMG **dmmg,DM *dm,PetscErrorCode *ierr)
144: {
145:   PetscInt i;
146:   *DMMGSetDM(*dmmg,*dm);if (*ierr) return;
147:   /* loop over the levels added a place to hang the function pointers in the DM for each level*/
148:   for (i=0; i<(**dmmg)->nlevels; i++) {
149:     *PetscMalloc(4*sizeof(FCNVOID),&((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers);if (*ierr) return;
150:   }
151: }

153: void PETSC_STDCALL dmmgview_(DMMG **dmmg,PetscViewer *viewer,PetscErrorCode *ierr)
154: {
155:   *DMMGView(*dmmg,*viewer);
156: }

158: void PETSC_STDCALL dmmgsolve_(DMMG **dmmg,PetscErrorCode *ierr)
159: {
160:   *DMMGSolve(*dmmg);
161: }

163: void PETSC_STDCALL dmmgcreate_(MPI_Comm *comm,PetscInt *nlevels,void *user,DMMG **dmmg,PetscErrorCode *ierr)
164: {
165:   *DMMGCreate((MPI_Comm)PetscToPointerComm(*comm),*nlevels,user,dmmg);
166: }

168: void PETSC_STDCALL dmmgdestroy_(DMMG **dmmg,PetscErrorCode *ierr)
169: {
170:   *DMMGDestroy(*dmmg);
171: }

173: void PETSC_STDCALL dmmgsetup_(DMMG **dmmg,PetscErrorCode *ierr)
174: {
175:   *DMMGSetUp(*dmmg);
176: }