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 sneslinesearchsetprecheck_       SNESLINESEARCHSETPRECHECK
 56: #define snessetupdate_                   SNESSETUPDATE
 57: #define sneslinesearchcubic_             SNESLINESEARCHCUBIC
 58: #define sneslinesearchquadratic_         SNESLINESEARCHQUADRATIC
 59: #define sneslinesearchno_                SNESLINESEARCHNO
 60: #define sneslinesearchnonorms_           SNESLINESEARCHNONORMS
 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 sneslinesearchcubic_             sneslinesearchcubic     
 71: #define sneslinesearchquadratic_         sneslinesearchquadratic    
 72: #define sneslinesearchno_                sneslinesearchno    
 73: #define sneslinesearchnonorms_           sneslinesearchnonorms    
 74: #define sneslinesearchsetparams_         sneslinesearchsetparams
 75: #define sneslinesearchgetparams_         sneslinesearchgetparams
 76: #define sneslinesearchset_               sneslinesearchset
 77: #define sneslinesearchsetpostcheck_      sneslinesearchsetpostcheck
 78: #define sneslinesearchsetprecheck_       sneslinesearchsetprecheck
 79: #define snessetupdate_                   snessetupdate
 80: #define snesconverged_tr_                snesconverged_tr
 81: #define snesconverged_ls_                snesconverged_ls
 82: #define snesgetconvergedreason_          snesgetconvergedreason
 83: #define sneslgmonitor_                   sneslgmonitor
 84: #define snesdefaultmonitor_              snesdefaultmonitor
 85: #define snesvecviewmonitor_              snesvecviewmonitor
 86: #define snesvecviewupdatemonitor_        snesvecviewupdatemonitor
 87: #define matsnesmfsetfunction_            matsnesmfsetfunction
 88: #define snesregisterdestroy_             snesregisterdestroy
 89: #define snessetjacobian_                 snessetjacobian
 90: #define snescreate_                      snescreate
 91: #define snessetfunction_                 snessetfunction
 92: #define snesgetksp_                      snesgetksp
 93: #define snesdestroy_                     snesdestroy
 94: #define snessetmonitor_                  snessetmonitor
 95: #define snessetconvergencetest_          snessetconvergencetest
 96: #define snesregisterdestroy_             snesregisterdestroy
 97: #define snesgetsolution_                 snesgetsolution
 98: #define snesgetsolutionupdate_           snesgetsolutionupdate
 99: #define snesgetfunction_                 snesgetfunction
100: #define snesgettype_                     snesgettype
101: #define snessetoptionsprefix_            snessetoptionsprefix 
102: #define snesappendoptionsprefix_         snesappendoptionsprefix
103: #define matcreatesnesmf_                 matcreatesnesmf
104: #define matcreatemf_                     matcreatemf
105: #define snessettype_                     snessettype
106: #define snesgetconvergencehistory_       snesgetconvergencehistory
107: #define snesdefaultcomputejacobian_      snesdefaultcomputejacobian
108: #define snesdefaultcomputejacobiancolor_ snesdefaultcomputejacobiancolor
109: #define matsnesmfsettype_                matsnesmfsettype
110: #define snesgetoptionsprefix_            snesgetoptionsprefix
111: #define snesgetjacobian_                 snesgetjacobian
112: #define snesview_                        snesview
113: #endif

