Actual source code: zsnes.c
1: /*$Id: zsnes.c,v 1.57 2001/03/29 16:37:13 balay Exp $*/
3: #include "src/fortran/custom/zpetsc.h"
4: #include "petscsnes.h"
6: #ifdef PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE
7: #define snesconverged_eq_tr_ snesconverged_eq_tr__
8: #define snesconverged_eq_ls_ snesconverged_eq_ls__
9: #define snesconverged_um_tr_ snesconverged_um_tr__
10: #define snesconverged_um_ls_ snesconverged_um_ls__
11: #endif
13: #ifdef PETSC_HAVE_FORTRAN_CAPS
14: #define matsnesmfsetbase_ MATSNESMFSETBASE
15: #define snesconverged_eq_tr_ SNESCONVERGED_EQ_TR
16: #define snesconverged_eq_ls_ SNESCONVERGED_EQ_LS
17: #define snesconverged_um_tr_ SNESCONVERGED_UM_TR
18: #define snesconverged_um_ls_ SNESCONVERGED_UM_LS
19: #define snesgetconvergedreason_ SNESGETCONVERGEDREASON
20: #define snesdefaultmonitor_ SNESDEFAULTMONITOR
21: #define snesvecviewmonitor_ SNESVECVIEWMONITOR
22: #define sneslgmonitor_ SNESLGMONITOR
23: #define snesvecviewupdatemonitor_ SNESVECVIEWUPDATEMONITOR
24: #define snesregisterdestroy_ SNESREGISTERDESTROY
25: #define snessetjacobian_ SNESSETJACOBIAN
26: #define snescreate_ SNESCREATE
27: #define snessetfunction_ SNESSETFUNCTION
28: #define snessetminimizationfunction_ SNESSETMINIMIZATIONFUNCTION
29: #define snesgetsles_ SNESGETSLES
30: #define snessetgradient_ SNESSETGRADIENT
31: #define snessethessian_ SNESSETHESSIAN
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 snesgetminimizationfunction_ SNESGETMINIMIZATIONFUNCTION
39: #define snesgetgradient_ SNESGETGRADIENT
40: #define snesdestroy_ SNESDESTROY
41: #define snesgettype_ SNESGETTYPE
42: #define snessetoptionsprefix_ SNESSETOPTIONSPREFIX
43: #define snesappendoptionsprefix_ SNESAPPENDOPTIONSPREFIX
44: #define matcreatesnesmf_ MATCREATESNESMF
45: #define matcreatemf_ MATCREATEMF
46: #define snessettype_ SNESSETTYPE
47: #define snesgetconvergencehistory_ SNESGETCONVERGENCEHISTORY
48: #define snesdefaultcomputejacobian_ SNESDEFAULTCOMPUTEJACOBIAN
49: #define snesdefaultcomputejacobiancolor_ SNESDEFAULTCOMPUTEJACOBIANCOLOR
50: #define matsnesmfsettype_ MATSNESMFSETTYPE
51: #define snesgetoptionsprefix_ SNESGETOPTIONSPREFIX
52: #define snesgetjacobian_ SNESGETJACOBIAN
53: #define matsnesmfsetfunction_ MATSNESMFSETFUNCTION
54: #define snessetlinesearchparams_ SNESSETLINESEARCHPARAMS
55: #define snesgetlinesearchparams_ SNESGETLINESEARCHPARAMS
56: #define snessetlinesearch_ SNESSETLINESEARCH
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 matsnesmfsetbase_ matsnesmfsetbase
64: #define snescubiclinesearch_ snescubiclinesearch
65: #define snesquadraticlinesearch_ snesquadraticlinesearch
66: #define snesnolinesearch_ snesnolinesearch
67: #define snesnolinesearchnonorms_ snesnolinesearchnonorms
68: #define snessetlinesearch_ snessetlinesearch
69: #define snesconverged_eq_tr_ snesconverged_eq_tr
70: #define snesconverged_eq_ls_ snesconverged_eq_ls
71: #define snesconverged_um_tr_ snesconverged_um_tr
72: #define snesconverged_um_ls_ snesconverged_um_ls
73: #define snesgetconvergedreason_ snesgetconvergedreason
74: #define sneslgmonitor_ sneslgmonitor
75: #define snesdefaultmonitor_ snesdefaultmonitor
76: #define snesvecviewmonitor_ snesvecviewmonitor
77: #define snesvecviewupdatemonitor_ snesvecviewupdatemonitor
78: #define matsnesmfsetfunction_ matsnesmfsetfunction
79: #define snesregisterdestroy_ snesregisterdestroy
80: #define snessetjacobian_ snessetjacobian
81: #define snescreate_ snescreate
82: #define snessetfunction_ snessetfunction
83: #define snessethessian_ snessethessian
84: #define snessetgradient_ snessetgradient
85: #define snesgetsles_ snesgetsles
86: #define snessetminimizationfunction_ snessetminimizationfunction
87: #define snesdestroy_ snesdestroy
88: #define snessetmonitor_ snessetmonitor
89: #define snessetconvergencetest_ snessetconvergencetest
90: #define snesregisterdestroy_ snesregisterdestroy
91: #define snesgetsolution_ snesgetsolution
92: #define snesgetsolutionupdate_ snesgetsolutionupdate
93: #define snesgetfunction_ snesgetfunction
94: #define snesgetminimizationfunction_ snesgetminimizationfunction
95: #define snesgetgradient_ snesgetgradient
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 snessetlinesearchparams_ snessetlinesearchparams
109: #define snesgetlinesearchparams_ snesgetlinesearchparams
110: #define snesview_ snesview
111: #endif
113: EXTERN_C_BEGIN
115: void PETSC_STDCALL snesview_(SNES *snes,PetscViewer *viewer, int *ierr)
116: {
117: PetscViewer v;
118: PetscPatchDefaultViewers_Fortran(viewer,v);
119: *SNESView(*snes,v);
120: }
122: void PETSC_STDCALL snesgetconvergedreason(SNES *snes,SNESConvergedReason *r,int *ierr)
123: {
124: *SNESGetConvergedReason(*snes,r);
125: }
127: void PETSC_STDCALL snessetlinesearchparams_(SNES *snes,double *alpha,double *maxstep,double *steptol,int *ierr)
128: {
129: *SNESSetLineSearchParams(*snes,*alpha,*maxstep,*steptol);
130: }
132: void PETSC_STDCALL snesgetlinesearchparams_(SNES *snes,double *alpha,double *maxstep,double *steptol,int *ierr)
133: {
134: if (FORTRANNULLDOUBLE(alpha)) alpha = PETSC_NULL;
135: if (FORTRANNULLDOUBLE(maxstep)) maxstep = PETSC_NULL;
136: if (FORTRANNULLDOUBLE(steptol)) steptol = PETSC_NULL;
137: *SNESGetLineSearchParams(*snes,alpha,maxstep,steptol);
138: }
140: /* func is currently ignored from Fortran */
141: void PETSC_STDCALL snesgetjacobian_(SNES *snes,Mat *A,Mat *B,void **ctx,int *func,int *ierr)
142: {
143: if (FORTRANNULLINTEGER(ctx)) ctx = PETSC_NULL;
144: if (FORTRANNULLOBJECT(A)) A = PETSC_NULL;
145: if (FORTRANNULLOBJECT(B)) B = PETSC_NULL;
146: *SNESGetJacobian(*snes,A,B,ctx,0);
147: }
149: void PETSC_STDCALL matsnesmfsettype_(Mat *mat,CHAR ftype PETSC_MIXED_LEN(len),
150: int *ierr PETSC_END_LEN(len))
151: {
152: char *t;
153: FIXCHAR(ftype,len,t);
154: *MatSNESMFSetType(*mat,t);
155: FREECHAR(ftype,t);
156: }
158: void PETSC_STDCALL snesgetconvergencehistory_(SNES *snes,int *na,int *ierr)
159: {
160: *SNESGetConvergenceHistory(*snes,PETSC_NULL,PETSC_NULL,na);
161: }
163: void PETSC_STDCALL snessettype_(SNES *snes,CHAR type PETSC_MIXED_LEN(len),
164: int *ierr PETSC_END_LEN(len))
165: {
166: char *t;
168: FIXCHAR(type,len,t);
169: *SNESSetType(*snes,t);
170: FREECHAR(type,t);
171: }
173: void PETSC_STDCALL snesappendoptionsprefix_(SNES *snes,CHAR prefix PETSC_MIXED_LEN(len),
174: int *ierr PETSC_END_LEN(len))
175: {
176: char *t;
178: FIXCHAR(prefix,len,t);
179: *SNESAppendOptionsPrefix(*snes,t);
180: FREECHAR(prefix,t);
181: }
183: void PETSC_STDCALL matsnesmfsetbase_(Mat *m,Vec *x,int *ierr)
184: {
185: *MatSNESMFSetBase(*m,*x);
186: }
188: void PETSC_STDCALL matcreatesnesmf_(SNES *snes,Vec *x,Mat *J,int *ierr)
189: {
190: *MatCreateSNESMF(*snes,*x,J);
191: }
193: void PETSC_STDCALL matcreatemf_(Vec *x,Mat *J,int *ierr)
194: {
195: *MatCreateMF(*x,J);
196: }
198: /* functions, hence no STDCALL */
200: void sneslgmonitor_(SNES *snes,int *its,double *fgnorm,void *dummy,int *ierr)
201: {
202: *SNESLGMonitor(*snes,*its,*fgnorm,dummy);
203: }
205: void snesdefaultmonitor_(SNES *snes,int *its,double *fgnorm,void *dummy,int *ierr)
206: {
207: *SNESDefaultMonitor(*snes,*its,*fgnorm,dummy);
208: }
210: void snesvecviewmonitor_(SNES *snes,int *its,double *fgnorm,void *dummy,int *ierr)
211: {
212: *SNESVecViewMonitor(*snes,*its,*fgnorm,dummy);
213: }
215: void snesvecviewupdatemonitor_(SNES *snes,int *its,double *fgnorm,void *dummy,int *ierr)
216: {
217: *SNESVecViewUpdateMonitor(*snes,*its,*fgnorm,dummy);
218: }
220: static void (PETSC_STDCALL *f7)(SNES*,int*,double*,void*,int*);
221: static int oursnesmonitor(SNES snes,int i,double d,void*ctx)
222: {
223: int 0;
225: (*f7)(&snes,&i,&d,ctx,&ierr);
226: return 0;
227: }
228: static void (PETSC_STDCALL *f71)(void*,int*);
229: static int ourmondestroy(void* ctx)
230: {
231: int 0;
233: (*f71)(ctx,&ierr);
234: return 0;
235: }
237: void PETSC_STDCALL snessetmonitor_(SNES *snes,void (PETSC_STDCALL *func)(SNES*,int*,double*,void*,int*),
238: void *mctx,void (PETSC_STDCALL *mondestroy)(void *,int *),int *ierr)
239: {
240: if ((void(*)())func == (void(*)())snesdefaultmonitor_) {
241: *SNESSetMonitor(*snes,SNESDefaultMonitor,0,0);
242: } else if ((void(*)())func == (void(*)())snesvecviewmonitor_) {
243: *SNESSetMonitor(*snes,SNESVecViewMonitor,0,0);
244: } else if ((void(*)())func == (void(*)())snesvecviewupdatemonitor_) {
245: *SNESSetMonitor(*snes,SNESVecViewUpdateMonitor,0,0);
246: } else if ((void(*)())func == (void(*)())sneslgmonitor_) {
247: *SNESSetMonitor(*snes,SNESLGMonitor,0,0);
248: } else {
249: f7 = func;
250: if (FORTRANNULLFUNCTION(mondestroy)){
251: *SNESSetMonitor(*snes,oursnesmonitor,mctx,0);
252: } else {
253: f71 = mondestroy;
254: *SNESSetMonitor(*snes,oursnesmonitor,mctx,ourmondestroy);
255: }
256: }
257: }
259: /* -----------------------------------------------------------------------------------------------------*/
260: void snescubiclinesearch_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,double*fnorm,
261: double *ynorm,double *gnorm,int *flag,int *ierr)
262: {
263: *SNESCubicLineSearch(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
264: }
265: void snesquadraticlinesearch_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,double*fnorm,
266: double *ynorm,double *gnorm,int *flag,int *ierr)
267: {
268: *SNESQuadraticLineSearch(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
269: }
270: void snesnolinesearch_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,double*fnorm,
271: double *ynorm,double *gnorm,int *flag,int *ierr)
272: {
273: *SNESNoLineSearch(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
274: }
275: void snesnolinesearchnonorms_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,double*fnorm,
276: double *ynorm,double *gnorm,int *flag,int *ierr)
277: {
278: *SNESNoLineSearchNoNorms(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
279: }
281: void (PETSC_STDCALL *f73)(SNES*,void *,Vec*,Vec*,Vec*,Vec*,Vec*,double*,double*,double*,int*,int*);
282: int OurSNESLineSearch(SNES snes,void *ctx,Vec x,Vec f,Vec g,Vec y,Vec w,double fnorm,double*ynorm,double*gnorm,int *flag)
283: {
284: int 0;
285: (*f73)(&snes,(void*)&ctx,&x,&f,&g,&y,&w,&fnorm,ynorm,gnorm,flag,&ierr);
286: return 0;
287: }
289: void PETSC_STDCALL snessetlinesearch_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,void *,Vec*,Vec*,Vec*,Vec*,Vec*,double*,double*,double*,int*,int*),void *ctx,int *ierr)
290: {
291: if ((void(*)())f == (void(*)())snescubiclinesearch_) {
292: *SNESSetLineSearch(*snes,SNESCubicLineSearch,0);
293: } else if ((void(*)())f == (void(*)())snesquadraticlinesearch_) {
294: *SNESSetLineSearch(*snes,SNESQuadraticLineSearch,0);
295: } else if ((void(*)())f == (void(*)())snesnolinesearch_) {
296: *SNESSetLineSearch(*snes,SNESNoLineSearch,0);
297: } else if ((void(*)())f == (void(*)())snesnolinesearchnonorms_) {
298: *SNESSetLineSearch(*snes,SNESNoLineSearchNoNorms,0);
299: } else {
300: f73 = f;
301: *SNESSetLineSearch(*snes,OurSNESLineSearch,0);
302: }
303: }
304:
306: /*--------------------------------------------------------------------------------------------*/
307: void snesconverged_um_ls_(SNES *snes,double *a,double *b,double *c,SNESConvergedReason *r,
308: void *ct,int *ierr)
309: {
310: *SNESConverged_UM_LS(*snes,*a,*b,*c,r,ct);
311: }
313: void snesconverged_um_tr_(SNES *snes,double *a,double *b,double *c,SNESConvergedReason *r,
314: void *ct,int *ierr)
315: {
316: *SNESConverged_UM_TR(*snes,*a,*b,*c,r,ct);
317: }
319: void snesconverged_eq_tr_(SNES *snes,double *a,double *b,double *c,SNESConvergedReason *r,
320: void *ct,int *ierr)
321: {
322: *SNESConverged_EQ_TR(*snes,*a,*b,*c,r,ct);
323: }
325: void snesconverged_eq_ls_(SNES *snes,double *a,double *b,double *c,SNESConvergedReason *r,
326: void *ct,int *ierr)
327: {
328: *SNESConverged_EQ_LS(*snes,*a,*b,*c,r,ct);
329: }
331: static void (PETSC_STDCALL *f8)(SNES*,double*,double*,double*,SNESConvergedReason*,void*,int*);
332: static int oursnestest(SNES snes,double a,double d,double c,SNESConvergedReason*reason,void*ctx)
333: {
334: int 0;
336: (*f8)(&snes,&a,&d,&c,reason,ctx,&ierr);
337: return 0;
338: }
340: void PETSC_STDCALL snessetconvergencetest_(SNES *snes,
341: void (PETSC_STDCALL *func)(SNES*,double*,double*,double*,SNESConvergedReason*,void*,int*),
342: void *cctx,int *ierr)
343: {
344: if ((void(*)())func == (void(*)())snesconverged_eq_ls_){
345: *SNESSetConvergenceTest(*snes,SNESConverged_EQ_LS,0);
346: } else if ((void(*)())func == (void(*)())snesconverged_eq_tr_){
347: *SNESSetConvergenceTest(*snes,SNESConverged_EQ_TR,0);
348: } else if ((void(*)())func == (void(*)())snesconverged_um_tr_){
349: *SNESSetConvergenceTest(*snes,SNESConverged_UM_TR,0);
350: } else if ((void(*)())func == (void(*)())snesconverged_um_ls_){
351: *SNESSetConvergenceTest(*snes,SNESConverged_UM_LS,0);
352: } else {
353: f8 = func;
354: *SNESSetConvergenceTest(*snes,oursnestest,cctx);
355: }
356: }
358: /*--------------------------------------------------------------------------------------------*/
360: void PETSC_STDCALL snesgetsolution_(SNES *snes,Vec *x,int *ierr)
361: {
362: *SNESGetSolution(*snes,x);
363: }
365: void PETSC_STDCALL snesgetsolutionupdate_(SNES *snes,Vec *x,int *ierr)
366: {
367: *SNESGetSolutionUpdate(*snes,x);
368: }
370: /* the func argument is ignored */
371: void PETSC_STDCALL snesgetfunction_(SNES *snes,Vec *r,void **ctx,void *func,int *ierr)
372: {
373: if (FORTRANNULLINTEGER(ctx)) ctx = PETSC_NULL;
374: if (FORTRANNULLINTEGER(r)) r = PETSC_NULL;
375: *SNESGetFunction(*snes,r,ctx,PETSC_NULL);
376: }
378: void PETSC_STDCALL snesgetminimizationfunction_(SNES *snes,double *r,void **ctx,int *ierr)
379: {
380: if (FORTRANNULLINTEGER(ctx)) ctx = PETSC_NULL;
381: if (FORTRANNULLDOUBLE(r)) r = PETSC_NULL;
382: *SNESGetMinimizationFunction(*snes,r,ctx);
383: }
385: void PETSC_STDCALL snesgetgradient_(SNES *snes,Vec *r,void **ctx,int *ierr)
386: {
387: if (FORTRANNULLINTEGER(ctx)) ctx = PETSC_NULL;
388: if (FORTRANNULLINTEGER(r)) r = PETSC_NULL;
389: *SNESGetGradient(*snes,r,ctx);
390: }
392: void PETSC_STDCALL snesdestroy_(SNES *snes,int *ierr)
393: {
394: *SNESDestroy(*snes);
395: }
397: void PETSC_STDCALL snesgetsles_(SNES *snes,SLES *sles,int *ierr)
398: {
399: *SNESGetSLES(*snes,sles);
400: }
402: static void (PETSC_STDCALL *f6)(SNES *,Vec *,Mat *,Mat *,int*,void*,int*);
403: static int oursneshessianfunction(SNES snes,Vec x,Mat* mat,Mat* pmat,
404: MatStructure* st,void *ctx)
405: {
406: int 0;
408: (*f6)(&snes,&x,mat,pmat,(int*)st,ctx,&ierr);
410: return 0;
411: }
413: void PETSC_STDCALL snessethessian_(SNES *snes,Mat *A,Mat *B,void (PETSC_STDCALL *func)(SNES*,Vec*,Mat*,Mat*,int*,void*,int*),
414: void *ctx,int *ierr)
415: {
416: f6 = func;
417: *SNESSetHessian(*snes,*A,*B,oursneshessianfunction,ctx);
418: }
420: static void (PETSC_STDCALL *f5)(SNES*,Vec*,Vec *,void*,int*);
421: static int oursnesgradientfunction(SNES snes,Vec x,Vec d,void *ctx)
422: {
423: int 0;
424: (*f5)(&snes,&x,&d,ctx,&ierr);
425: return 0;
426: }
428: void PETSC_STDCALL snessetgradient_(SNES *snes,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,int*),void *ctx,int *ierr){
429: f5 = func;
430: *SNESSetGradient(*snes,*r,oursnesgradientfunction,ctx);
431: }
433: static void (PETSC_STDCALL *f4)(SNES*,Vec*,double*,void*,int*);
434: static int oursnesminfunction(SNES snes,Vec x,double* d,void *ctx)
435: {
436: int 0;
437: (*f4)(&snes,&x,d,ctx,&ierr);
438: return 0;
439: }
441: void PETSC_STDCALL snessetminimizationfunction_(SNES *snes,
442: void (PETSC_STDCALL *func)(SNES*,Vec*,double*,void*,int*),void *ctx,int *ierr){
443: f4 = func;
444: *SNESSetMinimizationFunction(*snes,oursnesminfunction,ctx);
445: }
447: /* ---------------------------------------------------------*/
449: static void (PETSC_STDCALL *f2)(SNES*,Vec*,Vec*,void*,int*);
450: static int oursnesfunction(SNES snes,Vec x,Vec f,void *ctx)
451: {
452: int 0;
453: (*f2)(&snes,&x,&f,ctx,&ierr);
454: return 0;
455: }
456: void PETSC_STDCALL snessetfunction_(SNES *snes,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,int*),
457: void *ctx,int *ierr){
458: f2 = func;
459: *SNESSetFunction(*snes,*r,oursnesfunction,ctx);
460: }
462: /* ---------------------------------------------------------*/
464: static void (PETSC_STDCALL *f11)(SNES*,Vec*,Vec*,void*,int*);
465: static int ourmatsnesmffunction(SNES snes,Vec x,Vec f,void *ctx)
466: {
467: int 0;
468: (*f11)(&snes,&x,&f,ctx,&ierr);
469: return 0;
470: }
471: void PETSC_STDCALL matsnesmfsetfunction_(Mat *mat,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,int*),
472: void *ctx,int *ierr){
473: f11 = func;
474: *MatSNESMFSetFunction(*mat,*r,ourmatsnesmffunction,ctx);
475: }
476: /* ---------------------------------------------------------*/
478: void PETSC_STDCALL snescreate_(MPI_Comm *comm,SNESProblemType *type,SNES *outsnes,int *ierr){
480: *SNESCreate((MPI_Comm)PetscToPointerComm(*comm),*type,outsnes);
481: }
483: /* ---------------------------------------------------------*/
484: /*
485: snesdefaultcomputejacobian() and snesdefaultcomputejacobiancolor()
486: These can be used directly from Fortran but are mostly so that
487: Fortran SNESSetJacobian() will properly handle the defaults being passed in.
489: functions, hence no STDCALL
490: */
491: void snesdefaultcomputejacobian_(SNES *snes,Vec *x,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
492: {
493: *SNESDefaultComputeJacobian(*snes,*x,m,p,type,ctx);
494: }
495: void snesdefaultcomputejacobiancolor_(SNES *snes,Vec *x,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
496: {
497: *SNESDefaultComputeJacobianColor(*snes,*x,m,p,type,*(MatFDColoring*)ctx);
498: }
500: static void (PETSC_STDCALL *f3)(SNES*,Vec*,Mat*,Mat*,MatStructure*,void*,int*);
501: static int oursnesjacobian(SNES snes,Vec x,Mat* m,Mat* p,MatStructure* type,void*ctx)
502: {
503: int 0;
504: (*f3)(&snes,&x,m,p,type,ctx,&ierr);
505: return 0;
506: }
508: void PETSC_STDCALL snessetjacobian_(SNES *snes,Mat *A,Mat *B,void (PETSC_STDCALL *func)(SNES*,Vec*,Mat*,Mat*,
509: MatStructure*,void*,int*),void *ctx,int *ierr)
510: {
511: if ((void(*)())func == (void(*)())snesdefaultcomputejacobian_) {
512: *SNESSetJacobian(*snes,*A,*B,SNESDefaultComputeJacobian,ctx);
513: } else if ((void(*)())func == (void(*)())snesdefaultcomputejacobiancolor_) {
514: *SNESSetJacobian(*snes,*A,*B,SNESDefaultComputeJacobianColor,*(MatFDColoring*)ctx);
515: } else {
516: f3 = func;
517: *SNESSetJacobian(*snes,*A,*B,oursnesjacobian,ctx);
518: }
519: }
521: /* -------------------------------------------------------------*/
523: void PETSC_STDCALL snesregisterdestroy_(int *ierr)
524: {
525: *SNESRegisterDestroy();
526: }
528: void PETSC_STDCALL snesgettype_(SNES *snes,CHAR name PETSC_MIXED_LEN(len),
529: int *ierr PETSC_END_LEN(len))
530: {
531: char *tname;
533: *SNESGetType(*snes,&tname);
534: #if defined(PETSC_USES_CPTOFCD)
535: {
536: char *t = _fcdtocp(name); int len1 = _fcdlen(name);
537: *PetscStrncpy(t,tname,len1);if (*ierr) return;
538: }
539: #else
540: *PetscStrncpy(name,tname,len);if (*ierr) return;
541: #endif
542: }
544: void PETSC_STDCALL snesgetoptionsprefix_(SNES *snes,CHAR prefix PETSC_MIXED_LEN(len),
545: int *ierr PETSC_END_LEN(len))
546: {
547: char *tname;
549: *SNESGetOptionsPrefix(*snes,&tname);
550: #if defined(PETSC_USES_CPTOFCD)
551: {
552: char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
553: *PetscStrncpy(t,tname,len1);if (*ierr) return;
554: }
555: #else
556: *PetscStrncpy(prefix,tname,len);if (*ierr) return;
557: #endif
558: }
560: EXTERN_C_END