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_ epssetoptionsprefix
21: #define epsappendoptionsprefix_ epsappendoptionsprefix
22: #define epsgetoptionsprefix_ epsgetoptionsprefix
23: #define epscreate_ epscreate
24: #define epssettype_ epssettype
25: #define epsgettype_ epsgettype
26: #define epsdefaultestimatesmonitor_ epsdefaultestimatesmonitor
27: #define epsdefaultvaluesmonitor_ epsdefaultvaluesmonitor
28: #define epssetmonitor_ epssetmonitor
29: #define epssetvaluesmonitor_ epssetvaluesmonitor
30: #endif
32: EXTERN_C_BEGIN
34: void PETSC_STDCALL epsview_(EPS *eps,PetscViewer *viewer, PetscErrorCode *ierr)
35: {
36: PetscViewer v;
37: PetscPatchDefaultViewers_Fortran(viewer,v);
38: *EPSView(*eps,v);
39: }
41: void PETSC_STDCALL epssettype_(EPS *eps,CHAR type PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
42: {
43: char *t;
45: FIXCHAR(type,len,t);
46: *EPSSetType(*eps,t);
47: FREECHAR(type,t);
48: }
50: void PETSC_STDCALL epsgettype_(EPS *eps,CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
51: {
52: char *tname;
54: *EPSGetType(*eps,&tname);if (*ierr) return;
55: #if defined(PETSC_USES_CPTOFCD)
56: {
57: char *t = _fcdtocp(name); int len1 = _fcdlen(name);
58: *PetscStrncpy(t,tname,len1);
59: }
60: #else
61: *PetscStrncpy(name,tname,len);
62: #endif
63: FIXRETURNCHAR(name,len);
64: }
66: void PETSC_STDCALL epssetoptionsprefix_(EPS *eps,CHAR prefix PETSC_MIXED_LEN(len),
67: PetscErrorCode *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: PetscErrorCode *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,PetscErrorCode *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 epsdefaultmonitor_(EPS *eps,int *it,int *nconv,PetscScalar *eigr,PetscScalar *eigi,PetscReal *errest,int *nest,void *ctx,PetscErrorCode *ierr)
97: {
98: *EPSDefaultMonitor(*eps,*it,*nconv,eigr,eigi,errest,*nest,ctx);
99: }
100:
101: static void (PETSC_STDCALL *f1)(EPS*,int*,int*,PetscScalar*,PetscScalar*,PetscReal*,int*,void*,int*);
102: static int ourmonitor(EPS eps,int i,int nc,PetscScalar *er,PetscScalar *ei,PetscReal *d,int l,void* ctx)
103: {
104: int 0;
105: (*f1)(&eps,&i,&nc,er,ei,d,&l,ctx,&ierr);
106: return 0;
107: }
109: void PETSC_STDCALL epssetmonitor_(EPS *eps,void (PETSC_STDCALL *monitor)(EPS*,int*,int*,PetscScalar*,PetscScalar*,PetscReal*,int*,void*,int*),
110: void *mctx,void (PETSC_STDCALL *monitordestroy)(void *,int *),PetscErrorCode *ierr)
111: {
112: if ((void(*)())monitor == (void(*)())epsdefaultmonitor_) {
113: *EPSSetMonitor(*eps,EPSDefaultMonitor,0);
114: } else {
115: f1 = monitor;
116: if (FORTRANNULLFUNCTION(monitordestroy)) {
117: *EPSSetMonitor(*eps,ourmonitor,mctx);
118: } else {
119: *EPSSetMonitor(*eps,ourmonitor,mctx);
120: }
121: }
122: }
124: void PETSC_STDCALL epsgetoptionsprefix_(EPS *eps,CHAR prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
125: {
126: char *tname;
128: *EPSGetOptionsPrefix(*eps,&tname);
129: #if defined(PETSC_USES_CPTOFCD)
130: {
131: char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
132: *PetscStrncpy(t,tname,len1); if (*ierr) return;
133: }
134: #else
135: *PetscStrncpy(prefix,tname,len); if (*ierr) return;
136: #endif
137: FIXRETURNCHAR(prefix,len);
138: }
140: EXTERN_C_END