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 petscsles.h
 5:  #include petscda.h

  7: #ifdef PETSC_HAVE_FORTRAN_CAPS
  8: #define slesdestroy_             SLESDESTROY
  9: #define slescreate_              SLESCREATE
 10: #define slesgetpc_               SLESGETPC
 11: #define slessetoptionsprefix_    SLESSETOPTIONSPREFIX
 12: #define slesappendoptionsprefix_ SLESAPPENDOPTIONSPREFIX
 13: #define slesgetksp_              SLESGETKSP
 14: #define slesgetoptionsprefix_    SLESGETOPTIONSPREFIX
 15: #define slesview_                SLESVIEW
 16: #define dmmgcreate_              DMMGCREATE
 17: #define dmmgdestroy_             DMMGDESTROY
 18: #define dmmgsetup_               DMMGSETUP
 19: #define dmmgsetdm_               DMMGSETDM
 20: #define dmmgview_                DMMGVIEW
 21: #define dmmgsolve_               DMMGSOLVE
 22: #define dmmggetda_               DMMGGETDA
 23: #define dmmgsetsles_             DMMGSETSLES
 24: #define dmmggetx_                DMMGGETX
 25: #define dmmggetj_                DMMGGETJ
 26: #define dmmggetb_                DMMGGETB
 27: #define dmmggetsles_             DMMGGETSLES
 28: #define dmmggetlevels_           DMMGGETLEVELS
 29: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 30: #define dmmggetx_                dmmggetx
 31: #define dmmggetj_                dmmggetj
 32: #define dmmggetb_                dmmggetb
 33: #define dmmggetsles_             dmmggetsles
 34: #define dmmggetda_               dmmggetda
 35: #define dmmggetlevels_           dmmggetlevels
 36: #define dmmgsetsles_             dmmgsetsles
 37: #define dmmgdestroy_             dmmgdestroy
 38: #define dmmgcreate_              dmmgcreate
 39: #define dmmgsetup_               dmmgsetup
 40: #define slessetoptionsprefix_    slessetoptionsprefix
 41: #define slesappendoptionsprefix_ slesappendoptionsprefix
 42: #define slesdestroy_             slesdestroy
 43: #define slescreate_              slescreate
 44: #define slesgetpc_               slesgetpc
 45: #define slesgetksp_              slesgetksp
 46: #define slesgetoptionsprefix_    slesgetoptionsprefix
 47: #define slesview_                slesview
 48: #define dmmgsetdm_               dmmgsetdm
 49: #define dmmgview_                dmmgview
 50: #define dmmgsolve_               dmmgsolve
 51: #endif

 53: EXTERN_C_BEGIN

 55: void PETSC_STDCALL dmmggetx_(DMMG **dmmg,Vec *x,int *ierr)
 56: {
 57:   *0;
 58:   *x    = DMMGGetx(*dmmg);
 59: }

 61: void PETSC_STDCALL dmmggetj_(DMMG **dmmg,Mat *x,int *ierr)
 62: {
 63:   *0;
 64:   *x    = DMMGGetJ(*dmmg);
 65: }

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

 73: void PETSC_STDCALL dmmggetsles_(DMMG **dmmg,SLES *x,int *ierr)
 74: {
 75:   *0;
 76:   *x    = DMMGGetSLES(*dmmg);
 77: }

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

 85: /* ----------------------------------------------------------------------------------------------------------*/
 86: static int ourrhs(DMMG dmmg,Vec vec)
 87: {
 88:   int              0;
 89:   (*(int (PETSC_STDCALL *)(DMMG*,Vec*,int*))(((PetscObject)dmmg->dm)->fortran_func_pointers[0]))(&dmmg,&vec,&ierr);
 90:   return ierr;
 91: }

 93: /*
 94:    Since DMMGSetSLES() immediately calls the matrix functions for each level we do not need to store
 95:   the mat() function inside the DMMG object
 96: */
 97: static int (PETSC_STDCALL *theirmat)(DMMG*,Mat*,int*);
 98: static int ourmat(DMMG dmmg,Mat mat)
 99: {
100:   int              0;
101:   (*theirmat)(&dmmg,&mat,&ierr);
102:   return ierr;
103: }

