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