Actual source code: zsnes.c

  1: /*$Id: zsnes.c,v 1.63 2001/08/31 16:15:30 bsmith Exp $*/

 3:  #include src/fortran/custom/zpetsc.h
 4:  #include petscsnes.h
 5:  #include petscda.h

  7: #ifdef PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE
  8: #define snesconverged_tr_                snesconverged_tr__
  9: #define snesconverged_ls_                snesconverged_ls__
 10: #endif

 12: #ifdef PETSC_HAVE_FORTRAN_CAPS
 13: #define dmmgsetsnes_                     DMMGSETSNES
 14: #define matcreatedaad_                   MATCREATEDAAD
 15: #define matregisterdaad_                 MATREGISTERDAAD
 16: #define matdaadsetsnes_                  MATDAADSETSNES
 17: #define snesdacomputejacobian_           SNESDACOMPUTEJACOBIAN
 18: #define snesdacomputejacobianwithadifor_ SNESDACOMPUTEJACOBIANWITHADIFOR
 19: #define snesdaformfunction_              SNESDAFORMFUNCTION          
 20: #define snesconverged_tr_                SNESCONVERGED_TR
 21: #define snesconverged_ls_                SNESCONVERGED_LS
 22: #define snesgetconvergedreason_          SNESGETCONVERGEDREASON
 23: #define snesdefaultmonitor_              SNESDEFAULTMONITOR
 24: #define snesvecviewmonitor_              SNESVECVIEWMONITOR
 25: #define sneslgmonitor_                   SNESLGMONITOR
 26: #define snesvecviewupdatemonitor_        SNESVECVIEWUPDATEMONITOR
 27: #define snesregisterdestroy_             SNESREGISTERDESTROY
 28: #define snessetjacobian_                 SNESSETJACOBIAN
 29: #define snescreate_                      SNESCREATE
 30: #define snessetfunction_                 SNESSETFUNCTION
 31: #define snesgetksp_                     SNESGETKSP
 32: #define snessetmonitor_                  SNESSETMONITOR
 33: #define snessetconvergencetest_          SNESSETCONVERGENCETEST
 34: #define snesregisterdestroy_             SNESREGISTERDESTROY
 35: #define snesgetsolution_                 SNESGETSOLUTION
 36: #define snesgetsolutionupdate_           SNESGETSOLUTIONUPDATE
 37: #define snesgetfunction_                 SNESGETFUNCTION
 38: #define snesdestroy_                     SNESDESTROY
 39: #define snesgettype_                     SNESGETTYPE
 40: #define snessetoptionsprefix_            SNESSETOPTIONSPREFIX 
 41: #define snesappendoptionsprefix_         SNESAPPENDOPTIONSPREFIX 
 42: #define matcreatesnesmf_                 MATCREATESNESMF
 43: #define matcreatemf_                     MATCREATEMF
 44: #define snessettype_                     SNESSETTYPE
 45: #define snesgetconvergencehistory_       SNESGETCONVERGENCEHISTORY
 46: #define snesdefaultcomputejacobian_      SNESDEFAULTCOMPUTEJACOBIAN
 47: #define snesdefaultcomputejacobiancolor_ SNESDEFAULTCOMPUTEJACOBIANCOLOR
 48: #define matsnesmfsettype_                MATSNESMFSETTYPE
 49: #define snesgetoptionsprefix_            SNESGETOPTIONSPREFIX
 50: #define snesgetjacobian_                 SNESGETJACOBIAN
 51: #define matsnesmfsetfunction_            MATSNESMFSETFUNCTION
 52: #define snessetlinesearchparams_         SNESSETLINESEARCHPARAMS
 53: #define snesgetlinesearchparams_         SNESGETLINESEARCHPARAMS
 54: #define snessetlinesearch_               SNESSETLINESEARCH
 55: #define snessetlinesearchcheck_          SNESSETLINESEARCHCHECK
 56: #define snescubiclinesearch_             SNESCUBICLINESEARCH
 57: #define snesquadraticlinesearch_         SNESQUADRATICLINESEARCH
 58: #define snesnolinesearch_                SNESNOLINESEARCH
 59: #define snesnolinesearchnonorms_         SNESNOLINESEARCHNONORMS
 60: #define snesview_                        SNESVIEW
 61: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 62: #define dmmgsetsnes_                     dmmgsetsnes
 63: #define matcreatedaad_                   matcreatedaad
 64: #define matregisterdaad_                 matregisterdaad
 65: #define matdaadsetsnes_                  matdaadsetsnes
 66: #define snesdacomputejacobian_           snesdacomputejacobian
 67: #define snesdacomputejacobianwithadifor_ snesdacomputejacobianwithadifor
 68: #define snesdaformfunction_              snesdaformfunction
 69: #define snescubiclinesearch_             snescubiclinesearch     
 70: #define snesquadraticlinesearch_         snesquadraticlinesearch    
 71: #define snesnolinesearch_                snesnolinesearch    
 72: #define snesnolinesearchnonorms_         snesnolinesearchnonorms    
 73: #define snessetlinesearchparams_         snessetlinesearchparams
 74: #define snesgetlinesearchparams_         snesgetlinesearchparams
 75: #define snessetlinesearch_               snessetlinesearch
 76: #define snessetlinesearchcheck_          snessetlinesearchcheck
 77: #define snesconverged_tr_                snesconverged_tr
 78: #define snesconverged_ls_                snesconverged_ls
 79: #define snesgetconvergedreason_          snesgetconvergedreason
 80: #define sneslgmonitor_                   sneslgmonitor
 81: #define snesdefaultmonitor_              snesdefaultmonitor
 82: #define snesvecviewmonitor_              snesvecviewmonitor
 83: #define snesvecviewupdatemonitor_        snesvecviewupdatemonitor
 84: #define matsnesmfsetfunction_            matsnesmfsetfunction
 85: #define snesregisterdestroy_             snesregisterdestroy
 86: #define snessetjacobian_                 snessetjacobian
 87: #define snescreate_                      snescreate
 88: #define snessetfunction_                 snessetfunction
 89: #define snesgetksp_                     snesgetksp
 90: #define snesdestroy_                     snesdestroy
 91: #define snessetmonitor_                  snessetmonitor
 92: #define snessetconvergencetest_          snessetconvergencetest
 93: #define snesregisterdestroy_             snesregisterdestroy
 94: #define snesgetsolution_                 snesgetsolution
 95: #define snesgetsolutionupdate_           snesgetsolutionupdate
 96: #define snesgetfunction_                 snesgetfunction
 97: #define snesgettype_                     snesgettype
 98: #define snessetoptionsprefix_            snessetoptionsprefix 
 99: #define snesappendoptionsprefix_         snesappendoptionsprefix
