Date: 2024-04-26T10:22:13+00:00

Actual source code: zmfnf.c
slepc-3.21.1 2024-04-26
Report Typos and Errors

      1: /*
      2:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      3:    SLEPc - Scalable Library for Eigenvalue Problem Computations
      4:    Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain

      6:    This file is part of SLEPc.
      7:    SLEPc is distributed under a 2-clause BSD license (see LICENSE).
      8:    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      9: */

     11: #include <petsc/private/fortranimpl.h>
     12: #include <slepcmfn.h>

     14: #if defined(PETSC_HAVE_FORTRAN_CAPS)
     15: #define mfndestroy_                       MFNDESTROY
     16: #define mfnview_                          MFNVIEW
     17: #define mfnviewfromoptions_               MFNVIEWFROMOPTIONS
     18: #define mfnconvergedreasonview_           MFNCONVERGEDREASONVIEW
     19: #define mfnsetoptionsprefix_              MFNSETOPTIONSPREFIX
     20: #define mfnappendoptionsprefix_           MFNAPPENDOPTIONSPREFIX
     21: #define mfngetoptionsprefix_              MFNGETOPTIONSPREFIX
     22: #define mfnsettype_                       MFNSETTYPE
     23: #define mfngettype_                       MFNGETTYPE
     24: #define mfnmonitordefault_                MFNMONITORDEFAULT
     25: #define mfnmonitorset_                    MFNMONITORSET
     26: #define mfngettolerances00_               MFNGETTOLERANCES00
     27: #define mfngettolerances10_               MFNGETTOLERANCES10
     28: #define mfngettolerances01_               MFNGETTOLERANCES01
     29: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
     30: #define mfndestroy_                       mfndestroy
     31: #define mfnview_                          mfnview
     32: #define mfnviewfromoptions_               mfnviewfromoptions
     33: #define mfnconvergedreasonview_           mfnconvergedreasonview
     34: #define mfnsetoptionsprefix_              mfnsetoptionsprefix
     35: #define mfnappendoptionsprefix_           mfnappendoptionsprefix
     36: #define mfngetoptionsprefix_              mfngetoptionsprefix
     37: #define mfnsettype_                       mfnsettype
     38: #define mfngettype_                       mfngettype
     39: #define mfnmonitordefault_                mfnmonitordefault
     40: #define mfnmonitorset_                    mfnmonitorset
     41: #define mfngettolerances00_               mfngettolerances00
     42: #define mfngettolerances10_               mfngettolerances10
     43: #define mfngettolerances01_               mfngettolerances01
     44: #endif

     46: /*
     47:    These are not usually called from Fortran but allow Fortran users
     48:    to transparently set these monitors from .F code
     49: */
     50: SLEPC_EXTERN void mfnmonitordefault_(MFN *mfn,PetscInt *it,PetscReal *errest,PetscViewerAndFormat **ctx,PetscErrorCode *ierr)
     51: {
     52:   *ierr = MFNMonitorDefault(*mfn,*it,*errest,*ctx);
     53: }

     55: static struct {
     56:   PetscFortranCallbackId monitor;
     57:   PetscFortranCallbackId monitordestroy;
     58: } _cb;

     60: /* These are not extern C because they are passed into non-extern C user level functions */
     61: static PetscErrorCode ourmonitor(MFN mfn,PetscInt i,PetscReal d,void* ctx)
     62: {
     63:   PetscObjectUseFortranCallback(mfn,_cb.monitor,(MFN*,PetscInt*,PetscReal*,void*,PetscErrorCode*),(&mfn,&i,&d,_ctx,&ierr));
     64: }

     66: static PetscErrorCode ourdestroy(void** ctx)
     67: {
     68:   MFN mfn = (MFN)*ctx;
     69:   PetscObjectUseFortranCallback(mfn,_cb.monitordestroy,(void*,PetscErrorCode*),(_ctx,&ierr));
     70: }

     72: SLEPC_EXTERN void mfndestroy_(MFN *mfn,PetscErrorCode *ierr)
     73: {
     74:   PETSC_FORTRAN_OBJECT_F_DESTROYED_TO_C_NULL(mfn);
     75:   *ierr = MFNDestroy(mfn); if (*ierr) return;
     76:   PETSC_FORTRAN_OBJECT_C_NULL_TO_F_DESTROYED(mfn);
     77: }

     79: SLEPC_EXTERN void mfnview_(MFN *mfn,PetscViewer *viewer,PetscErrorCode *ierr)
     80: {
     81:   PetscViewer v;
     82:   PetscPatchDefaultViewers_Fortran(viewer,v);
     83:   *ierr = MFNView(*mfn,v);
     84: }

     86: SLEPC_EXTERN void mfnviewfromoptions_(MFN *mfn,PetscObject obj,char* type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
     87: {
     88:   char *t;

     90:   FIXCHAR(type,len,t);
     91:   CHKFORTRANNULLOBJECT(obj);
     92:   *ierr = MFNViewFromOptions(*mfn,obj,t);if (*ierr) return;
     93:   FREECHAR(type,t);
     94: }

     96: SLEPC_EXTERN void mfnconvergedreasonview_(MFN *mfn,PetscViewer *viewer,PetscErrorCode *ierr)
     97: {
     98:   PetscViewer v;
     99:   PetscPatchDefaultViewers_Fortran(viewer,v);
    100:   *ierr = MFNConvergedReasonView(*mfn,v);
    101: }

    103: SLEPC_EXTERN void mfnsettype_(MFN *mfn,char *type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
    104: {
    105:   char *t;

    107:   FIXCHAR(type,len,t);
    108:   *ierr = MFNSetType(*mfn,t);if (*ierr) return;
    109:   FREECHAR(type,t);
    110: }

    112: SLEPC_EXTERN void mfngettype_(MFN *mfn,char *name,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
    113: {
    114:   MFNType tname;

    116:   *ierr = MFNGetType(*mfn,&tname);if (*ierr) return;
    117:   *ierr = PetscStrncpy(name,tname,len);if (*ierr) return;
    118:   FIXRETURNCHAR(PETSC_TRUE,name,len);
    119: }

    121: SLEPC_EXTERN void mfnsetoptionsprefix_(MFN *mfn,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
    122: {
    123:   char *t;

    125:   FIXCHAR(prefix,len,t);
    126:   *ierr = MFNSetOptionsPrefix(*mfn,t);if (*ierr) return;
    127:   FREECHAR(prefix,t);
    128: }

    130: SLEPC_EXTERN void mfnappendoptionsprefix_(MFN *mfn,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
    131: {
    132:   char *t;

    134:   FIXCHAR(prefix,len,t);
    135:   *ierr = MFNAppendOptionsPrefix(*mfn,t);if (*ierr) return;
    136:   FREECHAR(prefix,t);
    137: }

    139: SLEPC_EXTERN void mfngetoptionsprefix_(MFN *mfn,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
    140: {
    141:   const char *tname;

    143:   *ierr = MFNGetOptionsPrefix(*mfn,&tname); if (*ierr) return;
    144:   *ierr = PetscStrncpy(prefix,tname,len);if (*ierr) return;
    145:   FIXRETURNCHAR(PETSC_TRUE,prefix,len);
    146: }

    148: SLEPC_EXTERN void mfnmonitorset_(MFN *mfn,void (*monitor)(MFN*,PetscInt*,PetscReal*,void*,PetscErrorCode*),void *mctx,void (*monitordestroy)(void *,PetscErrorCode*),PetscErrorCode *ierr)
    149: {
    150:   CHKFORTRANNULLOBJECT(mctx);
    151:   CHKFORTRANNULLFUNCTION(monitordestroy);
    152:   if ((PetscVoidFunction)monitor == (PetscVoidFunction)mfnmonitordefault_) {
    153:     *ierr = MFNMonitorSet(*mfn,(PetscErrorCode (*)(MFN,PetscInt,PetscReal,void*))MFNMonitorDefault,*(PetscViewerAndFormat**)mctx,(PetscErrorCode (*)(void**))PetscViewerAndFormatDestroy);
    154:   } else {
    155:     *ierr = PetscObjectSetFortranCallback((PetscObject)*mfn,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.monitor,(PetscVoidFunction)monitor,mctx); if (*ierr) return;
    156:     *ierr = PetscObjectSetFortranCallback((PetscObject)*mfn,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.monitordestroy,(PetscVoidFunction)monitordestroy,mctx); if (*ierr) return;
    157:     *ierr = MFNMonitorSet(*mfn,ourmonitor,*mfn,ourdestroy);
    158:   }
    159: }

    161: SLEPC_EXTERN void mfngettolerances_(MFN *mfn,PetscReal *tol,PetscInt *maxits,PetscErrorCode *ierr)
    162: {
    163:   CHKFORTRANNULLREAL(tol);
    164:   CHKFORTRANNULLINTEGER(maxits);
    165:   *ierr = MFNGetTolerances(*mfn,tol,maxits);
    166: }

    168: SLEPC_EXTERN void mfngettolerances00_(MFN *mfn,PetscReal *tol,PetscInt *maxits,PetscErrorCode *ierr)
    169: {
    170:   mfngettolerances_(mfn,tol,maxits,ierr);
    171: }

    173: SLEPC_EXTERN void mfngettolerances10_(MFN *mfn,PetscReal *tol,PetscInt *maxits,PetscErrorCode *ierr)
    174: {
    175:   mfngettolerances_(mfn,tol,maxits,ierr);
    176: }

    178: SLEPC_EXTERN void mfngettolerances01_(MFN *mfn,PetscReal *tol,PetscInt *maxits,PetscErrorCode *ierr)
    179: {
    180:   mfngettolerances_(mfn,tol,maxits,ierr);
    181: }