Actual source code: zshell.c
slepc-3.21.2 2024-09-25
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: }