100: #define matcreatesnesmf_                 matcreatesnesmf
101: #define matcreatemf_                     matcreatemf
102: #define snessettype_                     snessettype
103: #define snesgetconvergencehistory_       snesgetconvergencehistory
104: #define snesdefaultcomputejacobian_      snesdefaultcomputejacobian
105: #define snesdefaultcomputejacobiancolor_ snesdefaultcomputejacobiancolor
106: #define matsnesmfsettype_                matsnesmfsettype
107: #define snesgetoptionsprefix_            snesgetoptionsprefix
108: #define snesgetjacobian_                 snesgetjacobian
109: #define snesview_                        snesview
110: #endif

112: EXTERN_C_BEGIN
113: static void (PETSC_STDCALL *f7)(SNES*,int*,PetscReal*,void*,int*);
114: static void (PETSC_STDCALL *f71)(void*,int*);
115: static void (PETSC_STDCALL *f8)(SNES*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,int*);
116: static void (PETSC_STDCALL *f2)(SNES*,Vec*,Vec*,void*,int*);
117: static void (PETSC_STDCALL *f11)(SNES*,Vec*,Vec*,void*,int*);
118: static void (PETSC_STDCALL *f3)(SNES*,Vec*,Mat*,Mat*,MatStructure*,void*,int*);
119: static void (PETSC_STDCALL *f73)(SNES*,void *,Vec*,Vec*,Vec*,Vec*,Vec*,PetscReal*,PetscReal*,PetscReal*,int*,int*);
120: static void (PETSC_STDCALL *f74)(SNES*,void *,Vec*,PetscTruth*,int*);
121: EXTERN_C_END

