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 snesgetsles_ SNESGETSLES
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 snesgetsles_ snesgetsles
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
114: #if defined(notused)
115: static int ourrhs(SNES snes,Vec vec,Vec vec2,void*ctx)
116: {
117: int 0;
118: DMMG *dmmg = (DMMG*)ctx;
119: (*(int (PETSC_STDCALL *)(SNES*,Vec*,Vec*,int*))(((PetscObject)dmmg->dm)->fortran_func_pointers[0]))(&snes,&vec,&vec2,&ierr);
120: return ierr;
121: }
123: static int ourmat(DMMG dmmg,Mat mat)
124: {
125: int 0;
126: (*(int (PETSC_STDCALL *)(DMMG*,Vec*,int*))(((PetscObject)dmmg->dm)->fortran_func_pointers[1]))(&dmmg,&vec,&ierr);
127: return ierr;
128: }
130: void PETSC_STDCALL dmmgsetsnes_(DMMG **dmmg,int (PETSC_STDCALL *rhs)(SNES*,Vec*,Vec*,int*),int (PETSC_STDCALL *mat)(DMMG*,Mat*,int*),int *ierr)
131: {
132: int i;
133: theirmat = mat;
134: *DMMGSetSNES(*dmmg,ourrhs,ourmat,*dmmg);
135: /*
136: Save the fortran rhs function in the DM on each level; ourrhs() pulls it out when needed
137: */
138: for (i=0; i<(**dmmg)->nlevels; i++) {
139: ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[0] = (void (*)(void))rhs;
140: ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[1] = (void (*)(void))mat;
141: }
142: }
144: #endif
146: #if defined (PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX)
147: void PETSC_STDCALL matregisterdaad_(int *ierr)
148: {
149: *MatRegisterDAAD();
150: }
152: void PETSC_STDCALL matcreatedaad_(DA *da,Mat *mat,int *ierr)
153: {
154: *MatCreateDAAD(*da,mat);
155: }
157: void PETSC_STDCALL matdaadsetsnes_(Mat *mat,SNES *snes,int *ierr)
158: {
159: *MatDAADSetSNES(*mat,*snes);
160: }
161: #endif
163: void PETSC_STDCALL snesview_(SNES *snes,PetscViewer *viewer, int *ierr)
164: {
165: PetscViewer v;
166: PetscPatchDefaultViewers_Fortran(viewer,v);
167: *SNESView(*snes,v);
168: }
170: void PETSC_STDCALL snesgetconvergedreason(SNES *snes,SNESConvergedReason *r,int *ierr)
171: {
172: *SNESGetConvergedReason(*snes,r);
173: }
175: void PETSC_STDCALL snessetlinesearchparams_(SNES *snes,PetscReal *alpha,PetscReal *maxstep,PetscReal *steptol,int *ierr)
176: {
177: *SNESSetLineSearchParams(*snes,*alpha,*maxstep,*steptol);
178: }
180: void PETSC_STDCALL snesgetlinesearchparams_(SNES *snes,PetscReal *alpha,PetscReal *maxstep,PetscReal *steptol,int *ierr)
181: {
182: CHKFORTRANNULLREAL(alpha);
183: CHKFORTRANNULLREAL(maxstep);
184: CHKFORTRANNULLREAL(steptol);
185: *SNESGetLineSearchParams(*snes,alpha,maxstep,steptol);
186: }
188: /* func is currently ignored from Fortran */
189: void PETSC_STDCALL snesgetjacobian_(SNES *snes,Mat *A,Mat *B,void **ctx,int *func,int *ierr)
190: {
191: CHKFORTRANNULLINTEGER(ctx);
192: CHKFORTRANNULLOBJECT(A);
193: CHKFORTRANNULLOBJECT(B);
194: *SNESGetJacobian(*snes,A,B,ctx,0);
195: }
197: void PETSC_STDCALL matsnesmfsettype_(Mat *mat,CHAR ftype PETSC_MIXED_LEN(len),
198: int *ierr PETSC_END_LEN(len))
199: {
200: char *t;
201: FIXCHAR(ftype,len,t);
202: *MatSNESMFSetType(*mat,t);
203: FREECHAR(ftype,t);
204: }
206: void PETSC_STDCALL snesgetconvergencehistory_(SNES *snes,int *na,int *ierr)
207: {
208: *SNESGetConvergenceHistory(*snes,PETSC_NULL,PETSC_NULL,na);
209: }
211: void PETSC_STDCALL snessettype_(SNES *snes,CHAR type PETSC_MIXED_LEN(len),
212: int *ierr PETSC_END_LEN(len))
213: {
214: char *t;
216: FIXCHAR(type,len,t);
217: *SNESSetType(*snes,t);
218: FREECHAR(type,t);
219: }
221: void PETSC_STDCALL snesappendoptionsprefix_(SNES *snes,CHAR prefix PETSC_MIXED_LEN(len),
222: int *ierr PETSC_END_LEN(len))
223: {
224: char *t;
226: FIXCHAR(prefix,len,t);
227: *SNESAppendOptionsPrefix(*snes,t);
228: FREECHAR(prefix,t);
229: }
231: void PETSC_STDCALL matcreatesnesmf_(SNES *snes,Vec *x,Mat *J,int *ierr)
232: {
233: *MatCreateSNESMF(*snes,*x,J);
234: }
236: void PETSC_STDCALL matcreatemf_(Vec *x,Mat *J,int *ierr)
237: {
238: *MatCreateMF(*x,J);
239: }
241: /* functions, hence no STDCALL */
243: void sneslgmonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
244: {
245: *SNESLGMonitor(*snes,*its,*fgnorm,dummy);
246: }
248: void snesdefaultmonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
249: {
250: *SNESDefaultMonitor(*snes,*its,*fgnorm,dummy);
251: }
253: void snesvecviewmonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
254: {
255: *SNESVecViewMonitor(*snes,*its,*fgnorm,dummy);
256: }
258: void snesvecviewupdatemonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
259: {
260: *SNESVecViewUpdateMonitor(*snes,*its,*fgnorm,dummy);
261: }
263: static void (PETSC_STDCALL *f7)(SNES*,int*,PetscReal*,void*,int*);
264: static int oursnesmonitor(SNES snes,int i,PetscReal d,void*ctx)
265: {
266: int 0;
268: (*f7)(&snes,&i,&d,ctx,&ierr);
269: return 0;
270: }
271: static void (PETSC_STDCALL *f71)(void*,int*);
272: static int ourmondestroy(void* ctx)
273: {
274: int 0;
276: (*f71)(ctx,&ierr);
277: return 0;
278: }
280: void PETSC_STDCALL snessetmonitor_(SNES *snes,void (PETSC_STDCALL *func)(SNES*,int*,PetscReal*,void*,int*),
281: void *mctx,void (PETSC_STDCALL *mondestroy)(void *,int *),int *ierr)
282: {
283: CHKFORTRANNULLOBJECT(mctx);
284: if ((void(*)(void))func == (void(*)(void))snesdefaultmonitor_) {
285: *SNESSetMonitor(*snes,SNESDefaultMonitor,0,0);
286: } else if ((void(*)(void))func == (void(*)(void))snesvecviewmonitor_) {
287: *SNESSetMonitor(*snes,SNESVecViewMonitor,0,0);
288: } else if ((void(*)(void))func == (void(*)(void))snesvecviewupdatemonitor_) {
289: *SNESSetMonitor(*snes,SNESVecViewUpdateMonitor,0,0);
290: } else if ((void(*)(void))func == (void(*)(void))sneslgmonitor_) {
291: *SNESSetMonitor(*snes,SNESLGMonitor,0,0);
292: } else {
293: f7 = func;
294: if (FORTRANNULLFUNCTION(mondestroy)){
295: *SNESSetMonitor(*snes,oursnesmonitor,mctx,0);
296: } else {
297: f71 = mondestroy;
298: *SNESSetMonitor(*snes,oursnesmonitor,mctx,ourmondestroy);
299: }
300: }
301: }
303: /* -----------------------------------------------------------------------------------------------------*/
304: void snescubiclinesearch_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
305: PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
306: {
307: *SNESCubicLineSearch(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
308: }
309: void snesquadraticlinesearch_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
310: PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
311: {
312: *SNESQuadraticLineSearch(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
313: }
314: void snesnolinesearch_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
315: PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
316: {
317: *SNESNoLineSearch(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
318: }
319: void snesnolinesearchnonorms_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
320: PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
321: {
322: *SNESNoLineSearchNoNorms(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
323: }
325: void (PETSC_STDCALL *f73)(SNES*,void *,Vec*,Vec*,Vec*,Vec*,Vec*,PetscReal*,PetscReal*,PetscReal*,int*,int*);
326: int OurSNESLineSearch(SNES snes,void *ctx,Vec x,Vec f,Vec g,Vec y,Vec w,PetscReal fnorm,PetscReal*ynorm,PetscReal*gnorm,int *flag)
327: {
328: int 0;
329: (*f73)(&snes,(void*)&ctx,&x,&f,&g,&y,&w,&fnorm,ynorm,gnorm,flag,&ierr);
330: return 0;
331: }
333: 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)
334: {
335: if ((void(*)(void))f == (void(*)(void))snescubiclinesearch_) {
336: *SNESSetLineSearch(*snes,SNESCubicLineSearch,ctx);
337: } else if ((void(*)(void))f == (void(*)(void))snesquadraticlinesearch_) {
338: *SNESSetLineSearch(*snes,SNESQuadraticLineSearch,ctx);
339: } else if ((void(*)(void))f == (void(*)(void))snesnolinesearch_) {
340: *SNESSetLineSearch(*snes,SNESNoLineSearch,ctx);
341: } else if ((void(*)(void))f == (void(*)(void))snesnolinesearchnonorms_) {
342: *SNESSetLineSearch(*snes,SNESNoLineSearchNoNorms,ctx);
343: } else {
344: f73 = f;
345: *SNESSetLineSearch(*snes,OurSNESLineSearch,ctx);
346: }
347: }
349: void (PETSC_STDCALL *f74)(SNES*,void *,Vec*,PetscTruth*,int*);
350: int OurSNESLineSearchCheck(SNES snes,void *checkCtx,Vec x,PetscTruth *flag)
351: {
352: int 0;
353: (*f74)(&snes,(void*)&checkCtx,&x,flag,&ierr);
354: return 0;
355: }
357: void PETSC_STDCALL snessetlinesearchcheck_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,void *,Vec*,PetscTruth*,int*),void *ctx,int *ierr)
358: {
359: f74 = f;
360: *SNESSetLineSearchCheck(*snes,OurSNESLineSearchCheck,ctx);
361: }
363: /*----------------------------------------------------------------------*/
365: void snesconverged_tr_(SNES *snes,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,
366: void *ct,int *ierr)
367: {
368: *SNESConverged_TR(*snes,*a,*b,*c,r,ct);
369: }
371: void snesconverged_ls_(SNES *snes,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,
372: void *ct,int *ierr)
373: {
374: *SNESConverged_LS(*snes,*a,*b,*c,r,ct);
375: }
377: static void (PETSC_STDCALL *f8)(SNES*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,int*);
378: static int oursnestest(SNES snes,PetscReal a,PetscReal d,PetscReal c,SNESConvergedReason*reason,void*ctx)
379: {
380: int 0;
382: (*f8)(&snes,&a,&d,&c,reason,ctx,&ierr);
383: return 0;
384: }
386: void PETSC_STDCALL snessetconvergencetest_(SNES *snes,
387: void (PETSC_STDCALL *func)(SNES*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,int*),
388: void *cctx,int *ierr)
389: {
390: CHKFORTRANNULLOBJECT(cctx);
391: if ((void(*)(void))func == (void(*)(void))snesconverged_ls_){
392: *SNESSetConvergenceTest(*snes,SNESConverged_LS,0);
393: } else if ((void(*)(void))func == (void(*)(void))snesconverged_tr_){
394: *SNESSetConvergenceTest(*snes,SNESConverged_TR,0);
395: } else {
396: f8 = func;
397: *SNESSetConvergenceTest(*snes,oursnestest,cctx);
398: }
399: }
401: /*--------------------------------------------------------------------------------------------*/
403: void PETSC_STDCALL snesgetsolution_(SNES *snes,Vec *x,int *ierr)
404: {
405: *SNESGetSolution(*snes,x);
406: }
408: void PETSC_STDCALL snesgetsolutionupdate_(SNES *snes,Vec *x,int *ierr)
409: {
410: *SNESGetSolutionUpdate(*snes,x);
411: }
413: /* the func argument is ignored */
414: void PETSC_STDCALL snesgetfunction_(SNES *snes,Vec *r,void **ctx,void *func,int *ierr)
415: {
416: CHKFORTRANNULLINTEGER(ctx);
417: CHKFORTRANNULLINTEGER(r);
418: *SNESGetFunction(*snes,r,ctx,PETSC_NULL);
419: }
421: void PETSC_STDCALL snesdestroy_(SNES *snes,int *ierr)
422: {
423: *SNESDestroy(*snes);
424: }
426: void PETSC_STDCALL snesgetsles_(SNES *snes,SLES *sles,int *ierr)
427: {
428: *SNESGetSLES(*snes,sles);
429: }
431: /* ---------------------------------------------------------*/
433: static void (PETSC_STDCALL *f2)(SNES*,Vec*,Vec*,void*,int*);
434: static int oursnesfunction(SNES snes,Vec x,Vec f,void *ctx)
435: {
436: int 0;
437: (*f2)(&snes,&x,&f,ctx,&ierr);
438: return 0;
439: }
441: /*
442: These are not usually called from Fortran but allow Fortran users
443: to transparently set these monitors from .F code
444:
445: functions, hence no STDCALL
446: */
447: void snesdaformfunction_(SNES *snes,Vec *X, Vec *F,void *ptr,int *ierr)
448: {
449: *SNESDAFormFunction(*snes,*X,*F,ptr);
450: }
453: void PETSC_STDCALL snessetfunction_(SNES *snes,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,int*),
454: void *ctx,int *ierr)
455: {
456: CHKFORTRANNULLOBJECT(ctx);
457: f2 = func;
458: if ((void(*)(void))func == (void(*)(void))snesdaformfunction_) {
459: *SNESSetFunction(*snes,*r,SNESDAFormFunction,ctx);
460: } else {
461: *SNESSetFunction(*snes,*r,oursnesfunction,ctx);
462: }
463: }
465: /* ---------------------------------------------------------*/
467: static void (PETSC_STDCALL *f11)(SNES*,Vec*,Vec*,void*,int*);
468: static int ourmatsnesmffunction(SNES snes,Vec x,Vec f,void *ctx)
469: {
470: int 0;
471: (*f11)(&snes,&x,&f,ctx,&ierr);
472: return 0;
473: }
474: void PETSC_STDCALL matsnesmfsetfunction_(Mat *mat,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,int*),
475: void *ctx,int *ierr){
476: f11 = func;
477: CHKFORTRANNULLOBJECT(ctx);
478: *MatSNESMFSetFunction(*mat,*r,ourmatsnesmffunction,ctx);
479: }
480: /* ---------------------------------------------------------*/
482: void PETSC_STDCALL snescreate_(MPI_Comm *comm,SNES *outsnes,int *ierr){
484: *SNESCreate((MPI_Comm)PetscToPointerComm(*comm),outsnes);
485: }
487: /* ---------------------------------------------------------*/
488: /*
489: snesdefaultcomputejacobian() and snesdefaultcomputejacobiancolor()
490: These can be used directly from Fortran but are mostly so that
491: Fortran SNESSetJacobian() will properly handle the defaults being passed in.
493: functions, hence no STDCALL
494: */
495: void snesdefaultcomputejacobian_(SNES *snes,Vec *x,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
496: {
497: *SNESDefaultComputeJacobian(*snes,*x,m,p,type,ctx);
498: }
499: void snesdefaultcomputejacobiancolor_(SNES *snes,Vec *x,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
500: {
501: *SNESDefaultComputeJacobianColor(*snes,*x,m,p,type,*(MatFDColoring*)ctx);
502: }
504: void snesdacomputejacobianwithadifor_(SNES *snes,Vec *X,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
505: {
506: (*PetscErrorPrintf)("Cannot call this function from Fortran");
507: *1;
508: }
510: void snesdacomputejacobian_(SNES *snes,Vec *X,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
511: {
512: (*PetscErrorPrintf)("Cannot call this function from Fortran");
513: *1;
514: }
516: static void (PETSC_STDCALL *f3)(SNES*,Vec*,Mat*,Mat*,MatStructure*,void*,int*);
517: static int oursnesjacobian(SNES snes,Vec x,Mat* m,Mat* p,MatStructure* type,void*ctx)
518: {
519: int 0;
520: (*f3)(&snes,&x,m,p,type,ctx,&ierr);
521: return 0;
522: }
524: void PETSC_STDCALL snessetjacobian_(SNES *snes,Mat *A,Mat *B,void (PETSC_STDCALL *func)(SNES*,Vec*,Mat*,Mat*,
525: MatStructure*,void*,int*),void *ctx,int *ierr)
526: {
527: CHKFORTRANNULLOBJECT(ctx);
528: if ((void(*)(void))func == (void(*)(void))snesdefaultcomputejacobian_) {
529: *SNESSetJacobian(*snes,*A,*B,SNESDefaultComputeJacobian,ctx);
530: } else if ((void(*)(void))func == (void(*)(void))snesdefaultcomputejacobiancolor_) {
531: *SNESSetJacobian(*snes,*A,*B,SNESDefaultComputeJacobianColor,*(MatFDColoring*)ctx);
532: } else if ((void(*)(void))func == (void(*)(void))snesdacomputejacobianwithadifor_) {
533: *SNESSetJacobian(*snes,*A,*B,SNESDAComputeJacobianWithAdifor,ctx);
534: } else if ((void(*)(void))func == (void(*)(void))snesdacomputejacobian_) {
535: *SNESSetJacobian(*snes,*A,*B,SNESDAComputeJacobian,ctx);
536: } else {
537: f3 = func;
538: *SNESSetJacobian(*snes,*A,*B,oursnesjacobian,ctx);
539: }
540: }
542: /* -------------------------------------------------------------*/
544: void PETSC_STDCALL snesregisterdestroy_(int *ierr)
545: {
546: *SNESRegisterDestroy();
547: }
549: void PETSC_STDCALL snesgettype_(SNES *snes,CHAR name PETSC_MIXED_LEN(len),
550: int *ierr PETSC_END_LEN(len))
551: {
552: char *tname;
554: *SNESGetType(*snes,&tname);
555: #if defined(PETSC_USES_CPTOFCD)
556: {
557: char *t = _fcdtocp(name); int len1 = _fcdlen(name);
558: *PetscStrncpy(t,tname,len1);if (*ierr) return;
559: }
560: #else
561: *PetscStrncpy(name,tname,len);if (*ierr) return;
562: #endif
563: }
565: void PETSC_STDCALL snesgetoptionsprefix_(SNES *snes,CHAR prefix PETSC_MIXED_LEN(len),
566: int *ierr PETSC_END_LEN(len))
567: {
568: char *tname;
570: *SNESGetOptionsPrefix(*snes,&tname);
571: #if defined(PETSC_USES_CPTOFCD)
572: {
573: char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
574: *PetscStrncpy(t,tname,len1);if (*ierr) return;
575: }
576: #else
577: *PetscStrncpy(prefix,tname,len);if (*ierr) return;
578: #endif
579: }
581: EXTERN_C_END