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_eq_tr_ snesconverged_eq_tr__
9: #define snesconverged_eq_ls_ snesconverged_eq_ls__
10: #define snesconverged_um_tr_ snesconverged_um_tr__
11: #define snesconverged_um_ls_ snesconverged_um_ls__
12: #endif
14: #ifdef PETSC_HAVE_FORTRAN_CAPS
15: #define dmmgsetsnes_ DMMGSETSNES
16: #define matcreatedaad_ MATCREATEDAAD
17: #define matregisterdaad_ MATREGISTERDAAD
18: #define matdaadsetsnes_ MATDAADSETSNES
19: #define snesdacomputejacobian_ SNESDACOMPUTEJACOBIAN
20: #define snesdacomputejacobianwithadifor_ SNESDACOMPUTEJACOBIANWITHADIFOR
21: #define snesdaformfunction_ SNESDAFORMFUNCTION
22: #define matsnesmfsetbase_ MATSNESMFSETBASE
23: #define snesconverged_eq_tr_ SNESCONVERGED_EQ_TR
24: #define snesconverged_eq_ls_ SNESCONVERGED_EQ_LS
25: #define snesconverged_um_tr_ SNESCONVERGED_UM_TR
26: #define snesconverged_um_ls_ SNESCONVERGED_UM_LS
27: #define snesgetconvergedreason_ SNESGETCONVERGEDREASON
28: #define snesdefaultmonitor_ SNESDEFAULTMONITOR
29: #define snesvecviewmonitor_ SNESVECVIEWMONITOR
30: #define sneslgmonitor_ SNESLGMONITOR
31: #define snesvecviewupdatemonitor_ SNESVECVIEWUPDATEMONITOR
32: #define snesregisterdestroy_ SNESREGISTERDESTROY
33: #define snessetjacobian_ SNESSETJACOBIAN
34: #define snescreate_ SNESCREATE
35: #define snessetfunction_ SNESSETFUNCTION
36: #define snessetminimizationfunction_ SNESSETMINIMIZATIONFUNCTION
37: #define snesgetsles_ SNESGETSLES
38: #define snessetgradient_ SNESSETGRADIENT
39: #define snessethessian_ SNESSETHESSIAN
40: #define snessetmonitor_ SNESSETMONITOR
41: #define snessetconvergencetest_ SNESSETCONVERGENCETEST
42: #define snesregisterdestroy_ SNESREGISTERDESTROY
43: #define snesgetsolution_ SNESGETSOLUTION
44: #define snesgetsolutionupdate_ SNESGETSOLUTIONUPDATE
45: #define snesgetfunction_ SNESGETFUNCTION
46: #define snesgetminimizationfunction_ SNESGETMINIMIZATIONFUNCTION
47: #define snesgetgradient_ SNESGETGRADIENT
48: #define snesdestroy_ SNESDESTROY
49: #define snesgettype_ SNESGETTYPE
50: #define snessetoptionsprefix_ SNESSETOPTIONSPREFIX
51: #define snesappendoptionsprefix_ SNESAPPENDOPTIONSPREFIX
52: #define matcreatesnesmf_ MATCREATESNESMF
53: #define matcreatemf_ MATCREATEMF
54: #define snessettype_ SNESSETTYPE
55: #define snesgetconvergencehistory_ SNESGETCONVERGENCEHISTORY
56: #define snesdefaultcomputejacobian_ SNESDEFAULTCOMPUTEJACOBIAN
57: #define snesdefaultcomputejacobiancolor_ SNESDEFAULTCOMPUTEJACOBIANCOLOR
58: #define matsnesmfsettype_ MATSNESMFSETTYPE
59: #define snesgetoptionsprefix_ SNESGETOPTIONSPREFIX
60: #define snesgetjacobian_ SNESGETJACOBIAN
61: #define matsnesmfsetfunction_ MATSNESMFSETFUNCTION
62: #define snessetlinesearchparams_ SNESSETLINESEARCHPARAMS
63: #define snesgetlinesearchparams_ SNESGETLINESEARCHPARAMS
64: #define snessetlinesearch_ SNESSETLINESEARCH
65: #define snescubiclinesearch_ SNESCUBICLINESEARCH
66: #define snesquadraticlinesearch_ SNESQUADRATICLINESEARCH
67: #define snesnolinesearch_ SNESNOLINESEARCH
68: #define snesnolinesearchnonorms_ SNESNOLINESEARCHNONORMS
69: #define snesview_ SNESVIEW
70: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
71: #define dmmgsetsnes_ dmmgsetsnes
72: #define matcreatedaad_ matcreatedaad
73: #define matregisterdaad_ matregisterdaad
74: #define matdaadsetsnes_ matdaadsetsnes
75: #define snesdacomputejacobian_ snesdacomputejacobian
76: #define snesdacomputejacobianwithadifor_ snesdacomputejacobianwithadifor
77: #define snesdaformfunction_ snesdaformfunction
78: #define matsnesmfsetbase_ matsnesmfsetbase
79: #define snescubiclinesearch_ snescubiclinesearch
80: #define snesquadraticlinesearch_ snesquadraticlinesearch
81: #define snesnolinesearch_ snesnolinesearch
82: #define snesnolinesearchnonorms_ snesnolinesearchnonorms
83: #define snessetlinesearch_ snessetlinesearch
84: #define snesconverged_eq_tr_ snesconverged_eq_tr
85: #define snesconverged_eq_ls_ snesconverged_eq_ls
86: #define snesconverged_um_tr_ snesconverged_um_tr
87: #define snesconverged_um_ls_ snesconverged_um_ls
88: #define snesgetconvergedreason_ snesgetconvergedreason
89: #define sneslgmonitor_ sneslgmonitor
90: #define snesdefaultmonitor_ snesdefaultmonitor
91: #define snesvecviewmonitor_ snesvecviewmonitor
92: #define snesvecviewupdatemonitor_ snesvecviewupdatemonitor
93: #define matsnesmfsetfunction_ matsnesmfsetfunction
94: #define snesregisterdestroy_ snesregisterdestroy
95: #define snessetjacobian_ snessetjacobian
96: #define snescreate_ snescreate
97: #define snessetfunction_ snessetfunction
98: #define snessethessian_ snessethessian
99: #define snessetgradient_ snessetgradient
100: #define snesgetsles_ snesgetsles
101: #define snessetminimizationfunction_ snessetminimizationfunction
102: #define snesdestroy_ snesdestroy
103: #define snessetmonitor_ snessetmonitor
104: #define snessetconvergencetest_ snessetconvergencetest
105: #define snesregisterdestroy_ snesregisterdestroy
106: #define snesgetsolution_ snesgetsolution
107: #define snesgetsolutionupdate_ snesgetsolutionupdate
108: #define snesgetfunction_ snesgetfunction
109: #define snesgetminimizationfunction_ snesgetminimizationfunction
110: #define snesgetgradient_ snesgetgradient
111: #define snesgettype_ snesgettype
112: #define snessetoptionsprefix_ snessetoptionsprefix
113: #define snesappendoptionsprefix_ snesappendoptionsprefix
114: #define matcreatesnesmf_ matcreatesnesmf
115: #define matcreatemf_ matcreatemf
116: #define snessettype_ snessettype
117: #define snesgetconvergencehistory_ snesgetconvergencehistory
118: #define snesdefaultcomputejacobian_ snesdefaultcomputejacobian
119: #define snesdefaultcomputejacobiancolor_ snesdefaultcomputejacobiancolor
120: #define matsnesmfsettype_ matsnesmfsettype
121: #define snesgetoptionsprefix_ snesgetoptionsprefix
122: #define snesgetjacobian_ snesgetjacobian
123: #define snessetlinesearchparams_ snessetlinesearchparams
124: #define snesgetlinesearchparams_ snesgetlinesearchparams
125: #define snesview_ snesview
126: #endif
128: EXTERN_C_BEGIN
130: #if defined(notused)
131: static int ourrhs(SNES snes,Vec vec,Vec vec2,void*ctx)
132: {
133: int 0;
134: DMMG *dmmg = (DMMG*)ctx;
135: (*(int (PETSC_STDCALL *)(SNES*,Vec*,Vec*,int*))(((PetscObject)dmmg->dm)->fortran_func_pointers[0]))(&snes,&vec,&vec2,&ierr);
136: return ierr;
137: }
139: static int ourmat(DMMG dmmg,Mat mat)
140: {
141: int 0;
142: (*(int (PETSC_STDCALL *)(DMMG*,Vec*,int*))(((PetscObject)dmmg->dm)->fortran_func_pointers[1]))(&dmmg,&vec,&ierr);
143: return ierr;
144: }
146: void PETSC_STDCALL dmmgsetsnes_(DMMG **dmmg,int (PETSC_STDCALL *rhs)(SNES*,Vec*,Vec*,int*),int (PETSC_STDCALL *mat)(DMMG*,Mat*,int*),int *ierr)
147: {
148: int i;
149: theirmat = mat;
150: *DMMGSetSNES(*dmmg,ourrhs,ourmat,*dmmg);
151: /*
152: Save the fortran rhs function in the DM on each level; ourrhs() pulls it out when needed
153: */
154: for (i=0; i<(**dmmg)->nlevels; i++) {
155: ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[0] = (void (*)(void))rhs;
156: ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[1] = (void (*)(void))mat;
157: }
158: }
160: #endif
162: #if defined (PETSC_HAVE_ADIC) && !defined(PETSC_USE_COMPLEX)
163: void PETSC_STDCALL matregisterdaad_(int *ierr)
164: {
165: *MatRegisterDAAD();
166: }
168: void PETSC_STDCALL matcreatedaad_(DA *da,Mat *mat,int *ierr)
169: {
170: *MatCreateDAAD(*da,mat);
171: }
173: void PETSC_STDCALL matdaadsetsnes_(Mat *mat,SNES *snes,int *ierr)
174: {
175: *MatDAADSetSNES(*mat,*snes);
176: }
177: #endif
179: void PETSC_STDCALL snesview_(SNES *snes,PetscViewer *viewer, int *ierr)
180: {
181: PetscViewer v;
182: PetscPatchDefaultViewers_Fortran(viewer,v);
183: *SNESView(*snes,v);
184: }
186: void PETSC_STDCALL snesgetconvergedreason(SNES *snes,SNESConvergedReason *r,int *ierr)
187: {
188: *SNESGetConvergedReason(*snes,r);
189: }
191: void PETSC_STDCALL snessetlinesearchparams_(SNES *snes,PetscReal *alpha,PetscReal *maxstep,PetscReal *steptol,int *ierr)
192: {
193: *SNESSetLineSearchParams(*snes,*alpha,*maxstep,*steptol);
194: }
196: void PETSC_STDCALL snesgetlinesearchparams_(SNES *snes,PetscReal *alpha,PetscReal *maxstep,PetscReal *steptol,int *ierr)
197: {
198: CHKFORTRANNULLREAL(alpha);
199: CHKFORTRANNULLREAL(maxstep);
200: CHKFORTRANNULLREAL(steptol);
201: *SNESGetLineSearchParams(*snes,alpha,maxstep,steptol);
202: }
204: /* func is currently ignored from Fortran */
205: void PETSC_STDCALL snesgetjacobian_(SNES *snes,Mat *A,Mat *B,void **ctx,int *func,int *ierr)
206: {
207: CHKFORTRANNULLINTEGER(ctx);
208: CHKFORTRANNULLOBJECT(A);
209: CHKFORTRANNULLOBJECT(B);
210: *SNESGetJacobian(*snes,A,B,ctx,0);
211: }
213: void PETSC_STDCALL matsnesmfsettype_(Mat *mat,CHAR ftype PETSC_MIXED_LEN(len),
214: int *ierr PETSC_END_LEN(len))
215: {
216: char *t;
217: FIXCHAR(ftype,len,t);
218: *MatSNESMFSetType(*mat,t);
219: FREECHAR(ftype,t);
220: }
222: void PETSC_STDCALL snesgetconvergencehistory_(SNES *snes,int *na,int *ierr)
223: {
224: *SNESGetConvergenceHistory(*snes,PETSC_NULL,PETSC_NULL,na);
225: }
227: void PETSC_STDCALL snessettype_(SNES *snes,CHAR type PETSC_MIXED_LEN(len),
228: int *ierr PETSC_END_LEN(len))
229: {
230: char *t;
232: FIXCHAR(type,len,t);
233: *SNESSetType(*snes,t);
234: FREECHAR(type,t);
235: }
237: void PETSC_STDCALL snesappendoptionsprefix_(SNES *snes,CHAR prefix PETSC_MIXED_LEN(len),
238: int *ierr PETSC_END_LEN(len))
239: {
240: char *t;
242: FIXCHAR(prefix,len,t);
243: *SNESAppendOptionsPrefix(*snes,t);
244: FREECHAR(prefix,t);
245: }
247: void PETSC_STDCALL matsnesmfsetbase_(Mat *m,Vec *x,int *ierr)
248: {
249: *MatSNESMFSetBase(*m,*x);
250: }
252: void PETSC_STDCALL matcreatesnesmf_(SNES *snes,Vec *x,Mat *J,int *ierr)
253: {
254: *MatCreateSNESMF(*snes,*x,J);
255: }
257: void PETSC_STDCALL matcreatemf_(Vec *x,Mat *J,int *ierr)
258: {
259: *MatCreateMF(*x,J);
260: }
262: /* functions, hence no STDCALL */
264: void sneslgmonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
265: {
266: *SNESLGMonitor(*snes,*its,*fgnorm,dummy);
267: }
269: void snesdefaultmonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
270: {
271: *SNESDefaultMonitor(*snes,*its,*fgnorm,dummy);
272: }
274: void snesvecviewmonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
275: {
276: *SNESVecViewMonitor(*snes,*its,*fgnorm,dummy);
277: }
279: void snesvecviewupdatemonitor_(SNES *snes,int *its,PetscReal *fgnorm,void *dummy,int *ierr)
280: {
281: *SNESVecViewUpdateMonitor(*snes,*its,*fgnorm,dummy);
282: }
284: static void (PETSC_STDCALL *f7)(SNES*,int*,PetscReal*,void*,int*);
285: static int oursnesmonitor(SNES snes,int i,PetscReal d,void*ctx)
286: {
287: int 0;
289: (*f7)(&snes,&i,&d,ctx,&ierr);
290: return 0;
291: }
292: static void (PETSC_STDCALL *f71)(void*,int*);
293: static int ourmondestroy(void* ctx)
294: {
295: int 0;
297: (*f71)(ctx,&ierr);
298: return 0;
299: }
301: void PETSC_STDCALL snessetmonitor_(SNES *snes,void (PETSC_STDCALL *func)(SNES*,int*,PetscReal*,void*,int*),
302: void *mctx,void (PETSC_STDCALL *mondestroy)(void *,int *),int *ierr)
303: {
304: CHKFORTRANNULLOBJECT(mctx);
305: if ((void(*)(void))func == (void(*)(void))snesdefaultmonitor_) {
306: *SNESSetMonitor(*snes,SNESDefaultMonitor,0,0);
307: } else if ((void(*)(void))func == (void(*)(void))snesvecviewmonitor_) {
308: *SNESSetMonitor(*snes,SNESVecViewMonitor,0,0);
309: } else if ((void(*)(void))func == (void(*)(void))snesvecviewupdatemonitor_) {
310: *SNESSetMonitor(*snes,SNESVecViewUpdateMonitor,0,0);
311: } else if ((void(*)(void))func == (void(*)(void))sneslgmonitor_) {
312: *SNESSetMonitor(*snes,SNESLGMonitor,0,0);
313: } else {
314: f7 = func;
315: if (FORTRANNULLFUNCTION(mondestroy)){
316: *SNESSetMonitor(*snes,oursnesmonitor,mctx,0);
317: } else {
318: f71 = mondestroy;
319: *SNESSetMonitor(*snes,oursnesmonitor,mctx,ourmondestroy);
320: }
321: }
322: }
324: /* -----------------------------------------------------------------------------------------------------*/
325: void snescubiclinesearch_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
326: PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
327: {
328: *SNESCubicLineSearch(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
329: }
330: void snesquadraticlinesearch_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
331: PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
332: {
333: *SNESQuadraticLineSearch(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
334: }
335: void snesnolinesearch_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
336: PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
337: {
338: *SNESNoLineSearch(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
339: }
340: void snesnolinesearchnonorms_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
341: PetscReal *ynorm,PetscReal *gnorm,int *flag,int *ierr)
342: {
343: *SNESNoLineSearchNoNorms(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
344: }
346: void (PETSC_STDCALL *f73)(SNES*,void *,Vec*,Vec*,Vec*,Vec*,Vec*,PetscReal*,PetscReal*,PetscReal*,int*,int*);
347: int OurSNESLineSearch(SNES snes,void *ctx,Vec x,Vec f,Vec g,Vec y,Vec w,PetscReal fnorm,PetscReal*ynorm,PetscReal*gnorm,int *flag)
348: {
349: int 0;
350: (*f73)(&snes,(void*)&ctx,&x,&f,&g,&y,&w,&fnorm,ynorm,gnorm,flag,&ierr);
351: return 0;
352: }
354: 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)
355: {
356: if ((void(*)(void))f == (void(*)(void))snescubiclinesearch_) {
357: *SNESSetLineSearch(*snes,SNESCubicLineSearch,0);
358: } else if ((void(*)(void))f == (void(*)(void))snesquadraticlinesearch_) {
359: *SNESSetLineSearch(*snes,SNESQuadraticLineSearch,0);
360: } else if ((void(*)(void))f == (void(*)(void))snesnolinesearch_) {
361: *SNESSetLineSearch(*snes,SNESNoLineSearch,0);
362: } else if ((void(*)(void))f == (void(*)(void))snesnolinesearchnonorms_) {
363: *SNESSetLineSearch(*snes,SNESNoLineSearchNoNorms,0);
364: } else {
365: f73 = f;
366: *SNESSetLineSearch(*snes,OurSNESLineSearch,0);
367: }
368: }
369:
371: /*--------------------------------------------------------------------------------------------*/
372: void snesconverged_um_ls_(SNES *snes,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,
373: void *ct,int *ierr)
374: {
375: *SNESConverged_UM_LS(*snes,*a,*b,*c,r,ct);
376: }
378: void snesconverged_um_tr_(SNES *snes,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,
379: void *ct,int *ierr)
380: {
381: *SNESConverged_UM_TR(*snes,*a,*b,*c,r,ct);
382: }
384: void snesconverged_eq_tr_(SNES *snes,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,
385: void *ct,int *ierr)
386: {
387: *SNESConverged_EQ_TR(*snes,*a,*b,*c,r,ct);
388: }
390: void snesconverged_eq_ls_(SNES *snes,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,
391: void *ct,int *ierr)
392: {
393: *SNESConverged_EQ_LS(*snes,*a,*b,*c,r,ct);
394: }
396: static void (PETSC_STDCALL *f8)(SNES*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,int*);
397: static int oursnestest(SNES snes,PetscReal a,PetscReal d,PetscReal c,SNESConvergedReason*reason,void*ctx)
398: {
399: int 0;
401: (*f8)(&snes,&a,&d,&c,reason,ctx,&ierr);
402: return 0;
403: }
405: void PETSC_STDCALL snessetconvergencetest_(SNES *snes,
406: void (PETSC_STDCALL *func)(SNES*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,int*),
407: void *cctx,int *ierr)
408: {
409: CHKFORTRANNULLOBJECT(cctx);
410: if ((void(*)(void))func == (void(*)(void))snesconverged_eq_ls_){
411: *SNESSetConvergenceTest(*snes,SNESConverged_EQ_LS,0);
412: } else if ((void(*)(void))func == (void(*)(void))snesconverged_eq_tr_){
413: *SNESSetConvergenceTest(*snes,SNESConverged_EQ_TR,0);
414: } else if ((void(*)(void))func == (void(*)(void))snesconverged_um_tr_){
415: *SNESSetConvergenceTest(*snes,SNESConverged_UM_TR,0);
416: } else if ((void(*)(void))func == (void(*)(void))snesconverged_um_ls_){
417: *SNESSetConvergenceTest(*snes,SNESConverged_UM_LS,0);
418: } else {
419: f8 = func;
420: *SNESSetConvergenceTest(*snes,oursnestest,cctx);
421: }
422: }
424: /*--------------------------------------------------------------------------------------------*/
426: void PETSC_STDCALL snesgetsolution_(SNES *snes,Vec *x,int *ierr)
427: {
428: *SNESGetSolution(*snes,x);
429: }
431: void PETSC_STDCALL snesgetsolutionupdate_(SNES *snes,Vec *x,int *ierr)
432: {
433: *SNESGetSolutionUpdate(*snes,x);
434: }
436: /* the func argument is ignored */
437: void PETSC_STDCALL snesgetfunction_(SNES *snes,Vec *r,void **ctx,void *func,int *ierr)
438: {
439: CHKFORTRANNULLINTEGER(ctx);
440: CHKFORTRANNULLINTEGER(r);
441: *SNESGetFunction(*snes,r,ctx,PETSC_NULL);
442: }
444: void PETSC_STDCALL snesgetminimizationfunction_(SNES *snes,PetscReal *r,void **ctx,int *ierr)
445: {
446: CHKFORTRANNULLINTEGER(ctx);
447: CHKFORTRANNULLREAL(r);
448: *SNESGetMinimizationFunction(*snes,r,ctx);
449: }
451: void PETSC_STDCALL snesgetgradient_(SNES *snes,Vec *r,void **ctx,int *ierr)
452: {
453: CHKFORTRANNULLINTEGER(ctx);
454: CHKFORTRANNULLINTEGER(r);
455: *SNESGetGradient(*snes,r,ctx);
456: }
458: void PETSC_STDCALL snesdestroy_(SNES *snes,int *ierr)
459: {
460: *SNESDestroy(*snes);
461: }
463: void PETSC_STDCALL snesgetsles_(SNES *snes,SLES *sles,int *ierr)
464: {
465: *SNESGetSLES(*snes,sles);
466: }
468: static void (PETSC_STDCALL *f6)(SNES *,Vec *,Mat *,Mat *,int*,void*,int*);
469: static int oursneshessianfunction(SNES snes,Vec x,Mat* mat,Mat* pmat,
470: MatStructure* st,void *ctx)
471: {
472: int 0;
474: (*f6)(&snes,&x,mat,pmat,(int*)st,ctx,&ierr);
476: return 0;
477: }
479: void PETSC_STDCALL snessethessian_(SNES *snes,Mat *A,Mat *B,void (PETSC_STDCALL *func)(SNES*,Vec*,Mat*,Mat*,int*,void*,int*),
480: void *ctx,int *ierr)
481: {
482: f6 = func;
483: CHKFORTRANNULLOBJECT(ctx);
484: *SNESSetHessian(*snes,*A,*B,oursneshessianfunction,ctx);
485: }
487: static void (PETSC_STDCALL *f5)(SNES*,Vec*,Vec *,void*,int*);
488: static int oursnesgradientfunction(SNES snes,Vec x,Vec d,void *ctx)
489: {
490: int 0;
491: (*f5)(&snes,&x,&d,ctx,&ierr);
492: return 0;
493: }
495: void PETSC_STDCALL snessetgradient_(SNES *snes,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,int*),void *ctx,int *ierr)
496: {
497: CHKFORTRANNULLOBJECT(ctx);
498: f5 = func;
499: *SNESSetGradient(*snes,*r,oursnesgradientfunction,ctx);
500: }
502: static void (PETSC_STDCALL *f4)(SNES*,Vec*,PetscReal*,void*,int*);
503: static int oursnesminfunction(SNES snes,Vec x,PetscReal* d,void *ctx)
504: {
505: int 0;
506: (*f4)(&snes,&x,d,ctx,&ierr);
507: return 0;
508: }
510: void PETSC_STDCALL snessetminimizationfunction_(SNES *snes,
511: void (PETSC_STDCALL *func)(SNES*,Vec*,PetscReal*,void*,int*),void *ctx,int *ierr){
512: f4 = func;
513: *SNESSetMinimizationFunction(*snes,oursnesminfunction,ctx);
514: }
516: /* ---------------------------------------------------------*/
518: static void (PETSC_STDCALL *f2)(SNES*,Vec*,Vec*,void*,int*);
519: static int oursnesfunction(SNES snes,Vec x,Vec f,void *ctx)
520: {
521: int 0;
522: (*f2)(&snes,&x,&f,ctx,&ierr);
523: return 0;
524: }
526: /*
527: These are not usually called from Fortran but allow Fortran users
528: to transparently set these monitors from .F code
529:
530: functions, hence no STDCALL
531: */
532: void snesdaformfunction_(SNES *snes,Vec *X, Vec *F,void *ptr,int *ierr)
533: {
534: *SNESDAFormFunction(*snes,*X,*F,ptr);
535: }
538: void PETSC_STDCALL snessetfunction_(SNES *snes,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,int*),
539: void *ctx,int *ierr)
540: {
541: CHKFORTRANNULLOBJECT(ctx);
542: f2 = func;
543: if ((void(*)(void))func == (void(*)(void))snesdaformfunction_) {
544: *SNESSetFunction(*snes,*r,SNESDAFormFunction,ctx);
545: } else {
546: *SNESSetFunction(*snes,*r,oursnesfunction,ctx);
547: }
548: }
550: /* ---------------------------------------------------------*/
552: static void (PETSC_STDCALL *f11)(SNES*,Vec*,Vec*,void*,int*);
553: static int ourmatsnesmffunction(SNES snes,Vec x,Vec f,void *ctx)
554: {
555: int 0;
556: (*f11)(&snes,&x,&f,ctx,&ierr);
557: return 0;
558: }
559: void PETSC_STDCALL matsnesmfsetfunction_(Mat *mat,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,int*),
560: void *ctx,int *ierr){
561: f11 = func;
562: CHKFORTRANNULLOBJECT(ctx);
563: *MatSNESMFSetFunction(*mat,*r,ourmatsnesmffunction,ctx);
564: }
565: /* ---------------------------------------------------------*/
567: void PETSC_STDCALL snescreate_(MPI_Comm *comm,SNESProblemType *type,SNES *outsnes,int *ierr){
569: *SNESCreate((MPI_Comm)PetscToPointerComm(*comm),*type,outsnes);
570: }
572: /* ---------------------------------------------------------*/
573: /*
574: snesdefaultcomputejacobian() and snesdefaultcomputejacobiancolor()
575: These can be used directly from Fortran but are mostly so that
576: Fortran SNESSetJacobian() will properly handle the defaults being passed in.
578: functions, hence no STDCALL
579: */
580: void snesdefaultcomputejacobian_(SNES *snes,Vec *x,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
581: {
582: *SNESDefaultComputeJacobian(*snes,*x,m,p,type,ctx);
583: }
584: void snesdefaultcomputejacobiancolor_(SNES *snes,Vec *x,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
585: {
586: *SNESDefaultComputeJacobianColor(*snes,*x,m,p,type,*(MatFDColoring*)ctx);
587: }
589: void snesdacomputejacobianwithadifor_(SNES *snes,Vec *X,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
590: {
591: (*PetscErrorPrintf)("Cannot call this function from Fortran");
592: *1;
593: }
595: void snesdacomputejacobian_(SNES *snes,Vec *X,Mat *m,Mat *p,MatStructure* type,void *ctx,int *ierr)
596: {
597: (*PetscErrorPrintf)("Cannot call this function from Fortran");
598: *1;
599: }
601: static void (PETSC_STDCALL *f3)(SNES*,Vec*,Mat*,Mat*,MatStructure*,void*,int*);
602: static int oursnesjacobian(SNES snes,Vec x,Mat* m,Mat* p,MatStructure* type,void*ctx)
603: {
604: int 0;
605: (*f3)(&snes,&x,m,p,type,ctx,&ierr);
606: return 0;
607: }
609: void PETSC_STDCALL snessetjacobian_(SNES *snes,Mat *A,Mat *B,void (PETSC_STDCALL *func)(SNES*,Vec*,Mat*,Mat*,
610: MatStructure*,void*,int*),void *ctx,int *ierr)
611: {
612: CHKFORTRANNULLOBJECT(ctx);
613: if ((void(*)(void))func == (void(*)(void))snesdefaultcomputejacobian_) {
614: *SNESSetJacobian(*snes,*A,*B,SNESDefaultComputeJacobian,ctx);
615: } else if ((void(*)(void))func == (void(*)(void))snesdefaultcomputejacobiancolor_) {
616: *SNESSetJacobian(*snes,*A,*B,SNESDefaultComputeJacobianColor,*(MatFDColoring*)ctx);
617: } else if ((void(*)(void))func == (void(*)(void))snesdacomputejacobianwithadifor_) {
618: *SNESSetJacobian(*snes,*A,*B,SNESDAComputeJacobianWithAdifor,ctx);
619: } else if ((void(*)(void))func == (void(*)(void))snesdacomputejacobian_) {
620: *SNESSetJacobian(*snes,*A,*B,SNESDAComputeJacobian,ctx);
621: } else {
622: f3 = func;
623: *SNESSetJacobian(*snes,*A,*B,oursnesjacobian,ctx);
624: }
625: }
627: /* -------------------------------------------------------------*/
629: void PETSC_STDCALL snesregisterdestroy_(int *ierr)
630: {
631: *SNESRegisterDestroy();
632: }
634: void PETSC_STDCALL snesgettype_(SNES *snes,CHAR name PETSC_MIXED_LEN(len),
635: int *ierr PETSC_END_LEN(len))
636: {
637: char *tname;
639: *SNESGetType(*snes,&tname);
640: #if defined(PETSC_USES_CPTOFCD)
641: {
642: char *t = _fcdtocp(name); int len1 = _fcdlen(name);
643: *PetscStrncpy(t,tname,len1);if (*ierr) return;
644: }
645: #else
646: *PetscStrncpy(name,tname,len);if (*ierr) return;
647: #endif
648: }
650: void PETSC_STDCALL snesgetoptionsprefix_(SNES *snes,CHAR prefix PETSC_MIXED_LEN(len),
651: int *ierr PETSC_END_LEN(len))
652: {
653: char *tname;
655: *SNESGetOptionsPrefix(*snes,&tname);
656: #if defined(PETSC_USES_CPTOFCD)
657: {
658: char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
659: *PetscStrncpy(t,tname,len1);if (*ierr) return;
660: }
661: #else
662: *PetscStrncpy(prefix,tname,len);if (*ierr) return;
663: #endif
664: }
666: EXTERN_C_END