Actual source code: zsles.c

  1: /*$Id: zsles.c,v 1.37 2001/09/11 16:34:57 bsmith Exp $*/

 3:  #include src/fortran/custom/zpetsc.h
 4:  #include petscksp.h
 5:  #include petscda.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 dmmggetksp_              DMMGGETKSP
 20: #define dmmggetlevels_           DMMGGETLEVELS
 21: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 22: #define dmmggetx_                dmmggetx
 23: #define dmmggetj_                dmmggetj
 24: #define dmmggetb_                dmmggetb
 25: #define dmmggetksp_              dmmggetksp
 26: #define dmmggetda_               dmmggetda
 27: #define dmmggetlevels_           dmmggetlevels
 28: #define dmmgsetksp_              dmmgsetksp
 29: #define dmmgdestroy_             dmmgdestroy
 30: #define dmmgcreate_              dmmgcreate
 31: #define dmmgsetup_               dmmgsetup
 32: #define dmmgsetdm_               dmmgsetdm
 33: #define dmmgview_                dmmgview
 34: #define dmmgsolve_               dmmgsolve
 35: #endif

 37: EXTERN_C_BEGIN
 38: static int (PETSC_STDCALL *theirmat)(DMMG*,Mat*,int*);
 39: EXTERN_C_END

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

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

 59: EXTERN_C_BEGIN

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

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

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

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

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

 91: /* ----------------------------------------------------------------------------------------------------------*/

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

106: /* ----------------------------------------------------------------------------------------------------------*/

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

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

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

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

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

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

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

149: EXTERN_C_END