Actual source code: zeps.c
2: #include "src/fortran/custom/zpetsc.h"
3: #include slepceps.h
4: #include src/eps/epsimpl.h
6: #ifdef PETSC_HAVE_FORTRAN_CAPS
7: #define epsview_ EPSVIEW
8: #define epssetoptionsprefix_ EPSSETOPTIONSPREFIX
9: #define epsappendoptionsprefix_ EPSAPPENDOPTIONSPREFIX
10: #define epsgetoptionsprefix_ EPSGETOPTIONSPREFIX
11: #define epscreate_ EPSCREATE
12: #define epssettype_ EPSSETTYPE
13: #define epsgettype_ EPSGETTYPE
14: #define epsdefaultestimatesmonitor_ EPSDEFAULTESTIMATESMONITOR
15: #define epsdefaultvaluesmonitor_ EPSDEFAULTVALUESMONITOR
16: #define epssetmonitor_ EPSSETMONITOR
17: #define epssetvaluesmonitor_ EPSSETVALUESMONITOR
18: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
19: #define epsview_ epsview
20: #define epssetoptionsprefix_ ekepsview
21: #define epssetoptionsprefix_ epssetoptionsprefix
22: #define epsappendoptionsprefix_ epsappendoptionsprefix
23: #define epsgetoptionsprefix_ epsgetoptionsprefix
24: #define epscreate_ epscreate
25: #define epssettype_ epssettype
26: #define epsgettype_ epsgettype
27: #define epsdefaultestimatesmonitor_ epsdefaultestimatesmonitor
28: #define epsdefaultvaluesmonitor_ epsdefaultvaluesmonitor
29: #define epssetmonitor_ epssetmonitor
30: #define epssetvaluesmonitor_ epssetvaluesmonitor
31: #endif
33: EXTERN_C_BEGIN
35: void PETSC_STDCALL epsview_(EPS *eps,PetscViewer *viewer, int *ierr)
36: {
37: PetscViewer v;
38: PetscPatchDefaultViewers_Fortran(viewer,v);
39: *EPSView(*eps,v);
40: }
42: void PETSC_STDCALL epssettype_(EPS *eps,CHAR type PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
43: {
44: char *t;
46: FIXCHAR(type,len,t);
47: *EPSSetType(*eps,t);
48: FREECHAR(type,t);
49: }
51: void PETSC_STDCALL epsgettype_(EPS *eps,CHAR name PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
52: {
53: char *tname;
55: *EPSGetType(*eps,&tname);if (*ierr) return;
56: #if defined(PETSC_USES_CPTOFCD)
57: {
58: char *t = _fcdtocp(name); int len1 = _fcdlen(name);
59: *PetscStrncpy(t,tname,len1);
60: }
61: #else
62: *PetscStrncpy(name,tname,len);
63: #endif
64: }
66: void PETSC_STDCALL epssetoptionsprefix_(EPS *eps,CHAR prefix PETSC_MIXED_LEN(len),
67: int *ierr PETSC_END_LEN(len))
68: {
69: char *t;
71: FIXCHAR(prefix,len,t);
72: *EPSSetOptionsPrefix(*eps,t);
73: FREECHAR(prefix,t);
74: }
76: void PETSC_STDCALL epsappendoptionsprefix_(EPS *eps,CHAR prefix PETSC_MIXED_LEN(len),
77: int *ierr PETSC_END_LEN(len))
78: {
79: char *t;
81: FIXCHAR(prefix,len,t);
82: *EPSAppendOptionsPrefix(*eps,t);
83: FREECHAR(prefix,t);
84: }
86: void PETSC_STDCALL epscreate_(MPI_Comm *comm,EPS *eps,int *ierr){
87: *EPSCreate((MPI_Comm)PetscToPointerComm(*comm),eps);
88: }
90: /*
91: These are not usually called from Fortran but allow Fortran users
92: to transparently set these monitors from .F code
93:
94: functions, hence no STDCALL
95: */
96: void epsdefaultestimatesmonitor_(EPS *eps,int *it,int *nconv,PetscReal *errest,int *nest,void *ctx,int *ierr)
97: {
98: *EPSDefaultEstimatesMonitor(*eps,*it,*nconv,errest,*nest,ctx);
99: }
100:
101: void epsdefaultvaluesmonitor_(EPS *eps,int *it,int *nconv,PetscScalar *eigr,PetscScalar *eigi,int *neig,void *ctx,int *ierr)
102: {
103: *EPSDefaultValuesMonitor(*eps,*it,*nconv,eigr,eigi,*neig,ctx);
104: }
105:
106: static void (PETSC_STDCALL *f1)(EPS*,int*,int*,PetscReal*,int*,void*,int*);
107: static int ourmonitor(EPS eps,int i,int nc,PetscReal *d,int l,void* ctx)
108: {
109: int 0;
110: (*f1)(&eps,&i,&nc,d,&l,ctx,&ierr);
111: return 0;
112: }
114: void PETSC_STDCALL epssetmonitor_(EPS *eps,void (PETSC_STDCALL *monitor)(EPS*,int*,int*,PetscReal*,int*,void*,int*),
115: void *mctx,void (PETSC_STDCALL *monitordestroy)(void *,int *),int *ierr)
116: {
117: if ((void(*)())monitor == (void(*)())epsdefaultestimatesmonitor_) {
118: *EPSSetMonitor(*eps,EPSDefaultEstimatesMonitor,0);
119: } else {
120: f1 = monitor;
121: if (FORTRANNULLFUNCTION(monitordestroy)) {
122: *EPSSetMonitor(*eps,ourmonitor,mctx);
123: } else {
124: *EPSSetMonitor(*eps,ourmonitor,mctx);
125: }
126: }
127: }
129: static void (PETSC_STDCALL *f3)(EPS*,int*,int*,PetscScalar*,PetscScalar*,int*,void*,int*);
130: static int ourmonitor2(EPS eps,int i,int nc,PetscScalar *d1,PetscScalar *d2,int l,void* ctx)
131: {
132: int 0;
133: (*f3)(&eps,&i,&nc,d1,d2,&l,ctx,&ierr);
134: return 0;
135: }
137: void PETSC_STDCALL epssetvaluesmonitor_(EPS *eps,void (PETSC_STDCALL *monitor)(EPS*,int*,int*,PetscScalar*,PetscScalar*,int*,void*,int*),
138: void *mctx,void (PETSC_STDCALL *monitordestroy)(void *,int *),int *ierr)
139: {
140: if ((void(*)())monitor == (void(*)())epsdefaultvaluesmonitor_) {
141: *EPSSetValuesMonitor(*eps,EPSDefaultValuesMonitor,0);
142: } else {
143: f3 = monitor;
144: if (FORTRANNULLFUNCTION(monitordestroy)) {
145: *EPSSetValuesMonitor(*eps,ourmonitor2,mctx);
146: } else {
147: *EPSSetValuesMonitor(*eps,ourmonitor2,mctx);
148: }
149: }
150: }
152: void PETSC_STDCALL epsgetoptionsprefix_(EPS *eps,CHAR prefix PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
153: {
154: char *tname;
156: *EPSGetOptionsPrefix(*eps,&tname);
157: #if defined(PETSC_USES_CPTOFCD)
158: {
159: char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
160: *PetscStrncpy(t,tname,len1); if (*ierr) return;
161: }
162: #else
163: *PetscStrncpy(prefix,tname,len); if (*ierr) return;
164: #endif
165: }
167: EXTERN_C_END