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