123: /* These are not extern C because they are passed into non-extern C user level functions */
124: int OurSNESLineSearch(SNES snes,void *ctx,Vec x,Vec f,Vec g,Vec y,Vec w,PetscReal fnorm,PetscReal*ynorm,PetscReal*gnorm,int *flag)
125: {
126:   int 0;
127:   (*f73)(&snes,(void*)&ctx,&x,&f,&g,&y,&w,&fnorm,ynorm,gnorm,flag,&ierr);
128:   return 0;
129: }

131: int OurSNESLineSearchCheck(SNES snes,void *checkCtx,Vec x,PetscTruth *flag)
132: {
133:   int 0;
134:   (*f74)(&snes,(void*)&checkCtx,&x,flag,&ierr);
135:   return 0;
136: }

138: static int oursnesmonitor(SNES snes,int i,PetscReal d,void*ctx)
139: {
140:   int              0;

142:   (*f7)(&snes,&i,&d,ctx,&ierr);
143:   return 0;
144: }
145: static int ourmondestroy(void* ctx)
146: {
147:   int              0;

149:   (*f71)(ctx,&ierr);
150:   return 0;
151: }
152: static int oursnestest(SNES snes,PetscReal a,PetscReal d,PetscReal c,SNESConvergedReason*reason,void*ctx)
153: {
154:   int              0;

156:   (*f8)(&snes,&a,&d,&c,reason,ctx,&ierr);
157:   return 0;
158: }
159: static int oursnesfunction(SNES snes,Vec x,Vec f,void *ctx)
160: {
161:   int 0;
162:   (*f2)(&snes,&x,&f,ctx,&ierr);
163:   return 0;
164: }
165: static int ourmatsnesmffunction(SNES snes,Vec x,Vec f,void *ctx)
166: {
167:   int 0;
168:   (*f11)(&snes,&x,&f,ctx,&ierr);
169:   return 0;
170: }
171: static int oursnesjacobian(SNES snes,Vec x,Mat* m,Mat* p,MatStructure* type,void*ctx)
172: {
173:   int              0;
174:   (*f3)(&snes,&x,m,p,type,ctx,&ierr);
175:   return 0;
176: }

178: EXTERN_C_BEGIN

180: #if defined(notused)
181: static int ourrhs(SNES snes,Vec vec,Vec vec2,void*ctx)
182: {
183:   int              0;
184:   DMMG *dmmg = (DMMG*)ctx;
185:   (*(int (PETSC_STDCALL *)(SNES*,Vec*,Vec*,int*))(((PetscObject)dmmg->dm)->fortran_func_pointers[0]))(&snes,&vec,&vec2,&ierr);
186:   return ierr;
187: }

189: static int ourmat(DMMG dmmg,Mat mat)
190: {
191:   int              0;
192:   (*(int (PETSC_STDCALL *)(DMMG*,Vec*,int*))(((PetscObject)dmmg->dm)->fortran_func_pointers[1]))(&dmmg,&vec,&ierr);
193:   return ierr;
194: }

196: void PETSC_STDCALL dmmgsetsnes_(DMMG **dmmg,int (PETSC_STDCALL *rhs)(SNES*,Vec*,Vec*,int*),int (PETSC_STDCALL *mat)(DMMG*,Mat*,int*),int *ierr)
197: {
198:   int i;
199:   theirmat = mat;
200:   *DMMGSetSNES(*dmmg,ourrhs,ourmat,*dmmg);
201:   /*
202:     Save the fortran rhs function in the DM on each level; ourrhs() pulls it out when needed
203:   */
204:   for (i=0; i<(**dmmg)->nlevels; i++) {
205:     ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[0] = (FCNVOID)rhs;
206:     ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[1] = (FCNVOID)mat;
207:   }
208: }

