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