116: static void (PETSC_STDCALL *f7)(SNES*,PetscInt*,PetscReal*,void*,PetscErrorCode*);
117: static void (PETSC_STDCALL *f71)(void*,PetscErrorCode*);
118: static void (PETSC_STDCALL *f8)(SNES*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,PetscErrorCode*);
119: static void (PETSC_STDCALL *f2)(SNES*,Vec*,Vec*,void*,PetscErrorCode*);
120: static void (PETSC_STDCALL *f11)(SNES*,Vec*,Vec*,void*,PetscErrorCode*);
121: static void (PETSC_STDCALL *f3)(SNES*,Vec*,Mat*,Mat*,MatStructure*,void*,PetscErrorCode*);
122: static void (PETSC_STDCALL *f73)(SNES*,void *,Vec*,Vec*,Vec*,Vec*,Vec*,PetscReal*,PetscReal*,PetscReal*,PetscTruth*,PetscErrorCode*);
123: static void (PETSC_STDCALL *f74)(SNES*,Vec*,Vec*,Vec*,void*,PetscTruth*,PetscTruth*,PetscErrorCode*);
124: static void (PETSC_STDCALL *f75)(SNES*,Vec*,Vec*,void*,PetscTruth*,PetscErrorCode*);
125: static void (PETSC_STDCALL *f76)(SNES*,PetscInt*,PetscErrorCode*);

129: PetscErrorCode OurSNESLineSearch(SNES snes,void *ctx,Vec x,Vec f,Vec g,Vec y,Vec w,PetscReal fnorm,PetscReal*ynorm,PetscReal*gnorm,PetscTruth *flag)
130: {
131:   PetscErrorCode 0;
132:   (*f73)(&snes,(void*)&ctx,&x,&f,&g,&y,&w,&fnorm,ynorm,gnorm,flag,&ierr);
133:   return 0;
134: }

136: PetscErrorCode OurSNESLineSearchPostCheck(SNES snes,Vec x,Vec y,Vec z,void *checkCtx,PetscTruth *flag1,PetscTruth *flag2)
137: {
138:   PetscErrorCode 0;
139:   (*f74)(&snes,&x,&y,&z,(void*)&checkCtx,flag1,flag2,&ierr);
140:   return 0;
141: }

143: PetscErrorCode OurSNESLineSearchPreCheck(SNES snes,Vec x,Vec y,void *checkCtx,PetscTruth *flag1)
144: {
145:   PetscErrorCode 0;
146:   (*f75)(&snes,&x,&y,(void*)&checkCtx,flag1,&ierr);
147:   return 0;
148: }
149: PetscErrorCode OurSNESSetUpdate(SNES snes,PetscInt b)
150: {
151:   PetscErrorCode 0;
152:   (*f76)(&snes,&b,&ierr);
153:   return 0;
154: }
155: static PetscErrorCode oursnesmonitor(SNES snes,PetscInt i,PetscReal d,void*ctx)
156: {
157:   PetscErrorCode 0;

159:   (*f7)(&snes,&i,&d,ctx,&ierr);
160:   return 0;
161: }
162: static PetscErrorCode ourmondestroy(void* ctx)
163: {
164:   PetscErrorCode 0;

166:   (*f71)(ctx,&ierr);
167:   return 0;
168: }
169: static PetscErrorCode oursnestest(SNES snes,PetscReal a,PetscReal d,PetscReal c,SNESConvergedReason*reason,void*ctx)
170: {
171:   PetscErrorCode 0;

173:   (*f8)(&snes,&a,&d,&c,reason,ctx,&ierr);
174:   return 0;
175: }
176: static PetscErrorCode oursnesfunction(SNES snes,Vec x,Vec f,void *ctx)
177: {
178:   PetscErrorCode 0;
179:   (*f2)(&snes,&x,&f,ctx,&ierr);
180:   return 0;
181: }
182: static PetscErrorCode ourmatsnesmffunction(SNES snes,Vec x,Vec f,void *ctx)
183: {
184:   PetscErrorCode 0;
185:   (*f11)(&snes,&x,&f,ctx,&ierr);
186:   return 0;
187: }
188: static PetscErrorCode oursnesjacobian(SNES snes,Vec x,Mat* m,Mat* p,MatStructure* type,void*ctx)
189: {
190:   PetscErrorCode 0;
191:   (*f3)(&snes,&x,m,p,type,ctx,&ierr);
192:   return 0;
193: }