210: #endif

212: #if defined (PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
213: void PETSC_STDCALL matregisterdaad_(int *ierr)
214: {
215:   *MatRegisterDAAD();
216: }

218: void PETSC_STDCALL matcreatedaad_(DA *da,Mat *mat,int *ierr)
219: {
220:   *MatCreateDAAD(*da,mat);
221: }

223: void PETSC_STDCALL matdaadsetsnes_(Mat *mat,SNES *snes,int *ierr)
224: {
225:   *MatDAADSetSNES(*mat,*snes);
226: }
227: #endif

229: void PETSC_STDCALL snesview_(SNES *snes,PetscViewer *viewer, int *ierr)
230: {
231:   PetscViewer v;
232:   PetscPatchDefaultViewers_Fortran(viewer,v);
233:   *SNESView(*snes,v);
234: }

236: void PETSC_STDCALL snesgetconvergedreason_(SNES *snes,SNESConvergedReason *r,int *ierr)
237: {
238:   *SNESGetConvergedReason(*snes,r);
239: }

241: void PETSC_STDCALL snessetlinesearchparams_(SNES *snes,PetscReal *alpha,PetscReal *maxstep,PetscReal *steptol,int *ierr)
242: {
243:   *SNESSetLineSearchParams(*snes,*alpha,*maxstep,*steptol);
244: }

246: void PETSC_STDCALL snesgetlinesearchparams_(SNES *snes,PetscReal *alpha,PetscReal *maxstep,PetscReal *steptol,int *ierr)
247: {
248:   CHKFORTRANNULLREAL(alpha);
249:   CHKFORTRANNULLREAL(maxstep);
250:   CHKFORTRANNULLREAL(steptol);
251:   *SNESGetLineSearchParams(*snes,alpha,maxstep,steptol);
252: }

254: /*  func is currently ignored from Fortran */
255: void PETSC_STDCALL snesgetjacobian_(SNES *snes,Mat *A,Mat *B,void **ctx,int *func,int *ierr)
256: {
257:   CHKFORTRANNULLINTEGER(ctx);
258:   CHKFORTRANNULLOBJECT(A);
259:   CHKFORTRANNULLOBJECT(B);
260:   *SNESGetJacobian(*snes,A,B,ctx,0);
261: }

263: void PETSC_STDCALL matsnesmfsettype_(Mat *mat,CHAR ftype PETSC_MIXED_LEN(len),
264:                                      int *ierr PETSC_END_LEN(len))
265: {
266:   char *t;
267:   FIXCHAR(ftype,len,t);
268:   *MatSNESMFSetType(*mat,t);
269:   FREECHAR(ftype,t);
270: }

272: void PETSC_STDCALL snesgetconvergencehistory_(SNES *snes,int *na,int *ierr)
273: {
274:   *SNESGetConvergenceHistory(*snes,PETSC_NULL,PETSC_NULL,na);
275: }

277: void PETSC_STDCALL snessettype_(SNES *snes,CHAR type PETSC_MIXED_LEN(len),
278:                                 int *ierr PETSC_END_LEN(len))
279: {
280:   char *t;

282:   FIXCHAR(type,len,t);
283:   *SNESSetType(*snes,t);
284:   FREECHAR(type,t);
285: }

287: void PETSC_STDCALL snesappendoptionsprefix_(SNES *snes,CHAR prefix PETSC_MIXED_LEN(len),
288:                                             int *ierr PETSC_END_LEN(len))
289: {
290:   char *t;

292:   FIXCHAR(prefix,len,t);
293:   *SNESAppendOptionsPrefix(*snes,t);
294:   FREECHAR(prefix,t);
295: }

297: void PETSC_STDCALL matcreatesnesmf_(SNES *snes,Vec *x,Mat *J,int *ierr)
298: {
299:   *MatCreateSNESMF(*snes,*x,J);
300: }

302: void PETSC_STDCALL matcreatemf_(Vec *x,Mat *J,int *ierr)
303: {
304:   *MatCreateMF(*x,J);
305: }

