|
/*
|
|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
SLEPc - Scalable Library for Eigenvalue Problem Computations
|
|
Copyright (c) 2002-2007, Universidad Politecnica de Valencia, Spain
|
|
|
|
This file is part of SLEPc. See the README file for conditions of use
|
|
and additional information.
|
|
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
*/
|
|
|
#include "zpetsc.h"
|
#include "zpetsc.h"
|
#include "slepceps.h"
|
#include "slepceps.h"
|
#include "src/eps/epsimpl.h"
|
#include "src/eps/epsimpl.h"
|
|
|
#ifdef PETSC_HAVE_FORTRAN_CAPS
|
#ifdef PETSC_HAVE_FORTRAN_CAPS
|
#define epsview_ EPSVIEW
|
#define epsview_ EPSVIEW
|
#define epssetoptionsprefix_ EPSSETOPTIONSPREFIX
|
#define epssetoptionsprefix_ EPSSETOPTIONSPREFIX
|
#define epsappendoptionsprefix_ EPSAPPENDOPTIONSPREFIX
|
#define epsappendoptionsprefix_ EPSAPPENDOPTIONSPREFIX
|
#define epsgetoptionsprefix_ EPSGETOPTIONSPREFIX
|
#define epsgetoptionsprefix_ EPSGETOPTIONSPREFIX
|
#define epscreate_ EPSCREATE
|
#define epscreate_ EPSCREATE
|
#define epssettype_ EPSSETTYPE
|
#define epssettype_ EPSSETTYPE
|
#define epsgettype_ EPSGETTYPE
|
#define epsgettype_ EPSGETTYPE
|
#define epsmonitordefault_ EPSMONITORDEFAULT
|
#define epsmonitordefault_ EPSMONITORDEFAULT
|
#define epsmonitorlg_ EPSMONITORLG
|
#define epsmonitorlg_ EPSMONITORLG
|
#define epsmonitorset_ EPSMONITORSET
|
#define epsmonitorset_ EPSMONITORSET
|
#define epsgetst_ EPSGETST
|
#define epsgetst_ EPSGETST
|
#define epsgetip_ EPSGETIP
|
#define epsgetip_ EPSGETIP
|
#define epsgetwhicheigenpairs_ EPSGETWHICHEIGENPAIRS
|
#define epsgetwhicheigenpairs_ EPSGETWHICHEIGENPAIRS
|
#define epsgetproblemtype_ EPSGETPROBLEMTYPE
|
#define epsgetproblemtype_ EPSGETPROBLEMTYPE
|
#define epsgetclass_ EPSGETCLASS
|
#define epsgetclass_ EPSGETCLASS
|
#define epsgetconvergedreason_ EPSGETCONVERGEDREASON
|
#define epsgetconvergedreason_ EPSGETCONVERGEDREASON
|
#define epspowergetshifttype_ EPSPOWERGETSHIFTTYPE
|
#define epspowergetshifttype_ EPSPOWERGETSHIFTTYPE
|
#define epslanczosgetreorthog_ EPSLANCZOSGETREORTHOG
|
#define epslanczosgetreorthog_ EPSLANCZOSGETREORTHOG
|
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
|
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
|
#define epsview_ epsview
|
#define epsview_ epsview
|
#define epssetoptionsprefix_ epssetoptionsprefix
|
#define epssetoptionsprefix_ epssetoptionsprefix
|
#define epsappendoptionsprefix_ epsappendoptionsprefix
|
#define epsappendoptionsprefix_ epsappendoptionsprefix
|
#define epsgetoptionsprefix_ epsgetoptionsprefix
|
#define epsgetoptionsprefix_ epsgetoptionsprefix
|
#define epscreate_ epscreate
|
#define epscreate_ epscreate
|
#define epssettype_ epssettype
|
#define epssettype_ epssettype
|
#define epsgettype_ epsgettype
|
#define epsgettype_ epsgettype
|
#define epsmonitordefault_ epsmonitordefault
|
#define epsmonitordefault_ epsmonitordefault
|
#define epsmonitorlg_ epsmonitorlg
|
#define epsmonitorlg_ epsmonitorlg
|
#define epsmonitorset_ epsmonitorset
|
#define epsmonitorset_ epsmonitorset
|
#define epsgetst_ epsgetst
|
#define epsgetst_ epsgetst
|
#define epsgetip_ epsgetip
|
#define epsgetip_ epsgetip
|
#define epsgetwhicheigenpairs_ epsgetwhicheigenpairs
|
#define epsgetwhicheigenpairs_ epsgetwhicheigenpairs
|
#define epsgetproblemtype_ epsgetproblemtype
|
#define epsgetproblemtype_ epsgetproblemtype
|
#define epsgetclass_ epsgetclass
|
#define epsgetclass_ epsgetclass
|
#define epsgetconvergedreason_ epsgetconvergedreason
|
#define epsgetconvergedreason_ epsgetconvergedreason
|
#define epspowergetshifttype_ epspowergetshifttype
|
#define epspowergetshifttype_ epspowergetshifttype
|
#define epslanczosgetreorthog_ epslanczosgetreorthog
|
#define epslanczosgetreorthog_ epslanczosgetreorthog
|
#endif
|
#endif
|
|
|
EXTERN_C_BEGIN
|
EXTERN_C_BEGIN
|
static void (PETSC_STDCALL *f1)(EPS*,int*,int*,PetscScalar*,PetscScalar*,PetscReal*,int*,void*,PetscErrorCode*);
|
static void (PETSC_STDCALL *f1)(EPS*,int*,int*,PetscScalar*,PetscScalar*,PetscReal*,int*,void*,PetscErrorCode*);
|
static void (PETSC_STDCALL *f2)(void*,PetscErrorCode*);
|
static void (PETSC_STDCALL *f2)(void*,PetscErrorCode*);
|
|
|
/*
|
/*
|
These are not usually called from Fortran but allow Fortran users
|
These are not usually called from Fortran but allow Fortran users
|
to transparently set these monitors from .F code, hence no STDCALL
|
to transparently set these monitors from .F code, hence no STDCALL
|
*/
|
*/
|
void epsmonitordefault_(EPS *eps,int *it,int *nconv,PetscScalar *eigr,PetscScalar *eigi,PetscReal *errest,int *nest,void *ctx,PetscErrorCode *ierr)
|
void epsmonitordefault_(EPS *eps,int *it,int *nconv,PetscScalar *eigr,PetscScalar *eigi,PetscReal *errest,int *nest,void *ctx,PetscErrorCode *ierr)
|
{
|
{
|
*ierr = EPSMonitorDefault(*eps,*it,*nconv,eigr,eigi,errest,*nest,ctx);
|
*ierr = EPSMonitorDefault(*eps,*it,*nconv,eigr,eigi,errest,*nest,ctx);
|
}
|
}
|
|
|
void epsmonitorlg_(EPS *eps,int *it,int *nconv,PetscScalar *eigr,PetscScalar *eigi,PetscReal *errest,int *nest,void *ctx,PetscErrorCode *ierr)
|
void epsmonitorlg_(EPS *eps,int *it,int *nconv,PetscScalar *eigr,PetscScalar *eigi,PetscReal *errest,int *nest,void *ctx,PetscErrorCode *ierr)
|
{
|
{
|
*ierr = EPSMonitorLG(*eps,*it,*nconv,eigr,eigi,errest,*nest,ctx);
|
*ierr = EPSMonitorLG(*eps,*it,*nconv,eigr,eigi,errest,*nest,ctx);
|
}
|
}
|
EXTERN_C_END
|
EXTERN_C_END
|
|
|
/* These are not extern C because they are passed into non-extern C user level functions */
|
/* These are not extern C because they are passed into non-extern C user level functions */
|
static PetscErrorCode ourmonitor(EPS eps,int i,int nc,PetscScalar *er,PetscScalar *ei,PetscReal *d,int l,void* ctx)
|
static PetscErrorCode ourmonitor(EPS eps,int i,int nc,PetscScalar *er,PetscScalar *ei,PetscReal *d,int l,void* ctx)
|
{
|
{
|
PetscErrorCode ierr = 0;
|
PetscErrorCode ierr = 0;
|
(*f1)(&eps,&i,&nc,er,ei,d,&l,ctx,&ierr);CHKERRQ(ierr);
|
(*f1)(&eps,&i,&nc,er,ei,d,&l,ctx,&ierr);CHKERRQ(ierr);
|
return 0;
|
return 0;
|
}
|
}
|
|
|
static PetscErrorCode ourdestroy(void* ctx)
|
static PetscErrorCode ourdestroy(void* ctx)
|
{
|
{
|
PetscErrorCode ierr = 0;
|
PetscErrorCode ierr = 0;
|
(*f2)(ctx,&ierr);CHKERRQ(ierr);
|
(*f2)(ctx,&ierr);CHKERRQ(ierr);
|
return 0;
|
return 0;
|
}
|
}
|
|
|
EXTERN_C_BEGIN
|
EXTERN_C_BEGIN
|
|
|
void PETSC_STDCALL epsview_(EPS *eps,PetscViewer *viewer, PetscErrorCode *ierr)
|
void PETSC_STDCALL epsview_(EPS *eps,PetscViewer *viewer, PetscErrorCode *ierr)
|
{
|
{
|
PetscViewer v;
|
PetscViewer v;
|
PetscPatchDefaultViewers_Fortran(viewer,v);
|
PetscPatchDefaultViewers_Fortran(viewer,v);
|
*ierr = EPSView(*eps,v);
|
*ierr = EPSView(*eps,v);
|
}
|
}
|
|
|
void PETSC_STDCALL epssettype_(EPS *eps,CHAR type PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
|
void PETSC_STDCALL epssettype_(EPS *eps,CHAR type PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
|
{
|
{
|
char *t;
|
char *t;
|
|
|
FIXCHAR(type,len,t);
|
FIXCHAR(type,len,t);
|
*ierr = EPSSetType(*eps,t);
|
*ierr = EPSSetType(*eps,t);
|
FREECHAR(type,t);
|
FREECHAR(type,t);
|
}
|
}
|
|
|
void PETSC_STDCALL epsgettype_(EPS *eps,CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
|
void PETSC_STDCALL epsgettype_(EPS *eps,CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
|
{
|
{
|
const char *tname;
|
const char *tname;
|
|
|
*ierr = EPSGetType(*eps,&tname);if (*ierr) return;
|
*ierr = EPSGetType(*eps,&tname);if (*ierr) return;
|
#if defined(PETSC_USES_CPTOFCD)
|
#if defined(PETSC_USES_CPTOFCD)
|
{
|
{
|
char *t = _fcdtocp(name); int len1 = _fcdlen(name);
|
char *t = _fcdtocp(name); int len1 = _fcdlen(name);
|
*ierr = PetscStrncpy(t,tname,len1);
|
*ierr = PetscStrncpy(t,tname,len1);
|
}
|
}
|
#else
|
#else
|
*ierr = PetscStrncpy(name,tname,len);
|
*ierr = PetscStrncpy(name,tname,len);
|
#endif
|
#endif
|
FIXRETURNCHAR(name,len);
|
FIXRETURNCHAR(name,len);
|
}
|
}
|
|
|
void PETSC_STDCALL epssetoptionsprefix_(EPS *eps,CHAR prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
|
void PETSC_STDCALL epssetoptionsprefix_(EPS *eps,CHAR prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
|
{
|
{
|
char *t;
|
char *t;
|
|
|
FIXCHAR(prefix,len,t);
|
FIXCHAR(prefix,len,t);
|
*ierr = EPSSetOptionsPrefix(*eps,t);
|
*ierr = EPSSetOptionsPrefix(*eps,t);
|
FREECHAR(prefix,t);
|
FREECHAR(prefix,t);
|
}
|
}
|
|
|
void PETSC_STDCALL epsappendoptionsprefix_(EPS *eps,CHAR prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
|
void PETSC_STDCALL epsappendoptionsprefix_(EPS *eps,CHAR prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
|
{
|
{
|
char *t;
|
char *t;
|
|
|
FIXCHAR(prefix,len,t);
|
FIXCHAR(prefix,len,t);
|
*ierr = EPSAppendOptionsPrefix(*eps,t);
|
*ierr = EPSAppendOptionsPrefix(*eps,t);
|
FREECHAR(prefix,t);
|
FREECHAR(prefix,t);
|
}
|
}
|
|
|
void PETSC_STDCALL epscreate_(MPI_Fint *comm,EPS *eps,PetscErrorCode *ierr)
|
void PETSC_STDCALL epscreate_(MPI_Fint *comm,EPS *eps,PetscErrorCode *ierr)
|
{
|
{
|
*ierr = EPSCreate(MPI_Comm_f2c(*(comm)),eps);
|
*ierr = EPSCreate(MPI_Comm_f2c(*(comm)),eps);
|
}
|
}
|
|
|
void PETSC_STDCALL epsmonitorset_(EPS *eps,void (PETSC_STDCALL *monitor)(EPS*,int*,int*,PetscScalar*,PetscScalar*,PetscReal*,int*,void*,PetscErrorCode*),
|
void PETSC_STDCALL epsmonitorset_(EPS *eps,void (PETSC_STDCALL *monitor)(EPS*,int*,int*,PetscScalar*,PetscScalar*,PetscReal*,int*,void*,PetscErrorCode*),
|
void *mctx,void (PETSC_STDCALL *monitordestroy)(void *,PetscErrorCode *),PetscErrorCode *ierr)
|
void *mctx,void (PETSC_STDCALL *monitordestroy)(void *,PetscErrorCode *),PetscErrorCode *ierr)
|
{
|
{
|
if ((void(*)())monitor == (void(*)())epsmonitordefault_) {
|
if ((void(*)())monitor == (void(*)())epsmonitordefault_) {
|
*ierr = EPSMonitorSet(*eps,EPSMonitorDefault,0,0);
|
*ierr = EPSMonitorSet(*eps,EPSMonitorDefault,0,0);
|
} else if ((void(*)())monitor == (void(*)())epsmonitorlg_) {
|
} else if ((void(*)())monitor == (void(*)())epsmonitorlg_) {
|
*ierr = EPSMonitorSet(*eps,EPSMonitorLG,0,0);
|
*ierr = EPSMonitorSet(*eps,EPSMonitorLG,0,0);
|
} else {
|
} else {
|
f1 = monitor;
|
f1 = monitor;
|
if (FORTRANNULLFUNCTION(monitordestroy)) {
|
if (FORTRANNULLFUNCTION(monitordestroy)) {
|
*ierr = EPSMonitorSet(*eps,ourmonitor,mctx,0);
|
*ierr = EPSMonitorSet(*eps,ourmonitor,mctx,0);
|
} else {
|
} else {
|
f2 = monitordestroy;
|
f2 = monitordestroy;
|
*ierr = EPSMonitorSet(*eps,ourmonitor,mctx,ourdestroy);
|
*ierr = EPSMonitorSet(*eps,ourmonitor,mctx,ourdestroy);
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
void PETSC_STDCALL epsgetoptionsprefix_(EPS *eps,CHAR prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
|
void PETSC_STDCALL epsgetoptionsprefix_(EPS *eps,CHAR prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
|
{
|
{
|
const char *tname;
|
const char *tname;
|
|
|
*ierr = EPSGetOptionsPrefix(*eps,&tname);
|
*ierr = EPSGetOptionsPrefix(*eps,&tname);
|
#if defined(PETSC_USES_CPTOFCD)
|
#if defined(PETSC_USES_CPTOFCD)
|
{
|
{
|
char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
|
char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
|
*ierr = PetscStrncpy(t,tname,len1); if (*ierr) return;
|
*ierr = PetscStrncpy(t,tname,len1); if (*ierr) return;
|
}
|
}
|
#else
|
#else
|
*ierr = PetscStrncpy(prefix,tname,len); if (*ierr) return;
|
*ierr = PetscStrncpy(prefix,tname,len); if (*ierr) return;
|
#endif
|
#endif
|
FIXRETURNCHAR(prefix,len);
|
FIXRETURNCHAR(prefix,len);
|
}
|
}
|
|
|
void PETSC_STDCALL epsgetst_(EPS *eps,ST *st,int *ierr)
|
void PETSC_STDCALL epsgetst_(EPS *eps,ST *st,int *ierr)
|
{
|
{
|
*ierr = EPSGetST(*eps,st);
|
*ierr = EPSGetST(*eps,st);
|
}
|
}
|
|
|
void PETSC_STDCALL epsgetip_(EPS *eps,IP *ip,int *ierr)
|
void PETSC_STDCALL epsgetip_(EPS *eps,IP *ip,int *ierr)
|
{
|
{
|
*ierr = EPSGetIP(*eps,ip);
|
*ierr = EPSGetIP(*eps,ip);
|
}
|
}
|
|
|
void PETSC_STDCALL epsgetwhicheigenpairs_(EPS *eps,EPSWhich *which,int *ierr)
|
void PETSC_STDCALL epsgetwhicheigenpairs_(EPS *eps,EPSWhich *which,int *ierr)
|
{
|
{
|
*ierr = EPSGetWhichEigenpairs(*eps,which);
|
*ierr = EPSGetWhichEigenpairs(*eps,which);
|
}
|
}
|
|
|
void PETSC_STDCALL epsgetproblemtype_(EPS *eps,EPSProblemType *type,int *ierr)
|
void PETSC_STDCALL epsgetproblemtype_(EPS *eps,EPSProblemType *type,int *ierr)
|
{
|
{
|
*ierr = EPSGetProblemType(*eps,type);
|
*ierr = EPSGetProblemType(*eps,type);
|
}
|
}
|
|
|
void PETSC_STDCALL epsgetclass_(EPS *eps,EPSClass *cl,int *ierr)
|
void PETSC_STDCALL epsgetclass_(EPS *eps,EPSClass *cl,int *ierr)
|
{
|
{
|
*ierr = EPSGetClass(*eps,cl);
|
*ierr = EPSGetClass(*eps,cl);
|
}
|
}
|
|
|
void PETSC_STDCALL epsgetconvergedreason_(EPS *eps,EPSConvergedReason *reason,int *ierr)
|
void PETSC_STDCALL epsgetconvergedreason_(EPS *eps,EPSConvergedReason *reason,int *ierr)
|
{
|
{
|
*ierr = EPSGetConvergedReason(*eps,reason);
|
*ierr = EPSGetConvergedReason(*eps,reason);
|
}
|
}
|
|
|
void PETSC_STDCALL epspowergetshifttype_(EPS *eps,EPSPowerShiftType *shift,int *ierr)
|
void PETSC_STDCALL epspowergetshifttype_(EPS *eps,EPSPowerShiftType *shift,int *ierr)
|
{
|
{
|
*ierr = EPSPowerGetShiftType(*eps,shift);
|
*ierr = EPSPowerGetShiftType(*eps,shift);
|
}
|
}
|
|
|
void PETSC_STDCALL epslanczosgetreorthog_(EPS *eps,EPSLanczosReorthogType *reorthog,int *ierr)
|
void PETSC_STDCALL epslanczosgetreorthog_(EPS *eps,EPSLanczosReorthogType *reorthog,int *ierr)
|
{
|
{
|
*ierr = EPSLanczosGetReorthog(*eps,reorthog);
|
*ierr = EPSLanczosGetReorthog(*eps,reorthog);
|
}
|
}
|
EXTERN_C_END
|
EXTERN_C_END
|
|
|
|
|
|
|