Actual source code: zrgf.c
slepc-3.21.1 2024-04-26
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 <slepcrg.h>
14: #if defined(PETSC_HAVE_FORTRAN_CAPS)
15: #define rgsettype_ RGSETTYPE
16: #define rggettype_ RGGETTYPE
17: #define rgsetoptionsprefix_ RGSETOPTIONSPREFIX
18: #define rgappendoptionsprefix_ RGAPPENDOPTIONSPREFIX
19: #define rggetoptionsprefix_ RGGETOPTIONSPREFIX
20: #define rgdestroy_ RGDESTROY
21: #define rgview_ RGVIEW
22: #define rgviewfromoptions_ RGVIEWFROMOPTIONS
23: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
24: #define rgsettype_ rgsettype
25: #define rggettype_ rggettype
26: #define rgsetoptionsprefix_ rgsetoptionsprefix
27: #define rgappendoptionsprefix_ rgappendoptionsprefix
28: #define rggetoptionsprefix_ rggetoptionsprefix
29: #define rgdestroy_ rgdestroy
30: #define rgview_ rgview
31: #define rgviewfromoptions_ rgviewfromoptions
32: #endif
34: SLEPC_EXTERN void rgsettype_(RG *rg,char *type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
35: {
36: char *t;
38: FIXCHAR(type,len,t);
39: *ierr = RGSetType(*rg,t);
40: FREECHAR(type,t);
41: }
43: SLEPC_EXTERN void rggettype_(RG *rg,char *name,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
44: {
45: RGType tname;
47: *ierr = RGGetType(*rg,&tname); if (*ierr) return;
48: *ierr = PetscStrncpy(name,tname,len);if (*ierr) return;
49: FIXRETURNCHAR(PETSC_TRUE,name,len);
50: }
52: SLEPC_EXTERN void rgsetoptionsprefix_(RG *rg,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
53: {
54: char *t;
56: FIXCHAR(prefix,len,t);
57: *ierr = RGSetOptionsPrefix(*rg,t);if (*ierr) return;
58: FREECHAR(prefix,t);
59: }
61: SLEPC_EXTERN void rgappendoptionsprefix_(RG *rg,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
62: {
63: char *t;
65: FIXCHAR(prefix,len,t);
66: *ierr = RGAppendOptionsPrefix(*rg,t);if (*ierr) return;
67: FREECHAR(prefix,t);
68: }
70: SLEPC_EXTERN void rggetoptionsprefix_(RG *rg,char *prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
71: {
72: const char *tname;
74: *ierr = RGGetOptionsPrefix(*rg,&tname); if (*ierr) return;
75: *ierr = PetscStrncpy(prefix,tname,len);if (*ierr) return;
76: FIXRETURNCHAR(PETSC_TRUE,prefix,len);
77: }
79: SLEPC_EXTERN void rgdestroy_(RG *rg,PetscErrorCode *ierr)
80: {
81: PETSC_FORTRAN_OBJECT_F_DESTROYED_TO_C_NULL(rg);
82: *ierr = RGDestroy(rg); if (*ierr) return;
83: PETSC_FORTRAN_OBJECT_C_NULL_TO_F_DESTROYED(rg);
84: }
86: SLEPC_EXTERN void rgview_(RG *rg,PetscViewer *viewer,PetscErrorCode *ierr)
87: {
88: PetscViewer v;
89: PetscPatchDefaultViewers_Fortran(viewer,v);
90: *ierr = RGView(*rg,v);
91: }
93: SLEPC_EXTERN void rgviewfromoptions_(RG *rg,PetscObject obj,char* type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len)
94: {
95: char *t;
97: FIXCHAR(type,len,t);
98: CHKFORTRANNULLOBJECT(obj);
99: *ierr = RGViewFromOptions(*rg,obj,t);if (*ierr) return;
100: FREECHAR(type,t);
101: }