307: /* functions, hence no STDCALL */

309: void sneslgmonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
310: {
311:   *SNESLGMonitor(*snes,*its,*fgnorm,dummy);
312: }

314: void snesdefaultmonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
315: {
316:   *SNESDefaultMonitor(*snes,*its,*fgnorm,dummy);
317: }

319: void snesvecviewmonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
320: {
321:   *SNESVecViewMonitor(*snes,*its,*fgnorm,dummy);
322: }

324: void snesvecviewupdatemonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
325: {
326:   *SNESVecViewUpdateMonitor(*snes,*its,*fgnorm,dummy);
327: }


330: void PETSC_STDCALL snessetmonitor_(SNES *snes,void (PETSC_STDCALL *func)(SNES*,int*,PetscReal*,void*,int*),
331:                     void *mctx,void (PETSC_STDCALL *mondestroy)(void *,int *),int *ierr)
332: {
333:   CHKFORTRANNULLOBJECT(mctx);
334:   if ((FCNVOID)func == (FCNVOID)snesdefaultmonitor_) {
335:     *SNESSetMonitor(*snes,SNESDefaultMonitor,0,0);
336:   } else if ((FCNVOID)func == (FCNVOID)snesvecviewmonitor_) {
337:     *SNESSetMonitor(*snes,SNESVecViewMonitor,0,0);
338:   } else if ((FCNVOID)func == (FCNVOID)snesvecviewupdatemonitor_) {
339:     *SNESSetMonitor(*snes,SNESVecViewUpdateMonitor,0,0);
340:   } else if ((FCNVOID)func == (FCNVOID)sneslgmonitor_) {
341:     *SNESSetMonitor(*snes,SNESLGMonitor,0,0);
342:   } else {
343:     f7 = func;
344:     if (FORTRANNULLFUNCTION(mondestroy)){
345:       *SNESSetMonitor(*snes,oursnesmonitor,mctx,0);
346:     } else {
347:       f71 = mondestroy;
348:       *SNESSetMonitor(*snes,oursnesmonitor,mctx,ourmondestroy);
349:     }
350:   }
351: }

353: /* -----------------------------------------------------------------------------------------------------*/
354: void snescubiclinesearch_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
355:                                         PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
356: {
357:   *SNESCubicLineSearch(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
358: }
359: void snesquadraticlinesearch_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
360:                                         PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
361: {
362:   *SNESQuadraticLineSearch(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
363: }
364: void snesnolinesearch_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
365:                                         PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
366: {
367:   *SNESNoLineSearch(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
368: }
369: void snesnolinesearchnonorms_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
370:                                         PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
371: {
372:   *SNESNoLineSearchNoNorms(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
373: }


376: void PETSC_STDCALL snessetlinesearch_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,void *,Vec*,Vec*,Vec*,Vec*,Vec*,PetscReal*,PetscReal*,PetscReal*,int*,int*),void *ctx,int *ierr)
377: {
378:   if ((FCNVOID)f == (FCNVOID)snescubiclinesearch_) {
379:     *SNESSetLineSearch(*snes,SNESCubicLineSearch,ctx);
380:   } else if ((FCNVOID)f == (FCNVOID)snesquadraticlinesearch_) {
381:     *SNESSetLineSearch(*snes,SNESQuadraticLineSearch,ctx);
382:   } else if ((FCNVOID)f == (FCNVOID)snesnolinesearch_) {
383:     *SNESSetLineSearch(*snes,SNESNoLineSearch,ctx);
384:   } else if ((FCNVOID)f == (FCNVOID)snesnolinesearchnonorms_) {
385:     *SNESSetLineSearch(*snes,SNESNoLineSearchNoNorms,ctx);
386:   } else {
387:     f73 = f;
388:     *SNESSetLineSearch(*snes,OurSNESLineSearch,ctx);
389:   }
390: }


393: void PETSC_STDCALL snessetlinesearchcheck_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,void *,Vec*,PetscTruth*,int*),void *ctx,int *ierr)
394: {
395:   f74 = f;
396:   *SNESSetLineSearchCheck(*snes,OurSNESLineSearchCheck,ctx);
397: }

