Actual source code: zshell.c
slepc-3.23.0 2025-03-29
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/ftnimpl.h>
12: #include <slepcst.h>
14: #if defined(PETSC_HAVE_FORTRAN_CAPS)
15: #define stshellsetapply_ STSHELLSETAPPLY
16: #define stshellsetapplytranspose_ STSHELLSETAPPLYTRANSPOSE
17: #define stshellsetapplyhermitiantranspose_ STSHELLSETAPPLYHERMITIANTRANSPOSE
18: #define stshellsetbacktransform_ STSHELLSETBACKTRANSFORM
19: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
20: #define stshellsetapply_ stshellsetapply
21: #define stshellsetapplytranspose_ stshellsetapplytranspose
22: #define stshellsetapplyhermitiantranspose_ stshellsetapplyhermitiantranspose
23: #define stshellsetbacktransform_ stshellsetbacktransform
24: #endif
26: static struct {
27: PetscFortranCallbackId apply;
28: PetscFortranCallbackId applytranspose;
29: PetscFortranCallbackId applyhermtrans;
30: PetscFortranCallbackId backtransform;
31: } _cb;
33: /* These are not extern C because they are passed into non-extern C user level functions */
34: static PetscErrorCode ourshellapply(ST st,Vec x,Vec y)
35: {
36: PetscObjectUseFortranCallback(st,_cb.apply,(ST*,Vec*,Vec*,PetscErrorCode*),(&st,&x,&y,&ierr));
37: }
39: static PetscErrorCode ourshellapplytranspose(ST st,Vec x,Vec y)
40: {
41: PetscObjectUseFortranCallback(st,_cb.applytranspose,(ST*,Vec*,Vec*,PetscErrorCode*),(&st,&x,&y,&ierr));
42: }
44: static PetscErrorCode ourshellapplyhermitiantranspose(ST st,Vec x,Vec y)
45: {
46: PetscObjectUseFortranCallback(st,_cb.applyhermtrans,(ST*,Vec*,Vec*,PetscErrorCode*),(&st,&x,&y,&ierr));
47: }
49: static PetscErrorCode ourshellbacktransform(ST st,PetscInt n,PetscScalar *eigr,PetscScalar *eigi)
50: {
51: PetscObjectUseFortranCallback(st,_cb.backtransform,(ST*,PetscInt*,PetscScalar*,PetscScalar*,PetscErrorCode*),(&st,&n,eigr,eigi,&ierr));
52: }
54: SLEPC_EXTERN void stshellsetapply_(ST *st,void (*apply)(void*,Vec*,Vec*,PetscErrorCode*),PetscErrorCode *ierr)
55: {
56: *ierr = PetscObjectSetFortranCallback((PetscObject)*st,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.apply,(PetscVoidFunction)apply,NULL); if (*ierr) return;
57: *ierr = STShellSetApply(*st,ourshellapply);
58: }
60: SLEPC_EXTERN void stshellsetapplytranspose_(ST *st,void (*applytranspose)(void*,Vec*,Vec*,PetscErrorCode*),PetscErrorCode *ierr)
61: {
62: *ierr = PetscObjectSetFortranCallback((PetscObject)*st,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.applytranspose,(PetscVoidFunction)applytranspose,NULL); if (*ierr) return;
63: *ierr = STShellSetApplyTranspose(*st,ourshellapplytranspose);
64: }
66: SLEPC_EXTERN void stshellsetapplyhermitiantranspose_(ST *st,void (*applyhermtrans)(void*,Vec*,Vec*,PetscErrorCode*),PetscErrorCode *ierr)
67: {
68: *ierr = PetscObjectSetFortranCallback((PetscObject)*st,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.applyhermtrans,(PetscVoidFunction)applyhermtrans,NULL); if (*ierr) return;
69: *ierr = STShellSetApplyHermitianTranspose(*st,ourshellapplyhermitiantranspose);
70: }
72: SLEPC_EXTERN void stshellsetbacktransform_(ST *st,void (*backtransform)(void*,PetscScalar*,PetscScalar*,PetscErrorCode*),PetscErrorCode *ierr)
73: {
74: *ierr = PetscObjectSetFortranCallback((PetscObject)*st,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.backtransform,(PetscVoidFunction)backtransform,NULL); if (*ierr) return;
75: *ierr = STShellSetBackTransform(*st,ourshellbacktransform);
76: }