197: #if defined(notused)
198: static PetscErrorCode ourrhs(SNES snes,Vec vec,Vec vec2,void*ctx)
199: {
200:   PetscErrorCode 0;
201:   DMMG *dmmg = (DMMG*)ctx;
202:   (*(PetscErrorCode (PETSC_STDCALL *)(SNES*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)dmmg->dm)->fortran_func_pointers[0]))(&snes,&vec,&vec2,&ierr);
203:   return ierr;
204: }

206: static PetscErrorCode ourmat(DMMG dmmg,Mat mat)
207: {
208:   PetscErrorCode 0;
209:   (*(PetscErrorCode (PETSC_STDCALL *)(DMMG*,Vec*,PetscErrorCode*))(((PetscObject)dmmg->dm)->fortran_func_pointers[1]))(&dmmg,&vec,&ierr);
210:   return ierr;
211: }

213: void PETSC_STDCALL dmmgsetsnes_(DMMG **dmmg,PetscErrorCode (PETSC_STDCALL *rhs)(SNES*,Vec*,Vec*,PetscErrorCode*),PetscErrorCode (PETSC_STDCALL *mat)(DMMG*,Mat*,PetscErrorCode*),PetscErrorCode *ierr)
214: {
215:   PetscInt i;
216:   theirmat = mat;
217:   *DMMGSetSNES(*dmmg,ourrhs,ourmat,*dmmg);
218:   /*
219:     Save the fortran rhs function in the DM on each level; ourrhs() pulls it out when needed
220:   */
221:   for (i=0; i<(**dmmg)->nlevels; i++) {
222:     ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[0] = (FCNVOID)rhs;
223:     ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[1] = (FCNVOID)mat;
224:   }
225: }

227: #endif

229: #if defined (PETSC_HAVE_ADIC)
230: void PETSC_STDCALL matregisterdaad_(PetscErrorCode *ierr)
231: {
232:   *MatRegisterDAAD();
233: }

235: void PETSC_STDCALL matcreatedaad_(DA *da,Mat *mat,PetscErrorCode *ierr)
236: {
237:   *MatCreateDAAD(*da,mat);
238: }

240: void PETSC_STDCALL matdaadsetsnes_(Mat *mat,SNES *snes,PetscErrorCode *ierr)
241: {
242:   *MatDAADSetSNES(*mat,*snes);
243: }
244: #endif

246: void PETSC_STDCALL snesview_(SNES *snes,PetscViewer *viewer, PetscErrorCode *ierr)
247: {
248:   PetscViewer v;
249:   PetscPatchDefaultViewers_Fortran(viewer,v);
250:   *SNESView(*snes,v);
251: }

253: void PETSC_STDCALL snesgetconvergedreason_(SNES *snes,SNESConvergedReason *r,PetscErrorCode *ierr)
254: {
255:   *SNESGetConvergedReason(*snes,r);
256: }

258: void PETSC_STDCALL sneslinesearchsetparams_(SNES *snes,PetscReal *alpha,PetscReal *maxstep,PetscReal *steptol,PetscErrorCode *ierr)
259: {
260:   *SNESLineSearchSetParams(*snes,*alpha,*maxstep,*steptol);
261: }

263: void PETSC_STDCALL sneslinesearchgetparams_(SNES *snes,PetscReal *alpha,PetscReal *maxstep,PetscReal *steptol,PetscErrorCode *ierr)
264: {
265:   CHKFORTRANNULLREAL(alpha);
266:   CHKFORTRANNULLREAL(maxstep);
267:   CHKFORTRANNULLREAL(steptol);
268:   *SNESLineSearchGetParams(*snes,alpha,maxstep,steptol);
269: }

271: /*  func is currently ignored from Fortran */
272: void PETSC_STDCALL snesgetjacobian_(SNES *snes,Mat *A,Mat *B,int *func,void **ctx,PetscErrorCode *ierr)
273: {
274:   CHKFORTRANNULLINTEGER(ctx);
275:   CHKFORTRANNULLOBJECT(A);
276:   CHKFORTRANNULLOBJECT(B);
277:   *SNESGetJacobian(*snes,A,B,0,ctx);
278: }

