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

114: EXTERN_C_BEGIN

116: #if defined(notused)
117: static int ourrhs(SNES snes,Vec vec,Vec vec2,void*ctx)
118: {
119:   int              0;
120:   DMMG *dmmg = (DMMG*)ctx;
121:   (*(int (PETSC_STDCALL *)(SNES*,Vec*,Vec*,int*))(((PetscObject)dmmg->dm)->fortran_func_pointers[0]))(&snes,&vec,&vec2,&ierr);
122:   return ierr;
123: }

125: static int ourmat(DMMG dmmg,Mat mat)
126: {
127:   int              0;
128:   (*(int (PETSC_STDCALL *)(DMMG*,Vec*,int*))(((PetscObject)dmmg->dm)->fortran_func_pointers[1]))(&dmmg,&vec,&ierr);
129:   return ierr;
130: }

132: void PETSC_STDCALL dmmgsetsnes_(DMMG **dmmg,int (PETSC_STDCALL *rhs)(SNES*,Vec*,Vec*,int*),int (PETSC_STDCALL *mat)(DMMG*,Mat*,int*),int *ierr)
133: {
134:   int i;
135:   theirmat = mat;
136:   *DMMGSetSNES(*dmmg,ourrhs,ourmat,*dmmg);
137:   /*
138:     Save the fortran rhs function in the DM on each level; ourrhs() pulls it out when needed
139:   */
140:   for (i=0; i<(**dmmg)->nlevels; i++) {
141:     ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[0] = (void (*)(void))rhs;
142:     ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[1] = (void (*)(void))mat;
143:   }
144: }

146: #endif

148: #if defined (PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX)
149: void PETSC_STDCALL matregisterdaad_(int *ierr)
150: {
151:   *MatRegisterDAAD();
152: }

154: void PETSC_STDCALL matcreatedaad_(DA *da,Mat *mat,int *ierr)
155: {
156:   *MatCreateDAAD(*da,mat);
157: }

159: void PETSC_STDCALL matdaadsetsnes_(Mat *mat,SNES *snes,int *ierr)
160: {
161:   *MatDAADSetSNES(*mat,*snes);
162: }
163: #endif

165: void PETSC_STDCALL snesview_(SNES *snes,PetscViewer *viewer, int *ierr)
166: {
167:   PetscViewer v;
168:   PetscPatchDefaultViewers_Fortran(viewer,v);
169:   *SNESView(*snes,v);
170: }

172: void PETSC_STDCALL snesgetconvergedreason(SNES *snes,SNESConvergedReason *r,int *ierr)
173: {
174:   *SNESGetConvergedReason(*snes,r);
175: }

177: void PETSC_STDCALL snessetlinesearchparams_(SNES *snes,PetscReal *alpha,PetscReal *maxstep,PetscReal *steptol,int *ierr)
178: {
179:   *SNESSetLineSearchParams(*snes,*alpha,*maxstep,*steptol);
180: }

182: void PETSC_STDCALL snesgetlinesearchparams_(SNES *snes,PetscReal *alpha,PetscReal *maxstep,PetscReal *steptol,int *ierr)
183: {
184:   CHKFORTRANNULLREAL(alpha);
185:   CHKFORTRANNULLREAL(maxstep);
186:   CHKFORTRANNULLREAL(steptol);
187:   *SNESGetLineSearchParams(*snes,alpha,maxstep,steptol);
188: }

190: /*  func is currently ignored from Fortran */
191: void PETSC_STDCALL snesgetjacobian_(SNES *snes,Mat *A,Mat *B,void **ctx,int *func,int *ierr)
192: {
193:   CHKFORTRANNULLINTEGER(ctx);
194:   CHKFORTRANNULLOBJECT(A);
195:   CHKFORTRANNULLOBJECT(B);
196:   *SNESGetJacobian(*snes,A,B,ctx,0);
197: }

199: void PETSC_STDCALL matsnesmfsettype_(Mat *mat,CHAR ftype PETSC_MIXED_LEN(len),
200:                                      int *ierr PETSC_END_LEN(len))
201: {
202:   char *t;
203:   FIXCHAR(ftype,len,t);
204:   *MatSNESMFSetType(*mat,t);
205:   FREECHAR(ftype,t);
206: }

208: void PETSC_STDCALL snesgetconvergencehistory_(SNES *snes,int *na,int *ierr)
209: {
210:   *SNESGetConvergenceHistory(*snes,PETSC_NULL,PETSC_NULL,na);
211: }