105: void PETSC_STDCALL dmmgsetsles_(DMMG **dmmg,int (PETSC_STDCALL *rhs)(DMMG*,Vec*,int*),int (PETSC_STDCALL *mat)(DMMG*,Mat*,int*),int *ierr)
106: {
107:   int i;
108:   theirmat = mat;
109:   *DMMGSetSLES(*dmmg,ourrhs,ourmat);
110:   /*
111:     Save the fortran rhs function in the DM on each level; ourrhs() pulls it out when needed
112:   */
113:   for (i=0; i<(**dmmg)->nlevels; i++) {
114:     ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[0] = (void (*)(void))rhs;
115:   }
116: }

118: /* ----------------------------------------------------------------------------------------------------------*/

120: void PETSC_STDCALL dmmggetda_(DMMG *dmmg,DA *da,int *ierr)
121: {
122:   *da   = (DA)(*dmmg)->dm;
123:   *0;
124: }

126: void PETSC_STDCALL dmmgsetdm_(DMMG **dmmg,DM *dm,int *ierr)
127: {
128:   int i;
129:   *DMMGSetDM(*dmmg,*dm);if (*ierr) return;
130:   /* loop over the levels added a place to hang the function pointers in the DM for each level*/
131:   for (i=0; i<(**dmmg)->nlevels; i++) {
132:     *PetscMalloc(3*sizeof(void (*)(void)),&((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers);if (*ierr) return;
133:   }
134: }

136: void PETSC_STDCALL dmmgview_(DMMG **dmmg,PetscViewer *viewer,int *ierr)
137: {
138:   *DMMGView(*dmmg,*viewer);
139: }

141: void PETSC_STDCALL dmmgsolve_(DMMG **dmmg,int *ierr)
142: {
143:   *DMMGSolve(*dmmg);
144: }

146: void PETSC_STDCALL dmmgcreate_(MPI_Comm *comm,int *nlevels,void *user,DMMG **dmmg,int *ierr)
147: {
148:   *DMMGCreate((MPI_Comm)PetscToPointerComm(*comm),*nlevels,user,dmmg);
149: }

151: void PETSC_STDCALL dmmgdestroy_(DMMG **dmmg,int *ierr)
152: {
153:   *DMMGDestroy(*dmmg);
154: }

156: void PETSC_STDCALL dmmgsetup_(DMMG **dmmg,int *ierr)
157: {
158:   *DMMGSetUp(*dmmg);
159: }

161: void PETSC_STDCALL slesview_(SLES *sles,PetscViewer *viewer, int *ierr)
162: {
163:   PetscViewer v;
164:   PetscPatchDefaultViewers_Fortran(viewer,v);
165:   *SLESView(*sles,v);
166: }

168: void PETSC_STDCALL slessetoptionsprefix_(SLES *sles,CHAR prefix PETSC_MIXED_LEN(len),
169:                                          int *ierr PETSC_END_LEN(len))
170: {
171:   char *t;

173:   FIXCHAR(prefix,len,t);
174:   *SLESSetOptionsPrefix(*sles,t);
175:   FREECHAR(prefix,t);
176: }

178: void PETSC_STDCALL slesappendoptionsprefix_(SLES *sles,CHAR prefix PETSC_MIXED_LEN(len),
179:                                             int *ierr PETSC_END_LEN(len))
180: {
181:   char *t;

183:   FIXCHAR(prefix,len,t);
184:   *SLESAppendOptionsPrefix(*sles,t);
185:   FREECHAR(prefix,t);
186: }

188: void PETSC_STDCALL slesgetksp_(SLES *sles,KSP *ksp,int *ierr)
189: {
190:   *SLESGetKSP(*sles,ksp);
191: }

193: void PETSC_STDCALL slesgetpc_(SLES *sles,PC *pc,int *ierr)
194: {
195:   *SLESGetPC(*sles,pc);
196: }

198: void PETSC_STDCALL slesdestroy_(SLES *sles,int *ierr)
199: {
200:   *SLESDestroy(*sles);
201: }

203: void PETSC_STDCALL slescreate_(MPI_Comm *comm,SLES *outsles,int *ierr)
204: {
205:   *SLESCreate((MPI_Comm)PetscToPointerComm(*comm),outsles);

207: }

209: void PETSC_STDCALL slesgetoptionsprefix_(SLES *sles,CHAR prefix PETSC_MIXED_LEN(len),
210:                                          int *ierr PETSC_END_LEN(len))
211: {
212:   char *tname;

214:   *SLESGetOptionsPrefix(*sles,&tname);
215: #if defined(PETSC_USES_CPTOFCD)
216:   {
217:     char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
218:     *PetscStrncpy(t,tname,len1);
219:   }
220: #else
221:   *PetscStrncpy(prefix,tname,len);
222: #endif
223: }

225: EXTERN_C_END