280: void PETSC_STDCALL matsnesmfsettype_(Mat *mat,CHAR ftype PETSC_MIXED_LEN(len),
281:                                      PetscErrorCode *ierr PETSC_END_LEN(len))
282: {
283:   char *t;
284:   FIXCHAR(ftype,len,t);
285:   *MatSNESMFSetType(*mat,t);
286:   FREECHAR(ftype,t);
287: }

289: void PETSC_STDCALL snesgetconvergencehistory_(SNES *snes,PetscInt *na,PetscErrorCode *ierr)
290: {
291:   *SNESGetConvergenceHistory(*snes,PETSC_NULL,PETSC_NULL,na);
292: }

294: void PETSC_STDCALL snessettype_(SNES *snes,CHAR type PETSC_MIXED_LEN(len),
295:                                 PetscErrorCode *ierr PETSC_END_LEN(len))
296: {
297:   char *t;

299:   FIXCHAR(type,len,t);
300:   *SNESSetType(*snes,t);
301:   FREECHAR(type,t);
302: }

304: void PETSC_STDCALL snesappendoptionsprefix_(SNES *snes,CHAR prefix PETSC_MIXED_LEN(len),
305:                                             PetscErrorCode *ierr PETSC_END_LEN(len))
306: {
307:   char *t;

309:   FIXCHAR(prefix,len,t);
310:   *SNESAppendOptionsPrefix(*snes,t);
311:   FREECHAR(prefix,t);
312: }

314: void PETSC_STDCALL matcreatesnesmf_(SNES *snes,Vec *x,Mat *J,PetscErrorCode *ierr)
315: {
316:   *MatCreateSNESMF(*snes,*x,J);
317: }

319: void PETSC_STDCALL matcreatemf_(Vec *x,Mat *J,PetscErrorCode *ierr)
320: {
321:   *MatCreateMF(*x,J);
322: }

324: /* functions, hence no STDCALL */

326: void sneslgmonitor_(SNES *snes,PetscInt *its,PetscReal *fgnorm,void *dummy,PetscErrorCode *ierr)
327: {
328:   *SNESLGMonitor(*snes,*its,*fgnorm,dummy);
329: }

331: void snesdefaultmonitor_(SNES *snes,PetscInt *its,PetscReal *fgnorm,void *dummy,PetscErrorCode *ierr)
332: {
333:   *SNESDefaultMonitor(*snes,*its,*fgnorm,dummy);
334: }

336: void snesvecviewmonitor_(SNES *snes,PetscInt *its,PetscReal *fgnorm,void *dummy,PetscErrorCode *ierr)
337: {
338:   *SNESVecViewMonitor(*snes,*its,*fgnorm,dummy);
339: }

341: void snesvecviewupdatemonitor_(SNES *snes,PetscInt *its,PetscReal *fgnorm,void *dummy,PetscErrorCode *ierr)
342: {
343:   *SNESVecViewUpdateMonitor(*snes,*its,*fgnorm,dummy);
344: }


347: void PETSC_STDCALL snessetmonitor_(SNES *snes,void (PETSC_STDCALL *func)(SNES*,PetscInt*,PetscReal*,void*,PetscErrorCode*),
348:                     void *mctx,void (PETSC_STDCALL *mondestroy)(void*,PetscErrorCode*),PetscErrorCode *ierr)
349: {
350:   CHKFORTRANNULLOBJECT(mctx);
351:   if ((FCNVOID)func == (FCNVOID)snesdefaultmonitor_) {
352:     *SNESSetMonitor(*snes,SNESDefaultMonitor,0,0);
353:   } else if ((FCNVOID)func == (FCNVOID)snesvecviewmonitor_) {
354:     *SNESSetMonitor(*snes,SNESVecViewMonitor,0,0);
355:   } else if ((FCNVOID)func == (FCNVOID)snesvecviewupdatemonitor_) {
356:     *SNESSetMonitor(*snes,SNESVecViewUpdateMonitor,0,0);
357:   } else if ((FCNVOID)func == (FCNVOID)sneslgmonitor_) {
358:     *SNESSetMonitor(*snes,SNESLGMonitor,0,0);
359:   } else {
360:     f7 = func;
361:     if (FORTRANNULLFUNCTION(mondestroy)){
362:       *SNESSetMonitor(*snes,oursnesmonitor,mctx,0);
363:     } else {
364:       f71 = mondestroy;
365:       *SNESSetMonitor(*snes,oursnesmonitor,mctx,ourmondestroy);
366:     }
367:   }
368: }

