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