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 <slepcnep.h>

 14: #if defined(PETSC_HAVE_FORTRAN_CAPS)
 15: #define nepnleigssetsingularitiesfunction_ NEPNLEIGSSETSINGULARITIESFUNCTION
 16: #define nepnleigsgetrkshifts_              NEPNLEIGSGETRKSHIFTS
 17: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 18: #define nepnleigssetsingularitiesfunction_ nepnleigssetsingularitiesfunction
 19: #define nepnleigsgetrkshifts_              nepnleigsgetrkshifts
 20: #endif

 22: static struct {
 23:   PetscFortranCallbackId singularities;
 24: } _cb;

 26: static PetscErrorCode oursingularitiesfunc(NEP nep,PetscInt *maxnp,PetscScalar *xi,void *ctx)
 27: {
 28:   PetscObjectUseFortranCallback(nep,_cb.singularities,(NEP*,PetscInt*,PetscScalar*,void*,PetscErrorCode*),(&nep,maxnp,xi,_ctx,&ierr));
 29: }

 31: SLEPC_EXTERN void nepnleigssetsingularitiesfunction_(NEP *nep,void (*func)(NEP*,PetscInt*,PetscScalar*,void*,PetscErrorCode*),void *ctx,PetscErrorCode *ierr)
 32: {
 33:   CHKFORTRANNULLOBJECT(ctx);
 34:   *ierr = PetscObjectSetFortranCallback((PetscObject)*nep,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.singularities,(PetscVoidFunction)func,ctx); if (*ierr) return;
 35:   *ierr = NEPNLEIGSSetSingularitiesFunction(*nep,oursingularitiesfunc,*nep);
 36: }

 38: SLEPC_EXTERN void nepnleigsgetrkshifts_(NEP *nep,PetscInt *ns,PetscScalar *pshifts,PetscErrorCode *ierr)
 39: {
 40:   PetscScalar *oshifts;
 41:   PetscInt    n;

 43:   CHKFORTRANNULLSCALAR(pshifts);
 44:   *ierr = NEPNLEIGSGetRKShifts(*nep,&n,&oshifts); if (*ierr) return;
 45:   if (pshifts) { *ierr = PetscArraycpy(pshifts,oshifts,n); if (*ierr) return; }
 46:   *ns = n;
 47:   *ierr = PetscFree(oshifts);
 48: }