399: /*----------------------------------------------------------------------*/

401: void snesconverged_tr_(SNES *snes,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,
402:                                        void *ct,int *ierr)
403: {
404:   *SNESConverged_TR(*snes,*a,*b,*c,r,ct);
405: }

407: void snesconverged_ls_(SNES *snes,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,
408:                                        void *ct,int *ierr)
409: {
410:   *SNESConverged_LS(*snes,*a,*b,*c,r,ct);
411: }


414: void PETSC_STDCALL snessetconvergencetest_(SNES *snes,
415:        void (PETSC_STDCALL *func)(SNES*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,int*),
416:        void *cctx,int *ierr)
417: {
418:   CHKFORTRANNULLOBJECT(cctx);
419:   if ((FCNVOID)func == (FCNVOID)snesconverged_ls_){
420:     *SNESSetConvergenceTest(*snes,SNESConverged_LS,0);
421:   } else if ((FCNVOID)func == (FCNVOID)snesconverged_tr_){
422:     *SNESSetConvergenceTest(*snes,SNESConverged_TR,0);
423:   } else {
424:     f8 = func;
425:     *SNESSetConvergenceTest(*snes,oursnestest,cctx);
426:   }
427: }

429: /*--------------------------------------------------------------------------------------------*/

431: void PETSC_STDCALL snesgetsolution_(SNES *snes,Vec *x,int *ierr)
432: {
433:   *SNESGetSolution(*snes,x);
434: }

436: void PETSC_STDCALL snesgetsolutionupdate_(SNES *snes,Vec *x,int *ierr)
437: {
438:   *SNESGetSolutionUpdate(*snes,x);
439: }

441: /* the func argument is ignored */
442: void PETSC_STDCALL snesgetfunction_(SNES *snes,Vec *r,void **ctx,void *func,int *ierr)
443: {
444:   CHKFORTRANNULLINTEGER(ctx);
445:   CHKFORTRANNULLINTEGER(r);
446:   *SNESGetFunction(*snes,r,ctx,PETSC_NULL);
447: }

449: void PETSC_STDCALL snesdestroy_(SNES *snes,int *ierr)
450: {
451:   *SNESDestroy(*snes);
452: }

454: void PETSC_STDCALL snesgetksp_(SNES *snes,KSP *ksp,int *ierr)
455: {
456:   *SNESGetKSP(*snes,ksp);
457: }

459: /* ---------------------------------------------------------*/


462: /*
463:         These are not usually called from Fortran but allow Fortran users 
464:    to transparently set these monitors from .F code
465:    
466:    functions, hence no STDCALL
467: */
468: void  snesdaformfunction_(SNES *snes,Vec *X, Vec *F,void *ptr,int *ierr)
469: {
470:   *SNESDAFormFunction(*snes,*X,*F,ptr);
471: }


474: void PETSC_STDCALL snessetfunction_(SNES *snes,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,int*),
475:                       void *ctx,int *ierr)
476: {
477:   CHKFORTRANNULLOBJECT(ctx);
478:   f2 = func;
479:   if ((FCNVOID)func == (FCNVOID)snesdaformfunction_) {
480:     *SNESSetFunction(*snes,*r,SNESDAFormFunction,ctx);
481:   } else {
482:     *SNESSetFunction(*snes,*r,oursnesfunction,ctx);
483:   }
484: }

486: /* ---------------------------------------------------------*/

488: void PETSC_STDCALL matsnesmfsetfunction_(Mat *mat,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,int*),
489:                       void *ctx,int *ierr){
490:   f11 = func;
491:   CHKFORTRANNULLOBJECT(ctx);
492:   *MatSNESMFSetFunction(*mat,*r,ourmatsnesmffunction,ctx);
493: }
494: /* ---------------------------------------------------------*/

496: void PETSC_STDCALL snescreate_(MPI_Comm *comm,SNES *outsnes,int *ierr){

498: *SNESCreate((MPI_Comm)PetscToPointerComm(*comm),outsnes);
499: }

