Actual source code: zshell.c

slepc-3.22.1 2024-10-28
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 <slepcst.h>

 14: #if defined(PETSC_HAVE_FORTRAN_CAPS)
 15: #define stshellgetcontext_                 STSHELLGETCONTEXT
 16: #define stshellsetapply_                   STSHELLSETAPPLY
 17: #define stshellsetapplytranspose_          STSHELLSETAPPLYTRANSPOSE
 18: #define stshellsetapplyhermitiantranspose_ STSHELLSETAPPLYHERMITIANTRANSPOSE
 19: #define stshellsetbacktransform_           STSHELLSETBACKTRANSFORM
 20: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 21: #define stshellgetcontext_                 stshellgetcontext
 22: #define stshellsetapply_                   stshellsetapply
 23: #define stshellsetapplytranspose_          stshellsetapplytranspose
 24: #define stshellsetapplyhermitiantranspose_ stshellsetapplyhermitiantranspose
 25: #define stshellsetbacktransform_           stshellsetbacktransform
 26: #endif

 28: static struct {
 29:   PetscFortranCallbackId apply;
 30:   PetscFortranCallbackId applytranspose;
 31:   PetscFortranCallbackId applyhermtrans;
 32:   PetscFortranCallbackId backtransform;
 33: } _cb;

 35: /* These are not extern C because they are passed into non-extern C user level functions */
 36: static PetscErrorCode ourshellapply(ST st,Vec x,Vec y)
 37: {
 38:   PetscObjectUseFortranCallback(st,_cb.apply,(ST*,Vec*,Vec*,PetscErrorCode*),(&st,&x,&y,&ierr));
 39: }

 41: static PetscErrorCode ourshellapplytranspose(ST st,Vec x,Vec y)
 42: {
 43:   PetscObjectUseFortranCallback(st,_cb.applytranspose,(ST*,Vec*,Vec*,PetscErrorCode*),(&st,&x,&y,&ierr));
 44: }

 46: static PetscErrorCode ourshellapplyhermitiantranspose(ST st,Vec x,Vec y)
 47: {
 48:   PetscObjectUseFortranCallback(st,_cb.applyhermtrans,(ST*,Vec*,Vec*,PetscErrorCode*),(&st,&x,&y,&ierr));
 49: }

 51: static PetscErrorCode ourshellbacktransform(ST st,PetscInt n,PetscScalar *eigr,PetscScalar *eigi)
 52: {
 53:   PetscObjectUseFortranCallback(st,_cb.backtransform,(ST*,PetscInt*,PetscScalar*,PetscScalar*,PetscErrorCode*),(&st,&n,eigr,eigi,&ierr));
 54: }

 56: SLEPC_EXTERN void stshellgetcontext_(ST *st,void **ctx,PetscErrorCode *ierr)
 57: {
 58:   *ierr = STShellGetContext(*st,ctx);
 59: }

 61: SLEPC_EXTERN void stshellsetapply_(ST *st,void (*apply)(void*,Vec*,Vec*,PetscErrorCode*),PetscErrorCode *ierr)
 62: {
 63:   *ierr = PetscObjectSetFortranCallback((PetscObject)*st,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.apply,(PetscVoidFunction)apply,NULL); if (*ierr) return;
 64:   *ierr = STShellSetApply(*st,ourshellapply);
 65: }

 67: SLEPC_EXTERN void stshellsetapplytranspose_(ST *st,void (*applytranspose)(void*,Vec*,Vec*,PetscErrorCode*),PetscErrorCode *ierr)
 68: {
 69:   *ierr = PetscObjectSetFortranCallback((PetscObject)*st,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.applytranspose,(PetscVoidFunction)applytranspose,NULL); if (*ierr) return;
 70:   *ierr = STShellSetApplyTranspose(*st,ourshellapplytranspose);
 71: }

 73: SLEPC_EXTERN void stshellsetapplyhermitiantranspose_(ST *st,void (*applyhermtrans)(void*,Vec*,Vec*,PetscErrorCode*),PetscErrorCode *ierr)
 74: {
 75:   *ierr = PetscObjectSetFortranCallback((PetscObject)*st,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.applyhermtrans,(PetscVoidFunction)applyhermtrans,NULL); if (*ierr) return;
 76:   *ierr = STShellSetApplyHermitianTranspose(*st,ourshellapplyhermitiantranspose);
 77: }

 79: SLEPC_EXTERN void stshellsetbacktransform_(ST *st,void (*backtransform)(void*,PetscScalar*,PetscScalar*,PetscErrorCode*),PetscErrorCode *ierr)
 80: {
 81:   *ierr = PetscObjectSetFortranCallback((PetscObject)*st,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.backtransform,(PetscVoidFunction)backtransform,NULL); if (*ierr) return;
 82:   *ierr = STShellSetBackTransform(*st,ourshellbacktransform);
 83: }