| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | /* | ||
| 2 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 3 | SLEPc - Scalable Library for Eigenvalue Problem Computations | ||
| 4 | Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain | ||
| 5 | |||
| 6 | This file is part of SLEPc. | ||
| 7 | SLEPc is distributed under a 2-clause BSD license (see LICENSE). | ||
| 8 | - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | ||
| 9 | */ | ||
| 10 | |||
| 11 | #include <petsc/private/ftnimpl.h> | ||
| 12 | #include <slepcmfn.h> | ||
| 13 | |||
| 14 | #if defined(PETSC_HAVE_FORTRAN_CAPS) | ||
| 15 | #define mfnmonitordefault_ MFNMONITORDEFAULT | ||
| 16 | #define mfnmonitorset_ MFNMONITORSET | ||
| 17 | #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) | ||
| 18 | #define mfnmonitordefault_ mfnmonitordefault | ||
| 19 | #define mfnmonitorset_ mfnmonitorset | ||
| 20 | #endif | ||
| 21 | |||
| 22 | /* | ||
| 23 | These cannot be called from Fortran but allow Fortran users | ||
| 24 | to transparently set these monitors from .F code | ||
| 25 | */ | ||
| 26 | SLEPC_EXTERN void mfnmonitordefault_(MFN*,PetscInt*,PetscReal*,PetscViewerAndFormat*,PetscErrorCode*); | ||
| 27 | |||
| 28 | static struct { | ||
| 29 | PetscFortranCallbackId monitor; | ||
| 30 | PetscFortranCallbackId monitordestroy; | ||
| 31 | } _cb; | ||
| 32 | |||
| 33 | /* These are not extern C because they are passed into non-extern C user level functions */ | ||
| 34 | ✗ | static PetscErrorCode ourmonitor(MFN mfn,PetscInt i,PetscReal d,void *ctx) | |
| 35 | { | ||
| 36 | ✗ | PetscObjectUseFortranCallback(mfn,_cb.monitor,(MFN*,PetscInt*,PetscReal*,void*,PetscErrorCode*),(&mfn,&i,&d,_ctx,&ierr)); | |
| 37 | } | ||
| 38 | |||
| 39 | ✗ | static PetscErrorCode ourdestroy(PetscCtxRt ctx) | |
| 40 | { | ||
| 41 | ✗ | MFN mfn = *(MFN*)ctx; | |
| 42 | ✗ | PetscObjectUseFortranCallback(mfn,_cb.monitordestroy,(void*,PetscErrorCode*),(_ctx,&ierr)); | |
| 43 | } | ||
| 44 | |||
| 45 | ✗ | SLEPC_EXTERN void mfnmonitorset_(MFN *mfn,void (*monitor)(MFN*,PetscInt*,PetscReal*,void*,PetscErrorCode*),void *mctx,void (*monitordestroy)(void*,PetscErrorCode*),PetscErrorCode *ierr) | |
| 46 | { | ||
| 47 | ✗ | CHKFORTRANNULLOBJECT(mctx); | |
| 48 | ✗ | CHKFORTRANNULLFUNCTION(monitordestroy); | |
| 49 | ✗ | if ((PetscFortranCallbackFn*)monitor == (PetscFortranCallbackFn*)mfnmonitordefault_) { | |
| 50 | ✗ | *ierr = MFNMonitorSet(*mfn,(MFNMonitorFn*)MFNMonitorDefault,*(PetscViewerAndFormat**)mctx,(PetscCtxDestroyFn*)PetscViewerAndFormatDestroy); | |
| 51 | } else { | ||
| 52 | ✗ | *ierr = PetscObjectSetFortranCallback((PetscObject)*mfn,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.monitor,(PetscFortranCallbackFn*)monitor,mctx); if (*ierr) return; | |
| 53 | ✗ | *ierr = PetscObjectSetFortranCallback((PetscObject)*mfn,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.monitordestroy,(PetscFortranCallbackFn*)monitordestroy,mctx); if (*ierr) return; | |
| 54 | ✗ | *ierr = MFNMonitorSet(*mfn,ourmonitor,*mfn,ourdestroy); | |
| 55 | } | ||
| 56 | } | ||
| 57 |