213: void PETSC_STDCALL snessettype_(SNES *snes,CHAR type PETSC_MIXED_LEN(len),
214:                                 int *ierr PETSC_END_LEN(len))
215: {
216:   char *t;

218:   FIXCHAR(type,len,t);
219:   *SNESSetType(*snes,t);
220:   FREECHAR(type,t);
221: }

223: void PETSC_STDCALL snesappendoptionsprefix_(SNES *snes,CHAR prefix PETSC_MIXED_LEN(len),
224:                                             int *ierr PETSC_END_LEN(len))
225: {
226:   char *t;

228:   FIXCHAR(prefix,len,t);
229:   *SNESAppendOptionsPrefix(*snes,t);
230:   FREECHAR(prefix,t);
231: }

233: void PETSC_STDCALL matsnesmfsetbase_(Mat *m,Vec *x,int *ierr)
234: {
235:   *MatSNESMFSetBase(*m,*x);
236: }

238: void PETSC_STDCALL matcreatesnesmf_(SNES *snes,Vec *x,Mat *J,int *ierr)
239: {
240:   *MatCreateSNESMF(*snes,*x,J);
241: }

243: void PETSC_STDCALL matcreatemf_(Vec *x,Mat *J,int *ierr)
244: {
245:   *MatCreateMF(*x,J);
246: }

248: /* functions, hence no STDCALL */

250: void sneslgmonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
251: {
252:   *SNESLGMonitor(*snes,*its,*fgnorm,dummy);
253: }

255: void snesdefaultmonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
256: {
257:   *SNESDefaultMonitor(*snes,*its,*fgnorm,dummy);
258: }

260: void snesvecviewmonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
261: {
262:   *SNESVecViewMonitor(*snes,*its,*fgnorm,dummy);
263: }

265: void snesvecviewupdatemonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
266: {
267:   *SNESVecViewUpdateMonitor(*snes,*its,*fgnorm,dummy);
268: }

270: static void (PETSC_STDCALL *f7)(SNES*,int*,PetscReal*,void*,int*);
271: static int oursnesmonitor(SNES snes,int i,PetscReal d,void*ctx)
272: {
273:   int              0;

275:   (*f7)(&snes,&i,&d,ctx,&ierr);
276:   return 0;
277: }
278: static void (PETSC_STDCALL *f71)(void*,int*);
279: static int ourmondestroy(void* ctx)
280: {
281:   int              0;

283:   (*f71)(ctx,&ierr);
284:   return 0;
285: }

287: void PETSC_STDCALL snessetmonitor_(SNES *snes,void (PETSC_STDCALL *func)(SNES*,int*,PetscReal*,void*,int*),
288:                     void *mctx,void (PETSC_STDCALL *mondestroy)(void *,int *),int *ierr)
289: {
290:   CHKFORTRANNULLOBJECT(mctx);
291:   if ((void(*)(void))func == (void(*)(void))snesdefaultmonitor_) {
292:     *SNESSetMonitor(*snes,SNESDefaultMonitor,0,0);
293:   } else if ((void(*)(void))func == (void(*)(void))snesvecviewmonitor_) {
294:     *SNESSetMonitor(*snes,SNESVecViewMonitor,0,0);
295:   } else if ((void(*)(void))func == (void(*)(void))snesvecviewupdatemonitor_) {
296:     *SNESSetMonitor(*snes,SNESVecViewUpdateMonitor,0,0);
297:   } else if ((void(*)(void))func == (void(*)(void))sneslgmonitor_) {
298:     *SNESSetMonitor(*snes,SNESLGMonitor,0,0);
299:   } else {
300:     f7 = func;
301:     if (FORTRANNULLFUNCTION(mondestroy)){
302:       *SNESSetMonitor(*snes,oursnesmonitor,mctx,0);
303:     } else {
304:       f71 = mondestroy;
305:       *SNESSetMonitor(*snes,oursnesmonitor,mctx,ourmondestroy);
306:     }
307:   }
308: }

