Actual source code: zsnes.c

     2:  #include src/fortran/custom/zpetsc.h
     3:  #include petscsnes.h
     4:  #include petscda.h

      6: #ifdef PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE
      7: #define snesconverged_tr_                snesconverged_tr__
      8: #define snesconverged_ls_                snesconverged_ls__
      9: #endif

     11: #ifdef PETSC_HAVE_FORTRAN_CAPS
     12: #define dmmgsetsnes_                     DMMGSETSNES
     13: #define matcreatedaad_                   MATCREATEDAAD
     14: #define matregisterdaad_                 MATREGISTERDAAD
     15: #define matdaadsetsnes_                  MATDAADSETSNES
     16: #define snesdacomputejacobian_           SNESDACOMPUTEJACOBIAN
     17: #define snesdacomputejacobianwithadifor_ SNESDACOMPUTEJACOBIANWITHADIFOR
     18: #define snesdaformfunction_              SNESDAFORMFUNCTION
     19: #define snesconverged_tr_                SNESCONVERGED_TR
     20: #define snesconverged_ls_                SNESCONVERGED_LS
     21: #define snesgetconvergedreason_          SNESGETCONVERGEDREASON
     22: #define snesdefaultmonitor_              SNESDEFAULTMONITOR
     23: #define snesvecviewmonitor_              SNESVECVIEWMONITOR
     24: #define sneslgmonitor_                   SNESLGMONITOR
     25: #define snesvecviewupdatemonitor_        SNESVECVIEWUPDATEMONITOR
     26: #define snesregisterdestroy_             SNESREGISTERDESTROY
     27: #define snessetjacobian_                 SNESSETJACOBIAN
     28: #define snescreate_                      SNESCREATE
     29: #define snessetfunction_                 SNESSETFUNCTION
     30: #define snesgetksp_                      SNESGETKSP
     31: #define snessetmonitor_                  SNESSETMONITOR
     32: #define snessetconvergencetest_          SNESSETCONVERGENCETEST
     33: #define snesregisterdestroy_             SNESREGISTERDESTROY
     34: #define snesgetsolution_                 SNESGETSOLUTION
     35: #define snesgetsolutionupdate_           SNESGETSOLUTIONUPDATE
     36: #define snesgetfunction_                 SNESGETFUNCTION
     37: #define snesdestroy_                     SNESDESTROY
     38: #define snesgettype_                     SNESGETTYPE
     39: #define snessetoptionsprefix_            SNESSETOPTIONSPREFIX
     40: #define snesappendoptionsprefix_         SNESAPPENDOPTIONSPREFIX
     41: #define matcreatesnesmf_                 MATCREATESNESMF
     42: #define matcreatemf_                     MATCREATEMF
     43: #define snessettype_                     SNESSETTYPE
     44: #define snesgetconvergencehistory_       SNESGETCONVERGENCEHISTORY
     45: #define snesdefaultcomputejacobian_      SNESDEFAULTCOMPUTEJACOBIAN
     46: #define snesdefaultcomputejacobiancolor_ SNESDEFAULTCOMPUTEJACOBIANCOLOR
     47: #define matsnesmfsettype_                MATSNESMFSETTYPE
     48: #define snesgetoptionsprefix_            SNESGETOPTIONSPREFIX
     49: #define snesgetjacobian_                 SNESGETJACOBIAN
     50: #define matsnesmfsetfunction_            MATSNESMFSETFUNCTION
     51: #define sneslinesearchsetparams_         SNESLINESEARCHSETPARAMS
     52: #define sneslinesearchgetparams_         SNESLINESEARCHGETPARAMS
     53: #define sneslinesearchset_               SNESLINESEARCHSET
     54: #define sneslinesearchsetpostcheck_      SNESLINESEARCHSETPOSTCHECK
     55: #define sneslinesearchsetprecheck_       SNESLINESEARCHSETPRECHECK
     56: #define snessetupdate_                   SNESSETUPDATE
     57: #define sneslinesearchcubic_             SNESLINESEARCHCUBIC
     58: #define sneslinesearchquadratic_         SNESLINESEARCHQUADRATIC
     59: #define sneslinesearchno_                SNESLINESEARCHNO
     60: #define sneslinesearchnonorms_           SNESLINESEARCHNONORMS
     61: #define snesview_                        SNESVIEW
     62: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
     63: #define dmmgsetsnes_                     dmmgsetsnes
     64: #define matcreatedaad_                   matcreatedaad
     65: #define matregisterdaad_                 matregisterdaad
     66: #define matdaadsetsnes_                  matdaadsetsnes
     67: #define snesdacomputejacobian_           snesdacomputejacobian
     68: #define snesdacomputejacobianwithadifor_ snesdacomputejacobianwithadifor
     69: #define snesdaformfunction_              snesdaformfunction
     70: #define sneslinesearchcubic_             sneslinesearchcubic
     71: #define sneslinesearchquadratic_         sneslinesearchquadratic
     72: #define sneslinesearchno_                sneslinesearchno
     73: #define sneslinesearchnonorms_           sneslinesearchnonorms
     74: #define sneslinesearchsetparams_         sneslinesearchsetparams
     75: #define sneslinesearchgetparams_         sneslinesearchgetparams
     76: #define sneslinesearchset_               sneslinesearchset
     77: #define sneslinesearchsetpostcheck_      sneslinesearchsetpostcheck
     78: #define sneslinesearchsetprecheck_       sneslinesearchsetprecheck
     79: #define snessetupdate_                   snessetupdate
     80: #define snesconverged_tr_                snesconverged_tr
     81: #define snesconverged_ls_                snesconverged_ls
     82: #define snesgetconvergedreason_          snesgetconvergedreason
     83: #define sneslgmonitor_                   sneslgmonitor
     84: #define snesdefaultmonitor_              snesdefaultmonitor
     85: #define snesvecviewmonitor_              snesvecviewmonitor
     86: #define snesvecviewupdatemonitor_        snesvecviewupdatemonitor
     87: #define matsnesmfsetfunction_            matsnesmfsetfunction
     88: #define snesregisterdestroy_             snesregisterdestroy
     89: #define snessetjacobian_                 snessetjacobian
     90: #define snescreate_                      snescreate
     91: #define snessetfunction_                 snessetfunction
     92: #define snesgetksp_                      snesgetksp
     93: #define snesdestroy_                     snesdestroy
     94: #define snessetmonitor_                  snessetmonitor
     95: #define snessetconvergencetest_          snessetconvergencetest
     96: #define snesregisterdestroy_             snesregisterdestroy
     97: #define snesgetsolution_                 snesgetsolution
     98: #define snesgetsolutionupdate_           snesgetsolutionupdate
     99: #define snesgetfunction_                 snesgetfunction
    100: #define snesgettype_                     snesgettype
    101: #define snessetoptionsprefix_            snessetoptionsprefix
    102: #define snesappendoptionsprefix_         snesappendoptionsprefix
    103: #define matcreatesnesmf_                 matcreatesnesmf
    104: #define matcreatemf_                     matcreatemf
    105: #define snessettype_                     snessettype
    106: #define snesgetconvergencehistory_       snesgetconvergencehistory
    107: #define snesdefaultcomputejacobian_      snesdefaultcomputejacobian
    108: #define snesdefaultcomputejacobiancolor_ snesdefaultcomputejacobiancolor
    109: #define matsnesmfsettype_                matsnesmfsettype
    110: #define snesgetoptionsprefix_            snesgetoptionsprefix
    111: #define snesgetjacobian_                 snesgetjacobian
    112: #define snesview_                        snesview
    113: #endif

    116: static void (PETSC_STDCALL *f7)(SNES*,PetscInt*,PetscReal*,void*,PetscErrorCode*);
    117: static void (PETSC_STDCALL *f71)(void*,PetscErrorCode*);
    118: static void (PETSC_STDCALL *f8)(SNES*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,PetscErrorCode*);
    119: static void (PETSC_STDCALL *f2)(SNES*,Vec*,Vec*,void*,PetscErrorCode*);
    120: static void (PETSC_STDCALL *f11)(SNES*,Vec*,Vec*,void*,PetscErrorCode*);
    121: static void (PETSC_STDCALL *f3)(SNES*,Vec*,Mat*,Mat*,MatStructure*,void*,PetscErrorCode*);
    122: static void (PETSC_STDCALL *f73)(SNES*,void *,Vec*,Vec*,Vec*,Vec*,Vec*,PetscReal*,PetscReal*,PetscReal*,PetscTruth*,PetscErrorCode*);
    123: static void (PETSC_STDCALL *f74)(SNES*,Vec*,Vec*,Vec*,void*,PetscTruth*,PetscTruth*,PetscErrorCode*);
    124: static void (PETSC_STDCALL *f75)(SNES*,Vec*,Vec*,void*,PetscTruth*,PetscErrorCode*);
    125: static void (PETSC_STDCALL *f76)(SNES*,PetscInt*,PetscErrorCode*);

    129: PetscErrorCode OurSNESLineSearch(SNES snes,void *ctx,Vec x,Vec f,Vec g,Vec y,Vec w,PetscReal fnorm,PetscReal*ynorm,PetscReal*gnorm,PetscTruth *flag)
    130: {
    131:   PetscErrorCode 0;
    132:   (*f73)(&snes,(void*)&ctx,&x,&f,&g,&y,&w,&fnorm,ynorm,gnorm,flag,&ierr);
    133:   return 0;
    134: }

    136: PetscErrorCode OurSNESLineSearchPostCheck(SNES snes,Vec x,Vec y,Vec z,void *checkCtx,PetscTruth *flag1,PetscTruth *flag2)
    137: {
    138:   PetscErrorCode 0;
    139:   (*f74)(&snes,&x,&y,&z,(void*)&checkCtx,flag1,flag2,&ierr);
    140:   return 0;
    141: }

    143: PetscErrorCode OurSNESLineSearchPreCheck(SNES snes,Vec x,Vec y,void *checkCtx,PetscTruth *flag1)
    144: {
    145:   PetscErrorCode 0;
    146:   (*f75)(&snes,&x,&y,(void*)&checkCtx,flag1,&ierr);
    147:   return 0;
    148: }
    149: PetscErrorCode OurSNESSetUpdate(SNES snes,PetscInt b)
    150: {
    151:   PetscErrorCode 0;
    152:   (*f76)(&snes,&b,&ierr);
    153:   return 0;
    154: }
    155: static PetscErrorCode oursnesmonitor(SNES snes,PetscInt i,PetscReal d,void*ctx)
    156: {
    157:   PetscErrorCode 0;

    159:   (*f7)(&snes,&i,&d,ctx,&ierr);
    160:   return 0;
    161: }
    162: static PetscErrorCode ourmondestroy(void* ctx)
    163: {
    164:   PetscErrorCode 0;

    166:   (*f71)(ctx,&ierr);
    167:   return 0;
    168: }
    169: static PetscErrorCode oursnestest(SNES snes,PetscReal a,PetscReal d,PetscReal c,SNESConvergedReason*reason,void*ctx)
    170: {
    171:   PetscErrorCode 0;

    173:   (*f8)(&snes,&a,&d,&c,reason,ctx,&ierr);
    174:   return 0;
    175: }
    176: static PetscErrorCode oursnesfunction(SNES snes,Vec x,Vec f,void *ctx)
    177: {
    178:   PetscErrorCode 0;
    179:   (*f2)(&snes,&x,&f,ctx,&ierr);
    180:   return 0;
    181: }
    182: static PetscErrorCode ourmatsnesmffunction(SNES snes,Vec x,Vec f,void *ctx)
    183: {
    184:   PetscErrorCode 0;
    185:   (*f11)(&snes,&x,&f,ctx,&ierr);
    186:   return 0;
    187: }
    188: static PetscErrorCode oursnesjacobian(SNES snes,Vec x,Mat* m,Mat* p,MatStructure* type,void*ctx)
    189: {
    190:   PetscErrorCode 0;
    191:   (*f3)(&snes,&x,m,p,type,ctx,&ierr);
    192:   return 0;
    193: }

    197: #if defined(notused)
    198: static PetscErrorCode ourrhs(SNES snes,Vec vec,Vec vec2,void*ctx)
    199: {
    200:   PetscErrorCode 0;
    201:   DMMG *dmmg = (DMMG*)ctx;
    202:   (*(PetscErrorCode (PETSC_STDCALL *)(SNES*,Vec*,Vec*,PetscErrorCode*))(((PetscObject)dmmg->dm)->fortran_func_pointers[0]))(&snes,&vec,&vec2,&ierr);
    203:   return ierr;
    204: }

    206: static PetscErrorCode ourmat(DMMG dmmg,Mat mat)
    207: {
    208:   PetscErrorCode 0;
    209:   (*(PetscErrorCode (PETSC_STDCALL *)(DMMG*,Vec*,PetscErrorCode*))(((PetscObject)dmmg->dm)->fortran_func_pointers[1]))(&dmmg,&vec,&ierr);
    210:   return ierr;
    211: }

    213: void PETSC_STDCALL dmmgsetsnes_(DMMG **dmmg,PetscErrorCode (PETSC_STDCALL *rhs)(SNES*,Vec*,Vec*,PetscErrorCode*),PetscErrorCode (PETSC_STDCALL *mat)(DMMG*,Mat*,PetscErrorCode*),PetscErrorCode *ierr)
    214: {
    215:   PetscInt i;
    216:   theirmat = mat;
    217:   *DMMGSetSNES(*dmmg,ourrhs,ourmat,*dmmg);
    218:   /*
    219:     Save the fortran rhs function in the DM on each level; ourrhs() pulls it out when needed
    220:   */
    221:   for (i=0; i<(**dmmg)->nlevels; i++) {
    222:     ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[0] = (FCNVOID)rhs;
    223:     ((PetscObject)(*dmmg)[i]->dm)->fortran_func_pointers[1] = (FCNVOID)mat;
    224:   }
    225: }

    227: #endif

    229: #if defined (PETSC_HAVE_ADIC)
    230: void PETSC_STDCALL matregisterdaad_(PetscErrorCode *ierr)
    231: {
    232:   *MatRegisterDAAD();
    233: }

    235: void PETSC_STDCALL matcreatedaad_(DA *da,Mat *mat,PetscErrorCode *ierr)
    236: {
    237:   *MatCreateDAAD(*da,mat);
    238: }

    240: void PETSC_STDCALL matdaadsetsnes_(Mat *mat,SNES *snes,PetscErrorCode *ierr)
    241: {
    242:   *MatDAADSetSNES(*mat,*snes);
    243: }
    244: #endif

    246: void PETSC_STDCALL snesview_(SNES *snes,PetscViewer *viewer, PetscErrorCode *ierr)
    247: {
    248:   PetscViewer v;
    249:   PetscPatchDefaultViewers_Fortran(viewer,v);
    250:   *SNESView(*snes,v);
    251: }

    253: void PETSC_STDCALL snesgetconvergedreason_(SNES *snes,SNESConvergedReason *r,PetscErrorCode *ierr)
    254: {
    255:   *SNESGetConvergedReason(*snes,r);
    256: }

    258: void PETSC_STDCALL sneslinesearchsetparams_(SNES *snes,PetscReal *alpha,PetscReal *maxstep,PetscReal *steptol,PetscErrorCode *ierr)
    259: {
    260:   *SNESLineSearchSetParams(*snes,*alpha,*maxstep,*steptol);
    261: }

    263: void PETSC_STDCALL sneslinesearchgetparams_(SNES *snes,PetscReal *alpha,PetscReal *maxstep,PetscReal *steptol,PetscErrorCode *ierr)
    264: {
    265:   CHKFORTRANNULLREAL(alpha);
    266:   CHKFORTRANNULLREAL(maxstep);
    267:   CHKFORTRANNULLREAL(steptol);
    268:   *SNESLineSearchGetParams(*snes,alpha,maxstep,steptol);
    269: }

    271: /*  func is currently ignored from Fortran */
    272: void PETSC_STDCALL snesgetjacobian_(SNES *snes,Mat *A,Mat *B,int *func,void **ctx,PetscErrorCode *ierr)
    273: {
    274:   CHKFORTRANNULLINTEGER(ctx);
    275:   CHKFORTRANNULLOBJECT(A);
    276:   CHKFORTRANNULLOBJECT(B);
    277:   *SNESGetJacobian(*snes,A,B,0,ctx);
    278: }

    280: void PETSC_STDCALL matsnesmfsettype_(Mat *mat,CHAR ftype PETSC_MIXED_LEN(len),
    281:                                      PetscErrorCode *ierr PETSC_END_LEN(len))
    282: {
    283:   char *t;
    284:   FIXCHAR(ftype,len,t);
    285:   *MatSNESMFSetType(*mat,t);
    286:   FREECHAR(ftype,t);
    287: }

    289: void PETSC_STDCALL snesgetconvergencehistory_(SNES *snes,PetscInt *na,PetscErrorCode *ierr)
    290: {
    291:   *SNESGetConvergenceHistory(*snes,PETSC_NULL,PETSC_NULL,na);
    292: }

    294: void PETSC_STDCALL snessettype_(SNES *snes,CHAR type PETSC_MIXED_LEN(len),
    295:                                 PetscErrorCode *ierr PETSC_END_LEN(len))
    296: {
    297:   char *t;

    299:   FIXCHAR(type,len,t);
    300:   *SNESSetType(*snes,t);
    301:   FREECHAR(type,t);
    302: }

    304: void PETSC_STDCALL snesappendoptionsprefix_(SNES *snes,CHAR prefix PETSC_MIXED_LEN(len),
    305:                                             PetscErrorCode *ierr PETSC_END_LEN(len))
    306: {
    307:   char *t;

    309:   FIXCHAR(prefix,len,t);
    310:   *SNESAppendOptionsPrefix(*snes,t);
    311:   FREECHAR(prefix,t);
    312: }

    314: void PETSC_STDCALL matcreatesnesmf_(SNES *snes,Vec *x,Mat *J,PetscErrorCode *ierr)
    315: {
    316:   *MatCreateSNESMF(*snes,*x,J);
    317: }

    319: void PETSC_STDCALL matcreatemf_(Vec *x,Mat *J,PetscErrorCode *ierr)
    320: {
    321:   *MatCreateMF(*x,J);
    322: }

    324: /* functions, hence no STDCALL */

    326: void sneslgmonitor_(SNES *snes,PetscInt *its,PetscReal *fgnorm,void *dummy,PetscErrorCode *ierr)
    327: {
    328:   *SNESLGMonitor(*snes,*its,*fgnorm,dummy);
    329: }

    331: void snesdefaultmonitor_(SNES *snes,PetscInt *its,PetscReal *fgnorm,void *dummy,PetscErrorCode *ierr)
    332: {
    333:   *SNESDefaultMonitor(*snes,*its,*fgnorm,dummy);
    334: }

    336: void snesvecviewmonitor_(SNES *snes,PetscInt *its,PetscReal *fgnorm,void *dummy,PetscErrorCode *ierr)
    337: {
    338:   *SNESVecViewMonitor(*snes,*its,*fgnorm,dummy);
    339: }

    341: void snesvecviewupdatemonitor_(SNES *snes,PetscInt *its,PetscReal *fgnorm,void *dummy,PetscErrorCode *ierr)
    342: {
    343:   *SNESVecViewUpdateMonitor(*snes,*its,*fgnorm,dummy);
    344: }

    347: void PETSC_STDCALL snessetmonitor_(SNES *snes,void (PETSC_STDCALL *func)(SNES*,PetscInt*,PetscReal*,void*,PetscErrorCode*),
    348:                     void *mctx,void (PETSC_STDCALL *mondestroy)(void*,PetscErrorCode*),PetscErrorCode *ierr)
    349: {
    350:   CHKFORTRANNULLOBJECT(mctx);
    351:   if ((FCNVOID)func == (FCNVOID)snesdefaultmonitor_) {
    352:     *SNESSetMonitor(*snes,SNESDefaultMonitor,0,0);
    353:   } else if ((FCNVOID)func == (FCNVOID)snesvecviewmonitor_) {
    354:     *SNESSetMonitor(*snes,SNESVecViewMonitor,0,0);
    355:   } else if ((FCNVOID)func == (FCNVOID)snesvecviewupdatemonitor_) {
    356:     *SNESSetMonitor(*snes,SNESVecViewUpdateMonitor,0,0);
    357:   } else if ((FCNVOID)func == (FCNVOID)sneslgmonitor_) {
    358:     *SNESSetMonitor(*snes,SNESLGMonitor,0,0);
    359:   } else {
    360:     f7 = func;
    361:     if (FORTRANNULLFUNCTION(mondestroy)){
    362:       *SNESSetMonitor(*snes,oursnesmonitor,mctx,0);
    363:     } else {
    364:       f71 = mondestroy;
    365:       *SNESSetMonitor(*snes,oursnesmonitor,mctx,ourmondestroy);
    366:     }
    367:   }
    368: }

    370: /* -----------------------------------------------------------------------------------------------------*/
    371: void sneslinesearchcubic_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
    372:                                         PetscReal *ynorm,PetscReal *gnorm,PetscTruth *flag,PetscErrorCode *ierr)
    373: {
    374:   *SNESLineSearchCubic(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
    375: }
    376: void sneslinesearchquadratic_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
    377:                                         PetscReal *ynorm,PetscReal *gnorm,PetscTruth *flag,PetscErrorCode *ierr)
    378: {
    379:   *SNESLineSearchQuadratic(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
    380: }
    381: void sneslinesearchno_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
    382:                                         PetscReal *ynorm,PetscReal *gnorm,PetscTruth *flag,PetscErrorCode *ierr)
    383: {
    384:   *SNESLineSearchNo(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
    385: }
    386: void sneslinesearchnonorms_(SNES *snes,void *lsctx,Vec *x,Vec *f,Vec *g,Vec *y,Vec *w,PetscReal*fnorm,
    387:                                         PetscReal *ynorm,PetscReal *gnorm,PetscTruth *flag,PetscErrorCode *ierr)
    388: {
    389:   *SNESLineSearchNoNorms(*snes,lsctx,*x,*f,*g,*y,*w,*fnorm,ynorm,gnorm,flag);
    390: }

    393: void PETSC_STDCALL sneslinesearchset_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,void *,Vec*,Vec*,Vec*,Vec*,Vec*,PetscReal*,PetscReal*,PetscReal*,PetscTruth*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr)
    394: {
    395:   if ((FCNVOID)f == (FCNVOID)sneslinesearchcubic_) {
    396:     *SNESLineSearchSet(*snes,SNESLineSearchCubic,ctx);
    397:   } else if ((FCNVOID)f == (FCNVOID)sneslinesearchquadratic_) {
    398:     *SNESLineSearchSet(*snes,SNESLineSearchQuadratic,ctx);
    399:   } else if ((FCNVOID)f == (FCNVOID)sneslinesearchno_) {
    400:     *SNESLineSearchSet(*snes,SNESLineSearchNo,ctx);
    401:   } else if ((FCNVOID)f == (FCNVOID)sneslinesearchnonorms_) {
    402:     *SNESLineSearchSet(*snes,SNESLineSearchNoNorms,ctx);
    403:   } else {
    404:     f73 = f;
    405:     *SNESLineSearchSet(*snes,OurSNESLineSearch,ctx);
    406:   }
    407: }

    410: void PETSC_STDCALL sneslinesearchsetpostcheck_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,Vec*,Vec *,Vec *,void *,PetscTruth*,PetscTruth*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr)
    411: {
    412:   f74 = f;
    413:   *SNESLineSearchSetPostCheck(*snes,OurSNESLineSearchPostCheck,ctx);
    414: }

    416: void PETSC_STDCALL sneslinesearchsetprecheck_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,Vec*,Vec *,void *,PetscTruth*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr)
    417: {
    418:   f75 = f;
    419:   *SNESLineSearchSetPreCheck(*snes,OurSNESLineSearchPreCheck,ctx);
    420: }

    422: void PETSC_STDCALL snessetupdate_(SNES *snes,void (PETSC_STDCALL *f)(SNES*,PetscInt*,PetscErrorCode*),PetscErrorCode *ierr)
    423: {
    424:   f76 = f;
    425:   *SNESSetUpdate(*snes,OurSNESSetUpdate);
    426: }
    427: /*----------------------------------------------------------------------*/

    429: void snesconverged_tr_(SNES *snes,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,
    430:                                        void *ct,PetscErrorCode *ierr)
    431: {
    432:   *SNESConverged_TR(*snes,*a,*b,*c,r,ct);
    433: }

    435: void snesconverged_ls_(SNES *snes,PetscReal *a,PetscReal *b,PetscReal *c,SNESConvergedReason *r,
    436:                                        void *ct,PetscErrorCode *ierr)
    437: {
    438:   *SNESConverged_LS(*snes,*a,*b,*c,r,ct);
    439: }

    442: void PETSC_STDCALL snessetconvergencetest_(SNES *snes,
    443:        void (PETSC_STDCALL *func)(SNES*,PetscReal*,PetscReal*,PetscReal*,SNESConvergedReason*,void*,PetscErrorCode*),
    444:        void *cctx,PetscErrorCode *ierr)
    445: {
    446:   CHKFORTRANNULLOBJECT(cctx);
    447:   if ((FCNVOID)func == (FCNVOID)snesconverged_ls_){
    448:     *SNESSetConvergenceTest(*snes,SNESConverged_LS,0);
    449:   } else if ((FCNVOID)func == (FCNVOID)snesconverged_tr_){
    450:     *SNESSetConvergenceTest(*snes,SNESConverged_TR,0);
    451:   } else {
    452:     f8 = func;
    453:     *SNESSetConvergenceTest(*snes,oursnestest,cctx);
    454:   }
    455: }

    457: /*--------------------------------------------------------------------------------------------*/

    459: void PETSC_STDCALL snesgetsolution_(SNES *snes,Vec *x,PetscErrorCode *ierr)
    460: {
    461:   *SNESGetSolution(*snes,x);
    462: }

    464: void PETSC_STDCALL snesgetsolutionupdate_(SNES *snes,Vec *x,PetscErrorCode *ierr)
    465: {
    466:   *SNESGetSolutionUpdate(*snes,x);
    467: }

    469: /* the func argument is ignored */
    470: void PETSC_STDCALL snesgetfunction_(SNES *snes,Vec *r,void *func,void **ctx,PetscErrorCode *ierr)
    471: {
    472:   CHKFORTRANNULLINTEGER(ctx);
    473:   CHKFORTRANNULLOBJECT(r);
    474:   *SNESGetFunction(*snes,r,PETSC_NULL,ctx);
    475: }

    477: void PETSC_STDCALL snesdestroy_(SNES *snes,PetscErrorCode *ierr)
    478: {
    479:   *SNESDestroy(*snes);
    480: }

    482: void PETSC_STDCALL snesgetksp_(SNES *snes,KSP *ksp,PetscErrorCode *ierr)
    483: {
    484:   *SNESGetKSP(*snes,ksp);
    485: }

    487: /* ---------------------------------------------------------*/

    490: /*
    491:         These are not usually called from Fortran but allow Fortran users
    492:    to transparently set these monitors from .F code
    493:
    494:    functions, hence no STDCALL
    495: */
    496: void  snesdaformfunction_(SNES *snes,Vec *X, Vec *F,void *ptr,PetscErrorCode *ierr)
    497: {
    498:   *SNESDAFormFunction(*snes,*X,*F,ptr);
    499: }

    502: void PETSC_STDCALL snessetfunction_(SNES *snes,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,PetscErrorCode*),
    503:                       void *ctx,PetscErrorCode *ierr)
    504: {
    505:   CHKFORTRANNULLOBJECT(ctx);
    506:   f2 = func;
    507:   if ((FCNVOID)func == (FCNVOID)snesdaformfunction_) {
    508:     *SNESSetFunction(*snes,*r,SNESDAFormFunction,ctx);
    509:   } else {
    510:     *SNESSetFunction(*snes,*r,oursnesfunction,ctx);
    511:   }
    512: }

    514: /* ---------------------------------------------------------*/

    516: void PETSC_STDCALL matsnesmfsetfunction_(Mat *mat,Vec *r,void (PETSC_STDCALL *func)(SNES*,Vec*,Vec*,void*,PetscErrorCode*),
    517:                       void *ctx,PetscErrorCode *ierr){
    518:   f11 = func;
    519:   CHKFORTRANNULLOBJECT(ctx);
    520:   *MatSNESMFSetFunction(*mat,*r,ourmatsnesmffunction,ctx);
    521: }
    522: /* ---------------------------------------------------------*/

    524: void PETSC_STDCALL snescreate_(MPI_Comm *comm,SNES *outsnes,PetscErrorCode *ierr){

    526: *SNESCreate((MPI_Comm)PetscToPointerComm(*comm),outsnes);
    527: }

    529: /* ---------------------------------------------------------*/
    530: /*
    531:      snesdefaultcomputejacobian() and snesdefaultcomputejacobiancolor()
    532:   These can be used directly from Fortran but are mostly so that
    533:   Fortran SNESSetJacobian() will properly handle the defaults being passed in.

    535:   functions, hence no STDCALL
    536: */
    537: void snesdefaultcomputejacobian_(SNES *snes,Vec *x,Mat *m,Mat *p,MatStructure* type,void *ctx,PetscErrorCode *ierr)
    538: {
    539:   *SNESDefaultComputeJacobian(*snes,*x,m,p,type,ctx);
    540: }
    541: void  snesdefaultcomputejacobiancolor_(SNES *snes,Vec *x,Mat *m,Mat *p,MatStructure* type,void *ctx,PetscErrorCode *ierr)
    542: {
    543:   *SNESDefaultComputeJacobianColor(*snes,*x,m,p,type,*(MatFDColoring*)ctx);
    544: }

    546: void  snesdacomputejacobianwithadifor_(SNES *snes,Vec *X,Mat *m,Mat *p,MatStructure* type,void *ctx,PetscErrorCode *ierr)
    547: {
    548:   (*PetscErrorPrintf)("Cannot call this function from Fortran");
    549:   *1;
    550: }

    552: void  snesdacomputejacobian_(SNES *snes,Vec *X,Mat *m,Mat *p,MatStructure* type,void *ctx,PetscErrorCode *ierr)
    553: {
    554:   (*PetscErrorPrintf)("Cannot call this function from Fortran");
    555:   *1;
    556: }

    558: void PETSC_STDCALL snessetjacobian_(SNES *snes,Mat *A,Mat *B,void (PETSC_STDCALL *func)(SNES*,Vec*,Mat*,Mat*,
    559:             MatStructure*,void*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr)
    560: {
    561:   CHKFORTRANNULLOBJECT(ctx);
    562:   if ((FCNVOID)func == (FCNVOID)snesdefaultcomputejacobian_) {
    563:     *SNESSetJacobian(*snes,*A,*B,SNESDefaultComputeJacobian,ctx);
    564:   } else if ((FCNVOID)func == (FCNVOID)snesdefaultcomputejacobiancolor_) {
    565:     *SNESSetJacobian(*snes,*A,*B,SNESDefaultComputeJacobianColor,*(MatFDColoring*)ctx);
    566:   } else if ((FCNVOID)func == (FCNVOID)snesdacomputejacobianwithadifor_) {
    567:     *SNESSetJacobian(*snes,*A,*B,SNESDAComputeJacobianWithAdifor,ctx);
    568:   } else if ((FCNVOID)func == (FCNVOID)snesdacomputejacobian_) {
    569:     *SNESSetJacobian(*snes,*A,*B,SNESDAComputeJacobian,ctx);
    570:   } else {
    571:     f3 = func;
    572:     *SNESSetJacobian(*snes,*A,*B,oursnesjacobian,ctx);
    573:   }
    574: }

    576: /* -------------------------------------------------------------*/

    578: void PETSC_STDCALL snesregisterdestroy_(PetscErrorCode *ierr)
    579: {
    580:   *SNESRegisterDestroy();
    581: }

    583: void PETSC_STDCALL snesgettype_(SNES *snes,CHAR name PETSC_MIXED_LEN(len),
    584:                                 PetscErrorCode *ierr PETSC_END_LEN(len))
    585: {
    586:   const char *tname;

    588:   *SNESGetType(*snes,&tname);
    589: #if defined(PETSC_USES_CPTOFCD)
    590:   {
    591:     char *t = _fcdtocp(name); int len1 = _fcdlen(name);
    592:     *PetscStrncpy(t,tname,len1);if (*ierr) return;
    593:   }
    594: #else
    595:   *PetscStrncpy(name,tname,len);if (*ierr) return;
    596: #endif
    597:   FIXRETURNCHAR(name,len);
    598: }

    600: void PETSC_STDCALL snesgetoptionsprefix_(SNES *snes,CHAR prefix PETSC_MIXED_LEN(len),
    601:                                          PetscErrorCode *ierr PETSC_END_LEN(len))
    602: {
    603:   const char *tname;

    605:   *SNESGetOptionsPrefix(*snes,&tname);
    606: #if defined(PETSC_USES_CPTOFCD)
    607:   {
    608:     char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
    609:     *PetscStrncpy(t,tname,len1);if (*ierr) return;
    610:   }
    611: #else
    612:   *PetscStrncpy(prefix,tname,len);if (*ierr) return;
    613: #endif
    614: }