370: /* -----------------------------------------------------------------------------------------------------*/
371: void sneslinesearchcubic_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
372:                                         PetscReal *ynorm,PetscReal *gnorm,PetscTruth *flag,PetscErrorCode *ierr)
373: {
374:   *SNESLineSearchCubic(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
375: }
376: void sneslinesearchquadratic_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
377:                                         PetscReal *ynorm,PetscReal *gnorm,PetscTruth *flag,PetscErrorCode *ierr)
378: {
379:   *SNESLineSearchQuadratic(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
380: }
381: void sneslinesearchno_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
382:                                         PetscReal *ynorm,PetscReal *gnorm,PetscTruth *flag,PetscErrorCode *ierr)
383: {
384:   *SNESLineSearchNo(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
385: }
386: void sneslinesearchnonorms_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
387:                                         PetscReal *ynorm,PetscReal *gnorm,PetscTruth *flag,PetscErrorCode *ierr)
388: {
389:   *SNESLineSearchNoNorms(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
390: }


393: 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)
394: {
395:   if ((FCNVOID)f == (FCNVOID)sneslinesearchcubic_) {
396:     *SNESLineSearchSet(*snes,SNESLineSearchCubic,ctx);
397:   } else if ((FCNVOID)f == (FCNVOID)sneslinesearchquadratic_) {
398:     *SNESLineSearchSet(*snes,SNESLineSearchQuadratic,ctx);
399:   } else if ((FCNVOID)f == (FCNVOID)sneslinesearchno_) {
400:     *SNESLineSearchSet(*snes,SNESLineSearchNo,ctx);
401:   } else if ((FCNVOID)f == (FCNVOID)sneslinesearchnonorms_) {
402:     *SNESLineSearchSet(*snes,SNESLineSearchNoNorms,ctx);
403:   } else {
404:     f73 = f;
405:     *SNESLineSearchSet(*snes,OurSNESLineSearch,ctx);
406:   }
407: }


410: void PETSC_STDCALL sneslinesearchsetpostcheck_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,Vec*,Vec *,Vec *,void *,PetscTruth*,PetscTruth*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr)
411: {
412:   f74 = f;
413:   *SNESLineSearchSetPostCheck(*snes,OurSNESLineSearchPostCheck,ctx);
414: }

416: void PETSC_STDCALL sneslinesearchsetprecheck_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,Vec*,Vec *,void *,PetscTruth*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr)
417: {
418:   f75 = f;
419:   *SNESLineSearchSetPreCheck(*snes,OurSNESLineSearchPreCheck,ctx);
420: }

422: void PETSC_STDCALL snessetupdate_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,PetscInt*,PetscErrorCode*),PetscErrorCode *ierr)
423: {
424:   f76 = f;
425:   *SNESSetUpdate(*snes,OurSNESSetUpdate);
426: }
427: /*----------------------------------------------------------------------*/

429: void snesconverged_tr_(SNES *snes,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,
430:                                        void *ct,PetscErrorCode *ierr)
431: {
432:   *SNESConverged_TR(*snes,*a,*b,*c,r,ct);
433: }

435: void snesconverged_ls_(SNES *snes,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,
436:                                        void *ct,PetscErrorCode *ierr)
437: {
438:   *SNESConverged_LS(*snes,*a,*b,*c,r,ct);
439: }