310: /* -----------------------------------------------------------------------------------------------------*/
311: void snescubiclinesearch_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
312:                                         PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
313: {
314:   *SNESCubicLineSearch(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
315: }
316: void snesquadraticlinesearch_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
317:                                         PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
318: {
319:   *SNESQuadraticLineSearch(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
320: }
321: void snesnolinesearch_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
322:                                         PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
323: {
324:   *SNESNoLineSearch(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
325: }
326: void snesnolinesearchnonorms_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
327:                                         PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
328: {
329:   *SNESNoLineSearchNoNorms(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
330: }

332: void (PETSC_STDCALL *f73)(SNES*,void *,Vec*,Vec*,Vec*,Vec*,Vec*,PetscReal*,PetscReal*,PetscReal*,int*,int*);
333: int OurSNESLineSearch(SNES snes,void *ctx,Vec x,Vec f,Vec g,Vec y,Vec w,PetscReal fnorm,PetscReal*ynorm,PetscReal*gnorm,int *flag)
334: {
335:   int 0;
336:   (*f73)(&snes,(void*)&ctx,&x,&f,&g,&y,&w,&fnorm,ynorm,gnorm,flag,&ierr);
337:   return 0;
338: }

340: 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)
341: {
342:   if ((void(*)(void))f == (void(*)(void))snescubiclinesearch_) {
343:     *SNESSetLineSearch(*snes,SNESCubicLineSearch,ctx);
344:   } else if ((void(*)(void))f == (void(*)(void))snesquadraticlinesearch_) {
345:     *SNESSetLineSearch(*snes,SNESQuadraticLineSearch,ctx);
346:   } else if ((void(*)(void))f == (void(*)(void))snesnolinesearch_) {
347:     *SNESSetLineSearch(*snes,SNESNoLineSearch,ctx);
348:   } else if ((void(*)(void))f == (void(*)(void))snesnolinesearchnonorms_) {
349:     *SNESSetLineSearch(*snes,SNESNoLineSearchNoNorms,ctx);
350:   } else {
351:     f73 = f;
352:     *SNESSetLineSearch(*snes,OurSNESLineSearch,ctx);
353:   }
354: }

356: void (PETSC_STDCALL *f74)(SNES*,void *,Vec*,PetscTruth*,int*);
357: int OurSNESLineSearchCheck(SNES snes,void *checkCtx,Vec x,PetscTruth *flag)
358: {
359:   int 0;
360:   (*f74)(&snes,(void*)&checkCtx,&x,flag,&ierr);
361:   return 0;
362: }

364: void PETSC_STDCALL snessetlinesearchcheck_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,void *,Vec*,PetscTruth*,int*),void *ctx,int *ierr)
365: {
366:   f74 = f;
367:   *SNESSetLineSearchCheck(*snes,OurSNESLineSearchCheck,ctx);
368: }

370: /*----------------------------------------------------------------------*/

372: void snesconverged_tr_(SNES *snes,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,
373:                                        void *ct,int *ierr)
374: {
375:   *SNESConverged_TR(*snes,*a,*b,*c,r,ct);
376: }

378: void snesconverged_ls_(SNES *snes,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,
379:                                        void *ct,int *ierr)
380: {
381:   *SNESConverged_LS(*snes,*a,*b,*c,r,ct);
382: }

384: static void (PETSC_STDCALL *f8)(SNES*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,int*);
385: static int oursnestest(SNES snes,PetscReal a,PetscReal d,PetscReal c,SNESConvergedReason*reason,void*ctx)
386: {
387:   int              0;

389:   (*f8)(&snes,&a,&d,&c,reason,ctx,&ierr);
390:   return 0;
391: }

393: void PETSC_STDCALL snessetconvergencetest_(SNES *snes,
394:        void (PETSC_STDCALL *func)(SNES*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,int*),
395:        void *cctx,int *ierr)
396: {
397:   CHKFORTRANNULLOBJECT(cctx);
398:   if ((void(*)(void))func == (void(*)(void))snesconverged_ls_){
399:     *SNESSetConvergenceTest(*snes,SNESConverged_LS,0);
400:   } else if ((void(*)(void))func == (void(*)(void))snesconverged_tr_){
401:     *SNESSetConvergenceTest(*snes,SNESConverged_TR,0);
402:   } else {
403:     f8 = func;
404:     *SNESSetConvergenceTest(*snes,oursnestest,cctx);
405:   }
406: }

408: /*--------------------------------------------------------------------------------------------*/

410: void PETSC_STDCALL snesgetsolution_(SNES *snes,Vec *x,int *ierr)
411: {
412:   *SNESGetSolution(*snes,x);
413: }

415: void PETSC_STDCALL snesgetsolutionupdate_(SNES *snes,Vec *x,int *ierr)
416: {
417:   *SNESGetSolutionUpdate(*snes,x);
418: }

420: /* the func argument is ignored */
421: void PETSC_STDCALL snesgetfunction_(SNES *snes,Vec *r,void **ctx,void *func,int *ierr)
422: {
423:   CHKFORTRANNULLINTEGER(ctx);
424:   CHKFORTRANNULLINTEGER(r);
425:   *SNESGetFunction(*snes,r,ctx,PETSC_NULL);
426: }

428: void PETSC_STDCALL snesdestroy_(SNES *snes,int *ierr)
429: {
430:   *SNESDestroy(*snes);
431: }

433: void PETSC_STDCALL snesgetsles_(SNES *snes,SLES *sles,int *ierr)
434: {
435:   *SNESGetSLES(*snes,sles);
436: }

438: /* ---------------------------------------------------------*/

440: static void (PETSC_STDCALL *f2)(SNES*,Vec*,Vec*,void*,int*);
441: static int oursnesfunction(SNES snes,Vec x,Vec f,void *ctx)
442: {
443:   int 0;
444:   (*f2)(&snes,&x,&f,ctx,&ierr);
445:   return 0;
446: }

448: /*
449:         These are not usually called from Fortran but allow Fortran users 
450:    to transparently set these monitors from .F code
451:    
452:    functions, hence no STDCALL
453: */
454: void  snesdaformfunction_(SNES *snes,Vec *X, Vec *F,void *ptr,int *ierr)
455: {
456:   *SNESDAFormFunction(*snes,*X,*F,ptr);
457: }


460: void PETSC_STDCALL snessetfunction_(SNES *snes,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,int*),
461:                       void *ctx,int *ierr)
462: {
463:   CHKFORTRANNULLOBJECT(ctx);
464:   f2 = func;
465:   if ((void(*)(void))func == (void(*)(void))snesdaformfunction_) {
466:     *SNESSetFunction(*snes,*r,SNESDAFormFunction,ctx);
467:   } else {
468:     *SNESSetFunction(*snes,*r,oursnesfunction,ctx);
469:   }
470: }

