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