501: /* ---------------------------------------------------------*/
502: /*
503:      snesdefaultcomputejacobian() and snesdefaultcomputejacobiancolor()
504:   These can be used directly from Fortran but are mostly so that 
505:   Fortran SNESSetJacobian() will properly handle the defaults being passed in.

507:   functions, hence no STDCALL
508: */
509: void snesdefaultcomputejacobian_(SNES *snes,Vec *x,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
510: {
511:   *SNESDefaultComputeJacobian(*snes,*x,m,p,type,ctx);
512: }
513: void  snesdefaultcomputejacobiancolor_(SNES *snes,Vec *x,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
514: {
515:   *SNESDefaultComputeJacobianColor(*snes,*x,m,p,type,*(MatFDColoring*)ctx);
516: }

518: void  snesdacomputejacobianwithadifor_(SNES *snes,Vec *X,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
519: {
520:   (*PetscErrorPrintf)("Cannot call this function from Fortran");
521:   *1;
522: }

524: void  snesdacomputejacobian_(SNES *snes,Vec *X,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
525: {
526:   (*PetscErrorPrintf)("Cannot call this function from Fortran");
527:   *1;
528: }

530: void PETSC_STDCALL snessetjacobian_(SNES *snes,Mat *A,Mat *B,void (PETSC_STDCALL *func)(SNES*,Vec*,Mat*,Mat*,
531:             MatStructure*,void*,int*),void *ctx,int *ierr)
532: {
533:   CHKFORTRANNULLOBJECT(ctx);
534:   if ((FCNVOID)func == (FCNVOID)snesdefaultcomputejacobian_) {
535:     *SNESSetJacobian(*snes,*A,*B,SNESDefaultComputeJacobian,ctx);
536:   } else if ((FCNVOID)func == (FCNVOID)snesdefaultcomputejacobiancolor_) {
537:     *SNESSetJacobian(*snes,*A,*B,SNESDefaultComputeJacobianColor,*(MatFDColoring*)ctx);
538:   } else if ((FCNVOID)func == (FCNVOID)snesdacomputejacobianwithadifor_) {
539:     *SNESSetJacobian(*snes,*A,*B,SNESDAComputeJacobianWithAdifor,ctx);
540:   } else if ((FCNVOID)func == (FCNVOID)snesdacomputejacobian_) {
541:     *SNESSetJacobian(*snes,*A,*B,SNESDAComputeJacobian,ctx);
542:   } else {
543:     f3 = func;
544:     *SNESSetJacobian(*snes,*A,*B,oursnesjacobian,ctx);
545:   }
546: }

548: /* -------------------------------------------------------------*/

550: void PETSC_STDCALL snesregisterdestroy_(int *ierr)
551: {
552:   *SNESRegisterDestroy();
553: }

555: void PETSC_STDCALL snesgettype_(SNES *snes,CHAR name PETSC_MIXED_LEN(len),
556:                                 int *ierr PETSC_END_LEN(len))
557: {
558:   char *tname;

560:   *SNESGetType(*snes,&tname);
561: #if defined(PETSC_USES_CPTOFCD)
562:   {
563:     char *t = _fcdtocp(name); int len1 = _fcdlen(name);
564:     *PetscStrncpy(t,tname,len1);if (*ierr) return;
565:   }
566: #else
567:   *PetscStrncpy(name,tname,len);if (*ierr) return;
568: #endif
569: }

571: void PETSC_STDCALL snesgetoptionsprefix_(SNES *snes,CHAR prefix PETSC_MIXED_LEN(len),
572:                                          int *ierr PETSC_END_LEN(len))
573: {
574:   char *tname;

576:   *SNESGetOptionsPrefix(*snes,&tname);
577: #if defined(PETSC_USES_CPTOFCD)
578:   {
579:     char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
580:     *PetscStrncpy(t,tname,len1);if (*ierr) return;
581:   }
582: #else
583:   *PetscStrncpy(prefix,tname,len);if (*ierr) return;
584: #endif
585: }

587: EXTERN_C_END