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: }