442: void PETSC_STDCALL snessetconvergencetest_(SNES *snes,
443:        void (PETSC_STDCALL *func)(SNES*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,PetscErrorCode*),
444:        void *cctx,PetscErrorCode *ierr)
445: {
446:   CHKFORTRANNULLOBJECT(cctx);
447:   if ((FCNVOID)func == (FCNVOID)snesconverged_ls_){
448:     *SNESSetConvergenceTest(*snes,SNESConverged_LS,0);
449:   } else if ((FCNVOID)func == (FCNVOID)snesconverged_tr_){
450:     *SNESSetConvergenceTest(*snes,SNESConverged_TR,0);
451:   } else {
452:     f8 = func;
453:     *SNESSetConvergenceTest(*snes,oursnestest,cctx);
454:   }
455: }

457: /*--------------------------------------------------------------------------------------------*/

459: void PETSC_STDCALL snesgetsolution_(SNES *snes,Vec *x,PetscErrorCode *ierr)
460: {
461:   *SNESGetSolution(*snes,x);
462: }

464: void PETSC_STDCALL snesgetsolutionupdate_(SNES *snes,Vec *x,PetscErrorCode *ierr)
465: {
466:   *SNESGetSolutionUpdate(*snes,x);
467: }

469: /* the func argument is ignored */
470: void PETSC_STDCALL snesgetfunction_(SNES *snes,Vec *r,void *func,void **ctx,PetscErrorCode *ierr)
471: {
472:   CHKFORTRANNULLINTEGER(ctx);
473:   CHKFORTRANNULLOBJECT(r);
474:   *SNESGetFunction(*snes,r,PETSC_NULL,ctx);
475: }

477: void PETSC_STDCALL snesdestroy_(SNES *snes,PetscErrorCode *ierr)
478: {
479:   *SNESDestroy(*snes);
480: }

482: void PETSC_STDCALL snesgetksp_(SNES *snes,KSP *ksp,PetscErrorCode *ierr)
483: {
484:   *SNESGetKSP(*snes,ksp);
485: }

487: /* ---------------------------------------------------------*/


490: /*
491:         These are not usually called from Fortran but allow Fortran users 
492:    to transparently set these monitors from .F code
493:    
494:    functions, hence no STDCALL
495: */
496: void  snesdaformfunction_(SNES *snes,Vec *X, Vec *F,void *ptr,PetscErrorCode *ierr)
497: {
498:   *SNESDAFormFunction(*snes,*X,*F,ptr);
499: }


502: void PETSC_STDCALL snessetfunction_(SNES *snes,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,PetscErrorCode*),
503:                       void *ctx,PetscErrorCode *ierr)
504: {
505:   CHKFORTRANNULLOBJECT(ctx);
506:   f2 = func;
507:   if ((FCNVOID)func == (FCNVOID)snesdaformfunction_) {
508:     *SNESSetFunction(*snes,*r,SNESDAFormFunction,ctx);
509:   } else {
510:     *SNESSetFunction(*snes,*r,oursnesfunction,ctx);
511:   }
512: }

514: /* ---------------------------------------------------------*/

516: void PETSC_STDCALL matsnesmfsetfunction_(Mat *mat,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,PetscErrorCode*),
517:                       void *ctx,PetscErrorCode *ierr){
518:   f11 = func;
519:   CHKFORTRANNULLOBJECT(ctx);
520:   *MatSNESMFSetFunction(*mat,*r,ourmatsnesmffunction,ctx);
521: }
522: /* ---------------------------------------------------------*/

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

526: *SNESCreate((MPI_Comm)PetscToPointerComm(*comm),outsnes);
527: }

