Actual source code: zsnes.c

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

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

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

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

123: PetscErrorCode OurSNESLineSearch(SNES snes,void *ctx,Vec x,Vec f,Vec g,Vec y,Vec w,PetscReal fnorm,PetscReal*ynorm,PetscReal*gnorm,PetscTruth *flag)
124: {
125:   PetscErrorCode 0;
126:   (*f73)(&snes,(void*)&ctx,&x,&f,&g,&y,&w,&fnorm,ynorm,gnorm,flag,&ierr);
127:   return 0;
128: }

130: PetscErrorCode OurSNESLineSearchPostCheck(SNES snes,Vec x,Vec y,Vec z,void *checkCtx,PetscTruth *flag1,PetscTruth *flag2)
131: {
132:   PetscErrorCode 0;
133:   (*f74)(&snes,&x,&y,&z,(void*)&checkCtx,flag1,flag2,&ierr);
134:   return 0;
135: }

137: static PetscErrorCode oursnesmonitor(SNES snes,PetscInt i,PetscReal d,void*ctx)
138: {
139:   PetscErrorCode 0;

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

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

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


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

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

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

209: #endif

211: #if defined (PETSC_HAVE_ADIC)
212: void PETSC_STDCALL matregisterdaad_(PetscErrorCode *ierr)
213: {
214:   *MatRegisterDAAD();
215: }

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

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

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

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

240: void PETSC_STDCALL sneslinesearchsetparams_(SNES *snes,PetscReal *alpha,PetscReal *maxstep,PetscReal *steptol,PetscErrorCode *ierr)
241: {
242:   *SNESLineSearchSetParams(*snes,*alpha,*maxstep,*steptol);
243: }

245: void PETSC_STDCALL sneslinesearchgetparams_(SNES *snes,PetscReal *alpha,PetscReal *maxstep,PetscReal *steptol,PetscErrorCode *ierr)
246: {
247:   CHKFORTRANNULLREAL(alpha);
248:   CHKFORTRANNULLREAL(maxstep);
249:   CHKFORTRANNULLREAL(steptol);
250:   *SNESLineSearchGetParams(*snes,alpha,maxstep,steptol);
251: }

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

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

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

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

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

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

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

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

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

306: /* functions, hence no STDCALL */

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

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

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

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


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

352: /* -----------------------------------------------------------------------------------------------------*/
353: void sneslinesearchcubic_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
354:                                         PetscReal *ynorm,PetscReal *gnorm,PetscTruth *flag,PetscErrorCode *ierr)
355: {
356:   *SNESLineSearchCubic(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
357: }
358: void sneslinesearchquadratic_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
359:                                         PetscReal *ynorm,PetscReal *gnorm,PetscTruth *flag,PetscErrorCode *ierr)
360: {
361:   *SNESLineSearchQuadratic(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
362: }
363: void sneslinesearchno_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
364:                                         PetscReal *ynorm,PetscReal *gnorm,PetscTruth *flag,PetscErrorCode *ierr)
365: {
366:   *SNESLineSearchNo(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
367: }
368: void sneslinesearchnonorms_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
369:                                         PetscReal *ynorm,PetscReal *gnorm,PetscTruth *flag,PetscErrorCode *ierr)
370: {
371:   *SNESLineSearchNoNorms(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
372: }


375: void PETSC_STDCALL sneslinesearchset_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,void *,Vec*,Vec*,Vec*,Vec*,Vec*,PetscReal*,PetscReal*,PetscReal*,PetscTruth*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr)
376: {
377:   if ((FCNVOID)f == (FCNVOID)sneslinesearchcubic_) {
378:     *SNESLineSearchSet(*snes,SNESLineSearchCubic,ctx);
379:   } else if ((FCNVOID)f == (FCNVOID)sneslinesearchquadratic_) {
380:     *SNESLineSearchSet(*snes,SNESLineSearchQuadratic,ctx);
381:   } else if ((FCNVOID)f == (FCNVOID)sneslinesearchno_) {
382:     *SNESLineSearchSet(*snes,SNESLineSearchNo,ctx);
383:   } else if ((FCNVOID)f == (FCNVOID)sneslinesearchnonorms_) {
384:     *SNESLineSearchSet(*snes,SNESLineSearchNoNorms,ctx);
385:   } else {
386:     f73 = f;
387:     *SNESLineSearchSet(*snes,OurSNESLineSearch,ctx);
388:   }
389: }


392: void PETSC_STDCALL sneslinesearchsetpostcheck_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,Vec*,Vec *,Vec *,void *,PetscTruth*,PetscTruth*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr)
393: {
394:   f74 = f;
395:   *SNESLineSearchSetPostCheck(*snes,OurSNESLineSearchPostCheck,ctx);
396: }

398: /*----------------------------------------------------------------------*/

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

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


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

428: /*--------------------------------------------------------------------------------------------*/

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

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

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

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

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

458: /* ---------------------------------------------------------*/


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


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

485: /* ---------------------------------------------------------*/

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

495: void PETSC_STDCALL snescreate_(MPI_Comm *comm,SNES *outsnes,PetscErrorCode *ierr){

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

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

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

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

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

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

547: /* -------------------------------------------------------------*/

549: void PETSC_STDCALL snesregisterdestroy_(PetscErrorCode *ierr)
550: {
551:   *SNESRegisterDestroy();
552: }

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

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

571: void PETSC_STDCALL snesgetoptionsprefix_(SNES *snes,CHAR prefix PETSC_MIXED_LEN(len),
572:                                          PetscErrorCode *ierr PETSC_END_LEN(len))
573: {
574:   const 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: }