472: /* ---------------------------------------------------------*/

474: static void (PETSC_STDCALL *f11)(SNES*,Vec*,Vec*,void*,int*);
475: static int ourmatsnesmffunction(SNES snes,Vec x,Vec f,void *ctx)
476: {
477:   int 0;
478:   (*f11)(&snes,&x,&f,ctx,&ierr);
479:   return 0;
480: }
481: void PETSC_STDCALL matsnesmfsetfunction_(Mat *mat,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,int*),
482:                       void *ctx,int *ierr){
483:   f11 = func;
484:   CHKFORTRANNULLOBJECT(ctx);
485:   *MatSNESMFSetFunction(*mat,*r,ourmatsnesmffunction,ctx);
486: }
487: /* ---------------------------------------------------------*/

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

491: *SNESCreate((MPI_Comm)PetscToPointerComm(*comm),outsnes);
492: }

494: /* ---------------------------------------------------------*/
495: /*
496:      snesdefaultcomputejacobian() and snesdefaultcomputejacobiancolor()
497:   These can be used directly from Fortran but are mostly so that 
498:   Fortran SNESSetJacobian() will properly handle the defaults being passed in.

500:   functions, hence no STDCALL
501: */
502: void snesdefaultcomputejacobian_(SNES *snes,Vec *x,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
503: {
504:   *SNESDefaultComputeJacobian(*snes,*x,m,p,type,ctx);
505: }
506: void  snesdefaultcomputejacobiancolor_(SNES *snes,Vec *x,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
507: {
508:   *SNESDefaultComputeJacobianColor(*snes,*x,m,p,type,*(MatFDColoring*)ctx);
509: }

511: void  snesdacomputejacobianwithadifor_(SNES *snes,Vec *X,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
512: {
513:   (*PetscErrorPrintf)("Cannot call this function from Fortran");
514:   *1;
515: }

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

523: static void (PETSC_STDCALL *f3)(SNES*,Vec*,Mat*,Mat*,MatStructure*,void*,int*);
524: static int oursnesjacobian(SNES snes,Vec x,Mat* m,Mat* p,MatStructure* type,void*ctx)
525: {
526:   int              0;
527:   (*f3)(&snes,&x,m,p,type,ctx,&ierr);
528:   return 0;
529: }

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

549: /* -------------------------------------------------------------*/

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

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

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

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

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

588: EXTERN_C_END