529: /* ---------------------------------------------------------*/
530: /*
531:      snesdefaultcomputejacobian() and snesdefaultcomputejacobiancolor()
532:   These can be used directly from Fortran but are mostly so that 
533:   Fortran SNESSetJacobian() will properly handle the defaults being passed in.

535:   functions, hence no STDCALL
536: */
537: void snesdefaultcomputejacobian_(SNES *snes,Vec *x,Mat *m,Mat *p,MatStructure* type,void *ctx,PetscErrorCode *ierr)
538: {
539:   *SNESDefaultComputeJacobian(*snes,*x,m,p,type,ctx);
540: }
541: void  snesdefaultcomputejacobiancolor_(SNES *snes,Vec *x,Mat *m,Mat *p,MatStructure* type,void *ctx,PetscErrorCode *ierr)
542: {
543:   *SNESDefaultComputeJacobianColor(*snes,*x,m,p,type,*(MatFDColoring*)ctx);
544: }

546: void  snesdacomputejacobianwithadifor_(SNES *snes,Vec *X,Mat *m,Mat *p,MatStructure* type,void *ctx,PetscErrorCode *ierr)
547: {
548:   (*PetscErrorPrintf)("Cannot call this function from Fortran");
549:   *1;
550: }

552: void  snesdacomputejacobian_(SNES *snes,Vec *X,Mat *m,Mat *p,MatStructure* type,void *ctx,PetscErrorCode *ierr)
553: {
554:   (*PetscErrorPrintf)("Cannot call this function from Fortran");
555:   *1;
556: }

558: void PETSC_STDCALL snessetjacobian_(SNES *snes,Mat *A,Mat *B,void (PETSC_STDCALL *func)(SNES*,Vec*,Mat*,Mat*,
559:             MatStructure*,void*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr)
560: {
561:   CHKFORTRANNULLOBJECT(ctx);
562:   if ((FCNVOID)func == (FCNVOID)snesdefaultcomputejacobian_) {
563:     *SNESSetJacobian(*snes,*A,*B,SNESDefaultComputeJacobian,ctx);
564:   } else if ((FCNVOID)func == (FCNVOID)snesdefaultcomputejacobiancolor_) {
565:     *SNESSetJacobian(*snes,*A,*B,SNESDefaultComputeJacobianColor,*(MatFDColoring*)ctx);
566:   } else if ((FCNVOID)func == (FCNVOID)snesdacomputejacobianwithadifor_) {
567:     *SNESSetJacobian(*snes,*A,*B,SNESDAComputeJacobianWithAdifor,ctx);
568:   } else if ((FCNVOID)func == (FCNVOID)snesdacomputejacobian_) {
569:     *SNESSetJacobian(*snes,*A,*B,SNESDAComputeJacobian,ctx);
570:   } else {
571:     f3 = func;
572:     *SNESSetJacobian(*snes,*A,*B,oursnesjacobian,ctx);
573:   }
574: }

576: /* -------------------------------------------------------------*/

578: void PETSC_STDCALL snesregisterdestroy_(PetscErrorCode *ierr)
579: {
580:   *SNESRegisterDestroy();
581: }

583: void PETSC_STDCALL snesgettype_(SNES *snes,CHAR name PETSC_MIXED_LEN(len),
584:                                 PetscErrorCode *ierr PETSC_END_LEN(len))
585: {
586:   const char *tname;

588:   *SNESGetType(*snes,&tname);
589: #if defined(PETSC_USES_CPTOFCD)
590:   {
591:     char *t = _fcdtocp(name); int len1 = _fcdlen(name);
592:     *PetscStrncpy(t,tname,len1);if (*ierr) return;
593:   }
594: #else
595:   *PetscStrncpy(name,tname,len);if (*ierr) return;
596: #endif
597:   FIXRETURNCHAR(name,len);
598: }

600: void PETSC_STDCALL snesgetoptionsprefix_(SNES *snes,CHAR prefix PETSC_MIXED_LEN(len),
601:                                          PetscErrorCode *ierr PETSC_END_LEN(len))
602: {
603:   const char *tname;

605:   *SNESGetOptionsPrefix(*snes,&tname);
606: #if defined(PETSC_USES_CPTOFCD)
607:   {
608:     char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
609:     *PetscStrncpy(t,tname,len1);if (*ierr) return;
610:   }
611: #else
612:   *PetscStrncpy(prefix,tname,len);if (*ierr) return;
613: #endif
614: }