Actual source code: zsnes.c
1: /*$Id: zsnes.c,v 1.63 2001/08/31 16:15:30 bsmith Exp $*/
3: #include src/fortran/custom/zpetsc.h
4: #include petscsnes.h
5: #include petscda.h
7: #ifdef PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE
8: #define snesconverged_tr_ snesconverged_tr__
9: #define snesconverged_ls_ snesconverged_ls__
10: #endif
12: #ifdef PETSC_HAVE_FORTRAN_CAPS
13: #define dmmgsetsnes_ DMMGSETSNES
14: #define matcreatedaad_ MATCREATEDAAD
15: #define matregisterdaad_ MATREGISTERDAAD
16: #define matdaadsetsnes_ MATDAADSETSNES
17: #define snesdacomputejacobian_ SNESDACOMPUTEJACOBIAN
18: #define snesdacomputejacobianwithadifor_ SNESDACOMPUTEJACOBIANWITHADIFOR
19: #define snesdaformfunction_ SNESDAFORMFUNCTION
20: #define snesconverged_tr_ SNESCONVERGED_TR
21: #define snesconverged_ls_ SNESCONVERGED_LS
22: #define snesgetconvergedreason_ SNESGETCONVERGEDREASON
23: #define snesdefaultmonitor_ SNESDEFAULTMONITOR
24: #define snesvecviewmonitor_ SNESVECVIEWMONITOR
25: #define sneslgmonitor_ SNESLGMONITOR
26: #define snesvecviewupdatemonitor_ SNESVECVIEWUPDATEMONITOR
27: #define snesregisterdestroy_ SNESREGISTERDESTROY
28: #define snessetjacobian_ SNESSETJACOBIAN
29: #define snescreate_ SNESCREATE
30: #define snessetfunction_ SNESSETFUNCTION
31: #define snesgetksp_ SNESGETKSP
32: #define snessetmonitor_ SNESSETMONITOR
33: #define snessetconvergencetest_ SNESSETCONVERGENCETEST
34: #define snesregisterdestroy_ SNESREGISTERDESTROY
35: #define snesgetsolution_ SNESGETSOLUTION
36: #define snesgetsolutionupdate_ SNESGETSOLUTIONUPDATE
37: #define snesgetfunction_ SNESGETFUNCTION
38: #define snesdestroy_ SNESDESTROY
39: #define snesgettype_ SNESGETTYPE
40: #define snessetoptionsprefix_ SNESSETOPTIONSPREFIX
41: #define snesappendoptionsprefix_ SNESAPPENDOPTIONSPREFIX
42: #define matcreatesnesmf_ MATCREATESNESMF
43: #define matcreatemf_ MATCREATEMF
44: #define snessettype_ SNESSETTYPE
45: #define snesgetconvergencehistory_ SNESGETCONVERGENCEHISTORY
46: #define snesdefaultcomputejacobian_ SNESDEFAULTCOMPUTEJACOBIAN
47: #define snesdefaultcomputejacobiancolor_ SNESDEFAULTCOMPUTEJACOBIANCOLOR
48: #define matsnesmfsettype_ MATSNESMFSETTYPE
49: #define snesgetoptionsprefix_ SNESGETOPTIONSPREFIX
50: #define snesgetjacobian_ SNESGETJACOBIAN
51: #define matsnesmfsetfunction_ MATSNESMFSETFUNCTION
52: #define snessetlinesearchparams_ SNESSETLINESEARCHPARAMS
53: #define snesgetlinesearchparams_ SNESGETLINESEARCHPARAMS
54: #define snessetlinesearch_ SNESSETLINESEARCH
55: #define snessetlinesearchcheck_ SNESSETLINESEARCHCHECK
56: #define snescubiclinesearch_ SNESCUBICLINESEARCH
57: #define snesquadraticlinesearch_ SNESQUADRATICLINESEARCH
58: #define snesnolinesearch_ SNESNOLINESEARCH
59: #define snesnolinesearchnonorms_ SNESNOLINESEARCHNONORMS
60: #define snesview_ SNESVIEW
61: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
62: #define dmmgsetsnes_ dmmgsetsnes
63: #define matcreatedaad_ matcreatedaad
64: #define matregisterdaad_ matregisterdaad
65: #define matdaadsetsnes_ matdaadsetsnes
66: #define snesdacomputejacobian_ snesdacomputejacobian
67: #define snesdacomputejacobianwithadifor_ snesdacomputejacobianwithadifor
68: #define snesdaformfunction_ snesdaformfunction
69: #define snescubiclinesearch_ snescubiclinesearch
70: #define snesquadraticlinesearch_ snesquadraticlinesearch
71: #define snesnolinesearch_ snesnolinesearch
72: #define snesnolinesearchnonorms_ snesnolinesearchnonorms
73: #define snessetlinesearchparams_ snessetlinesearchparams
74: #define snesgetlinesearchparams_ snesgetlinesearchparams
75: #define snessetlinesearch_ snessetlinesearch
76: #define snessetlinesearchcheck_ snessetlinesearchcheck
77: #define snesconverged_tr_ snesconverged_tr
78: #define snesconverged_ls_ snesconverged_ls
79: #define snesgetconvergedreason_ snesgetconvergedreason
80: #define sneslgmonitor_ sneslgmonitor
81: #define snesdefaultmonitor_ snesdefaultmonitor
82: #define snesvecviewmonitor_ snesvecviewmonitor
83: #define snesvecviewupdatemonitor_ snesvecviewupdatemonitor
84: #define matsnesmfsetfunction_ matsnesmfsetfunction
85: #define snesregisterdestroy_ snesregisterdestroy
86: #define snessetjacobian_ snessetjacobian
87: #define snescreate_ snescreate
88: #define snessetfunction_ snessetfunction
89: #define snesgetksp_ snesgetksp
90: #define snesdestroy_ snesdestroy
91: #define snessetmonitor_ snessetmonitor
92: #define snessetconvergencetest_ snessetconvergencetest
93: #define snesregisterdestroy_ snesregisterdestroy
94: #define snesgetsolution_ snesgetsolution
95: #define snesgetsolutionupdate_ snesgetsolutionupdate
96: #define snesgetfunction_ snesgetfunction
97: #define snesgettype_ snesgettype
98: #define snessetoptionsprefix_ snessetoptionsprefix
99: #define snesappendoptionsprefix_ snesappendoptionsprefix
100: #define matcreatesnesmf_ matcreatesnesmf
101: #define matcreatemf_ matcreatemf
102: #define snessettype_ snessettype
103: #define snesgetconvergencehistory_ snesgetconvergencehistory
104: #define snesdefaultcomputejacobian_ snesdefaultcomputejacobian
105: #define snesdefaultcomputejacobiancolor_ snesdefaultcomputejacobiancolor
106: #define matsnesmfsettype_ matsnesmfsettype
107: #define snesgetoptionsprefix_ snesgetoptionsprefix
108: #define snesgetjacobian_ snesgetjacobian
109: #define snesview_ snesview
110: #endif
112: EXTERN_C_BEGIN
113: static void (PETSC_STDCALL *f7)(SNES*,int*,PetscReal*,void*,int*);
114: static void (PETSC_STDCALL *f71)(void*,int*);
115: static void (PETSC_STDCALL *f8)(SNES*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,int*);
116: static void (PETSC_STDCALL *f2)(SNES*,Vec*,Vec*,void*,int*);
117: static void (PETSC_STDCALL *f11)(SNES*,Vec*,Vec*,void*,int*);
118: static void (PETSC_STDCALL *f3)(SNES*,Vec*,Mat*,Mat*,MatStructure*,void*,int*);
119: static void (PETSC_STDCALL *f73)(SNES*,void *,Vec*,Vec*,Vec*,Vec*,Vec*,PetscReal*,PetscReal*,PetscReal*,int*,int*);
120: static void (PETSC_STDCALL *f74)(SNES*,void *,Vec*,PetscTruth*,int*);
121: EXTERN_C_END
123: /* These are not extern C because they are passed into non-extern C user level functions */
124: int OurSNESLineSearch(SNES snes,void *ctx,Vec x,Vec f,Vec g,Vec y,Vec w,PetscReal fnorm,PetscReal*ynorm,PetscReal*gnorm,int *flag)
125: {
126: int 0;
127: (*f73)(&snes,(void*)&ctx,&x,&f,&g,&y,&w,&fnorm,ynorm,gnorm,flag,&ierr);
128: return 0;
129: }
131: int OurSNESLineSearchCheck(SNES snes,void *checkCtx,Vec x,PetscTruth *flag)
132: {
133: int 0;
134: (*f74)(&snes,(void*)&checkCtx,&x,flag,&ierr);
135: return 0;
136: }
138: static int oursnesmonitor(SNES snes,int i,PetscReal d,void*ctx)
139: {
140: int 0;
142: (*f7)(&snes,&i,&d,ctx,&ierr);
143: return 0;
144: }
145: static int ourmondestroy(void* ctx)
146: {
147: int 0;
149: (*f71)(ctx,&ierr);
150: return 0;
151: }
152: static int oursnestest(SNES snes,PetscReal a,PetscReal d,PetscReal c,SNESConvergedReason*reason,void*ctx)
153: {
154: int 0;
156: (*f8)(&snes,&a,&d,&c,reason,ctx,&ierr);
157: return 0;
158: }
159: static int oursnesfunction(SNES snes,Vec x,Vec f,void *ctx)
160: {
161: int 0;
162: (*f2)(&snes,&x,&f,ctx,&ierr);
163: return 0;
164: }
165: static int ourmatsnesmffunction(SNES snes,Vec x,Vec f,void *ctx)
166: {
167: int 0;
168: (*f11)(&snes,&x,&f,ctx,&ierr);
169: return 0;
170: }
171: static int oursnesjacobian(SNES snes,Vec x,Mat* m,Mat* p,MatStructure* type,void*ctx)
172: {
173: int 0;
174: (*f3)(&snes,&x,m,p,type,ctx,&ierr);
175: return 0;
176: }
178: EXTERN_C_BEGIN
180: #if defined(notused)
181: static int ourrhs(SNES snes,Vec vec,Vec vec2,void*ctx)
182: {
183: int 0;
184: DMMG *dmmg = (DMMG*)ctx;
185: (*(int (PETSC_STDCALL *)(SNES*,Vec*,Vec*,int*))(((PetscObject)dmmg->dm)->fortran_func_pointers[0]))(&snes,&vec,&vec2,&ierr);
186: return ierr;
187: }
189: static int ourmat(DMMG dmmg,Mat mat)
190: {
191: int 0;
192: (*(int (PETSC_STDCALL *)(DMMG*,Vec*,int*))(((PetscObject)dmmg->dm)->fortran_func_pointers[1]))(&dmmg,&vec,&ierr);
193: return ierr;
194: }
196: void PETSC_STDCALL dmmgsetsnes_(DMMG **dmmg,int (PETSC_STDCALL *rhs)(SNES*,Vec*,Vec*,int*),int (PETSC_STDCALL *mat)(DMMG*,Mat*,int*),int *ierr)
197: {
198: int i;
199: theirmat = mat;
200: *DMMGSetSNES(*dmmg,ourrhs,ourmat,*dmmg);
201: /*
202: Save the fortran rhs function in the DM on each level; ourrhs() pulls it out when needed
203: */
204: for (i=0; i<(**dmmg)->nlevels; i++) {
205: ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[0] = (FCNVOID)rhs;
206: ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[1] = (FCNVOID)mat;
207: }
208: }
210: #endif
212: #if defined (PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX) && !defined(PETSC_USE_SINGLE)
213: void PETSC_STDCALL matregisterdaad_(int *ierr)
214: {
215: *MatRegisterDAAD();
216: }
218: void PETSC_STDCALL matcreatedaad_(DA *da,Mat *mat,int *ierr)
219: {
220: *MatCreateDAAD(*da,mat);
221: }
223: void PETSC_STDCALL matdaadsetsnes_(Mat *mat,SNES *snes,int *ierr)
224: {
225: *MatDAADSetSNES(*mat,*snes);
226: }
227: #endif
229: void PETSC_STDCALL snesview_(SNES *snes,PetscViewer *viewer, int *ierr)
230: {
231: PetscViewer v;
232: PetscPatchDefaultViewers_Fortran(viewer,v);
233: *SNESView(*snes,v);
234: }
236: void PETSC_STDCALL snesgetconvergedreason_(SNES *snes,SNESConvergedReason *r,int *ierr)
237: {
238: *SNESGetConvergedReason(*snes,r);
239: }
241: void PETSC_STDCALL snessetlinesearchparams_(SNES *snes,PetscReal *alpha,PetscReal *maxstep,PetscReal *steptol,int *ierr)
242: {
243: *SNESSetLineSearchParams(*snes,*alpha,*maxstep,*steptol);
244: }
246: void PETSC_STDCALL snesgetlinesearchparams_(SNES *snes,PetscReal *alpha,PetscReal *maxstep,PetscReal *steptol,int *ierr)
247: {
248: CHKFORTRANNULLREAL(alpha);
249: CHKFORTRANNULLREAL(maxstep);
250: CHKFORTRANNULLREAL(steptol);
251: *SNESGetLineSearchParams(*snes,alpha,maxstep,steptol);
252: }
254: /* func is currently ignored from Fortran */
255: void PETSC_STDCALL snesgetjacobian_(SNES *snes,Mat *A,Mat *B,void **ctx,int *func,int *ierr)
256: {
257: CHKFORTRANNULLINTEGER(ctx);
258: CHKFORTRANNULLOBJECT(A);
259: CHKFORTRANNULLOBJECT(B);
260: *SNESGetJacobian(*snes,A,B,ctx,0);
261: }
263: void PETSC_STDCALL matsnesmfsettype_(Mat *mat,CHAR ftype PETSC_MIXED_LEN(len),
264: int *ierr PETSC_END_LEN(len))
265: {
266: char *t;
267: FIXCHAR(ftype,len,t);
268: *MatSNESMFSetType(*mat,t);
269: FREECHAR(ftype,t);
270: }
272: void PETSC_STDCALL snesgetconvergencehistory_(SNES *snes,int *na,int *ierr)
273: {
274: *SNESGetConvergenceHistory(*snes,PETSC_NULL,PETSC_NULL,na);
275: }
277: void PETSC_STDCALL snessettype_(SNES *snes,CHAR type PETSC_MIXED_LEN(len),
278: int *ierr PETSC_END_LEN(len))
279: {
280: char *t;
282: FIXCHAR(type,len,t);
283: *SNESSetType(*snes,t);
284: FREECHAR(type,t);
285: }
287: void PETSC_STDCALL snesappendoptionsprefix_(SNES *snes,CHAR prefix PETSC_MIXED_LEN(len),
288: int *ierr PETSC_END_LEN(len))
289: {
290: char *t;
292: FIXCHAR(prefix,len,t);
293: *SNESAppendOptionsPrefix(*snes,t);
294: FREECHAR(prefix,t);
295: }
297: void PETSC_STDCALL matcreatesnesmf_(SNES *snes,Vec *x,Mat *J,int *ierr)
298: {
299: *MatCreateSNESMF(*snes,*x,J);
300: }
302: void PETSC_STDCALL matcreatemf_(Vec *x,Mat *J,int *ierr)
303: {
304: *MatCreateMF(*x,J);
305: }
307: /* functions, hence no STDCALL */
309: void sneslgmonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
310: {
311: *SNESLGMonitor(*snes,*its,*fgnorm,dummy);
312: }
314: void snesdefaultmonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
315: {
316: *SNESDefaultMonitor(*snes,*its,*fgnorm,dummy);
317: }
319: void snesvecviewmonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
320: {
321: *SNESVecViewMonitor(*snes,*its,*fgnorm,dummy);
322: }
324: void snesvecviewupdatemonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
325: {
326: *SNESVecViewUpdateMonitor(*snes,*its,*fgnorm,dummy);
327: }
330: void PETSC_STDCALL snessetmonitor_(SNES *snes,void (PETSC_STDCALL *func)(SNES*,int*,PetscReal*,void*,int*),
331: void *mctx,void (PETSC_STDCALL *mondestroy)(void *,int *),int *ierr)
332: {
333: CHKFORTRANNULLOBJECT(mctx);
334: if ((FCNVOID)func == (FCNVOID)snesdefaultmonitor_) {
335: *SNESSetMonitor(*snes,SNESDefaultMonitor,0,0);
336: } else if ((FCNVOID)func == (FCNVOID)snesvecviewmonitor_) {
337: *SNESSetMonitor(*snes,SNESVecViewMonitor,0,0);
338: } else if ((FCNVOID)func == (FCNVOID)snesvecviewupdatemonitor_) {
339: *SNESSetMonitor(*snes,SNESVecViewUpdateMonitor,0,0);
340: } else if ((FCNVOID)func == (FCNVOID)sneslgmonitor_) {
341: *SNESSetMonitor(*snes,SNESLGMonitor,0,0);
342: } else {
343: f7 = func;
344: if (FORTRANNULLFUNCTION(mondestroy)){
345: *SNESSetMonitor(*snes,oursnesmonitor,mctx,0);
346: } else {
347: f71 = mondestroy;
348: *SNESSetMonitor(*snes,oursnesmonitor,mctx,ourmondestroy);
349: }
350: }
351: }
353: /* -----------------------------------------------------------------------------------------------------*/
354: void snescubiclinesearch_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
355: PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
356: {
357: *SNESCubicLineSearch(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
358: }
359: void snesquadraticlinesearch_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
360: PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
361: {
362: *SNESQuadraticLineSearch(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
363: }
364: void snesnolinesearch_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
365: PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
366: {
367: *SNESNoLineSearch(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
368: }
369: void snesnolinesearchnonorms_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
370: PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
371: {
372: *SNESNoLineSearchNoNorms(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
373: }
376: void PETSC_STDCALL snessetlinesearch_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,void *,Vec*,Vec*,Vec*,Vec*,Vec*,PetscReal*,PetscReal*,PetscReal*,int*,int*),void *ctx,int *ierr)
377: {
378: if ((FCNVOID)f == (FCNVOID)snescubiclinesearch_) {
379: *SNESSetLineSearch(*snes,SNESCubicLineSearch,ctx);
380: } else if ((FCNVOID)f == (FCNVOID)snesquadraticlinesearch_) {
381: *SNESSetLineSearch(*snes,SNESQuadraticLineSearch,ctx);
382: } else if ((FCNVOID)f == (FCNVOID)snesnolinesearch_) {
383: *SNESSetLineSearch(*snes,SNESNoLineSearch,ctx);
384: } else if ((FCNVOID)f == (FCNVOID)snesnolinesearchnonorms_) {
385: *SNESSetLineSearch(*snes,SNESNoLineSearchNoNorms,ctx);
386: } else {
387: f73 = f;
388: *SNESSetLineSearch(*snes,OurSNESLineSearch,ctx);
389: }
390: }
393: void PETSC_STDCALL snessetlinesearchcheck_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,void *,Vec*,PetscTruth*,int*),void *ctx,int *ierr)
394: {
395: f74 = f;
396: *SNESSetLineSearchCheck(*snes,OurSNESLineSearchCheck,ctx);
397: }
399: /*----------------------------------------------------------------------*/
401: void snesconverged_tr_(SNES *snes,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,
402: void *ct,int *ierr)
403: {
404: *SNESConverged_TR(*snes,*a,*b,*c,r,ct);
405: }
407: void snesconverged_ls_(SNES *snes,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,
408: void *ct,int *ierr)
409: {
410: *SNESConverged_LS(*snes,*a,*b,*c,r,ct);
411: }
414: void PETSC_STDCALL snessetconvergencetest_(SNES *snes,
415: void (PETSC_STDCALL *func)(SNES*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,int*),
416: void *cctx,int *ierr)
417: {
418: CHKFORTRANNULLOBJECT(cctx);
419: if ((FCNVOID)func == (FCNVOID)snesconverged_ls_){
420: *SNESSetConvergenceTest(*snes,SNESConverged_LS,0);
421: } else if ((FCNVOID)func == (FCNVOID)snesconverged_tr_){
422: *SNESSetConvergenceTest(*snes,SNESConverged_TR,0);
423: } else {
424: f8 = func;
425: *SNESSetConvergenceTest(*snes,oursnestest,cctx);
426: }
427: }
429: /*--------------------------------------------------------------------------------------------*/
431: void PETSC_STDCALL snesgetsolution_(SNES *snes,Vec *x,int *ierr)
432: {
433: *SNESGetSolution(*snes,x);
434: }
436: void PETSC_STDCALL snesgetsolutionupdate_(SNES *snes,Vec *x,int *ierr)
437: {
438: *SNESGetSolutionUpdate(*snes,x);
439: }
441: /* the func argument is ignored */
442: void PETSC_STDCALL snesgetfunction_(SNES *snes,Vec *r,void **ctx,void *func,int *ierr)
443: {
444: CHKFORTRANNULLINTEGER(ctx);
445: CHKFORTRANNULLINTEGER(r);
446: *SNESGetFunction(*snes,r,ctx,PETSC_NULL);
447: }
449: void PETSC_STDCALL snesdestroy_(SNES *snes,int *ierr)
450: {
451: *SNESDestroy(*snes);
452: }
454: void PETSC_STDCALL snesgetksp_(SNES *snes,KSP *ksp,int *ierr)
455: {
456: *SNESGetKSP(*snes,ksp);
457: }
459: /* ---------------------------------------------------------*/
462: /*
463: These are not usually called from Fortran but allow Fortran users
464: to transparently set these monitors from .F code
465:
466: functions, hence no STDCALL
467: */
468: void snesdaformfunction_(SNES *snes,Vec *X, Vec *F,void *ptr,int *ierr)
469: {
470: *SNESDAFormFunction(*snes,*X,*F,ptr);
471: }
474: void PETSC_STDCALL snessetfunction_(SNES *snes,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,int*),
475: void *ctx,int *ierr)
476: {
477: CHKFORTRANNULLOBJECT(ctx);
478: f2 = func;
479: if ((FCNVOID)func == (FCNVOID)snesdaformfunction_) {
480: *SNESSetFunction(*snes,*r,SNESDAFormFunction,ctx);
481: } else {
482: *SNESSetFunction(*snes,*r,oursnesfunction,ctx);
483: }
484: }
486: /* ---------------------------------------------------------*/
488: void PETSC_STDCALL matsnesmfsetfunction_(Mat *mat,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,int*),
489: void *ctx,int *ierr){
490: f11 = func;
491: CHKFORTRANNULLOBJECT(ctx);
492: *MatSNESMFSetFunction(*mat,*r,ourmatsnesmffunction,ctx);
493: }
494: /* ---------------------------------------------------------*/
496: void PETSC_STDCALL snescreate_(MPI_Comm *comm,SNES *outsnes,int *ierr){
498: *SNESCreate((MPI_Comm)PetscToPointerComm(*comm),outsnes);
499: }
501: /* ---------------------------------------------------------*/
502: /*
503: snesdefaultcomputejacobian() and snesdefaultcomputejacobiancolor()
504: These can be used directly from Fortran but are mostly so that
505: Fortran SNESSetJacobian() will properly handle the defaults being passed in.
507: functions, hence no STDCALL
508: */
509: void snesdefaultcomputejacobian_(SNES *snes,Vec *x,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
510: {
511: *SNESDefaultComputeJacobian(*snes,*x,m,p,type,ctx);
512: }
513: void snesdefaultcomputejacobiancolor_(SNES *snes,Vec *x,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
514: {
515: *SNESDefaultComputeJacobianColor(*snes,*x,m,p,type,*(MatFDColoring*)ctx);
516: }
518: void snesdacomputejacobianwithadifor_(SNES *snes,Vec *X,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
519: {
520: (*PetscErrorPrintf)("Cannot call this function from Fortran");
521: *1;
522: }
524: void snesdacomputejacobian_(SNES *snes,Vec *X,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
525: {
526: (*PetscErrorPrintf)("Cannot call this function from Fortran");
527: *1;
528: }
530: void PETSC_STDCALL snessetjacobian_(SNES *snes,Mat *A,Mat *B,void (PETSC_STDCALL *func)(SNES*,Vec*,Mat*,Mat*,
531: MatStructure*,void*,int*),void *ctx,int *ierr)
532: {
533: CHKFORTRANNULLOBJECT(ctx);
534: if ((FCNVOID)func == (FCNVOID)snesdefaultcomputejacobian_) {
535: *SNESSetJacobian(*snes,*A,*B,SNESDefaultComputeJacobian,ctx);
536: } else if ((FCNVOID)func == (FCNVOID)snesdefaultcomputejacobiancolor_) {
537: *SNESSetJacobian(*snes,*A,*B,SNESDefaultComputeJacobianColor,*(MatFDColoring*)ctx);
538: } else if ((FCNVOID)func == (FCNVOID)snesdacomputejacobianwithadifor_) {
539: *SNESSetJacobian(*snes,*A,*B,SNESDAComputeJacobianWithAdifor,ctx);
540: } else if ((FCNVOID)func == (FCNVOID)snesdacomputejacobian_) {
541: *SNESSetJacobian(*snes,*A,*B,SNESDAComputeJacobian,ctx);
542: } else {
543: f3 = func;
544: *SNESSetJacobian(*snes,*A,*B,oursnesjacobian,ctx);
545: }
546: }
548: /* -------------------------------------------------------------*/
550: void PETSC_STDCALL snesregisterdestroy_(int *ierr)
551: {
552: *SNESRegisterDestroy();
553: }
555: void PETSC_STDCALL snesgettype_(SNES *snes,CHAR name PETSC_MIXED_LEN(len),
556: int *ierr PETSC_END_LEN(len))
557: {
558: char *tname;
560: *SNESGetType(*snes,&tname);
561: #if defined(PETSC_USES_CPTOFCD)
562: {
563: char *t = _fcdtocp(name); int len1 = _fcdlen(name);
564: *PetscStrncpy(t,tname,len1);if (*ierr) return;
565: }
566: #else
567: *PetscStrncpy(name,tname,len);if (*ierr) return;
568: #endif
569: }
571: void PETSC_STDCALL snesgetoptionsprefix_(SNES *snes,CHAR prefix PETSC_MIXED_LEN(len),
572: int *ierr PETSC_END_LEN(len))
573: {
574: char *tname;
576: *SNESGetOptionsPrefix(*snes,&tname);
577: #if defined(PETSC_USES_CPTOFCD)
578: {
579: char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
580: *PetscStrncpy(t,tname,len1);if (*ierr) return;
581: }
582: #else
583: *PetscStrncpy(prefix,tname,len);if (*ierr) return;
584: #endif
585: }
587: EXTERN_C_END