Date: 2024-12-02T08:58:29+00:00

Actual source code: zshell.c
slepc-3.22.2 2024-12-02
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: }