Subversion Repositories slepc-dev

Compare Revisions

Ignore whitespace Rev 1410 → Rev 1411

/tags/slepc-2_3_3-1/bmake/slepc_common_variables New file
0,0 → 1,22
include ${PETSC_DIR}/bmake/common/variables
include ${SLEPC_DIR}/bmake/${PETSC_ARCH}/slepcconf
 
SLEPC_LIB_DIR = ${SLEPC_DIR}/lib/${PETSC_ARCH}
SLEPC_INCLUDE = -I${SLEPC_DIR} -I${SLEPC_DIR}/include
CC_INCLUDES = ${PETSC_INCLUDE} ${SLEPC_INCLUDE}
FC_INCLUDES = ${PETSC_INCLUDE} ${SLEPC_INCLUDE}
 
PCONF = ${SLEPC_HAVE_ARPACK} ${SLEPC_HAVE_BLZPACK} ${SLEPC_HAVE_PLANSO} ${SLEPC_HAVE_TRLAN} ${SLEPC_MISSING_LAPACK} ${SLEPC_HAVE_PRIMME}
SLEPC_EXTERNAL_LIB = ${ARPACK_LIB} ${BLZPACK_LIB} ${PLANSO_LIB} ${TRLAN_LIB} ${PRIMME_LIB}
 
INSTALL_LIB_DIR = ${SLEPC_LIB_DIR}
CCPPFLAGS = ${PETSC_CCPPFLAGS} ${SLEPC_INCLUDE} ${PCONF}
FCPPFLAGS = ${PETSC_FCPPFLAGS} ${SLEPC_INCLUDE} ${PCONF}
 
SLEPC_LIB = ${CC_LINKER_SLFLAG}${SLEPC_LIB_DIR} -L${SLEPC_LIB_DIR} -lslepc ${SLEPC_EXTERNAL_LIB} ${PETSC_KSP_LIB}
 
# no longer required
SLEPC_FORTRAN_LIB =
 
SHLIBS = libslepc
 
tags/slepc-2_3_3-1/bmake/slepc_common_variables Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/bmake/slepc_common_rules New file
0,0 → 1,76
include ${PETSC_DIR}/bmake/common/rules
 
chkslepc_dir:
@mypwd=`pwd`; cd ${true_SLEPC_DIR} 2>&1 > /dev/null; true_SLEPC_DIR=`pwd`; cd $${mypwd} 2>&1 >/dev/null; \
newpwd=`echo $${mypwd} | sed "s+$${true_SLEPC_DIR}+DUMMY+g"`;\
hasslepc=`echo $${mypwd} | sed "s+slepc-+DUMMY+g"`;\
if [ $${mypwd} = $${newpwd} -a $${hasslepc} != $${mypwd} ]; then \
echo "*********************Warning*************************" ; \
echo "Your true_SLEPC_DIR may not match the directory you are in";\
echo "true_SLEPC_DIR " $${true_SLEPC_DIR} "Current directory" $${mypwd};\
echo "******************************************************" ; \
fi
 
slepc_manualpages:
-@if [ "${MANSEC}" != "" ] ; then \
DOCTEXT_PATH=${PETSC_DIR}/src/docs/tex/doctext; export DOCTEXT_PATH; \
${DOCTEXT} -html \
-mpath ${LOC}/docs/manualpages/${MANSEC} -heading SLEPc \
-defn ${SLEPC_DIR}/src/docs/tex/doctext/html.def \
-locdir ${LOCDIR} -mapref ${LOC}/docs/manualpages/manualpages.cit \
${SOURCEC} ${SOURCEH}; \
chmod -f g+w ${LOC}/docs/manualpages/${MANSEC}/* ; fi
 
slepc_html:
-@sed -e s?man+../?man+ROOT/docs/manualpages/? ${LOC}/docs/manualpages/manualpages.cit > /tmp/$$USER.htmlmap
-@cat ${PETSC_DIR}/src/docs/mpi.www.index >> /tmp/$$USER.htmlmap
-@ROOT=`echo ${LOCDIR} | sed -e s?/[a-z]*?/..?g -e s?src/??g -e s?include/??g` ;\
loc=`pwd | sed -e s?\$${PETSC_DIR}?$${LOC}/?g -e s?/disks??g`; \
${MKDIR} -p $${loc} ;\
for i in ${SOURCEC} ${SOURCEF} ${SOURCEH} ${EXAMPLESC} ${EXAMPLESF} ${EXAMPLESCH} ${EXAMPLESFH} ${EXAMPLESMATLAB} foo ; do\
if [ -f $$i ]; then \
iroot=`echo $$i | sed -e "s?[a-z.]*/??g"`;\
IROOT=`echo $${i} | sed -e s?[.][.]??g` ;\
if [ "$${IROOT}" != "$${i}" ] ; then \
IROOT=".."; \
else \
IROOT=$${ROOT};\
fi;\
${RM} $${loc}/$$i.html; \
echo "<center><a href=\"$${iroot}\">Actual source code: $${iroot}</a></center><br>" > $${loc}/$$i.html; \
sed -e "s/CHKERRQ(ierr);//g" -e "s/PetscFunctionReturn(0)/return(0)/g" \
-e "s/ierr [ ]*= //g" $$i | ${C2HTML} -n | ${PETSC_DIR}/maint/fixinclude $$i $${ROOT} | \
egrep -v '(PetscValid|PetscFunctionBegin|PetscCheck|PetscErrorCode ierr;|#if !defined\(__|#define __|#undef __|EXTERN_C|extern )' | \
${MAPNAMES} -map /tmp/$$USER.htmlmap -inhtml | sed -e s?ROOT?$${IROOT}?g >> $${loc}/$$i.html ; \
fi; \
done
-@ROOT=`echo ${LOCDIR} | sed -e s?/[a-z]*?/..?g -e s?src/??g -e s?include/??g` ;\
loc=`pwd | sed -e s?\$${PETSC_DIR}?$${LOC}/?g -e s?/disks??g`; ${RM} $${loc}/index.html; \
cat ${SLEPC_DIR}/src/docs/manualpages-sec/header_${MANSEC} | sed -e "s?<A HREF=\"PETSC_DIR[a-z/]*\">Examples</A>?<A HREF=\"$${ROOT}/docs/manualpages/${MANSEC}\">Manual pages</A>?g" -e "s?PETSC_DIR?$${ROOT}/?g"> $${loc}/index.html; \
echo "<p>" >> $${loc}/index.html
-@loc=`pwd | sed -e s?\$${PETSC_DIR}?$${LOC}/?g -e s?/disks??g`;\
if [ "${EXAMPLESC}" != "" ] ; then \
for file in ${EXAMPLESC} foo ; do \
if [ -f $$file ]; then \
cmess=`grep "static char help" $${file} | cut -d\" -f2 | cut -d\. -f1`; \
echo "<a href=\"$${file}.html\">$${file}: $${cmess}</a><br>" >> $${loc}/index.html;\
fi; \
done ;\
else \
for file in ${DIRS} foo; do \
if [ -d $$file ]; then \
echo "<a href=\"$${file}/\">$${file}/</a><br>" >> $${loc}/index.html; \
fi; \
done; \
echo " " >> $${loc}/index.html; \
for file in ${SOURCEH} ${SOURCEC} ${SOURCEF} foo ; do \
if [ -f $$file ]; then \
echo "<a href=\"$${file}.html\">$${file}</a><br>" >> $${loc}/index.html; \
fi; \
done; \
fi ;\
echo " " >> $${loc}/index.html; \
echo "<a href=\"makefile.html\">makefile</a><br>" >> $${loc}/index.html
-@loc=`pwd | sed -e s?\$${PETSC_DIR}?$${LOC}/?g -e s?/disks??g`; \
cat makefile | ${C2HTML} | ${MAPNAMES} -map /tmp/$$USER.htmlmap -inhtml > $${loc}/makefile.html
-@${RM} /tmp/$$USER.htmlmap tmp
tags/slepc-2_3_3-1/bmake/slepc_common_rules Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/bmake/slepc_common New file
0,0 → 1,18
#
# SLEPc uses the portable makefile system provided by the PETSc library.
# The following include files set customized site, optimization, and version
# options. Do NOT remove any of these include files! You should generally
# need to edit only ${SLEPC_DIR}/bmake/${PETSC_ARCH}/packages to specify the
# packages installed in your system.
#
#
# a dummy target which does nothing - just in case
# 'ALL: get mapped into this file'
#
all_dummy:
-@true
 
include ${SLEPC_DIR}/bmake/slepc_common_variables
include ${SLEPC_DIR}/bmake/slepc_common_rules
include ${PETSC_DIR}/bmake/common/test
 
tags/slepc-2_3_3-1/bmake/slepc_common Property changes : Added: svn:eol-style
+ native
tags/slepc-2_3_3-1/bmake Property changes : Added: svn:ignore
+ linux*
darwin*
/tags/slepc-2_3_3-1/include/slepcversion.h New file
0,0 → 1,28
/*
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
 
#if !defined(__SLEPCVERSION_H)
#define __SLEPCVERSION_H
 
/* ========================================================================== */
/*
Current SLEPC version number and release date
*/
#define SLEPC_VERSION_RELEASE 1
#define SLEPC_VERSION_MAJOR 2
#define SLEPC_VERSION_MINOR 3
#define SLEPC_VERSION_SUBMINOR 3
#define SLEPC_VERSION_PATCH 1
#define SLEPC_VERSION_DATE "June 1, 2007"
#define SLEPC_VERSION_PATCH_DATE "July 5, 2007"
#define SLEPC_AUTHOR_INFO " The SLEPc Team\n\
slepc-maint@grycap.upv.es\n\
http://www.grycap.upv.es/slepc\n"
#endif
tags/slepc-2_3_3-1/include/slepcversion.h Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/include/slepcst.h New file
0,0 → 1,117
/*
Spectral transformation module for eigenvalue problems.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
 
#if !defined(__SLEPCST_H)
#define __SLEPCST_H
#include "petscksp.h"
PETSC_EXTERN_CXX_BEGIN
 
extern PetscCookie ST_COOKIE;
 
/*S
ST - Abstract SLEPc object that manages spectral transformations.
This object is accessed only in advanced applications.
 
Level: beginner
 
.seealso: STCreate(), EPS
S*/
typedef struct _p_ST* ST;
 
/*E
STType - String with the name of a SLEPc spectral transformation
 
Level: beginner
 
.seealso: STSetType(), ST
E*/
#define STType const char*
#define STSHELL "shell"
#define STSHIFT "shift"
#define STSINV "sinvert"
#define STCAYLEY "cayley"
#define STFOLD "fold"
 
EXTERN PetscErrorCode STCreate(MPI_Comm,ST*);
EXTERN PetscErrorCode STDestroy(ST);
EXTERN PetscErrorCode STSetType(ST,STType);
EXTERN PetscErrorCode STGetType(ST,STType*);
EXTERN PetscErrorCode STSetOperators(ST,Mat,Mat);
EXTERN PetscErrorCode STGetOperators(ST,Mat*,Mat*);
EXTERN PetscErrorCode STSetUp(ST);
EXTERN PetscErrorCode STSetFromOptions(ST);
EXTERN PetscErrorCode STView(ST,PetscViewer);
 
EXTERN PetscErrorCode STApply(ST,Vec,Vec);
EXTERN PetscErrorCode STGetBilinearForm(ST,Mat*);
EXTERN PetscErrorCode STApplyTranspose(ST,Vec,Vec);
EXTERN PetscErrorCode STComputeExplicitOperator(ST,Mat*);
EXTERN PetscErrorCode STPostSolve(ST);
 
EXTERN PetscErrorCode STInitializePackage(char*);
 
EXTERN PetscErrorCode STSetKSP(ST,KSP);
EXTERN PetscErrorCode STGetKSP(ST,KSP*);
EXTERN PetscErrorCode STAssociatedKSPSolve(ST,Vec,Vec);
EXTERN PetscErrorCode STSetShift(ST,PetscScalar);
EXTERN PetscErrorCode STGetShift(ST,PetscScalar*);
 
EXTERN PetscErrorCode STSetOptionsPrefix(ST,const char*);
EXTERN PetscErrorCode STAppendOptionsPrefix(ST,const char*);
EXTERN PetscErrorCode STGetOptionsPrefix(ST,const char*[]);
 
EXTERN PetscErrorCode STBackTransform(ST,PetscScalar*,PetscScalar*);
 
EXTERN PetscErrorCode STCheckNullSpace(ST,int,const Vec[]);
 
EXTERN PetscErrorCode STGetOperationCounters(ST,int*,int*);
EXTERN PetscErrorCode STResetOperationCounters(ST);
 
/*E
STMatMode - determines how to handle the coefficient matrix associated
to the spectral transformation
 
Level: intermediate
 
.seealso: STSetMatMode(), STGetMatMode()
E*/
typedef enum { STMATMODE_COPY, STMATMODE_INPLACE,
STMATMODE_SHELL } STMatMode;
EXTERN PetscErrorCode STSetMatMode(ST,STMatMode);
EXTERN PetscErrorCode STGetMatMode(ST,STMatMode*);
EXTERN PetscErrorCode STSetMatStructure(ST,MatStructure);
 
EXTERN PetscErrorCode STRegister(const char*,const char*,const char*,int(*)(ST));
#if defined(PETSC_USE_DYNAMIC_LIBRARIES)
#define STRegisterDynamic(a,b,c,d) STRegister(a,b,c,0)
#else
#define STRegisterDynamic(a,b,c,d) STRegister(a,b,c,d)
#endif
EXTERN PetscErrorCode STRegisterDestroy(void);
 
/* --------- options specific to particular spectral transformations-------- */
 
EXTERN PetscErrorCode STShellGetContext(ST st,void **ctx);
EXTERN PetscErrorCode STShellSetContext(ST st,void *ctx);
EXTERN PetscErrorCode STShellSetApply(ST st,PetscErrorCode (*apply)(void*,Vec,Vec));
EXTERN PetscErrorCode STShellSetApplyTranspose(ST st,PetscErrorCode (*applytrans)(void*,Vec,Vec));
EXTERN PetscErrorCode STShellSetBackTransform(ST st,PetscErrorCode (*backtr)(void*,PetscScalar*,PetscScalar*));
EXTERN PetscErrorCode STShellSetName(ST,const char[]);
EXTERN PetscErrorCode STShellGetName(ST,char*[]);
 
EXTERN PetscErrorCode STCayleySetAntishift(ST,PetscScalar);
 
EXTERN PetscErrorCode STFoldSetLeftSide(ST st,PetscTruth left);
 
PETSC_EXTERN_CXX_END
#endif
 
tags/slepc-2_3_3-1/include/slepcst.h Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/include/slepceps.h New file
0,0 → 1,274
/*
User interface for the SLEPC eigenproblem solvers.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
 
#if !defined(__SLEPCEPS_H)
#define __SLEPCEPS_H
#include "slepc.h"
#include "slepcst.h"
#include "slepcip.h"
PETSC_EXTERN_CXX_BEGIN
 
extern PetscCookie EPS_COOKIE;
 
/*S
EPS - Abstract SLEPc object that manages all the eigenvalue
problem solvers.
 
Level: beginner
 
.seealso: EPSCreate(), ST
S*/
typedef struct _p_EPS* EPS;
 
/*E
EPSType - String with the name of a SLEPc eigensolver
 
Level: beginner
 
.seealso: EPSSetType(), EPS
E*/
#define EPSType const char*
#define EPSPOWER "power"
#define EPSSUBSPACE "subspace"
#define EPSARNOLDI "arnoldi"
#define EPSLANCZOS "lanczos"
#define EPSKRYLOVSCHUR "krylovschur"
#define EPSLAPACK "lapack"
/* the next ones are interfaces to external libraries */
#define EPSARPACK "arpack"
#define EPSBLZPACK "blzpack"
#define EPSTRLAN "trlan"
#define EPSBLOPEX "blopex"
#define EPSPRIMME "primme"
 
/*E
EPSProblemType - determines the type of eigenvalue problem
 
Level: beginner
 
.seealso: EPSSetProblemType(), EPSGetProblemType()
E*/
typedef enum { EPS_HEP=1, EPS_GHEP,
EPS_NHEP, EPS_GNHEP, EPS_PGNHEP } EPSProblemType;
 
/*E
EPSClass - determines if the eigensolver is one- or two-sided
 
Level: intermediate
 
.seealso: EPSSetClass(), EPSGetClass()
E*/
typedef enum { EPS_ONE_SIDE, EPS_TWO_SIDE } EPSClass;
 
/*E
EPSWhich - determines which part of the spectrum is requested
 
Level: intermediate
 
.seealso: EPSSetWhichEigenpairs(), EPSGetWhichEigenpairs()
E*/
typedef enum { EPS_LARGEST_MAGNITUDE, EPS_SMALLEST_MAGNITUDE,
EPS_LARGEST_REAL, EPS_SMALLEST_REAL,
EPS_LARGEST_IMAGINARY, EPS_SMALLEST_IMAGINARY } EPSWhich;
 
EXTERN PetscErrorCode EPSCreate(MPI_Comm,EPS *);
EXTERN PetscErrorCode EPSDestroy(EPS);
EXTERN PetscErrorCode EPSSetType(EPS,EPSType);
EXTERN PetscErrorCode EPSGetType(EPS,EPSType*);
EXTERN PetscErrorCode EPSSetProblemType(EPS,EPSProblemType);
EXTERN PetscErrorCode EPSGetProblemType(EPS,EPSProblemType*);
EXTERN PetscErrorCode EPSSetClass(EPS,EPSClass);
EXTERN PetscErrorCode EPSGetClass(EPS,EPSClass*);
EXTERN PetscErrorCode EPSSetOperators(EPS,Mat,Mat);
EXTERN PetscErrorCode EPSSetFromOptions(EPS);
EXTERN PetscErrorCode EPSSetUp(EPS);
EXTERN PetscErrorCode EPSSolve(EPS);
EXTERN PetscErrorCode EPSView(EPS,PetscViewer);
 
EXTERN PetscErrorCode EPSInitializePackage(char *);
 
EXTERN PetscErrorCode EPSSetST(EPS,ST);
EXTERN PetscErrorCode EPSGetST(EPS,ST*);
EXTERN PetscErrorCode EPSSetIP(EPS,IP);
EXTERN PetscErrorCode EPSGetIP(EPS,IP*);
EXTERN PetscErrorCode EPSSetTolerances(EPS,PetscReal,int);
EXTERN PetscErrorCode EPSGetTolerances(EPS,PetscReal*,int*);
EXTERN PetscErrorCode EPSSetDimensions(EPS,int,int);
EXTERN PetscErrorCode EPSGetDimensions(EPS,int*,int*);
 
EXTERN PetscErrorCode EPSGetConverged(EPS,int*);
EXTERN PetscErrorCode EPSGetEigenpair(EPS,int,PetscScalar*,PetscScalar*,Vec,Vec);
EXTERN PetscErrorCode EPSGetValue(EPS,int,PetscScalar*,PetscScalar*);
EXTERN PetscErrorCode EPSGetRightVector(EPS,int,Vec,Vec);
EXTERN PetscErrorCode EPSGetLeftVector(EPS,int,Vec,Vec);
EXTERN PetscErrorCode EPSComputeRelativeError(EPS,int,PetscReal*);
EXTERN PetscErrorCode EPSComputeRelativeErrorLeft(EPS,int,PetscReal*);
EXTERN PetscErrorCode EPSComputeResidualNorm(EPS,int,PetscReal*);
EXTERN PetscErrorCode EPSComputeResidualNormLeft(EPS,int,PetscReal*);
EXTERN PetscErrorCode EPSGetInvariantSubspace(EPS,Vec*);
EXTERN PetscErrorCode EPSGetLeftInvariantSubspace(EPS,Vec*);
EXTERN PetscErrorCode EPSGetErrorEstimate(EPS,int,PetscReal*);
EXTERN PetscErrorCode EPSGetErrorEstimateLeft(EPS,int,PetscReal*);
 
EXTERN PetscErrorCode EPSMonitorSet(EPS,PetscErrorCode (*)(EPS,int,int,PetscScalar*,PetscScalar*,PetscReal*,int,void*),
void*,PetscErrorCode (*monitordestroy)(void*));
EXTERN PetscErrorCode EPSMonitorCancel(EPS);
EXTERN PetscErrorCode EPSGetMonitorContext(EPS,void **);
EXTERN PetscErrorCode EPSGetIterationNumber(EPS,int*);
EXTERN PetscErrorCode EPSGetOperationCounters(EPS,int*,int*,int*);
 
EXTERN PetscErrorCode EPSSetInitialVector(EPS,Vec);
EXTERN PetscErrorCode EPSGetInitialVector(EPS,Vec*);
EXTERN PetscErrorCode EPSSetLeftInitialVector(EPS,Vec);
EXTERN PetscErrorCode EPSGetLeftInitialVector(EPS,Vec*);
EXTERN PetscErrorCode EPSSetWhichEigenpairs(EPS,EPSWhich);
EXTERN PetscErrorCode EPSGetWhichEigenpairs(EPS,EPSWhich*);
EXTERN PetscErrorCode EPSIsGeneralized(EPS,PetscTruth*);
EXTERN PetscErrorCode EPSIsHermitian(EPS,PetscTruth*);
 
EXTERN PetscErrorCode EPSMonitorDefault(EPS,int,int,PetscScalar*,PetscScalar*,PetscReal*,int,void*);
EXTERN PetscErrorCode EPSMonitorLG(EPS,int,int,PetscScalar*,PetscScalar*,PetscReal*,int,void*);
 
EXTERN PetscErrorCode EPSAttachDeflationSpace(EPS,int,Vec*,PetscTruth);
EXTERN PetscErrorCode EPSRemoveDeflationSpace(EPS);
 
EXTERN PetscErrorCode EPSSetOptionsPrefix(EPS,const char*);
EXTERN PetscErrorCode EPSAppendOptionsPrefix(EPS,const char*);
EXTERN PetscErrorCode EPSGetOptionsPrefix(EPS,const char*[]);
 
/*E
EPSConvergedReason - reason an eigensolver was said to
have converged or diverged
 
Level: beginner
 
.seealso: EPSSolve(), EPSGetConvergedReason(), EPSSetTolerances()
E*/
typedef enum {/* converged */
EPS_CONVERGED_TOL = 2,
/* diverged */
EPS_DIVERGED_ITS = -3,
EPS_DIVERGED_BREAKDOWN = -4,
EPS_DIVERGED_NONSYMMETRIC = -5,
EPS_CONVERGED_ITERATING = 0} EPSConvergedReason;
 
EXTERN PetscErrorCode EPSGetConvergedReason(EPS,EPSConvergedReason *);
 
EXTERN PetscErrorCode EPSSortEigenvalues(int,PetscScalar*,PetscScalar*,EPSWhich,int,int*);
EXTERN PetscErrorCode EPSDenseNHEP(int,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*);
EXTERN PetscErrorCode EPSDenseGNHEP(int,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*);
EXTERN PetscErrorCode EPSDenseHEP(int,PetscScalar*,int,PetscReal*,PetscScalar*);
EXTERN PetscErrorCode EPSDenseGHEP(int,PetscScalar*,PetscScalar*,PetscReal*,PetscScalar*);
EXTERN PetscErrorCode EPSDenseHessenberg(int,int,PetscScalar*,int,PetscScalar*);
EXTERN PetscErrorCode EPSDenseSchur(int,int,PetscScalar*,int,PetscScalar*,PetscScalar*,PetscScalar*);
EXTERN PetscErrorCode EPSSortDenseSchur(int,int,PetscScalar*,int,PetscScalar*,PetscScalar*,PetscScalar*,EPSWhich);
EXTERN PetscErrorCode EPSDenseTridiagonal(int,PetscScalar*,int,PetscReal*,PetscScalar*);
 
EXTERN PetscErrorCode EPSGetStartVector(EPS,int,Vec,PetscTruth*);
EXTERN PetscErrorCode EPSGetLeftStartVector(EPS,int,Vec);
 
EXTERN PetscErrorCode EPSRegister(const char*,const char*,const char*,int(*)(EPS));
#if defined(PETSC_USE_DYNAMIC_LIBRARIES)
#define EPSRegisterDynamic(a,b,c,d) EPSRegister(a,b,c,0)
#else
#define EPSRegisterDynamic(a,b,c,d) EPSRegister(a,b,c,d)
#endif
EXTERN PetscErrorCode EPSRegisterDestroy(void);
 
/* --------- options specific to particular eigensolvers -------- */
 
/*E
EPSPowerShiftType - determines the type of shift used in the Power iteration
 
Level: advanced
 
.seealso: EPSPowerSetShiftType(), EPSPowerGetShiftType()
E*/
typedef enum { EPSPOWER_SHIFT_CONSTANT, EPSPOWER_SHIFT_RAYLEIGH,
EPSPOWER_SHIFT_WILKINSON } EPSPowerShiftType;
 
EXTERN PetscErrorCode EPSPowerSetShiftType(EPS,EPSPowerShiftType);
EXTERN PetscErrorCode EPSPowerGetShiftType(EPS,EPSPowerShiftType*);
 
EXTERN PetscErrorCode EPSArnoldiSetDelayed(EPS,PetscTruth);
EXTERN PetscErrorCode EPSArnoldiGetDelayed(EPS,PetscTruth*);
 
/*E
EPSLanczosReorthogType - determines the type of reorthogonalization
used in the Lanczos method
 
Level: advanced
 
.seealso: EPSLanczosSetReorthog(), EPSLanczosGetReorthog()
E*/
typedef enum { EPSLANCZOS_REORTHOG_LOCAL,
EPSLANCZOS_REORTHOG_FULL,
EPSLANCZOS_REORTHOG_SELECTIVE,
EPSLANCZOS_REORTHOG_PERIODIC,
EPSLANCZOS_REORTHOG_PARTIAL,
EPSLANCZOS_REORTHOG_DELAYED } EPSLanczosReorthogType;
 
EXTERN PetscErrorCode EPSLanczosSetReorthog(EPS,EPSLanczosReorthogType);
EXTERN PetscErrorCode EPSLanczosGetReorthog(EPS,EPSLanczosReorthogType*);
 
EXTERN PetscErrorCode EPSBlzpackSetBlockSize(EPS,int);
EXTERN PetscErrorCode EPSBlzpackSetInterval(EPS,PetscReal,PetscReal);
EXTERN PetscErrorCode EPSBlzpackSetNSteps(EPS,int);
 
/*E
EPSPRIMMEMethod - determines the method selected in the PRIMME library
 
Level: advanced
 
.seealso: EPSPRIMMESetMethod(), EPSPRIMMEGetMethod()
E*/
typedef enum {
EPSPRIMME_DYNAMIC,
EPSPRIMME_DEFAULT_MIN_TIME,
EPSPRIMME_DEFAULT_MIN_MATVECS,
EPSPRIMME_ARNOLDI,
EPSPRIMME_GD,
EPSPRIMME_GD_PLUSK,
EPSPRIMME_GD_OLSEN_PLUSK,
EPSPRIMME_JD_OLSEN_PLUSK,
EPSPRIMME_RQI,
EPSPRIMME_JDQR,
EPSPRIMME_JDQMR,
EPSPRIMME_JDQMR_ETOL,
EPSPRIMME_SUBSPACE_ITERATION,
EPSPRIMME_LOBPCG_ORTHOBASIS,
EPSPRIMME_LOBPCG_ORTHOBASIS_WINDOW
} EPSPRIMMEMethod;
 
/*E
EPSPRIMMEPrecond - determines the type of preconditioning
used in the PRIMME library
 
Level: advanced
 
.seealso: EPSPRIMMESetPrecond(), EPSPRIMMEGetPrecond()
E*/
typedef enum {
EPSPRIMME_NONE,
EPSPRIMME_DIAGONAL
} EPSPRIMMEPrecond;
 
EXTERN PetscErrorCode EPSPRIMMESetBlockSize(EPS eps,int bs);
EXTERN PetscErrorCode EPSPRIMMESetMethod(EPS eps, EPSPRIMMEMethod method);
EXTERN PetscErrorCode EPSPRIMMESetPrecond(EPS eps, EPSPRIMMEPrecond precond);
EXTERN PetscErrorCode EPSPRIMMEGetBlockSize(EPS eps,int *bs);
EXTERN PetscErrorCode EPSPRIMMEGetMethod(EPS eps, EPSPRIMMEMethod *method);
EXTERN PetscErrorCode EPSPRIMMEGetPrecond(EPS eps, EPSPRIMMEPrecond *precond);
 
PETSC_EXTERN_CXX_END
#endif
 
tags/slepc-2_3_3-1/include/slepceps.h Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/include/slepcip.h New file
0,0 → 1,90
/*
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
 
#if !defined(__SLEPCIP_H)
#define __SLEPCIP_H
#include "slepc.h"
PETSC_EXTERN_CXX_BEGIN
 
extern PetscCookie IP_COOKIE;
 
/*E
IPOrthogonalizationType - determines what type of orthogonalization to use
 
Level: advanced
 
.seealso: IPSetOrthogonalization(), IPGetOrthogonalization(), IPOrthogonalize()
E*/
typedef enum { IP_MGS_ORTH, IP_CGS_ORTH } IPOrthogonalizationType;
 
/*E
IPOrthogonalizationRefinementType - determines what type of refinement
to use during orthogonalization
 
Level: advanced
 
.seealso: IPSetOrthogonalization(), IPGetOrthogonalization(), IPOrthogonalize()
E*/
typedef enum { IP_ORTH_REFINE_NEVER, IP_ORTH_REFINE_IFNEEDED,
IP_ORTH_REFINE_ALWAYS } IPOrthogonalizationRefinementType;
 
/*S
IP - Abstraction of a vector inner product, that can be defined
in different ways. Using this object is not required for application
programmers.
 
Level: beginner
 
.seealso: IPCreate()
S*/
typedef struct _p_IP* IP;
 
EXTERN PetscErrorCode IPInitializePackage(char *path);
EXTERN PetscErrorCode IPCreate(MPI_Comm,IP*);
EXTERN PetscErrorCode IPSetOptionsPrefix(IP,const char *);
EXTERN PetscErrorCode IPAppendOptionsPrefix(IP,const char *);
EXTERN PetscErrorCode IPSetFromOptions(IP);
EXTERN PetscErrorCode IPSetOrthogonalization(IP,IPOrthogonalizationType,IPOrthogonalizationRefinementType,PetscReal);
EXTERN PetscErrorCode IPGetOrthogonalization(IP,IPOrthogonalizationType*,IPOrthogonalizationRefinementType*,PetscReal*);
EXTERN PetscErrorCode IPView(IP,PetscViewer);
EXTERN PetscErrorCode IPDestroy(IP);
 
EXTERN PetscErrorCode IPOrthogonalize(IP,int,PetscTruth*,Vec*,Vec,PetscScalar*,PetscReal*,PetscTruth*,Vec);
EXTERN PetscErrorCode IPOrthogonalizeCGS(IP,int,PetscTruth*,Vec*,Vec,PetscScalar*,PetscReal*,PetscReal*,Vec);
EXTERN PetscErrorCode IPBiOrthogonalize(IP,int,Vec*,Vec*,Vec,PetscScalar*,PetscReal*);
EXTERN PetscErrorCode IPQRDecomposition(IP,Vec*,int,int,PetscScalar*,int,Vec);
 
/*E
IPBilinearForm - determines the type of bilinear/sesquilinear form
 
Level: developer
 
.seealso: IPSetBilinearForm(), IPGetBilinearForm()
E*/
typedef enum { IPINNER_HERMITIAN, IPINNER_SYMMETRIC } IPBilinearForm;
EXTERN PetscErrorCode IPSetBilinearForm(IP,Mat,IPBilinearForm);
EXTERN PetscErrorCode IPGetBilinearForm(IP,Mat*,IPBilinearForm*);
EXTERN PetscErrorCode IPApplyMatrix(IP,Vec,Vec);
 
EXTERN PetscErrorCode IPInnerProduct(IP ip,Vec,Vec,PetscScalar*);
EXTERN PetscErrorCode IPInnerProductBegin(IP ip,Vec,Vec,PetscScalar*);
EXTERN PetscErrorCode IPInnerProductEnd(IP ip,Vec,Vec,PetscScalar*);
EXTERN PetscErrorCode IPMInnerProduct(IP ip,Vec,PetscInt,const Vec[],PetscScalar*);
EXTERN PetscErrorCode IPMInnerProductBegin(IP ip,Vec,PetscInt,const Vec[],PetscScalar*);
EXTERN PetscErrorCode IPMInnerProductEnd(IP ip,Vec,PetscInt,const Vec[],PetscScalar*);
EXTERN PetscErrorCode IPNorm(IP ip,Vec,PetscReal*);
EXTERN PetscErrorCode IPNormBegin(IP ip,Vec,PetscReal*);
EXTERN PetscErrorCode IPNormEnd(IP ip,Vec,PetscReal*);
 
EXTERN PetscErrorCode IPGetOperationCounters(IP,int*);
EXTERN PetscErrorCode IPResetOperationCounters(IP);
 
PETSC_EXTERN_CXX_END
#endif
tags/slepc-2_3_3-1/include/slepcip.h Property changes : Added: svn:keywords
+ Author Date Id Revision
Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/include/finclude/slepcst.h New file
0,0 → 1,42
!
! Include file for Fortran use of the ST object in SLEPc
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! 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.
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
#if !defined(__SLEPCST_H)
#define __SLEPCST_H
 
#define ST PetscFortranAddr
#define STType character*(80)
 
#define STSHELL 'shell'
#define STSHIFT 'shift'
#define STSINV 'sinvert'
#define STCAYLEY 'cayley'
#define STFOLD 'fold'
 
integer STMATMODE_COPY
integer STMATMODE_INPLACE
integer STMATMODE_SHELL
 
parameter (STMATMODE_COPY = 0)
parameter (STMATMODE_INPLACE = 1)
parameter (STMATMODE_SHELL = 2)
 
integer STINNER_HERMITIAN
integer STINNER_SYMMETRIC
integer STINNER_B_HERMITIAN
integer STINNER_B_SYMMETRIC
 
parameter (STINNER_HERMITIAN = 0)
parameter (STINNER_SYMMETRIC = 1)
parameter (STINNER_B_HERMITIAN = 2)
parameter (STINNER_B_SYMMETRIC = 3)
 
#endif
tags/slepc-2_3_3-1/include/finclude/slepcst.h Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/include/finclude/slepceps.h New file
0,0 → 1,110
!
! Include file for Fortran use of the EPS object in SLEPc
!
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! 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.
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
#if !defined(__SLEPCEPS_H)
#define __SLEPCEPS_H
 
#define EPS PetscFortranAddr
#define EPSType character*(80)
#define EPSConvergedReason integer
 
#define EPSPOWER 'power'
#define EPSSUBSPACE 'subspace'
#define EPSARNOLDI 'arnoldi'
#define EPSLANCZOS 'lanczos'
#define EPSLAPACK 'lapack'
#define EPSARPACK 'arpack'
#define EPSBLZPACK 'blzpack'
#define EPSPLANSO 'planso'
#define EPSTRLAN 'trlan'
#define EPSLOBPCG 'lobpcg'
 
! Convergence flags.
! They sould match the flags in $SLEPC_DIR/include/slepceps.h
 
integer EPS_CONVERGED_TOL
integer EPS_DIVERGED_ITS
integer EPS_DIVERGED_BREAKDOWN
integer EPS_DIVERGED_NONSYMMETRIC
integer EPS_CONVERGED_ITERATING
 
parameter (EPS_CONVERGED_TOL = 2)
parameter (EPS_DIVERGED_ITS = -3)
parameter (EPS_DIVERGED_BREAKDOWN = -4)
parameter (EPS_DIVERGED_NONSYMMETRIC = -5)
parameter (EPS_CONVERGED_ITERATING = 0)
 
integer EPS_HEP
integer EPS_GHEP
integer EPS_NHEP
integer EPS_GNHEP
 
parameter (EPS_HEP = 1)
parameter (EPS_GHEP = 2)
parameter (EPS_NHEP = 3)
parameter (EPS_GNHEP = 4)
integer EPS_LARGEST_MAGNITUDE
integer EPS_SMALLEST_MAGNITUDE
integer EPS_LARGEST_REAL
integer EPS_SMALLEST_REAL
integer EPS_LARGEST_IMAGINARY
integer EPS_SMALLEST_IMAGINARY
 
parameter (EPS_LARGEST_MAGNITUDE = 0)
parameter (EPS_SMALLEST_MAGNITUDE = 1)
parameter (EPS_LARGEST_REAL = 2)
parameter (EPS_SMALLEST_REAL = 3)
parameter (EPS_LARGEST_IMAGINARY = 4)
parameter (EPS_SMALLEST_IMAGINARY = 5)
 
integer EPS_MGS_ORTH
integer EPS_CGS_ORTH
parameter (EPS_MGS_ORTH = 0)
parameter (EPS_CGS_ORTH = 1)
 
integer EPS_ORTH_REFINE_NEVER
integer EPS_ORTH_REFINE_IFNEEDED
integer EPS_ORTH_REFINE_ALWAYS
 
parameter (EPS_ORTH_REFINE_NEVER = 0)
parameter (EPS_ORTH_REFINE_IFNEEDED = 1)
parameter (EPS_ORTH_REFINE_ALWAYS = 2)
integer EPSPOWER_SHIFT_CONSTANT
integer EPSPOWER_SHIFT_RAYLEIGH
integer EPSPOWER_SHIFT_WILKINSON
 
parameter (EPSPOWER_SHIFT_CONSTANT = 0)
parameter (EPSPOWER_SHIFT_RAYLEIGH = 1)
parameter (EPSPOWER_SHIFT_WILKINSON = 2)
 
integer EPS_ONE_SIDE
integer EPS_TWO_SIDE
 
parameter (EPS_ONE_SIDE = 0)
parameter (EPS_TWO_SIDE = 1)
 
integer EPSLANCZOS_REORTHOG_NONE
integer EPSLANCZOS_REORTHOG_FULL
integer EPSLANCZOS_REORTHOG_SELECTIVE
integer EPSLANCZOS_REORTHOG_PERIODIC
integer EPSLANCZOS_REORTHOG_PARTIAL
 
parameter (EPSLANCZOS_REORTHOG_NONE = 0)
parameter (EPSLANCZOS_REORTHOG_FULL = 1)
parameter (EPSLANCZOS_REORTHOG_SELECTIVE = 2)
parameter (EPSLANCZOS_REORTHOG_PERIODIC = 3)
parameter (EPSLANCZOS_REORTHOG_PARTIAL = 4)
 
#endif
tags/slepc-2_3_3-1/include/finclude/slepceps.h Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/include/finclude/slepc.h New file
0,0 → 1,14
!
! Include file for Fortran use of the SLEPc package
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! 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 "petscconf.h"
#include "finclude/petscdef.h"
tags/slepc-2_3_3-1/include/finclude/slepc.h Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/include/finclude/makefile New file
0,0 → 1,29
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
CFLAGS =
FFLAGS =
SOURCEC =
SOURCEF =
SOURCEH = slepc.h slepceps.h slepcst.h
OBJSC =
OBJSF =
LIBBASE = libslepc
DIRS =
MANSEC =
LOCDIR = include/finclude/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
runexamples:
 
 
 
 
tags/slepc-2_3_3-1/include/finclude/makefile Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/include/slepcsvd.h New file
0,0 → 1,143
/*
User interface for the SLEPC singular value solvers.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
 
#if !defined(__SLEPCSVD_H)
#define __SLEPCSVD_H
#include "slepc.h"
#include "slepceps.h"
PETSC_EXTERN_CXX_BEGIN
 
extern PetscCookie SVD_COOKIE;
 
/*S
SVD - Abstract SLEPc object that manages all the singular value
problem solvers.
 
Level: beginner
 
.seealso: SVDCreate()
S*/
typedef struct _p_SVD* SVD;
 
/*E
SVDType - String with the name of a SLEPc singular value solver
 
Level: beginner
 
.seealso: SVDSetType(), SVD
E*/
#define SVDType const char*
#define SVDCROSS "cross"
#define SVDCYCLIC "cyclic"
#define SVDLAPACK "lapack"
#define SVDLANCZOS "lanczos"
#define SVDTRLANCZOS "trlanczos"
 
/*E
SVDTransposeMode - determines how to handle the transpose of the matrix
 
Level: advanced
 
.seealso: SVDSetTransposeMode(), SVDGetTransposeMode()
E*/
typedef enum { SVD_TRANSPOSE_EXPLICIT, SVD_TRANSPOSE_IMPLICIT } SVDTransposeMode;
 
/*E
SVDWhich - determines whether largest or smallest singular triplets
are to be computed
 
Level: intermediate
 
.seealso: SVDSetWhichSingularTriplets(), SVDGetWhichSingularTriplets()
E*/
typedef enum { SVD_LARGEST, SVD_SMALLEST } SVDWhich;
 
/*E
SVDConvergedReason - reason a singular value solver was said to
have converged or diverged
 
Level: beginner
 
.seealso: SVDSolve(), SVDGetConvergedReason(), SVDSetTolerances()
E*/
typedef enum {/* converged */
SVD_CONVERGED_TOL = 2,
/* diverged */
SVD_DIVERGED_ITS = -3,
SVD_DIVERGED_BREAKDOWN = -4,
SVD_CONVERGED_ITERATING = 0 } SVDConvergedReason;
 
EXTERN PetscErrorCode SVDCreate(MPI_Comm,SVD*);
EXTERN PetscErrorCode SVDSetIP(SVD,IP);
EXTERN PetscErrorCode SVDGetIP(SVD,IP*);
EXTERN PetscErrorCode SVDSetType(SVD,SVDType);
EXTERN PetscErrorCode SVDGetType(SVD,SVDType*);
EXTERN PetscErrorCode SVDSetOperator(SVD,Mat);
EXTERN PetscErrorCode SVDGetOperator(SVD,Mat*);
EXTERN PetscErrorCode SVDSetInitialVector(SVD,Vec);
EXTERN PetscErrorCode SVDGetInitialVector(SVD,Vec*);
EXTERN PetscErrorCode SVDSetTransposeMode(SVD,SVDTransposeMode);
EXTERN PetscErrorCode SVDGetTransposeMode(SVD,SVDTransposeMode*);
EXTERN PetscErrorCode SVDSetDimensions(SVD,int,int);
EXTERN PetscErrorCode SVDGetDimensions(SVD,int*,int*);
EXTERN PetscErrorCode SVDSetTolerances(SVD,PetscReal,int);
EXTERN PetscErrorCode SVDGetTolerances(SVD,PetscReal*,int*);
EXTERN PetscErrorCode SVDSetWhichSingularTriplets(SVD,SVDWhich);
EXTERN PetscErrorCode SVDGetWhichSingularTriplets(SVD,SVDWhich*);
EXTERN PetscErrorCode SVDSetFromOptions(SVD);
EXTERN PetscErrorCode SVDSetOptionsPrefix(SVD,const char*);
EXTERN PetscErrorCode SVDAppendOptionsPrefix(SVD,const char*);
EXTERN PetscErrorCode SVDGetOptionsPrefix(SVD,const char*[]);
EXTERN PetscErrorCode SVDSetUp(SVD);
EXTERN PetscErrorCode SVDSolve(SVD);
EXTERN PetscErrorCode SVDGetIterationNumber(SVD,int*);
EXTERN PetscErrorCode SVDGetConvergedReason(SVD,SVDConvergedReason*);
EXTERN PetscErrorCode SVDGetConverged(SVD,int*);
EXTERN PetscErrorCode SVDGetSingularTriplet(SVD,int,PetscReal*,Vec,Vec);
EXTERN PetscErrorCode SVDComputeResidualNorms(SVD,int,PetscReal*,PetscReal*);
EXTERN PetscErrorCode SVDComputeRelativeError(SVD,int,PetscReal*);
EXTERN PetscErrorCode SVDGetOperationCounters(SVD,int*,int*);
EXTERN PetscErrorCode SVDView(SVD,PetscViewer);
EXTERN PetscErrorCode SVDDestroy(SVD);
EXTERN PetscErrorCode SVDInitializePackage(char*);
 
EXTERN PetscErrorCode SVDMonitorSet(SVD,PetscErrorCode (*)(SVD,int,int,PetscReal*,PetscReal*,int,void*),
void*,PetscErrorCode (*monitordestroy)(void*));
EXTERN PetscErrorCode SVDMonitorCancel(SVD);
EXTERN PetscErrorCode SVDGetMonitorContext(SVD,void **);
EXTERN PetscErrorCode SVDMonitorDefault(SVD,int,int,PetscReal*,PetscReal*,int,void*);
EXTERN PetscErrorCode SVDMonitorLG(SVD,int,int,PetscReal*,PetscReal*,int,void*);
 
EXTERN PetscErrorCode SVDDense(int,int,PetscScalar*,PetscReal*,PetscScalar*,PetscScalar*);
 
EXTERN PetscErrorCode SVDCrossSetEPS(SVD,EPS);
EXTERN PetscErrorCode SVDCrossGetEPS(SVD,EPS*);
 
EXTERN PetscErrorCode SVDCyclicSetExplicitMatrix(SVD,PetscTruth);
EXTERN PetscErrorCode SVDCyclicGetExplicitMatrix(SVD,PetscTruth*);
EXTERN PetscErrorCode SVDCyclicSetEPS(SVD,EPS);
EXTERN PetscErrorCode SVDCyclicGetEPS(SVD,EPS*);
 
EXTERN PetscErrorCode SVDLanczosSetOneSide(SVD,PetscTruth);
 
EXTERN PetscErrorCode SVDTRLanczosSetOneSide(SVD,PetscTruth);
 
EXTERN PetscErrorCode SVDRegister(const char*,const char*,const char*,int(*)(SVD));
#if defined(PETSC_USE_DYNAMIC_LIBRARIES)
#define SVDRegisterDynamic(a,b,c,d) SVDRegister(a,b,c,0)
#else
#define SVDRegisterDynamic(a,b,c,d) SVDRegister(a,b,c,d)
#endif
EXTERN PetscErrorCode SVDRegisterDestroy(void);
 
PETSC_EXTERN_CXX_END
#endif
tags/slepc-2_3_3-1/include/slepcsvd.h Property changes : Added: svn:keywords
+ Author Date Id Revision
Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/include/slepcblaslapack.h New file
0,0 → 1,143
/*
 
Necessary routines in BLAS and LAPACK not included in petscblaslapack.f
 
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
 
#if !defined(__SLEPCBLASLAPACK_H)
#define __SLEPCBLASLAPACK_H
#include "petscblaslapack.h"
PETSC_EXTERN_CXX_BEGIN
 
 
#if defined(PETSC_HAVE_FORTRAN_UNDERSCORE) || defined(PETSC_BLASLAPACK_UNDERSCORE)
#if defined(PETSC_USE_SINGLE)
#define SLEPC_BLASLAPACKREAL(lcase,ucase) s##lcase##_
#if defined(PETSC_USE_COMPLEX)
#define SLEPC_BLASLAPACK(lcase,ucase) c##lcase##_
#else
#define SLEPC_BLASLAPACK(lcase,ucase) s##lcase##_
#endif
#else
#define SLEPC_BLASLAPACKREAL(lcase,ucase) d##lcase##_
#if defined(PETSC_USE_COMPLEX)
#define SLEPC_BLASLAPACK(lcase,ucase) z##lcase##_
#else
#define SLEPC_BLASLAPACK(lcase,ucase) d##lcase##_
#endif
#endif
 
#elif defined(PETSC_HAVE_FORTRAN_CAPS)
#if defined(PETSC_USE_SINGLE)
#define SLEPC_BLASLAPACKREAL(lcase,ucase) S##ucase
#if defined(PETSC_USE_COMPLEX)
#define SLEPC_BLASLAPACK(lcase,ucase) C##ucase
#else
#define SLEPC_BLASLAPACK(lcase,ucase) S##ucase
#endif
#else
#define SLEPC_BLASLAPACKREAL(lcase,ucase) D##ucase
#if defined(PETSC_USE_COMPLEX)
#define SLEPC_BLASLAPACK(lcase,ucase) Z##ucase
#else
#define SLEPC_BLASLAPACK(lcase,ucase) D##ucase
#endif
#endif
 
#else
#if defined(PETSC_USE_SINGLE)
#define SLEPC_BLASLAPACKREAL(lcase,ucase) s##lcase
#if defined(PETSC_USE_COMPLEX)
#define SLEPC_BLASLAPACK(lcase,ucase) c##lcase
#else
#define SLEPC_BLASLAPACK(lcase,ucase) s##lcase
#endif
#else
#define SLEPC_BLASLAPACKREAL(lcase,ucase) d##lcase
#if defined(PETSC_USE_COMPLEX)
#define SLEPC_BLASLAPACK(lcase,ucase) z##lcase
#else
#define SLEPC_BLASLAPACK(lcase,ucase) d##lcase
#endif
#endif
 
#endif
 
#define BLAStrsm_ SLEPC_BLASLAPACK(trsm,TRSM)
#define LAPACKlaev2_ SLEPC_BLASLAPACK(laev2,LAEV2)
#define LAPACKgehrd_ SLEPC_BLASLAPACK(gehrd,GEHRD)
#define LAPACKlanhs_ SLEPC_BLASLAPACK(lanhs,LANHS)
#define LAPACKlange_ SLEPC_BLASLAPACK(lange,LANGE)
#define LAPACKgetri_ SLEPC_BLASLAPACK(getri,GETRI)
#define LAPACKhseqr_ SLEPC_BLASLAPACK(hseqr,HSEQR)
#define LAPACKtrexc_ SLEPC_BLASLAPACK(trexc,TREXC)
#define LAPACKtrevc_ SLEPC_BLASLAPACK(trevc,TREVC)
#define LAPACKgeevx_ SLEPC_BLASLAPACK(geevx,GEEVX)
#define LAPACKggevx_ SLEPC_BLASLAPACK(ggevx,GGEVX)
#define LAPACKgelqf_ SLEPC_BLASLAPACK(gelqf,GELQF)
#define LAPACKgesdd_ SLEPC_BLASLAPACK(gesdd,GESDD)
 
#if !defined(PETSC_USE_COMPLEX)
#define LAPACKorghr_ SLEPC_BLASLAPACK(orghr,ORGHR)
#define LAPACKsyevr_ SLEPC_BLASLAPACK(syevr,SYEVR)
#define LAPACKsygvd_ SLEPC_BLASLAPACK(sygvd,SYGVD)
#define LAPACKormlq_ SLEPC_BLASLAPACK(ormlq,ORMLQ)
#else
#define LAPACKorghr_ SLEPC_BLASLAPACK(unghr,UNGHR)
#define LAPACKsyevr_ SLEPC_BLASLAPACK(heevr,HEEVR)
#define LAPACKsygvd_ SLEPC_BLASLAPACK(hegvd,HEGVD)
#define LAPACKormlq_ SLEPC_BLASLAPACK(unmlq,UNMLQ)
#endif
 
#define LAPACKlamch_ SLEPC_BLASLAPACKREAL(lamch,LAMCH)
#define LAPACKstevr_ SLEPC_BLASLAPACKREAL(stevr,STEVR)
#define LAPACKbdsdc_ SLEPC_BLASLAPACKREAL(bdsdc,BDSDC)
 
EXTERN_C_BEGIN
 
EXTERN PetscReal LAPACKlamch_(const char*,PetscBLASInt);
EXTERN PetscReal LAPACKlanhs_(const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscBLASInt);
EXTERN PetscReal LAPACKlange_(const char*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscBLASInt);
EXTERN void LAPACKlaev2_(PetscScalar*,PetscScalar*,PetscScalar*,PetscReal*,PetscReal*,PetscReal*,PetscScalar*);
EXTERN void LAPACKgehrd_(PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*);
EXTERN void LAPACKorghr_(PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*);
EXTERN void LAPACKgetri_(PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*);
EXTERN void LAPACKstevr_(const char*,const char*,PetscBLASInt*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscReal*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt);
EXTERN void LAPACKgelqf_(PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*);
EXTERN void BLAStrsm_(const char*,const char*,const char*,const char*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt,PetscBLASInt,PetscBLASInt,PetscBLASInt);
EXTERN void LAPACKormlq_(const char*,const char*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt);
EXTERN void LAPACKbdsdc_(const char*,const char*,PetscBLASInt*,PetscReal*,PetscReal*,PetscReal*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt);
 
#if !defined(PETSC_USE_COMPLEX)
EXTERN void LAPACKhseqr_(const char*,const char*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt);
EXTERN void LAPACKtrexc_(const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt);
EXTERN void LAPACKtrevc_(const char*,const char*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt,PetscBLASInt);
EXTERN void LAPACKgeevx_(const char*,const char*,const char*,const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt,PetscBLASInt,PetscBLASInt);
EXTERN void LAPACKggevx_(const char*,const char*,const char*,const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt,PetscBLASInt,PetscBLASInt);
EXTERN void LAPACKsyevr_(const char*,const char*,const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt,PetscBLASInt);
EXTERN void LAPACKsygvd_(PetscBLASInt*,const char*,const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt);
EXTERN void LAPACKgesdd_(const char*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt);
#else
EXTERN void LAPACKhseqr_(const char*,const char*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt);
EXTERN void LAPACKtrexc_(const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt);
EXTERN void LAPACKtrevc_(const char*,const char*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscReal*,PetscBLASInt*,PetscBLASInt,PetscBLASInt);
EXTERN void LAPACKgeevx_(const char*,const char*,const char*,const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt,PetscBLASInt,PetscBLASInt,PetscBLASInt);
EXTERN void LAPACKggevx_(const char*,const char*,const char*,const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*, PetscBLASInt*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscScalar*, PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt,PetscBLASInt,PetscBLASInt);
EXTERN void LAPACKsyevr_(const char *,const char*,const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscReal*,PetscScalar*,PetscBLASInt*,PetscBLASInt*, PetscScalar*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt,PetscBLASInt);
EXTERN void LAPACKsygvd_(PetscBLASInt*,const char*,const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt);
EXTERN void LAPACKgesdd_(const char*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt);
#endif
 
 
EXTERN_C_END
 
PETSC_EXTERN_CXX_END
#endif
tags/slepc-2_3_3-1/include/slepcblaslapack.h Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/include/slepc.h New file
0,0 → 1,54
/*
This is the main SLEPc include file (for C and C++). It is included
by all other SLEPc include files, so it almost never has to be
specifically included.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
 
#if !defined(__SLEPC_H)
#define __SLEPC_H
 
/* ========================================================================== */
/*
Current SLEPc version number and release date
*/
#include "slepcversion.h"
 
/* ========================================================================== */
/*
The PETSc include files.
*/
#include "petsc.h"
#include "petscvec.h"
#include "petscmat.h"
 
PETSC_EXTERN_CXX_BEGIN
/*
Initialization of SLEPc and other system routines
*/
EXTERN PetscErrorCode SlepcInitialize(int*,char***,char[],const char[]);
EXTERN PetscErrorCode SlepcFinalize(void);
EXTERN PetscErrorCode SlepcInitializeFortran(void);
 
EXTERN PetscErrorCode SlepcVecSetRandom(Vec);
EXTERN PetscErrorCode SlepcIsHermitian(Mat,PetscTruth*);
#if !defined(PETSC_USE_COMPLEX)
EXTERN PetscReal SlepcAbsEigenvalue(PetscScalar,PetscScalar);
#else
#define SlepcAbsEigenvalue(x,y) PetscAbsScalar(x)
#endif
EXTERN PetscErrorCode SlepcMatConvertSeqDense(Mat,Mat*);
EXTERN PetscErrorCode SlepcCheckOrthogonality(Vec*,PetscInt,Vec *,PetscInt,Mat,PetscScalar*);
extern PetscTruth SlepcInitializeCalled;
 
PETSC_EXTERN_CXX_END
#endif
 
tags/slepc-2_3_3-1/include/slepc.h Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/include/README New file
0,0 → 1,4
 
This is a directory for public include files. Subdirectories are:
- finclude - Fortran interface include files
 
tags/slepc-2_3_3-1/include/README Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/include/makefile New file
0,0 → 1,28
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
CFLAGS =
FFLAGS =
SOURCEC =
SOURCEF =
SOURCEH = slepc.h slepceps.h slepcst.h slepclog.h slepcversion.h slepcblaslapack.h
OBJSC =
OBJSF =
LIBBASE = libslepc
DIRS = finclude
LOCDIR = include/
MANSEC =
 
include ${SLEPC_DIR}/bmake/slepc_common
 
runexamples:
 
 
 
tags/slepc-2_3_3-1/include/makefile Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/config/primme.py New file
0,0 → 1,56
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
import os
import sys
 
import petscconf
import log
import check
 
def Check(conf,directory,libs):
log.Write('='*80)
log.Println('Checking PRIMME library...')
 
if petscconf.PRECISION == 'single':
sys.exit('ERROR: PRIMME does not support single precision.')
functions_base = ['primme_set_method','primme_Free','primme_initialize']
if directory:
dirs = [directory]
else:
dirs = check.GenerateGuesses('Primme')
 
include = 'PRIMMESRC/COMMONSRC'
if not libs:
libs = ['-lprimme']
if petscconf.SCALAR == 'real':
functions = functions_base + ['dprimme']
else:
functions = functions_base + ['zprimme']
 
for d in dirs:
if d:
l = ['-L' + d] + libs
f = ['-I' + d + '/' + include]
else:
l = libs
f = []
if check.Link(functions,[],l+f):
conf.write('SLEPC_HAVE_PRIMME = -DSLEPC_HAVE_PRIMME\n')
conf.write('PRIMME_LIB =' + str.join(' ', l) + '\n')
conf.write('PRIMME_FLAGS =' + str.join(' ', f) + '\n')
return l+f
 
log.Println('ERROR: Unable to link with PRIMME library')
print 'ERROR: In directories',dirs
print 'ERROR: With flags',libs,
log.Exit('')
tags/slepc-2_3_3-1/config/primme.py Property changes : Added: svn:keywords
+ Author Date Id Revision
Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/config/lapack.py New file
0,0 → 1,75
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
import os
import sys
 
import petscconf
import log
import check
 
def Check(conf):
log.Write('='*80)
log.Println('Checking LAPACK library...')
 
functions = ['laev2','gehrd','lanhs','lange','getri','hseqr','trexc','trevc','geevx','ggevx','gelqf','gesdd']
 
if petscconf.SCALAR == 'real':
functions += ['orghr','syevr','sygvd','ormlq']
if petscconf.PRECISION == 'single':
prefix = 's'
else:
prefix = 'd'
else:
functions += ['unghr','heevr','hegvd','unmlq']
if petscconf.PRECISION == 'single':
prefix = 'c'
else:
prefix = 'z'
missing = []
conf.write('SLEPC_MISSING_LAPACK =')
for i in functions:
f = '#if defined(PETSC_HAVE_FORTRAN_UNDERSCORE) || defined(PETSC_BLASLAPACK_UNDERSCORE)\n'
f += prefix + i + '_\n'
f += '#elif defined(PETSC_HAVE_FORTRAN_CAPS)\n'
f += prefix.upper() + i.upper() + '\n'
f += '#else\n'
f += prefix + i + '\n'
f += '#endif\n'
log.Write('=== Checking LAPACK '+prefix+i+' function...')
if not check.Link([f],[],[]):
missing.append(prefix + i)
conf.write(' -DSLEPC_MISSING_LAPACK_' + i.upper())
 
 
if petscconf.PRECISION == 'single':
functions = ['slamch','sstevr','sbdsdc']
else:
functions = ['dlamch','dstevr','dbdsdc']
 
for i in functions:
f = '#if defined(PETSC_HAVE_FORTRAN_UNDERSCORE) || defined(PETSC_BLASLAPACK_UNDERSCORE)\n'
f += i + '_\n'
f += '#elif defined(PETSC_HAVE_FORTRAN_CAPS)\n'
f += i.upper() + '\n'
f += '#else\n'
f += i + '\n'
f += '#endif\n'
log.Write('=== Checking LAPACK '+i+' function...')
if not check.Link([f],[],[]):
missing.append(i)
conf.write(' -DSLEPC_MISSING_LAPACK_' + i.upper())
conf.write('\n')
return missing
tags/slepc-2_3_3-1/config/lapack.py Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/config/check.py New file
0,0 → 1,132
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
import os
import sys
import commands
 
import petscconf
import log
 
def LinkWithOutput(functions,callbacks,flags):
code = '#include "petscksp.h"\n'
code += 'EXTERN_C_BEGIN\n'
for f in functions:
code += 'EXTERN int\n' + f + '();\n'
code += 'EXTERN_C_END\n'
for c in callbacks:
code += 'int '+ c + '() { return 0; } \n'
 
code += 'int main() {\n'
code += 'PetscInitialize(PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL);\n'
code += 'VecCreate(PETSC_NULL,PETSC_NULL);\n'
code += 'MatCreate(PETSC_NULL,PETSC_NULL);\n'
code += 'KSPCreate(PETSC_NULL,PETSC_NULL);\n'
for f in functions:
code += f + '();\n'
code += 'return 0;\n}\n'
os.chdir('config')
cfile = open('checklink.c','w')
cfile.write(code)
cfile.close()
(result, output) = commands.getstatusoutput(petscconf.MAKE + ' checklink TESTFLAGS="'+str.join(' ',flags)+'"')
if os.path.exists('checklink.o'):
os.unlink('checklink.o')
os.chdir(os.pardir)
if result:
return (0,code + output)
else:
return (1,code + output)
def Link(functions,callbacks,flags):
(result, output) = LinkWithOutput(functions,callbacks,flags)
log.Write(output)
return result
 
def FortranLink(functions,callbacks,flags):
output = '\n=== With linker flags: '+str.join(' ',flags)
 
f = []
for i in functions:
f.append(i+'_')
c = []
for i in callbacks:
c.append(i+'_')
(result, output1) = LinkWithOutput(f,c,flags)
output1 = '\n====== With underscore Fortran names\n' + output1
if result: return ('UNDERSCORE',output1)
 
f = []
for i in functions:
f.append(i.upper())
c = []
for i in callbacks:
c.append(i.upper())
(result, output2) = LinkWithOutput(f,c,flags)
output2 = '\n====== With capital Fortran names\n' + output2
if result: return ('CAPS',output2)
 
(result, output3) = LinkWithOutput(functions,callbacks,flags)
output3 = '\n====== With unmodified Fortran names\n' + output3
if result: return ('STDCALL',output3)
return ('',output + output1 + output2 + output3)
 
def GenerateGuesses(name):
installdirs = ['/usr/local','/opt']
if 'HOME' in os.environ:
installdirs.insert(0,os.environ['HOME'])
 
dirs = []
for i in installdirs:
dirs = dirs + [i + '/lib']
for d in [name,name.upper(),name.lower()]:
dirs = dirs + [i + '/' + d]
dirs = dirs + [i + '/' + d + '/lib']
dirs = dirs + [i + '/lib/' + d]
for d in dirs[:]:
if not os.path.exists(d):
dirs.remove(d)
dirs = [''] + dirs
return dirs
 
def FortranLib(conf,name,dirs,libs,functions,callbacks = []):
log.Write('='*80)
log.Println('Checking '+name+' library...')
 
error = ''
mangling = ''
for d in dirs:
for l in libs:
if d:
flags = ['-L' + d] + l
else:
flags = l
(mangling, output) = FortranLink(functions,callbacks,flags)
error += output
if mangling: break
if mangling: break
 
if mangling:
log.Write(output)
else:
log.Write(error)
log.Println('ERROR: Unable to link with library '+ name)
print 'ERROR: In directories',dirs
print 'ERROR: With flags',libs,
log.Exit('')
 
conf.write('SLEPC_HAVE_' + name + ' = -DSLEPC_HAVE_' + name + ' -DSLEPC_' + name + '_HAVE_'+mangling+'\n')
conf.write(name + '_LIB = '+str.join(' ',flags)+'\n')
return flags
tags/slepc-2_3_3-1/config/check.py Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/config/trlan.py New file
0,0 → 1,39
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
import os
import sys
 
import petscconf
import check
 
def Check(conf,directory,libs):
 
if petscconf.SCALAR == 'complex':
sys.exit('ERROR: TRLAN does not support complex numbers.')
 
if petscconf.PRECISION == 'single':
sys.exit('ERROR: TRLAN does not support single precision.')
 
functions = ['trlan77']
if libs:
libs = [libs]
else:
if petscconf.MPIUNI:
libs = [['-ltrlan']]
else:
libs = [['-ltrlan_mpi']]
 
if directory:
dirs = [directory]
else:
dirs = check.GenerateGuesses('TRLan')
return check.FortranLib(conf,'TRLAN',dirs,libs,functions)
tags/slepc-2_3_3-1/config/trlan.py Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/config/arpack.py New file
0,0 → 1,60
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
import os
import sys
 
import petscconf
import check
 
def Check(conf,directory,libs):
 
if petscconf.MPIUNI:
 
if petscconf.SCALAR == 'real':
if petscconf.PRECISION == 'single':
functions = ['snaupd','sneupd','dsaupd','dseupd']
else:
functions = ['dnaupd','dneupd','dsaupd','dseupd']
else:
if petscconf.PRECISION == 'single':
functions = ['cnaupd','cneupd']
else:
functions = ['znaupd','zneupd']
 
if libs:
libs = [libs]
else:
libs = [['-larpack'],['-larpack_LINUX'],['-larpack_SUN4']]
 
else:
 
if petscconf.SCALAR == 'real':
if petscconf.PRECISION == 'single':
functions = ['psnaupd','psneupd','pdsaupd','pdseupd']
else:
functions = ['pdnaupd','pdneupd','pdsaupd','pdseupd']
else:
if petscconf.PRECISION == 'single':
functions = ['pcnaupd','pcneupd']
else:
functions = ['pznaupd','pzneupd']
 
if libs:
libs = [libs]
else:
libs = [['-lparpack','-larpack'],['-lparpack_MPI','-larpack'],['-lparpack_MPI-LINUX','-larpack_LINUX'],['-lparpack_MPI-SUN4','-larpack_SUN4']]
 
if directory:
dirs = [directory]
else:
dirs = check.GenerateGuesses('Arpack')
return check.FortranLib(conf,'ARPACK',dirs,libs,functions)
tags/slepc-2_3_3-1/config/arpack.py Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/config/configure.py New file
0,0 → 1,228
#!/usr/bin/env python
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
import os
import sys
import time
 
import petscconf
import log
import check
import arpack
import blzpack
import trlan
import lapack
import primme
 
if not hasattr(sys, 'version_info') or not sys.version_info[1] >= 2:
print '**** You must have Python version 2.2 or higher to run config/configure.py ******'
print '* Python is easy to install for end users or sys-admin. *'
print '* http://www.python.org/download/ *'
print '* *'
print '* You CANNOT configure SLEPc without Python *'
print '*********************************************************************************'
sys.exit(4)
 
# support a few standard configure option types
for l in range(1,len(sys.argv)):
name = sys.argv[l]
if name.startswith('--enable'):
sys.argv[l] = name.replace('--enable','--with')
if name.find('=') == -1: sys.argv[l] += '=1'
if name.startswith('--disable'):
sys.argv[l] = name.replace('--disable','--with')
if name.find('=') == -1: sys.argv[l] += '=0'
elif name.endswith('=1'): sys.argv[l].replace('=1','=0')
if name.startswith('--without'):
sys.argv[l] = name.replace('--without','--with')
if name.find('=') == -1: sys.argv[l] += '=0'
elif name.endswith('=1'): sys.argv[l].replace('=1','=0')
 
# Check configure parameters
havearpack = 0
arpackdir = ''
arpacklibs = []
haveblzpack = 0
blzpackdir = ''
blzpacklibs = []
havetrlan = 0
trlandir = ''
trlanlibs = []
haveprimme = 0
primmedir = ''
primmelibs = []
prefixdir = ''
 
for i in sys.argv[1:]:
if i.startswith('--with-arpack-dir='):
arpackdir = i.split('=')[1]
havearpack = 1
elif i.startswith('--with-arpack-flags='):
arpacklibs = i.split('=')[1].split(',')
havearpack = 1
elif i.startswith('--with-arpack'):
havearpack = not i.endswith('=0')
elif i.startswith('--with-blzpack-dir='):
blzpackdir = i.split('=')[1]
haveblzpack = 1
elif i.startswith('--with-blzpack-flags='):
blzpacklibs = i.split('=')[1].split(',')
haveblzpack = 1
elif i.startswith('--with-blzpack'):
haveblzpack = not i.endswith('=0')
elif i.startswith('--with-trlan-dir='):
trlandir = i.split('=')[1]
havetrlan = 1
elif i.startswith('--with-trlan-flags='):
trlanlibs = i.split('=')[1].split(',')
havetrlan = 1
elif i.startswith('--with-trlan'):
havetrlan = not i.endswith('=0')
elif i.startswith('--with-primme-dir'):
primmedir = i.split('=')[1]
haveprimme = 1
elif i.startswith('--with-primme-flags='):
primmelibs = i.split('=')[1].split(',')
haveprimme = 1
elif i.startswith('--with-primme'):
haveprimme = not i.endswith('=0')
elif i.startswith('--prefix='):
prefixdir = i.split('=')[1]
elif i.startswith('--h') or i.startswith('-h') or i.startswith('-?'):
print 'SLEPc Configure Help'
print '-'*80
print ' --prefix=<dir> : Specifiy location to install SLEPc (eg. /usr/local)'
print 'ARPACK:'
print ' --with-arpack : Indicate if you wish to test for ARPACK (PARPACK)'
print ' --with-arpack-dir=<dir> : Indicate the directory for ARPACK libraries'
print ' --with-arpack-flags=<flags> : Indicate comma-separated flags for linking ARPACK'
print 'BLZPACK:'
print ' --with-blzpack : Indicate if you wish to test for BLZPACK'
print ' --with-blzpack-dir=<dir> : Indicate the directory for BLZPACK libraries'
print ' --with-blzpack-flags=<flags> : Indicate comma-separated flags for linking BLZPACK'
print 'TRLAN:'
print ' --with-trlan : Indicate if you wish to test for TRLAN'
print ' --with-trlan-dir=<dir> : Indicate the directory for TRLAN libraries'
print ' --with-trlan-flags=<flags> : Indicate comma-separated flags for linking TRLAN'
print 'PRIMME:'
print ' --with-primme : Indicate if you wish to test for PRIMME'
print ' --with-primme-dir=<dir> : Indicate the directory for PRIMME libraries'
print ' --with-primme-flags=<flags> : Indicate comma-separated flags for linking PRIMME'
sys.exit(0)
else:
sys.exit('ERROR: Invalid argument ' + i +' use -h for help')
 
# Check if enviroment is ok
print 'Checking environment...'
if 'SLEPC_DIR' not in os.environ:
sys.exit('ERROR: SLEPC_DIR enviroment variable is not set')
slepcdir = os.environ['SLEPC_DIR']
if not os.path.exists(slepcdir) or not os.path.exists(os.sep.join([slepcdir,'bmake'])):
sys.exit('ERROR: SLEPC_DIR enviroment variable is not valid')
os.chdir(slepcdir)
if 'PETSC_DIR' not in os.environ:
sys.exit('ERROR: PETSC_DIR enviroment variable is not set')
petscdir = os.environ['PETSC_DIR']
if not os.path.exists(petscdir) or not os.path.exists(os.sep.join([petscdir,'bmake'])):
sys.exit('ERROR: PETSC_DIR enviroment variable is not valid')
 
# Check some information about PETSc configuration
petscconf.Load(petscdir)
if petscconf.VERSION < '2.3.3':
sys.exit('ERROR: This SLEPc version is not compatible with PETSc version '+petscconf.VERSION)
if not petscconf.PRECISION in ['double','single','matsingle']:
sys.exit('ERROR: This SLEPc version does not work with '+petscconf.PRECISION+' precision')
 
# Create architecture directory and configuration file
archdir = os.sep.join([slepcdir,'bmake',petscconf.ARCH])
if not os.path.exists(archdir):
try:
os.mkdir(archdir)
except:
sys.exit('ERROR: cannot create architecture directory ' + archdir)
try:
slepcconf = open(os.sep.join([archdir,'slepcconf']),'w')
if not prefixdir:
prefixdir = slepcdir
slepcconf.write('SLEPC_INSTALL_DIR =' + prefixdir +'\n')
except:
sys.exit('ERROR: cannot create configuration file in ' + archdir)
 
# Open log file
log.Open('configure_log_' + petscconf.ARCH)
log.Write('='*80)
log.Write('Starting Configure Run at '+time.ctime(time.time()))
log.Write('Configure Options: '+str.join(' ',sys.argv))
log.Write('Working directory: '+os.getcwd())
log.Write('Python version:\n' + sys.version)
log.Write('='*80)
 
# Check if PETSc is working
log.Println('Checking PETSc installation...')
if petscconf.VERSION > '2.3.3':
log.Println('WARNING: PETSc version '+petscconf.VERSION+' is newer than SLEPc version')
if petscconf.RELEASE != '1':
log.Println('WARNING: using PETSc development version')
if petscconf.INSTALL_DIR != petscdir:
log.Println('WARNING: PETSC_DIR does not point to PETSc installation path')
if not check.Link([],[],[]):
log.Exit('ERROR: Unable to link with PETSc')
 
# Check for missing LAPACK functions
missing = lapack.Check(slepcconf)
 
# Check for external packages
if havearpack:
arpacklibs = arpack.Check(slepcconf,arpackdir,arpacklibs)
if haveblzpack:
blzpacklibs = blzpack.Check(slepcconf,blzpackdir,blzpacklibs)
if havetrlan:
trlanlibs = trlan.Check(slepcconf,trlandir,trlanlibs)
if haveprimme:
primmelibs = primme.Check(slepcconf,primmedir,primmelibs)
 
slepcconf.close()
 
log.Println('')
log.Println('='*80)
log.Println('SLEPc Configuration')
log.Println('='*80)
log.Println('')
log.Println('SLEPc source directory:')
log.Println(' '+slepcdir)
log.Println('SLEPc install directory:')
log.Println(' '+prefixdir)
log.Println('PETSc directory:')
log.Println(' '+petscdir)
log.Println('Architecture "'+petscconf.ARCH+'" with '+petscconf.PRECISION+' precision '+petscconf.SCALAR+' numbers')
if petscconf.MPIUNI:
log.Println(' Uniprocessor version without MPI')
if havearpack:
log.Println('ARPACK library flags:')
log.Println(' '+str.join(' ',arpacklibs))
if haveblzpack:
log.Println('BLZPACK library flags:')
log.Println(' '+str.join(' ',blzpacklibs))
if havetrlan:
log.Println('TRLAN library flags:')
log.Println(' '+str.join(' ',trlanlibs))
if haveprimme:
log.Println('PRIMME library flags:')
log.Println(' '+str.join(' ',primmelibs))
if missing:
log.Println('LAPACK missing functions:')
log.Print(' ')
for i in missing: log.Print(i)
log.Println('')
log.Println('')
log.Println('WARNING: Some SLEPc functionality will not be available')
log.Println('PLEASE reconfigure and recompile PETSc with a full LAPACK implementation')
print
tags/slepc-2_3_3-1/config/configure.py Property changes : Added: svn:executable
+ *
Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/config/log.py New file
0,0 → 1,39
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
import sys
 
import petscconf
 
def Open(filename):
global f
f = open(filename,'w')
return
 
def Println(string):
print string
f.write(string)
f.write('\n')
 
def Print(string):
print string,
f.write(string+' ')
def Write(string):
f.write(string)
f.write('\n')
def Exit(string):
f.write(string)
f.write('\n')
f.close()
print string
sys.exit('ERROR: See "configure_log_' + petscconf.ARCH + '" file for details')
 
tags/slepc-2_3_3-1/config/log.py Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/config/petscconf.py New file
0,0 → 1,72
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
import os
import sys
 
def Load(petscdir):
global ARCH,DIR,MAKE,SCALAR,PRECISION,MPIUNI,VERSION,RELEASE,INSTALL_DIR
if 'PETSC_ARCH' in os.environ:
ARCH = os.environ['PETSC_ARCH']
else:
try:
f = open(os.sep.join([petscdir,'bmake','petscconf']))
ARCH = ''
for l in f.readlines():
if l.startswith('PETSC_ARCH='):
ARCH = l.split('=')[1].rstrip()
f.close()
break
f.close()
except:
sys.exit('ERROR: PETSc must be configured first')
if not ARCH:
sys.exit('ERROR: please set enviroment variable PETSC_ARCH')
 
MPIUNI = 0
try:
f = open(os.sep.join([petscdir,'bmake',ARCH,'petscconf']))
for l in f.readlines():
(k,v) = l.split('=',1)
k = k.strip()
v = v.strip()
if k == 'PETSC_SCALAR':
SCALAR = v
elif k == 'PETSC_PRECISION':
PRECISION = v
elif k == 'MPI_INCLUDE' and v.endswith('mpiuni'):
MPIUNI = 1
elif k == 'MAKE':
MAKE = v
elif k == 'INSTALL_DIR':
INSTALL_DIR = v
f.close()
except:
sys.exit('ERROR: PETSc is not configured for architecture ' + ARCH)
 
try:
f = open(os.sep.join([petscdir,'include','petscversion.h']))
for l in f.readlines():
l = l.split()
if len(l) == 3:
if l[1] == 'PETSC_VERSION_RELEASE':
RELEASE = l[2]
if l[1] == 'PETSC_VERSION_MAJOR':
major = l[2]
elif l[1] == 'PETSC_VERSION_MINOR':
minor = l[2]
elif l[1] == 'PETSC_VERSION_SUBMINOR':
subminor = l[2]
f.close()
VERSION = major + '.' + minor + '.' + subminor
except:
sys.exit('ERROR: file error while reading PETSC version')
tags/slepc-2_3_3-1/config/petscconf.py Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/config/blzpack.py New file
0,0 → 1,37
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
import os
import sys
 
import petscconf
import check
 
def Check(conf,directory,libs):
 
if petscconf.SCALAR == 'complex':
sys.exit('ERROR: BLZPACK does not support complex numbers.')
if petscconf.PRECISION == 'single':
functions = ['blzdrs']
else:
functions = ['blzdrd']
 
if libs:
libs = [libs]
else:
libs = [['-lblzpack']]
 
if directory:
dirs = [directory]
else:
dirs = check.GenerateGuesses('Blzpack')
 
return check.FortranLib(conf,'BLZPACK',dirs,libs,functions)
tags/slepc-2_3_3-1/config/blzpack.py Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/config/makefile New file
0,0 → 1,15
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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 ${PETSC_DIR}/bmake/common/base
 
checklink: checklink.o chkopts
${CLINKER} -o checklink checklink.o ${TESTFLAGS} ${PETSC_KSP_LIB}
@${RM} -f checklink checklink.o
tags/slepc-2_3_3-1/config/makefile Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/config/generatefortranstubs.py New file
0,0 → 1,136
#!/usr/bin/env python
#!/bin/env python
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
# Generates fortran stubs for PETSc using Sowings bfort program
#
import os
#
# Opens all generated files and fixes them; also generates list in makefile.src
#
def FixFile(filename):
import re
ff = open(filename)
data = ff.read()
ff.close()
 
# gotta be a better way to do this
data = re.subn('\nvoid ','\nvoid PETSC_STDCALL ',data)[0]
data = re.subn('\nPetscErrorCode ','\nvoid PETSC_STDCALL ',data)[0]
data = re.subn('Petsc([ToRm]*)Pointer\(int\)','Petsc\\1Pointer(void*)',data)[0]
data = re.subn('PetscToPointer\(a\) \(a\)','PetscToPointer(a) (*(long *)(a))',data)[0]
data = re.subn('PetscFromPointer\(a\) \(int\)\(a\)','PetscFromPointer(a) (long)(a)',data)[0]
data = re.subn('PetscToPointer\( \*\(int\*\)','PetscToPointer(',data)[0]
data = re.subn('MPI_Comm comm','MPI_Comm *comm',data)[0]
data = re.subn('\(MPI_Comm\)PetscToPointer\( \(comm\) \)','(MPI_Comm)MPI_Comm_f2c(*(MPI_Fint*)(comm))',data)[0]
data = re.subn('\(PetscInt\* \)PetscToPointer','',data)[0]
match = re.compile(r"""\b(PETSC)(_DLL|VEC_DLL|MAT_DLL|DM_DLL|KSP_DLL|SNES_DLL|TS_DLL|FORTRAN_DLL)(EXPORT)""")
data = match.sub(r'',data)
 
ff = open(filename, 'w')
ff.write('#include "petsc.h"\n#include "petscfix.h"\n'+data)
ff.close()
return
 
def FixDir(dir):
names = []
for f in os.listdir(dir):
if os.path.splitext(f)[1] == '.c':
FixFile(os.path.join(dir, f))
names.append(f)
if not names == []:
mfile=os.path.abspath(os.path.join(dir,'..','makefile'))
try:
fd=open(mfile,'r')
except:
print 'Error! missing file:', mfile
return
inbuf = fd.read()
fd.close()
libbase = ""
locdir = ""
for line in inbuf.splitlines():
if line.find('LIBBASE') >=0:
libbase = line
elif line.find('LOCDIR') >=0:
locdir = line.rstrip() + 'ftn-auto/'
 
# now assemble the makefile
outbuf = '\n'
outbuf += "#requirespackage 'PETSC_HAVE_FORTRAN'\n"
outbuf += 'ALL: lib\n'
outbuf += 'CFLAGS =\n'
outbuf += 'FFLAGS =\n'
outbuf += 'SOURCEC = ' +' '.join(names)+ '\n'
outbuf += 'OBJSC = ' +' '.join(names).replace('.c','.o')+ '\n'
outbuf += 'SOURCEF =\n'
outbuf += 'SOURCEH =\n'
outbuf += 'DIRS =\n'
outbuf += libbase + '\n'
outbuf += locdir + '\n'
# outbuf += 'include ${PETSC_DIR}/bmake/common/base\n'
# outbuf += 'include ${PETSC_DIR}/bmake/common/test\n'
outbuf += 'include ${SLEPC_DIR}/bmake/slepc_common \n'
ff = open(os.path.join(dir, 'makefile'), 'w')
ff.write(outbuf)
ff.close()
 
# if dir is empty - remove it
if os.path.exists(dir) and os.path.isdir(dir) and os.listdir(dir) == []:
os.rmdir(dir)
return
 
def PrepFtnDir(dir):
if os.path.exists(dir) and not os.path.isdir(dir):
raise RuntimeError('Error - specified path is not a dir: ' + dir)
elif not os.path.exists(dir):
os.mkdir(dir)
else:
files = os.listdir(dir)
for file in files:
os.remove(os.path.join(dir,file))
return
 
def processDir(arg,dirname,names):
import commands
petscdir = arg[0]
bfort = arg[1]
newls = []
for l in names:
if os.path.splitext(l)[1] =='.c' or os.path.splitext(l)[1] == '.h':
newls.append(l)
if newls:
outdir = os.path.join(dirname,'ftn-auto')
PrepFtnDir(outdir)
options = ['-dir '+outdir, '-mnative', '-ansi', '-nomsgs', '-noprofile', '-anyname', '-mapptr',
'-mpi', '-mpi2', '-ferr', '-ptrprefix Petsc', '-ptr64 PETSC_USE_POINTER_CONVERSION',
'-fcaps PETSC_HAVE_FORTRAN_CAPS', '-fuscore PETSC_HAVE_FORTRAN_UNDERSCORE']
(status,output) = commands.getstatusoutput('cd '+dirname+';'+bfort+' '+' '.join(options+newls))
if status:
raise RuntimeError('Error running bfort '+output)
FixDir(outdir)
for name in ['CVS', 'SCCS', 'output', 'BitKeeper', 'examples', 'externalpackages', 'bilinear', 'ftn-auto','fortran']:
if name in names:
names.remove(name)
return
 
def main(bfort):
petscdir = os.getcwd()
tmpdir = os.path
os.path.walk(petscdir, processDir, [petscdir, bfort])
return
#
# The classes in this file can also be used in other python-programs by using 'import'
#
if __name__ == '__main__':
import sys
if len(sys.argv) < 2:
sys.exit('Must give the BFORT program as the first argument')
main(sys.argv[1])
tags/slepc-2_3_3-1/config/generatefortranstubs.py Property changes : Added: svn:executable
+ *
Added: svn:keywords
+ Author Date Id Revision
Added: svn:eol-style
+ native
tags/slepc-2_3_3-1/config Property changes : Added: svn:ignore
+ checklink.c
*.pyc
/tags/slepc-2_3_3-1/src/mat/examples/bfw62a.petsc Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
tags/slepc-2_3_3-1/src/mat/examples/bfw62a.petsc Property changes : Added: svn:mime-type
+ application/octet-stream
/tags/slepc-2_3_3-1/src/mat/examples/bfw62b.petsc Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
tags/slepc-2_3_3-1/src/mat/examples/bfw62b.petsc Property changes : Added: svn:mime-type
+ application/octet-stream
/tags/slepc-2_3_3-1/src/mat/examples/rdb200.petsc Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
tags/slepc-2_3_3-1/src/mat/examples/rdb200.petsc Property changes : Added: svn:mime-type
+ application/octet-stream
/tags/slepc-2_3_3-1/src/mat/examples/readme New file
0,0 → 1,17
 
SLEPc example matrices
----------------------
 
Matrices taken from the Non-Hermitian Eigenvalue Problem Collection.
Matrix Market - NEP Collection (http://math.nist.gov/MatrixMarket/data/NEP).
 
Saved in MATMPIAIJ format with a PetscViewerBinary.
 
 
File Name Description
----------------------------------------------------------------------------
rdb200 Brusselator real unsymmetric, 200 by 200, 1120 entries
 
bfw62a Waveguide real unsymmetric, 62 by 62, 450 entries
bfw62b real symmetric indefinite, 62 by 62, 342 entries
 
tags/slepc-2_3_3-1/src/mat/examples/readme Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/interface/ftn-custom/zstf.c New file
0,0 → 1,125
/*
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "slepcst.h"
 
#ifdef PETSC_HAVE_FORTRAN_CAPS
#define stsettype_ STSETTYPE
#define stgettype_ STGETTYPE
#define stcreate_ STCREATE
#define stgetoperators_ STGETOPERATORS
#define stsetoptionsprefix_ STSETOPTIONSPREFIX
#define stappendoptionsprefix_ STAPPENDOPTIONSPREFIX
#define stgetoptionsprefix_ STGETOPTIONSPREFIX
#define stview_ STVIEW
#define stgetmatmode_ STGETMATMODE
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
#define stsettype_ stsettype
#define stgettype_ stgettype
#define stcreate_ stcreate
#define stgetoperators_ stgetoperators
#define stsetoptionsprefix_ stsetoptionsprefix
#define stappendoptionsprefix_ stappendoptionsprefix
#define stgetoptionsprefix_ stgetoptionsprefix
#define stview_ stview
#define stgetmatmode_ stgetmatmode
#endif
 
EXTERN_C_BEGIN
 
void PETSC_STDCALL stsettype_(ST *st,CHAR type PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
{
char *t;
 
FIXCHAR(type,len,t);
*ierr = STSetType(*st,t);
FREECHAR(type,t);
}
 
void PETSC_STDCALL stgettype_(ST *st,CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
{
const char *tname;
 
*ierr = STGetType(*st,&tname);
#if defined(PETSC_USES_CPTOFCD)
{
char *t = _fcdtocp(name); int len1 = _fcdlen(name);
*ierr = PetscStrncpy(t,tname,len1); if (*ierr) return;
}
#else
*ierr = PetscStrncpy(name,tname,len);if (*ierr) return;
#endif
FIXRETURNCHAR(name,len);
}
 
void PETSC_STDCALL stcreate_(MPI_Fint *comm,ST *newst,PetscErrorCode *ierr)
{
*ierr = STCreate(MPI_Comm_f2c(*(comm)),newst);
}
 
void PETSC_STDCALL stgetoperators_(ST *st,Mat *mat,Mat *pmat,PetscErrorCode *ierr)
{
if (FORTRANNULLOBJECT(mat)) mat = PETSC_NULL;
if (FORTRANNULLOBJECT(pmat)) pmat = PETSC_NULL;
*ierr = STGetOperators(*st,mat,pmat);
}
 
void PETSC_STDCALL stsetoptionsprefix_(ST *st,CHAR prefix PETSC_MIXED_LEN(len),
PetscErrorCode *ierr PETSC_END_LEN(len))
{
char *t;
 
FIXCHAR(prefix,len,t);
*ierr = STSetOptionsPrefix(*st,t);
FREECHAR(prefix,t);
}
 
void PETSC_STDCALL stappendoptionsprefix_(ST *st,CHAR prefix PETSC_MIXED_LEN(len),
PetscErrorCode *ierr PETSC_END_LEN(len))
{
char *t;
 
FIXCHAR(prefix,len,t);
*ierr = STAppendOptionsPrefix(*st,t);
FREECHAR(prefix,t);
}
 
void PETSC_STDCALL stgetoptionsprefix_(ST *st,CHAR prefix PETSC_MIXED_LEN(len),
PetscErrorCode *ierr PETSC_END_LEN(len))
{
const char *tname;
 
*ierr = STGetOptionsPrefix(*st,&tname);
#if defined(PETSC_USES_CPTOFCD)
{
char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
*ierr = PetscStrncpy(t,tname,len1);if (*ierr) return;
}
#else
*ierr = PetscStrncpy(prefix,tname,len);if (*ierr) return;
#endif
FIXRETURNCHAR(prefix,len);
}
 
void PETSC_STDCALL stview_(ST *st,PetscViewer *viewer, PetscErrorCode *ierr)
{
PetscViewer v;
PetscPatchDefaultViewers_Fortran(viewer,v);
*ierr = STView(*st,v);
}
 
void PETSC_STDCALL stgetmatmode_(ST *st,STMatMode *mode,int *ierr)
{
*ierr = STGetMatMode(*st,mode);
}
 
EXTERN_C_END
 
tags/slepc-2_3_3-1/src/st/interface/ftn-custom/zstf.c Property changes : Added: svn:keywords
+ Author Date Id Revision
Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/interface/ftn-custom/makefile New file
0,0 → 1,22
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
#requirespackage 'PETSC_HAVE_FORTRAN'
ALL: lib
CFLAGS =
FFLAGS =
SOURCEC = zstf.c
OBJSC = zstf.o
SOURCEF =
SOURCEH =
DIRS =
LIBBASE = libslepc
LOCDIR = src/st/interface/ftn-custom/
include ${SLEPC_DIR}/bmake/slepc_common
tags/slepc-2_3_3-1/src/st/interface/ftn-custom/makefile Property changes : Added: svn:keywords
+ Author Date Id Revision
Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/interface/stsolve.c New file
0,0 → 1,288
/*
The ST (spectral transformation) interface routines, callable by users.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/st/stimpl.h" /*I "slepcst.h" I*/
 
#undef __FUNCT__
#define __FUNCT__ "STApply"
/*@
STApply - Applies the spectral transformation operator to a vector, for
instance (A - sB)^-1 B in the case of the shift-and-invert tranformation
and generalized eigenproblem.
 
Collective on ST and Vec
 
Input Parameters:
+ st - the spectral transformation context
- x - input vector
 
Output Parameter:
. y - output vector
 
Level: developer
 
.seealso: STApplyTranspose()
@*/
PetscErrorCode STApply(ST st,Vec x,Vec y)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
PetscValidHeaderSpecific(x,VEC_COOKIE,2);
PetscValidHeaderSpecific(y,VEC_COOKIE,3);
if (x == y) SETERRQ(PETSC_ERR_ARG_IDN,"x and y must be different vectors");
 
if (!st->setupcalled) { ierr = STSetUp(st); CHKERRQ(ierr); }
 
ierr = PetscLogEventBegin(ST_Apply,st,x,y,0);CHKERRQ(ierr);
st->applys++;
ierr = (*st->ops->apply)(st,x,y);CHKERRQ(ierr);
ierr = PetscLogEventEnd(ST_Apply,st,x,y,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STGetBilinearForm"
/*@
STGetBilinearForm - Returns the matrix used in the bilinear form with a semi-definite generalised problem.
 
Collective on ST and Mat
 
Input Parameters:
. st - the spectral transformation context
 
Output Parameter:
. B - output matrix
 
Level: developer
@*/
PetscErrorCode STGetBilinearForm(ST st,Mat *B)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
PetscValidPointer(B,2);
ierr = (*st->ops->getbilinearform)(st,B);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STGetBilinearForm_Default"
PetscErrorCode STGetBilinearForm_Default(ST st,Mat *B)
{
PetscFunctionBegin;
*B = st->B;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STApplyTranspose"
/*@
STApplyTranspose - Applies the transpose of the operator to a vector, for
instance B^T(A - sB)^-T in the case of the shift-and-invert tranformation
and generalized eigenproblem.
 
Collective on ST and Vec
 
Input Parameters:
+ st - the spectral transformation context
- x - input vector
 
Output Parameter:
. y - output vector
 
Level: developer
 
.seealso: STApply()
@*/
PetscErrorCode STApplyTranspose(ST st,Vec x,Vec y)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
PetscValidHeaderSpecific(x,VEC_COOKIE,2);
PetscValidHeaderSpecific(y,VEC_COOKIE,3);
if (x == y) SETERRQ(PETSC_ERR_ARG_IDN,"x and y must be different vectors");
 
if (!st->setupcalled) { ierr = STSetUp(st); CHKERRQ(ierr); }
 
ierr = PetscLogEventBegin(ST_ApplyTranspose,st,x,y,0);CHKERRQ(ierr);
ierr = (*st->ops->applytrans)(st,x,y);CHKERRQ(ierr);
ierr = PetscLogEventEnd(ST_ApplyTranspose,st,x,y,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STComputeExplicitOperator"
/*@
STComputeExplicitOperator - Computes the explicit operator associated
to the eigenvalue problem with the specified spectral transformation.
 
Collective on ST
 
Input Parameter:
. st - the spectral transform context
 
Output Parameter:
. mat - the explicit operator
 
Notes:
This routine builds a matrix containing the explicit operator. For
example, in generalized problems with shift-and-invert spectral
transformation the result would be matrix (A - s B)^-1 B.
This computation is done by applying the operator to columns of the
identity matrix. Note that the result is a dense matrix.
 
Level: advanced
 
.seealso: STApply()
@*/
PetscErrorCode STComputeExplicitOperator(ST st,Mat *mat)
{
PetscErrorCode ierr;
Vec in,out;
PetscInt i,M,m,*rows,start,end;
PetscScalar *array,one = 1.0;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
PetscValidPointer(mat,2);
 
ierr = MatGetVecs(st->A,&in,&out);CHKERRQ(ierr);
ierr = VecGetSize(out,&M);CHKERRQ(ierr);
ierr = VecGetLocalSize(out,&m);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(out,&start,&end);CHKERRQ(ierr);
ierr = PetscMalloc(m*sizeof(int),&rows);CHKERRQ(ierr);
for (i=0; i<m; i++) rows[i] = start + i;
 
ierr = MatCreateMPIDense(st->comm,m,m,M,M,PETSC_NULL,mat);CHKERRQ(ierr);
 
for (i=0; i<M; i++) {
ierr = VecSet(in,0.0);CHKERRQ(ierr);
ierr = VecSetValues(in,1,&i,&one,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(in);CHKERRQ(ierr);
ierr = VecAssemblyEnd(in);CHKERRQ(ierr);
 
ierr = STApply(st,in,out); CHKERRQ(ierr);
ierr = VecGetArray(out,&array);CHKERRQ(ierr);
ierr = MatSetValues(*mat,m,rows,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecRestoreArray(out,&array);CHKERRQ(ierr);
}
ierr = PetscFree(rows);CHKERRQ(ierr);
ierr = VecDestroy(in);CHKERRQ(ierr);
ierr = VecDestroy(out);CHKERRQ(ierr);
ierr = MatAssemblyBegin(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetUp"
/*@
STSetUp - Prepares for the use of a spectral transformation.
 
Collective on ST
 
Input Parameter:
. st - the spectral transformation context
 
Level: advanced
 
.seealso: STCreate(), STApply(), STDestroy()
@*/
PetscErrorCode STSetUp(ST st)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
 
PetscInfo(st,"Setting up new ST\n");
if (st->setupcalled) PetscFunctionReturn(0);
ierr = PetscLogEventBegin(ST_SetUp,st,0,0,0);CHKERRQ(ierr);
if (!st->A) {SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Matrix must be set first");}
if (!st->type_name) {
ierr = STSetType(st,STSHIFT);CHKERRQ(ierr);
}
if (st->w) { ierr = VecDestroy(st->w);CHKERRQ(ierr); }
ierr = MatGetVecs(st->A,&st->w,PETSC_NULL);CHKERRQ(ierr);
if (st->ops->setup) {
ierr = (*st->ops->setup)(st); CHKERRQ(ierr);
}
st->setupcalled = 1;
ierr = PetscLogEventEnd(ST_SetUp,st,0,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STPostSolve"
/*@
STPostSolve - Optional post-solve phase, intended for any actions that must
be performed on the ST object after the eigensolver has finished.
 
Collective on ST
 
Input Parameters:
. st - the spectral transformation context
 
Level: developer
 
.seealso: EPSSolve()
@*/
PetscErrorCode STPostSolve(ST st)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
if (st->ops->postsolve) {
ierr = (*st->ops->postsolve)(st);CHKERRQ(ierr);
}
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STBackTransform"
/*@
STBackTransform - Back-transformation phase, intended for
spectral transformations which require to transform the computed
eigenvalues back to the original eigenvalue problem.
 
Collective on ST
 
Input Parameters:
st - the spectral transformation context
eigr - real part of a computed eigenvalue
eigi - imaginary part of a computed eigenvalue
 
Level: developer
 
.seealso: EPSBackTransform()
@*/
PetscErrorCode STBackTransform(ST st,PetscScalar* eigr,PetscScalar* eigi)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
if (st->ops->backtr) {
ierr = (*st->ops->backtr)(st,eigr,eigi);CHKERRQ(ierr);
}
 
PetscFunctionReturn(0);
}
tags/slepc-2_3_3-1/src/st/interface/stsolve.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/interface/stregis.c New file
0,0 → 1,47
/*
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/st/stimpl.h" /*I "slepcst.h" I*/
 
EXTERN_C_BEGIN
EXTERN PetscErrorCode STCreate_Shell(ST);
EXTERN PetscErrorCode STCreate_Shift(ST);
EXTERN PetscErrorCode STCreate_Sinvert(ST);
EXTERN PetscErrorCode STCreate_Cayley(ST);
EXTERN PetscErrorCode STCreate_Fold(ST);
EXTERN_C_END
 
#undef __FUNCT__
#define __FUNCT__ "STRegisterAll"
/*@C
STRegisterAll - Registers all of the spectral transformations in the ST package.
 
Not Collective
 
Input Parameter:
. path - the library where the routines are to be found (optional)
 
Level: advanced
 
.seealso: STRegisterDynamic()
@*/
PetscErrorCode STRegisterAll(char *path)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
ierr = STRegisterDynamic(STSHELL ,path,"STCreate_Shell",STCreate_Shell);CHKERRQ(ierr);
ierr = STRegisterDynamic(STSHIFT ,path,"STCreate_Shift",STCreate_Shift);CHKERRQ(ierr);
ierr = STRegisterDynamic(STSINV ,path,"STCreate_Sinvert",STCreate_Sinvert);CHKERRQ(ierr);
ierr = STRegisterDynamic(STCAYLEY ,path,"STCreate_Cayley",STCreate_Cayley);CHKERRQ(ierr);
ierr = STRegisterDynamic(STFOLD ,path,"STCreate_Fold",STCreate_Fold);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
tags/slepc-2_3_3-1/src/st/interface/stregis.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/interface/stfunc.c New file
0,0 → 1,567
/*
The ST (spectral transformation) interface routines, callable by users.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/st/stimpl.h" /*I "slepcst.h" I*/
 
PetscCookie ST_COOKIE = 0;
PetscEvent ST_SetUp = 0, ST_Apply = 0, ST_ApplyTranspose = 0;
 
#undef __FUNCT__
#define __FUNCT__ "STInitializePackage"
/*@C
STInitializePackage - This function initializes everything in the ST package. It is called
from PetscDLLibraryRegister() when using dynamic libraries, and on the first call to STCreate()
when using static libraries.
 
Input Parameter:
path - The dynamic library path, or PETSC_NULL
 
Level: developer
 
.seealso: SlepcInitialize()
@*/
PetscErrorCode STInitializePackage(char *path) {
static PetscTruth initialized = PETSC_FALSE;
char logList[256];
char *className;
PetscTruth opt;
PetscErrorCode ierr;
 
PetscFunctionBegin;
if (initialized) PetscFunctionReturn(0);
initialized = PETSC_TRUE;
/* Register Classes */
ierr = PetscLogClassRegister(&ST_COOKIE,"Spectral Transform");CHKERRQ(ierr);
/* Register Constructors */
ierr = STRegisterAll(path);CHKERRQ(ierr);
/* Register Events */
ierr = PetscLogEventRegister(&ST_SetUp,"STSetUp",ST_COOKIE);CHKERRQ(ierr);
ierr = PetscLogEventRegister(&ST_Apply,"STApply",ST_COOKIE);CHKERRQ(ierr);
ierr = PetscLogEventRegister(&ST_ApplyTranspose,"STApplyTranspose",ST_COOKIE); CHKERRQ(ierr);
/* Process info exclusions */
ierr = PetscOptionsGetString(PETSC_NULL, "-log_info_exclude", logList, 256, &opt);CHKERRQ(ierr);
if (opt) {
ierr = PetscStrstr(logList, "st", &className);CHKERRQ(ierr);
if (className) {
ierr = PetscInfoDeactivateClass(ST_COOKIE);CHKERRQ(ierr);
}
}
/* Process summary exclusions */
ierr = PetscOptionsGetString(PETSC_NULL, "-log_summary_exclude", logList, 256, &opt);CHKERRQ(ierr);
if (opt) {
ierr = PetscStrstr(logList, "st", &className);CHKERRQ(ierr);
if (className) {
ierr = PetscLogEventDeactivateClass(ST_COOKIE);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STDestroy"
/*@
STDestroy - Destroys ST context that was created with STCreate().
 
Collective on ST
 
Input Parameter:
. st - the spectral transformation context
 
Level: beginner
 
.seealso: STCreate(), STSetUp()
@*/
PetscErrorCode STDestroy(ST st)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
if (--st->refct > 0) PetscFunctionReturn(0);
 
/* if memory was published with AMS then destroy it */
ierr = PetscObjectDepublish(st);CHKERRQ(ierr);
 
if (st->ops->destroy) { ierr = (*st->ops->destroy)(st);CHKERRQ(ierr); }
if (st->ksp) { ierr = KSPDestroy(st->ksp);CHKERRQ(ierr); }
if (st->w) { ierr = VecDestroy(st->w);CHKERRQ(ierr); }
if (st->shift_matrix != STMATMODE_INPLACE && st->mat) {
ierr = MatDestroy(st->mat);CHKERRQ(ierr);
}
 
PetscHeaderDestroy(st);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STPublish_Petsc"
static PetscErrorCode STPublish_Petsc(PetscObject object)
{
PetscFunctionBegin;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STCreate"
/*@C
STCreate - Creates a spectral transformation context.
 
Collective on MPI_Comm
 
Input Parameter:
. comm - MPI communicator
 
Output Parameter:
. st - location to put the spectral transformation context
 
Level: beginner
 
.seealso: STSetUp(), STApply(), STDestroy(), ST
@*/
PetscErrorCode STCreate(MPI_Comm comm,ST *newst)
{
PetscErrorCode ierr;
ST st;
const char *prefix;
 
PetscFunctionBegin;
PetscValidPointer(newst,2);
*newst = 0;
 
PetscHeaderCreate(st,_p_ST,struct _STOps,ST_COOKIE,-1,"ST",comm,STDestroy,STView);
st->bops->publish = STPublish_Petsc;
ierr = PetscMemzero(st->ops,sizeof(struct _STOps));CHKERRQ(ierr);
 
st->A = 0;
st->B = 0;
st->sigma = 0.0;
st->data = 0;
st->setupcalled = 0;
st->w = 0;
st->shift_matrix = STMATMODE_COPY;
st->str = DIFFERENT_NONZERO_PATTERN;
ierr = KSPCreate(st->comm,&st->ksp);CHKERRQ(ierr);
ierr = STGetOptionsPrefix(st,&prefix);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(st->ksp,prefix);CHKERRQ(ierr);
ierr = KSPAppendOptionsPrefix(st->ksp,"st_");CHKERRQ(ierr);
*newst = st;
ierr = PetscPublishAll(st);CHKERRQ(ierr);
PetscFunctionReturn(0);
 
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetOperators"
/*@
STSetOperators - Sets the matrices associated with the eigenvalue problem.
 
Collective on ST and Mat
 
Input Parameters:
+ st - the spectral transformation context
. A - the matrix associated with the eigensystem
- B - the second matrix in the case of generalized eigenproblems
 
Notes:
To specify a standard eigenproblem, use PETSC_NULL for B.
 
Level: intermediate
 
.seealso: STGetOperators()
@*/
PetscErrorCode STSetOperators(ST st,Mat A,Mat B)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
PetscValidHeaderSpecific(A,MAT_COOKIE,2);
if (B) PetscValidHeaderSpecific(B,MAT_COOKIE,3);
PetscCheckSameComm(st,1,A,2);
if (B) PetscCheckSameComm(st,1,B,3);
st->A = A;
st->B = B;
st->setupcalled = 0;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STGetOperators"
/*@C
STGetOperators - Gets the matrices associated with the eigensystem.
 
Not collective, though parallel Mats are returned if the ST is parallel
 
Input Parameter:
. st - the spectral transformation context
 
Output Parameters:
. A - the matrix associated with the eigensystem
- B - the second matrix in the case of generalized eigenproblems
 
Level: intermediate
 
.seealso: STSetOperators()
@*/
PetscErrorCode STGetOperators(ST st,Mat *A,Mat *B)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
if (A) *A = st->A;
if (B) *B = st->B;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetShift"
/*@
STSetShift - Sets the shift associated with the spectral transformation
 
Not collective
 
Input Parameters:
+ st - the spectral transformation context
- shift - the value of the shift
 
Note:
In some spectral transformations, changing the shift may have associated
a lot of work, for example recomputing a factorization.
Level: beginner
 
@*/
PetscErrorCode STSetShift(ST st,PetscScalar shift)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
if (st->sigma != shift) {
if (st->ops->setshift) {
ierr = (*st->ops->setshift)(st,shift); CHKERRQ(ierr);
}
}
st->sigma = shift;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STGetShift"
/*@
STGetShift - Gets the shift associated with the spectral transformation.
 
Not collective
 
Input Parameter:
. st - the spectral transformation context
 
Output Parameter:
. shift - the value of the shift
 
Level: beginner
 
@*/
PetscErrorCode STGetShift(ST st,PetscScalar* shift)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
if (shift) *shift = st->sigma;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetOptionsPrefix"
/*@C
STSetOptionsPrefix - Sets the prefix used for searching for all
ST options in the database.
 
Collective on ST
 
Input Parameters:
+ st - the spectral transformation context
- prefix - the prefix string to prepend to all ST option requests
 
Notes:
A hyphen (-) must NOT be given at the beginning of the prefix name.
The first character of all runtime options is AUTOMATICALLY the
hyphen.
 
Level: advanced
 
.seealso: STAppendOptionsPrefix(), STGetOptionsPrefix()
@*/
PetscErrorCode STSetOptionsPrefix(ST st,const char *prefix)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
ierr = PetscObjectSetOptionsPrefix((PetscObject)st,prefix);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(st->ksp,prefix);CHKERRQ(ierr);
ierr = KSPAppendOptionsPrefix(st->ksp,"st_");CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STAppendOptionsPrefix"
/*@C
STAppendOptionsPrefix - Appends to the prefix used for searching for all
ST options in the database.
 
Collective on ST
 
Input Parameters:
+ st - the spectral transformation context
- prefix - the prefix string to prepend to all ST option requests
 
Notes:
A hyphen (-) must NOT be given at the beginning of the prefix name.
The first character of all runtime options is AUTOMATICALLY the
hyphen.
 
Level: advanced
 
.seealso: STSetOptionsPrefix(), STGetOptionsPrefix()
@*/
PetscErrorCode STAppendOptionsPrefix(ST st,const char *prefix)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
ierr = PetscObjectAppendOptionsPrefix((PetscObject)st,prefix);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(st->ksp,st->prefix);CHKERRQ(ierr);
ierr = KSPAppendOptionsPrefix(st->ksp,"st_");CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STGetOptionsPrefix"
/*@C
STGetOptionsPrefix - Gets the prefix used for searching for all
ST options in the database.
 
Not Collective
 
Input Parameters:
. st - the spectral transformation context
 
Output Parameters:
. prefix - pointer to the prefix string used, is returned
 
Notes: On the Fortran side, the user should pass in a string 'prefix' of
sufficient length to hold the prefix.
 
Level: advanced
 
.seealso: STSetOptionsPrefix(), STAppendOptionsPrefix()
@*/
PetscErrorCode STGetOptionsPrefix(ST st,const char *prefix[])
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
ierr = PetscObjectGetOptionsPrefix((PetscObject)st, prefix);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STView"
/*@C
STView - Prints the ST data structure.
 
Collective on ST
 
Input Parameters:
+ ST - the ST context
- viewer - optional visualization context
 
Note:
The available visualization contexts include
+ PETSC_VIEWER_STDOUT_SELF - standard output (default)
- PETSC_VIEWER_STDOUT_WORLD - synchronized standard
output where only the first processor opens
the file. All other processors send their
data to the first processor to print.
 
The user can open an alternative visualization contexts with
PetscViewerASCIIOpen() (output to a specified file).
 
Level: beginner
 
.seealso: EPSView(), PetscViewerASCIIOpen()
@*/
PetscErrorCode STView(ST st,PetscViewer viewer)
{
PetscErrorCode ierr;
STType cstr;
const char* str;
PetscTruth isascii,isstring;
PetscViewerFormat format;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
if (!viewer) viewer = PETSC_VIEWER_STDOUT_(st->comm);
PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE,2);
PetscCheckSameComm(st,1,viewer,2);
 
ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);CHKERRQ(ierr);
ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_STRING,&isstring);CHKERRQ(ierr);
if (isascii) {
ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"ST Object:\n");CHKERRQ(ierr);
ierr = STGetType(st,&cstr);CHKERRQ(ierr);
if (cstr) {
ierr = PetscViewerASCIIPrintf(viewer," type: %s\n",cstr);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer," type: not yet set\n");CHKERRQ(ierr);
}
#if !defined(PETSC_USE_COMPLEX)
ierr = PetscViewerASCIIPrintf(viewer," shift: %g\n",st->sigma);CHKERRQ(ierr);
#else
ierr = PetscViewerASCIIPrintf(viewer," shift: %g+%g i\n",PetscRealPart(st->sigma),PetscImaginaryPart(st->sigma));CHKERRQ(ierr);
#endif
switch (st->shift_matrix) {
case STMATMODE_COPY:
break;
case STMATMODE_INPLACE:
ierr = PetscViewerASCIIPrintf(viewer,"Shifting the matrix and unshifting at exit\n");CHKERRQ(ierr);
break;
case STMATMODE_SHELL:
ierr = PetscViewerASCIIPrintf(viewer,"Using a shell matrix\n");CHKERRQ(ierr);
break;
}
if (st->B && st->shift_matrix != STMATMODE_SHELL) {
switch (st->str) {
case SAME_NONZERO_PATTERN: str = "same nonzero pattern";break;
case DIFFERENT_NONZERO_PATTERN: str = "different nonzero pattern";break;
case SUBSET_NONZERO_PATTERN: str = "subset nonzero pattern";break;
default: SETERRQ(1,"Wrong structure flag");
}
ierr = PetscViewerASCIIPrintf(viewer,"Matrices A and B have %s\n",str);CHKERRQ(ierr);
}
if (st->ops->view) {
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = (*st->ops->view)(st,viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
}
} else if (isstring) {
ierr = STGetType(st,&cstr);CHKERRQ(ierr);
ierr = PetscViewerStringSPrintf(viewer," %-7.7s",cstr);CHKERRQ(ierr);
if (st->ops->view) {ierr = (*st->ops->view)(st,viewer);CHKERRQ(ierr);}
} else {
SETERRQ1(1,"Viewer type %s not supported by ST",((PetscObject)viewer)->type_name);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STView_Default"
PetscErrorCode STView_Default(ST st,PetscViewer viewer)
{
PetscErrorCode ierr;
PetscTruth isascii,isstring;
 
PetscFunctionBegin;
ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);CHKERRQ(ierr);
ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_STRING,&isstring);CHKERRQ(ierr);
if (isascii) {
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"Associated KSP object\n");CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"------------------------------\n");CHKERRQ(ierr);
ierr = KSPView(st->ksp,viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"------------------------------\n");CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
} else if (isstring) {
ierr = KSPView(st->ksp,viewer);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
/*MC
STRegisterDynamic - Adds a method to the spectral transformation package.
 
Synopsis:
STRegisterDynamic(char *name_solver,char *path,char *name_create,int (*routine_create)(ST))
 
Not collective
 
Input Parameters:
+ name_solver - name of a new user-defined solver
. path - path (either absolute or relative) the library containing this solver
. name_create - name of routine to create method context
- routine_create - routine to create method context
 
Notes:
STRegisterDynamic() may be called multiple times to add several user-defined spectral transformations.
 
If dynamic libraries are used, then the fourth input argument (routine_create)
is ignored.
 
Sample usage:
.vb
STRegisterDynamic("my_solver","/home/username/my_lib/lib/libO/solaris/mylib.a",
"MySolverCreate",MySolverCreate);
.ve
 
Then, your solver can be chosen with the procedural interface via
$ STSetType(st,"my_solver")
or at runtime via the option
$ -st_type my_solver
 
Level: advanced
 
$PETSC_DIR, $PETSC_ARCH and $PETSC_LIB_DIR occuring in pathname will be replaced with appropriate values.
 
.seealso: STRegisterDestroy(), STRegisterAll()
M*/
 
#undef __FUNCT__
#define __FUNCT__ "STRegister"
/*@C
STRegister - See STRegisterDynamic()
 
Level: advanced
@*/
PetscErrorCode STRegister(const char *sname,const char *path,const char *name,int (*function)(ST))
{
PetscErrorCode ierr;
char fullname[256];
 
PetscFunctionBegin;
ierr = PetscFListConcat(path,name,fullname);CHKERRQ(ierr);
ierr = PetscFListAdd(&STList,sname,fullname,(void (*)(void))function);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STRegisterDestroy"
/*@
STRegisterDestroy - Frees the list of ST methods that were
registered by STRegisterDynamic().
 
Not Collective
 
Level: advanced
 
.seealso: STRegisterDynamic(), STRegisterAll()
@*/
PetscErrorCode STRegisterDestroy(void)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
ierr = PetscFListDestroy(&STList);CHKERRQ(ierr);
ierr = STRegisterAll(PETSC_NULL);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
tags/slepc-2_3_3-1/src/st/interface/stfunc.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/interface/stset.c New file
0,0 → 1,295
/*
Routines to set ST methods and options.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/st/stimpl.h" /*I "slepcst.h" I*/
#include "petscsys.h"
 
/*
Contains the list of registered ST routines
*/
PetscFList STList = 0;
 
#undef __FUNCT__
#define __FUNCT__ "STSetType"
/*@C
STSetType - Builds ST for a particular spectral transformation.
 
Collective on ST
 
Input Parameter:
+ st - the spectral transformation context.
- type - a known type
 
Options Database Key:
. -st_type <type> - Sets ST type
 
Use -help for a list of available transformations
 
Notes:
See "slepc/include/slepcst.h" for available transformations
 
Normally, it is best to use the EPSSetFromOptions() command and
then set the ST type from the options database rather than by using
this routine. Using the options database provides the user with
maximum flexibility in evaluating the many different transformations.
 
Level: intermediate
 
.seealso: EPSSetType()
 
@*/
PetscErrorCode STSetType(ST st,STType type)
{
PetscErrorCode ierr,(*r)(ST);
PetscTruth match;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
PetscValidCharPointer(type,2);
 
ierr = PetscTypeCompare((PetscObject)st,type,&match);CHKERRQ(ierr);
if (match) PetscFunctionReturn(0);
 
if (st->ops->destroy) {ierr = (*st->ops->destroy)(st);CHKERRQ(ierr);}
ierr = PetscFListDestroy(&st->qlist);CHKERRQ(ierr);
st->data = 0;
st->setupcalled = 0;
 
/* Determine the STCreateXXX routine for a particular type */
ierr = PetscFListFind(STList, st->comm, type,(void (**)(void)) &r );CHKERRQ(ierr);
if (!r) SETERRQ1(1,"Unable to find requested ST type %s",type);
ierr = PetscFree(st->data);CHKERRQ(ierr);
 
ierr = PetscMemzero(st->ops,sizeof(struct _STOps));CHKERRQ(ierr);
 
/* Call the STCreateXXX routine for this particular type */
ierr = (*r)(st);CHKERRQ(ierr);
 
ierr = PetscObjectChangeTypeName((PetscObject)st,type);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STGetType"
/*@C
STGetType - Gets the ST type name (as a string) from the ST context.
 
Not Collective
 
Input Parameter:
. st - the spectral transformation context
 
Output Parameter:
. name - name of the spectral transformation
 
Level: intermediate
 
.seealso: STSetType()
 
@*/
PetscErrorCode STGetType(ST st,STType *meth)
{
PetscFunctionBegin;
*meth = (STType) st->type_name;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetFromOptions"
/*@
STSetFromOptions - Sets ST options from the options database.
This routine must be called before STSetUp() if the user is to be
allowed to set the type of transformation.
 
Collective on ST
 
Input Parameter:
. st - the spectral transformation context
 
Level: beginner
 
.seealso:
 
@*/
PetscErrorCode STSetFromOptions(ST st)
{
PetscErrorCode ierr;
PetscInt i;
char type[256];
PetscTruth flg;
const char *mode_list[3] = { "copy", "inplace", "shell" };
const char *structure_list[3] = { "same", "different", "subset" };
PC pc;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
 
ierr = PetscOptionsBegin(st->comm,st->prefix,"Spectral Transformation (ST) Options","ST");CHKERRQ(ierr);
ierr = PetscOptionsList("-st_type","Spectral Transformation type","STSetType",STList,(char*)(st->type_name?st->type_name:STSHIFT),type,256,&flg);CHKERRQ(ierr);
if (flg) {
ierr = STSetType(st,type);CHKERRQ(ierr);
}
/*
Set the type if it was never set.
*/
if (!st->type_name) {
ierr = STSetType(st,STSHIFT);CHKERRQ(ierr);
}
 
ierr = PetscOptionsScalar("-st_shift","Value of the shift","STSetShift",st->sigma,&st->sigma,PETSC_NULL); CHKERRQ(ierr);
 
ierr = PetscOptionsEList("-st_matmode", "Shift matrix mode","STSetMatMode",mode_list,3,mode_list[st->shift_matrix],&i,&flg);CHKERRQ(ierr);
if (flg) { st->shift_matrix = (STMatMode)i; }
 
ierr = PetscOptionsEList("-st_matstructure", "Shift nonzero pattern","STSetMatStructure",structure_list,3,structure_list[st->str],&i,&flg);CHKERRQ(ierr);
if (flg) { st->str = (MatStructure)i; }
if (st->ops->setfromoptions) {
ierr = (*st->ops->setfromoptions)(st);CHKERRQ(ierr);
}
 
ierr = PetscOptionsEnd();CHKERRQ(ierr);
 
if (st->ksp) {
if (st->shift_matrix == STMATMODE_SHELL) {
/* if shift_mat is set then the default preconditioner is ILU,
otherwise set Jacobi as the default */
ierr = KSPGetPC(st->ksp,&pc); CHKERRQ(ierr);
ierr = PCSetType(pc,PCJACOBI);CHKERRQ(ierr);
}
ierr = KSPSetFromOptions(st->ksp);CHKERRQ(ierr);
}
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetMatStructure"
/*@
STSetMatStructure - Sets an internal MatStructure attribute to
indicate which is the relation of the sparsity pattern of the two matrices
A and B constituting the generalized eigenvalue problem. This function
has no effect in the case of standard eigenproblems.
 
Collective on ST
 
Input Parameters:
+ st - the spectral transformation context
- str - either SAME_NONZERO_PATTERN, DIFFERENT_NONZERO_PATTERN or
SUBSET_NONZERO_PATTERN
 
Options Database Key:
. -st_matstructure <str> - Indicates the structure flag, where <str> is one
of 'same' (A and B have the same nonzero pattern), 'different' (A
and B have different nonzero pattern) or 'subset' (B's nonzero
pattern is a subset of A's).
 
Note:
By default, the sparsity patterns are assumed to be different. If the
patterns are equal or a subset then it is recommended to set this attribute
for efficiency reasons (in particular, for internal MatAXPY() operations).
Level: advanced
 
.seealso: STSetOperators(), MatAXPY()
@*/
PetscErrorCode STSetMatStructure(ST st,MatStructure str)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
switch (str) {
case SAME_NONZERO_PATTERN:
case DIFFERENT_NONZERO_PATTERN:
case SUBSET_NONZERO_PATTERN:
st->str = str;
break;
default:
SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Invalid matrix structure flag");
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetMatMode"
/*@
STSetMatMode - Sets a flag to indicate how the matrix is
being shifted in the shift-and-invert and Cayley spectral transformations.
 
Collective on ST
 
Input Parameters:
+ st - the spectral transformation context
- mode - the mode flag, one of STMATMODE_COPY,
STMATMODE_INPLACE or STMATMODE_SHELL
 
Options Database Key:
. -st_matmode <mode> - Indicates the mode flag, where <mode> is one of
'copy', 'inplace' or 'shell' (see explanation below).
 
Notes:
By default (STMATMODE_COPY), a copy of matrix A is made and then
this copy is shifted explicitly, e.g. A <- (A - s B).
 
With STMATMODE_INPLACE, the original matrix A is shifted at
STSetUp() and unshifted at the end of the computations. With respect to
the previous one, this mode avoids a copy of matrix A. However, a
backdraw is that the recovered matrix might be slightly different
from the original one (due to roundoff).
 
With STMATMODE_SHELL, the solver works with an implicit shell
matrix that represents the shifted matrix. This mode is the most efficient
in creating the shifted matrix but it places serious limitations to the
linear solves performed in each iteration of the eigensolver (typically,
only interative solvers with Jacobi preconditioning can be used).
In the case of generalized problems, in the two first modes the matrix
A - s B has to be computed explicitly. The efficiency of this computation
can be controlled with STSetMatStructure().
 
Level: intermediate
 
.seealso: STSetOperators(), STSetMatStructure(), STGetMatMode(), STMatMode
@*/
PetscErrorCode STSetMatMode(ST st,STMatMode mode)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
st->shift_matrix = mode;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STGetMatMode"
/*@C
STGetMatMode - Gets a flag that indicates how the matrix is being
shifted in the shift-and-invert and Cayley spectral transformations.
 
Collective on ST
 
Input Parameter:
. st - the spectral transformation context
 
Output Parameter:
. mode - the mode flag
 
Level: intermediate
 
.seealso: STSetMatMode(), STMatMode
@*/
PetscErrorCode STGetMatMode(ST st,STMatMode *mode)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
*mode = st->shift_matrix;
PetscFunctionReturn(0);
}
 
tags/slepc-2_3_3-1/src/st/interface/stset.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/interface/shellmat.c New file
0,0 → 1,110
/*
This file contains the subroutines which implement various operations
of the matrix associated to the shift-and-invert technique for eigenvalue
problems, and also a subroutine to create it.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/st/stimpl.h"
 
#undef __FUNCT__
#define __FUNCT__ "STMatShellMult"
PetscErrorCode STMatShellMult(Mat A,Vec x,Vec y)
{
PetscErrorCode ierr;
ST ctx;
 
PetscFunctionBegin;
ierr = MatShellGetContext(A,(void**)&ctx);CHKERRQ(ierr);
 
ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
if (ctx->sigma != 0.0) {
if (ctx->B) { /* y = (A - sB) x */
ierr = MatMult(ctx->B,x,ctx->w);CHKERRQ(ierr);
ierr = VecAXPY(y,-ctx->sigma,ctx->w);CHKERRQ(ierr);
} else { /* y = (A - sI) x */
ierr = VecAXPY(y,-ctx->sigma,x);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STMatShellMultTranspose"
PetscErrorCode STMatShellMultTranspose(Mat A,Vec x,Vec y)
{
PetscErrorCode ierr;
ST ctx;
 
PetscFunctionBegin;
ierr = MatShellGetContext(A,(void**)&ctx);CHKERRQ(ierr);
 
ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
if (ctx->sigma != 0.0) {
if (ctx->B) { /* y = (A - sB) x */
ierr = MatMultTranspose(ctx->B,x,ctx->w);CHKERRQ(ierr);
ierr = VecAXPY(y,-ctx->sigma,ctx->w);CHKERRQ(ierr);
} else { /* y = (A - sI) x */
ierr = VecAXPY(y,-ctx->sigma,x);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STMatShellGetDiagonal"
PetscErrorCode STMatShellGetDiagonal(Mat A,Vec diag)
{
PetscErrorCode ierr;
ST ctx;
Vec diagb;
 
PetscFunctionBegin;
ierr = MatShellGetContext(A,(void**)&ctx);CHKERRQ(ierr);
 
ierr = MatGetDiagonal(ctx->A,diag);CHKERRQ(ierr);
if (ctx->sigma != 0.0) {
if (ctx->B) {
ierr = VecDuplicate(diag,&diagb);CHKERRQ(ierr);
ierr = MatGetDiagonal(ctx->B,diagb);CHKERRQ(ierr);
ierr = VecAXPY(diag,-ctx->sigma,diagb);CHKERRQ(ierr);
ierr = VecDestroy(diagb);CHKERRQ(ierr);
} else {
ierr = VecShift(diag,-ctx->sigma);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STMatShellCreate"
PetscErrorCode STMatShellCreate(ST st,Mat *mat)
{
PetscErrorCode ierr;
PetscInt n, m, N, M;
PetscTruth hasA, hasB;
 
PetscFunctionBegin;
ierr = MatGetSize(st->A,&M,&N);CHKERRQ(ierr);
ierr = MatGetLocalSize(st->A,&m,&n);CHKERRQ(ierr);
ierr = MatCreateShell(st->comm,m,n,M,N,(void*)st,mat);CHKERRQ(ierr);
ierr = MatShellSetOperation(*mat,MATOP_MULT,(void(*)(void))STMatShellMult);CHKERRQ(ierr);
ierr = MatShellSetOperation(*mat,MATOP_MULT_TRANSPOSE,(void(*)(void))STMatShellMultTranspose);CHKERRQ(ierr);
 
ierr = MatHasOperation(st->A,MATOP_GET_DIAGONAL,&hasA);CHKERRQ(ierr);
if (st->B) { ierr = MatHasOperation(st->B,MATOP_GET_DIAGONAL,&hasB);CHKERRQ(ierr); }
if ( (hasA && !st->B) || (hasA && hasB) ) {
ierr = MatShellSetOperation(*mat,MATOP_GET_DIAGONAL,(void(*)(void))STMatShellGetDiagonal);CHKERRQ(ierr);
}
 
PetscFunctionReturn(0);
}
 
tags/slepc-2_3_3-1/src/st/interface/shellmat.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/interface/makefile New file
0,0 → 1,26
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
ALL: lib
 
CFLAGS =
FFLAGS =
SOURCEC = stfunc.c stset.c stsolve.c stsles.c stregis.c shellmat.c
SOURCEF =
SOURCEH =
OBJSC = stfunc.o stset.o stsolve.o stsles.o stregis.o shellmat.o
LIBBASE = libslepc
DIRS =
MANSEC = ST
LOCDIR = src/st/interface/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
tags/slepc-2_3_3-1/src/st/interface/makefile Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/interface/stsles.c New file
0,0 → 1,270
/*
The ST (spectral transformation) interface routines related to the
KSP object associated to it.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/st/stimpl.h" /*I "slepcst.h" I*/
 
#undef __FUNCT__
#define __FUNCT__ "STAssociatedKSPSolve"
/*
STAssociatedKSPSolve - Solves the linear system of equations associated
to the spectral transformation.
 
Input Parameters:
. st - the spectral transformation context
. b - right hand side vector
 
Output Parameter:
. x - computed solution
*/
PetscErrorCode STAssociatedKSPSolve(ST st,Vec b,Vec x)
{
PetscErrorCode ierr;
PetscInt its;
KSPConvergedReason reason;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
PetscValidHeaderSpecific(b,VEC_COOKIE,2);
PetscValidHeaderSpecific(x,VEC_COOKIE,3);
if (!st->ksp) { SETERRQ(PETSC_ERR_SUP,"ST has no associated KSP"); }
ierr = KSPSolve(st->ksp,b,x);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(st->ksp,&reason);CHKERRQ(ierr);
if (reason<0) { SETERRQ1(0,"Warning: KSP did not converge (%d)",reason); }
ierr = KSPGetIterationNumber(st->ksp,&its);CHKERRQ(ierr);
st->lineariterations += its;
PetscInfo1(st,"Linear solve iterations=%d\n",its);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STAssociatedKSPSolveTranspose"
/*
STAssociatedKSPSolveTranspose - Solves the transpose of the linear
system of equations associated to the spectral transformation.
 
Input Parameters:
. st - the spectral transformation context
. b - right hand side vector
 
Output Parameter:
. x - computed solution
*/
PetscErrorCode STAssociatedKSPSolveTranspose(ST st,Vec b,Vec x)
{
PetscErrorCode ierr;
PetscInt its;
KSPConvergedReason reason;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
PetscValidHeaderSpecific(b,VEC_COOKIE,2);
PetscValidHeaderSpecific(x,VEC_COOKIE,3);
if (!st->ksp) { SETERRQ(PETSC_ERR_SUP,"ST has no associated KSP"); }
ierr = KSPSolveTranspose(st->ksp,b,x);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(st->ksp,&reason);CHKERRQ(ierr);
if (reason<0) { SETERRQ1(0,"Warning: KSP did not converge (%d)",reason); }
ierr = KSPGetIterationNumber(st->ksp,&its);CHKERRQ(ierr);
st->lineariterations += its;
PetscInfo1(st,"Linear solve iterations=%d\n",its);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetKSP"
/*@
STSetKSP - Sets the KSP object associated with the spectral
transformation.
 
Not collective
 
Input Parameters:
+ st - the spectral transformation context
- ksp - the linear system context
 
Level: advanced
 
@*/
PetscErrorCode STSetKSP(ST st,KSP ksp)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
PetscValidHeaderSpecific(ksp,KSP_COOKIE,2);
PetscCheckSameComm(st,1,ksp,2);
ierr = PetscObjectReference((PetscObject)ksp);CHKERRQ(ierr);
if (st->ksp) {
ierr = KSPDestroy(st->ksp);CHKERRQ(ierr);
}
st->ksp = ksp;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STGetKSP"
/*@
STGetKSP - Gets the KSP object associated with the spectral
transformation.
 
Not collective
 
Input Parameter:
. st - the spectral transformation context
 
Output Parameter:
. ksp - the linear system context
 
Notes:
On output, the value of ksp can be PETSC_NULL if the combination of
eigenproblem type and selected transformation does not require to
solve a linear system of equations.
Level: intermediate
 
@*/
PetscErrorCode STGetKSP(ST st,KSP* ksp)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
if (!st->type_name) { SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Must call STSetType first"); }
if (ksp) *ksp = st->ksp;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STGetOperationCounters"
/*@
STGetOperationCounters - Gets the total number of operator applications
and linear solver iterations used by the ST object.
 
Not Collective
 
Input Parameter:
. st - the spectral transformation context
 
Output Parameter:
+ ops - number of operator applications
- lits - number of linear solver iterations
 
Notes:
Any output parameter may be PETSC_NULL on input if not needed.
Level: intermediate
 
.seealso: STResetOperationCounters()
@*/
PetscErrorCode STGetOperationCounters(ST st,int* ops,int* lits)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
if (ops) *ops = st->applys;
if (lits) *lits = st->lineariterations;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STResetOperationCounters"
/*@
STResetOperationCounters - Resets the counters for operator applications,
inner product operations and total number of linear iterations used by
the ST object.
 
Collective on ST
 
Input Parameter:
. st - the spectral transformation context
 
Level: intermediate
 
.seealso: STGetOperationCounters()
@*/
PetscErrorCode STResetOperationCounters(ST st)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
st->lineariterations = 0;
st->applys = 0;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STCheckNullSpace_Default"
PetscErrorCode STCheckNullSpace_Default(ST st,int n,const Vec V[])
{
PetscErrorCode ierr;
int i,c;
PetscReal norm;
Vec *T,w;
Mat A;
PC pc;
MatNullSpace nullsp;
PetscFunctionBegin;
ierr = PetscMalloc(n*sizeof(Vec),&T);CHKERRQ(ierr);
ierr = KSPGetPC(st->ksp,&pc);CHKERRQ(ierr);
ierr = PCGetOperators(pc,&A,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
ierr = MatGetVecs(A,PETSC_NULL,&w);CHKERRQ(ierr);
c = 0;
for (i=0;i<n;i++) {
ierr = MatMult(A,V[i],w);CHKERRQ(ierr);
ierr = VecNorm(w,NORM_2,&norm);CHKERRQ(ierr);
if (norm < 1e-8) {
PetscInfo2(st,"Vector %i norm=%g\n",i,norm);
T[c] = V[i];
c++;
}
}
ierr = VecDestroy(w);CHKERRQ(ierr);
if (c>0) {
ierr = MatNullSpaceCreate(st->comm,PETSC_FALSE,c,T,&nullsp);CHKERRQ(ierr);
ierr = KSPSetNullSpace(st->ksp,nullsp);CHKERRQ(ierr);
ierr = MatNullSpaceDestroy(nullsp);CHKERRQ(ierr);
}
ierr = PetscFree(T);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STCheckNullSpace"
/*@
STCheckNullSpace - Given a set of vectors, this function tests each of
them to be a nullspace vector of the coefficient matrix of the associated
KSP object. All these nullspace vectors are passed to the KSP object.
 
Collective on ST
 
Input Parameters:
+ st - the spectral transformation context
. n - number of vectors
- V - vectors to be checked
 
Note:
This function allows to handle singular pencils and to solve some problems
in which the nullspace is important (see the users guide for details).
Level: developer
 
.seealso: EPSAttachDeflationSpace()
@*/
PetscErrorCode STCheckNullSpace(ST st,int n,const Vec V[])
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
if (n>0 && st->checknullspace) {
ierr = (*st->checknullspace)(st,n,V);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
 
tags/slepc-2_3_3-1/src/st/interface/stsles.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/impls/fold/fold.c New file
0,0 → 1,258
/*
Folding spectral transformation, applies (A + sigma I)^2 as operator, or
inv(B)(A + sigma I)^2 for generalized problems
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/st/stimpl.h" /*I "slepcst.h" I*/
 
typedef struct {
PetscTruth left;
Vec w2;
} ST_FOLD;
 
#undef __FUNCT__
#define __FUNCT__ "STApply_Fold"
PetscErrorCode STApply_Fold(ST st,Vec x,Vec y)
{
PetscErrorCode ierr;
ST_FOLD *ctx = (ST_FOLD *) st->data;
 
PetscFunctionBegin;
if (st->B) {
/* generalized eigenproblem: y = (B^-1 A + sI)^2 x */
ierr = MatMult(st->A,x,st->w);CHKERRQ(ierr);
ierr = STAssociatedKSPSolve(st,st->w,ctx->w2);CHKERRQ(ierr);
if (st->sigma != 0.0) {
ierr = VecAXPY(ctx->w2,-st->sigma,x);CHKERRQ(ierr);
}
ierr = MatMult(st->A,ctx->w2,st->w);CHKERRQ(ierr);
ierr = STAssociatedKSPSolve(st,st->w,y);CHKERRQ(ierr);
if (st->sigma != 0.0) {
ierr = VecAXPY(y,-st->sigma,ctx->w2);CHKERRQ(ierr);
}
} else {
/* standard eigenproblem: y = (A + sI)^2 x */
ierr = MatMult(st->A,x,st->w);CHKERRQ(ierr);
if (st->sigma != 0.0) {
ierr = VecAXPY(st->w,-st->sigma,x);CHKERRQ(ierr);
}
ierr = MatMult(st->A,st->w,y);CHKERRQ(ierr);
if (st->sigma != 0.0) {
ierr = VecAXPY(y,-st->sigma,st->w);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STApplyTranspose_Fold"
PetscErrorCode STApplyTranspose_Fold(ST st,Vec x,Vec y)
{
PetscErrorCode ierr;
ST_FOLD *ctx = (ST_FOLD *) st->data;
 
PetscFunctionBegin;
if (st->B) {
/* generalized eigenproblem: y = (A^T B^-T + sI)^2 x */
ierr = STAssociatedKSPSolveTranspose(st,x,st->w);CHKERRQ(ierr);
ierr = MatMult(st->A,st->w,ctx->w2);CHKERRQ(ierr);
if (st->sigma != 0.0) {
ierr = VecAXPY(ctx->w2,-st->sigma,x);CHKERRQ(ierr);
}
ierr = STAssociatedKSPSolveTranspose(st,ctx->w2,st->w);CHKERRQ(ierr);
ierr = MatMult(st->A,st->w,y);CHKERRQ(ierr);
if (st->sigma != 0.0) {
ierr = VecAXPY(y,-st->sigma,ctx->w2);CHKERRQ(ierr);
}
} else {
/* standard eigenproblem: y = (A^T + sI)^2 x */
ierr = MatMultTranspose(st->A,x,st->w);CHKERRQ(ierr);
if (st->sigma != 0.0) {
ierr = VecAXPY(st->w,-st->sigma,x);CHKERRQ(ierr);
}
ierr = MatMultTranspose(st->A,st->w,y);CHKERRQ(ierr);
if (st->sigma != 0.0) {
ierr = VecAXPY(y,-st->sigma,st->w);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STBackTransform_Fold"
PetscErrorCode STBackTransform_Fold(ST st,PetscScalar *eigr,PetscScalar *eigi)
{
ST_FOLD *ctx = (ST_FOLD *) st->data;
PetscFunctionBegin;
PetscValidScalarPointer(eigr,2);
PetscValidScalarPointer(eigi,3);
#if !defined(PETSC_USE_COMPLEX)
if (*eigi == 0) {
#endif
if (ctx->left) *eigr = st->sigma - PetscSqrtScalar(*eigr);
else *eigr = st->sigma + PetscSqrtScalar(*eigr);
#if !defined(PETSC_USE_COMPLEX)
} else {
PetscScalar r,x,y;
r = PetscSqrtScalar(*eigr * *eigr + *eigi * *eigi);
x = PetscSqrtScalar((r + *eigr) / 2);
y = PetscSqrtScalar((r - *eigr) / 2);
if (*eigi < 0) y = - y;
if (ctx->left) {
*eigr = st->sigma - x;
*eigi = - y;
} else {
*eigr = st->sigma + x;
*eigi = y;
}
}
#endif
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetUp_Fold"
PetscErrorCode STSetUp_Fold(ST st)
{
PetscErrorCode ierr;
ST_FOLD *ctx = (ST_FOLD *) st->data;
 
PetscFunctionBegin;
if (st->B) {
ierr = KSPSetOperators(st->ksp,st->B,st->B,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = KSPSetUp(st->ksp);CHKERRQ(ierr);
if (ctx->w2) { ierr = VecDestroy(ctx->w2);CHKERRQ(ierr); }
ierr = MatGetVecs(st->B,&ctx->w2,PETSC_NULL);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STFoldSetLeftSide_Fold"
PetscErrorCode STFoldSetLeftSide_Fold(ST st,PetscTruth left)
{
ST_FOLD *ctx = (ST_FOLD *) st->data;
 
PetscFunctionBegin;
ctx->left = left;
PetscFunctionReturn(0);
}
EXTERN_C_END
 
#undef __FUNCT__
#define __FUNCT__ "STFoldSetLeftSide"
/*@
STFoldSetLeftSide - Sets a flag to compute eigenvalues on the left side of shift.
 
Collective on ST
 
Input Parameters:
+ st - the spectral transformation context
- left - if true compute eigenvalues on the left side
 
Options Database Key:
. -st_fold_leftside - Sets the value of the flag
 
Level: intermediate
 
.seealso: STSetShift()
@*/
PetscErrorCode STFoldSetLeftSide(ST st,PetscTruth left)
{
PetscErrorCode ierr, (*f)(ST,PetscTruth);
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
ierr = PetscObjectQueryFunction((PetscObject)st,"STFoldSetLeftSide_C",(void (**)(void))&f);CHKERRQ(ierr);
if (f) {
ierr = (*f)(st,left);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STView_Fold"
PetscErrorCode STView_Fold(ST st,PetscViewer viewer)
{
PetscErrorCode ierr;
ST_FOLD *ctx = (ST_FOLD *) st->data;
 
PetscFunctionBegin;
if (ctx->left) {
ierr = PetscViewerASCIIPrintf(viewer," computing eigenvalues on left side of shift\n");CHKERRQ(ierr);
}
if (st->B) {
ierr = STView_Default(st,viewer);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetFromOptions_Fold"
PetscErrorCode STSetFromOptions_Fold(ST st)
{
PetscErrorCode ierr;
ST_FOLD *ctx = (ST_FOLD *) st->data;
 
PetscFunctionBegin;
ierr = PetscOptionsHead("ST Fold Options");CHKERRQ(ierr);
ierr = PetscOptionsTruth("-st_fold_leftside","Compute eigenvalues on left side of shift","STFoldSetLeftSide",ctx->left,&ctx->left,PETSC_NULL); CHKERRQ(ierr);
ierr = PetscOptionsTail();CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STDestroy_Fold"
PetscErrorCode STDestroy_Fold(ST st)
{
PetscErrorCode ierr;
ST_FOLD *ctx = (ST_FOLD *) st->data;
 
PetscFunctionBegin;
if (ctx->w2) { ierr = VecDestroy(ctx->w2);CHKERRQ(ierr); }
ierr = PetscFree(ctx);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STCreate_Fold"
PetscErrorCode STCreate_Fold(ST st)
{
PetscErrorCode ierr;
ST_FOLD *ctx;
 
PetscFunctionBegin;
 
ierr = PetscNew(ST_FOLD,&ctx); CHKERRQ(ierr);
PetscLogObjectMemory(st,sizeof(ST_FOLD));
st->data = (void *) ctx;
 
st->ops->apply = STApply_Fold;
st->ops->getbilinearform = STGetBilinearForm_Default;
st->ops->applytrans = STApplyTranspose_Fold;
st->ops->backtr = STBackTransform_Fold;
st->ops->setup = STSetUp_Fold;
st->ops->view = STView_Fold;
st->ops->setfromoptions = STSetFromOptions_Fold;
st->ops->destroy = STDestroy_Fold;
st->checknullspace = 0;
ctx->left = PETSC_FALSE;
ierr = PetscObjectComposeFunctionDynamic((PetscObject)st,"STFoldSetLeftSide_C","STFoldSetLeftSide_Fold",
STFoldSetLeftSide_Fold);CHKERRQ(ierr);
 
PetscFunctionReturn(0);
}
EXTERN_C_END
 
tags/slepc-2_3_3-1/src/st/impls/fold/fold.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/impls/fold/makefile New file
0,0 → 1,26
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
ALL: lib
 
CFLAGS =
FFLAGS =
SOURCEC = fold.c
SOURCEF =
SOURCEH =
OBJSC = fold.o
LIBBASE = libslepc
DIRS =
MANSEC = ST
LOCDIR = src/st/impls/fold/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
tags/slepc-2_3_3-1/src/st/impls/fold/makefile Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/impls/cayley/cayley.c New file
0,0 → 1,410
/*
Implements the Cayley spectral transform.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/st/stimpl.h" /*I "slepcst.h" I*/
 
typedef struct {
PetscScalar tau;
PetscTruth tau_set;
Vec w2;
} ST_CAYLEY;
 
#undef __FUNCT__
#define __FUNCT__ "STApply_Cayley"
PetscErrorCode STApply_Cayley(ST st,Vec x,Vec y)
{
PetscErrorCode ierr;
ST_CAYLEY *ctx = (ST_CAYLEY *) st->data;
PetscScalar tau = ctx->tau;
PetscFunctionBegin;
if (st->shift_matrix == STMATMODE_INPLACE) { tau = tau + st->sigma; };
 
if (st->B) {
/* generalized eigenproblem: y = (A - sB)^-1 (A + tB)x */
ierr = MatMult(st->A,x,st->w);CHKERRQ(ierr);
ierr = MatMult(st->B,x,ctx->w2);CHKERRQ(ierr);
ierr = VecAXPY(st->w,tau,ctx->w2);CHKERRQ(ierr);
ierr = STAssociatedKSPSolve(st,st->w,y);CHKERRQ(ierr);
}
else {
/* standard eigenproblem: y = (A - sI)^-1 (A + tI)x */
ierr = MatMult(st->A,x,st->w);CHKERRQ(ierr);
ierr = VecAXPY(st->w,tau,x);CHKERRQ(ierr);
ierr = STAssociatedKSPSolve(st,st->w,y);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STApplyTranspose_Cayley"
PetscErrorCode STApplyTranspose_Cayley(ST st,Vec x,Vec y)
{
PetscErrorCode ierr;
ST_CAYLEY *ctx = (ST_CAYLEY *) st->data;
PetscScalar tau = ctx->tau;
PetscFunctionBegin;
if (st->shift_matrix == STMATMODE_INPLACE) { tau = tau + st->sigma; };
 
if (st->B) {
/* generalized eigenproblem: y = (A + tB)^T (A - sB)^-T x */
ierr = STAssociatedKSPSolve(st,x,st->w);CHKERRQ(ierr);
ierr = MatMult(st->A,st->w,y);CHKERRQ(ierr);
ierr = MatMult(st->B,st->w,ctx->w2);CHKERRQ(ierr);
ierr = VecAXPY(y,tau,ctx->w2);CHKERRQ(ierr);
}
else {
/* standard eigenproblem: y = (A + tI)^T (A - sI)^-T x */
ierr = STAssociatedKSPSolve(st,x,st->w);CHKERRQ(ierr);
ierr = MatMult(st->A,st->w,y);CHKERRQ(ierr);
ierr = VecAXPY(y,tau,st->w);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STBilinearMatMult_Cayley"
PetscErrorCode STBilinearMatMult_Cayley(Mat B,Vec x,Vec y)
{
PetscErrorCode ierr;
ST st;
ST_CAYLEY *ctx;
PetscScalar tau;
PetscFunctionBegin;
ierr = MatShellGetContext(B,(void**)&st);CHKERRQ(ierr);
ctx = (ST_CAYLEY *) st->data;
tau = ctx->tau;
if (st->shift_matrix == STMATMODE_INPLACE) { tau = tau + st->sigma; };
 
if (st->B) {
/* generalized eigenproblem: y = (A + tB)x */
ierr = MatMult(st->A,x,y);CHKERRQ(ierr);
ierr = MatMult(st->B,x,ctx->w2);CHKERRQ(ierr);
ierr = VecAXPY(y,tau,ctx->w2);CHKERRQ(ierr);
}
else {
/* standard eigenproblem: y = (A + tI)x */
ierr = MatMult(st->A,x,y);CHKERRQ(ierr);
ierr = VecAXPY(y,tau,x);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STGetBilinearForm_Cayley"
PetscErrorCode STGetBilinearForm_Cayley(ST st,Mat *B)
{
PetscErrorCode ierr;
PetscInt n,m;
 
PetscFunctionBegin;
ierr = MatGetLocalSize(st->B,&n,&m);CHKERRQ(ierr);
ierr = MatCreateShell(st->comm,n,m,PETSC_DETERMINE,PETSC_DETERMINE,st,B);CHKERRQ(ierr);
ierr = MatShellSetOperation(*B,MATOP_MULT,(void(*)(void))STBilinearMatMult_Cayley);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STBackTransform_Cayley"
PetscErrorCode STBackTransform_Cayley(ST st,PetscScalar *eigr,PetscScalar *eigi)
{
ST_CAYLEY *ctx = (ST_CAYLEY *) st->data;
#ifndef PETSC_USE_COMPLEX
PetscScalar t,i,r;
PetscFunctionBegin;
PetscValidPointer(eigr,2);
PetscValidPointer(eigi,3);
if (*eigi == 0.0) *eigr = (ctx->tau + *eigr * st->sigma) / (*eigr - 1.0);
else {
r = *eigr;
i = *eigi;
r = st->sigma * (r * r + i * i - r) + ctx->tau * (r - 1);
i = - st->sigma * i - ctx->tau * i;
t = i * i + r * (r - 2.0) + 1.0;
*eigr = r / t;
*eigi = i / t;
}
#else
PetscFunctionBegin;
PetscValidPointer(eigr,2);
*eigr = (ctx->tau + *eigr * st->sigma) / (*eigr - 1.0);
#endif
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STPostSolve_Cayley"
PetscErrorCode STPostSolve_Cayley(ST st)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
if (st->shift_matrix == STMATMODE_INPLACE) {
if (st->B) {
ierr = MatAXPY(st->A,st->sigma,st->B,st->str);CHKERRQ(ierr);
} else {
ierr = MatShift(st->A,st->sigma); CHKERRQ(ierr);
}
st->setupcalled = 0;
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetUp_Cayley"
PetscErrorCode STSetUp_Cayley(ST st)
{
PetscErrorCode ierr;
ST_CAYLEY *ctx = (ST_CAYLEY *) st->data;
 
PetscFunctionBegin;
 
if (st->mat) { ierr = MatDestroy(st->mat);CHKERRQ(ierr); }
if (!ctx->tau_set) { ctx->tau = st->sigma; }
if (ctx->tau == 0.0 && st->sigma == 0.0) {
SETERRQ(1,"Values of shift and antishift cannot be zero simultaneously");
}
 
switch (st->shift_matrix) {
case STMATMODE_INPLACE:
st->mat = PETSC_NULL;
if (st->sigma != 0.0) {
if (st->B) {
ierr = MatAXPY(st->A,-st->sigma,st->B,st->str);CHKERRQ(ierr);
} else {
ierr = MatShift(st->A,-st->sigma);CHKERRQ(ierr);
}
}
ierr = KSPSetOperators(st->ksp,st->A,st->A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
break;
case STMATMODE_SHELL:
ierr = STMatShellCreate(st,&st->mat);CHKERRQ(ierr);
ierr = KSPSetOperators(st->ksp,st->mat,st->mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
break;
default:
ierr = MatDuplicate(st->A,MAT_COPY_VALUES,&st->mat);CHKERRQ(ierr);
if (st->sigma != 0.0) {
if (st->B) {
ierr = MatAXPY(st->mat,-st->sigma,st->B,st->str);CHKERRQ(ierr);
} else {
ierr = MatShift(st->mat,-st->sigma);CHKERRQ(ierr);
}
}
ierr = KSPSetOperators(st->ksp,st->mat,st->mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
}
if (st->B) {
if (ctx->w2) { ierr = VecDestroy(ctx->w2);CHKERRQ(ierr); }
ierr = MatGetVecs(st->B,&ctx->w2,PETSC_NULL);CHKERRQ(ierr);
}
ierr = KSPSetUp(st->ksp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetShift_Cayley"
PetscErrorCode STSetShift_Cayley(ST st,PetscScalar newshift)
{
PetscErrorCode ierr;
ST_CAYLEY *ctx = (ST_CAYLEY *) st->data;
MatStructure flg;
 
PetscFunctionBegin;
if (!ctx->tau_set) { ctx->tau = newshift; }
if (ctx->tau == 0.0 && newshift == 0.0) {
SETERRQ(1,"Values of shift and antishift cannot be zero simultaneously");
}
 
/* Nothing to be done if STSetUp has not been called yet */
if (!st->setupcalled) PetscFunctionReturn(0);
 
/* Check if the new KSP matrix has the same zero structure */
if (st->B && st->str == DIFFERENT_NONZERO_PATTERN && (st->sigma == 0.0 || newshift == 0.0)) {
flg = DIFFERENT_NONZERO_PATTERN;
} else {
flg = SAME_NONZERO_PATTERN;
}
 
switch (st->shift_matrix) {
case STMATMODE_INPLACE:
/* Undo previous operations */
if (st->sigma != 0.0) {
if (st->B) {
ierr = MatAXPY(st->A,st->sigma,st->B,st->str);CHKERRQ(ierr);
} else {
ierr = MatShift(st->A,st->sigma);CHKERRQ(ierr);
}
}
/* Apply new shift */
if (newshift != 0.0) {
if (st->B) {
ierr = MatAXPY(st->A,-newshift,st->B,st->str);CHKERRQ(ierr);
} else {
ierr = MatShift(st->A,-newshift);CHKERRQ(ierr);
}
}
ierr = KSPSetOperators(st->ksp,st->A,st->A,flg);CHKERRQ(ierr);
break;
case STMATMODE_SHELL:
ierr = KSPSetOperators(st->ksp,st->mat,st->mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
break;
default:
ierr = MatCopy(st->A, st->mat,SUBSET_NONZERO_PATTERN); CHKERRQ(ierr);
if (newshift != 0.0) {
if (st->B) { ierr = MatAXPY(st->mat,-newshift,st->B,st->str);CHKERRQ(ierr); }
else { ierr = MatShift(st->mat,-newshift);CHKERRQ(ierr); }
}
ierr = KSPSetOperators(st->ksp,st->mat,st->mat,flg);CHKERRQ(ierr);
}
st->sigma = newshift;
ierr = KSPSetUp(st->ksp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetFromOptions_Cayley"
PetscErrorCode STSetFromOptions_Cayley(ST st)
{
PetscErrorCode ierr;
PetscScalar tau;
PetscTruth flg;
ST_CAYLEY *ctx = (ST_CAYLEY *) st->data;
 
PetscFunctionBegin;
ierr = PetscOptionsHead("ST Cayley Options");CHKERRQ(ierr);
ierr = PetscOptionsScalar("-st_antishift","Value of the antishift","STSetAntishift",ctx->tau,&tau,&flg); CHKERRQ(ierr);
if (flg) {
ierr = STCayleySetAntishift(st,tau);CHKERRQ(ierr);
}
ierr = PetscOptionsTail();CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STCayleySetAntishift_Cayley"
PetscErrorCode STCayleySetAntishift_Cayley(ST st,PetscScalar newshift)
{
ST_CAYLEY *ctx = (ST_CAYLEY *) st->data;
 
PetscFunctionBegin;
ctx->tau = newshift;
ctx->tau_set = PETSC_TRUE;
PetscFunctionReturn(0);
}
EXTERN_C_END
 
#undef __FUNCT__
#define __FUNCT__ "STCayleySetAntishift"
/*@
STCayleySetAntishift - Sets the value of the anti-shift for the Cayley
spectral transformation.
 
Collective on ST
 
Input Parameters:
+ st - the spectral transformation context
- tau - the anti-shift
 
Options Database Key:
. -st_antishift - Sets the value of the anti-shift
 
Level: intermediate
 
Note:
In the generalized Cayley transform, the operator can be expressed as
OP = inv(A - sigma B)*(A + tau B). This function sets the value of tau.
Use STSetShift() for setting sigma.
 
.seealso: STSetShift()
@*/
PetscErrorCode STCayleySetAntishift(ST st,PetscScalar tau)
{
PetscErrorCode ierr, (*f)(ST,PetscScalar);
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
ierr = PetscObjectQueryFunction((PetscObject)st,"STCayleySetAntishift_C",(void (**)(void))&f);CHKERRQ(ierr);
if (f) {
ierr = (*f)(st,tau);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STView_Cayley"
PetscErrorCode STView_Cayley(ST st,PetscViewer viewer)
{
PetscErrorCode ierr;
ST_CAYLEY *ctx = (ST_CAYLEY *) st->data;
 
PetscFunctionBegin;
#if !defined(PETSC_USE_COMPLEX)
ierr = PetscViewerASCIIPrintf(viewer," antishift: %g\n",ctx->tau);CHKERRQ(ierr);
#else
ierr = PetscViewerASCIIPrintf(viewer," antishift: %g+%g i\n",PetscRealPart(ctx->tau),PetscImaginaryPart(ctx->tau));CHKERRQ(ierr);
#endif
ierr = STView_Default(st,viewer);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STDestroy_Cayley"
PetscErrorCode STDestroy_Cayley(ST st)
{
PetscErrorCode ierr;
ST_CAYLEY *ctx = (ST_CAYLEY *) st->data;
 
PetscFunctionBegin;
if (ctx->w2) { ierr = VecDestroy(ctx->w2);CHKERRQ(ierr); }
ierr = PetscFree(ctx);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STCreate_Cayley"
PetscErrorCode STCreate_Cayley(ST st)
{
PetscErrorCode ierr;
ST_CAYLEY *ctx;
 
PetscFunctionBegin;
ierr = PetscNew(ST_CAYLEY,&ctx); CHKERRQ(ierr);
PetscLogObjectMemory(st,sizeof(ST_CAYLEY));
st->data = (void *) ctx;
 
st->ops->apply = STApply_Cayley;
st->ops->getbilinearform = STGetBilinearForm_Cayley;
st->ops->applytrans = STApplyTranspose_Cayley;
st->ops->postsolve = STPostSolve_Cayley;
st->ops->backtr = STBackTransform_Cayley;
st->ops->setfromoptions = STSetFromOptions_Cayley;
st->ops->setup = STSetUp_Cayley;
st->ops->setshift = STSetShift_Cayley;
st->ops->destroy = STDestroy_Cayley;
st->ops->view = STView_Cayley;
st->checknullspace = STCheckNullSpace_Default;
 
ctx->tau = 0.0;
ctx->tau_set = PETSC_FALSE;
 
ierr = PetscObjectComposeFunctionDynamic((PetscObject)st,"STCayleySetAntishift_C","STCayleySetAntishift_Cayley",
STCayleySetAntishift_Cayley);CHKERRQ(ierr);
 
PetscFunctionReturn(0);
}
EXTERN_C_END
 
tags/slepc-2_3_3-1/src/st/impls/cayley/cayley.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/impls/cayley/makefile New file
0,0 → 1,26
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
ALL: lib
 
CFLAGS =
FFLAGS =
SOURCEC = cayley.c
SOURCEF =
SOURCEH =
OBJSC = cayley.o
LIBBASE = libslepc
DIRS =
MANSEC = ST
LOCDIR = src/st/impls/cayley/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
tags/slepc-2_3_3-1/src/st/impls/cayley/makefile Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/impls/shell/ftn-custom/zshell.c New file
0,0 → 1,76
/*
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "slepcst.h"
 
#ifdef PETSC_HAVE_FORTRAN_CAPS
#define stshellsetapply_ STSHELLSETAPPLY
#define stshellsetapplytranspose_ STSHELLSETAPPLYTRANSPOSE
#define stshellsetbacktransform_ STSHELLSETBACKTRANSFORM
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
#define stshellsetapply_ stshellsetapply
#define stshellsetapplytranspose_ stshellsetapplytranspose
#define stshellsetbacktransform_ stshellsetbacktransform
#endif
 
EXTERN_C_BEGIN
static void (PETSC_STDCALL *f1)(void*,Vec*,Vec*,PetscErrorCode*);
static void (PETSC_STDCALL *f2)(void*,Vec*,Vec*,PetscErrorCode*);
static void (PETSC_STDCALL *f3)(void*,PetscScalar*,PetscScalar*,PetscErrorCode*);
EXTERN_C_END
 
/* These are not extern C because they are passed into non-extern C user level functions */
static PetscErrorCode ourshellapply(void *ctx,Vec x,Vec y)
{
PetscErrorCode ierr = 0;
(*f1)(ctx,&x,&y,&ierr);CHKERRQ(ierr);
return 0;
}
 
static PetscErrorCode ourshellapplytranspose(void *ctx,Vec x,Vec y)
{
PetscErrorCode ierr = 0;
(*f2)(ctx,&x,&y,&ierr);CHKERRQ(ierr);
return 0;
}
 
static PetscErrorCode ourshellbacktransform(void *ctx,PetscScalar *eigr,PetscScalar *eigi)
{
PetscErrorCode ierr = 0;
(*f3)(ctx,eigr,eigi,&ierr);CHKERRQ(ierr);
return 0;
}
 
EXTERN_C_BEGIN
 
void PETSC_STDCALL stshellsetapply_(ST *st,void (PETSC_STDCALL *apply)(void*,Vec *,Vec *,PetscErrorCode*),
PetscErrorCode *ierr)
{
f1 = apply;
*ierr = STShellSetApply(*st,ourshellapply);
}
 
void PETSC_STDCALL stshellsetapplytranspose_(ST *st,void (PETSC_STDCALL *applytranspose)(void*,Vec *,Vec *,PetscErrorCode*),
PetscErrorCode *ierr)
{
f2 = applytranspose;
*ierr = STShellSetApplyTranspose(*st,ourshellapplytranspose);
}
 
void PETSC_STDCALL stshellsetbacktransform_(ST *st,void (PETSC_STDCALL *backtransform)(void*,PetscScalar*,PetscScalar*,PetscErrorCode*),
PetscErrorCode *ierr)
{
f3 = backtransform;
*ierr = STShellSetBackTransform(*st,ourshellbacktransform);
}
 
EXTERN_C_END
 
tags/slepc-2_3_3-1/src/st/impls/shell/ftn-custom/zshell.c Property changes : Added: svn:keywords
+ Author Date Id Revision
Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/impls/shell/ftn-custom/makefile New file
0,0 → 1,22
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
#requirespackage 'PETSC_HAVE_FORTRAN'
ALL: lib
CFLAGS =
FFLAGS =
SOURCEC = zshell.c
OBJSC = zshell.o
SOURCEF =
SOURCEH =
DIRS =
LIBBASE = libslepc
LOCDIR = src/st/impls/shell/ftn-custom/
include ${SLEPC_DIR}/bmake/slepc_common
tags/slepc-2_3_3-1/src/st/impls/shell/ftn-custom/makefile Property changes : Added: svn:keywords
+ Author Date Id Revision
Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/impls/shell/shell.c New file
0,0 → 1,476
/*
This provides a simple shell interface for programmers to
create their own spectral transformations without writing much
interface code.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/st/stimpl.h" /*I "slepcst.h" I*/
#include "slepceps.h"
 
EXTERN_C_BEGIN
typedef struct {
void *ctx; /* user provided context */
PetscErrorCode (*apply)(void *,Vec,Vec);
PetscErrorCode (*applytrans)(void *,Vec,Vec);
PetscErrorCode (*backtr)(void *,PetscScalar*,PetscScalar*);
char *name;
} ST_Shell;
EXTERN_C_END
 
#undef __FUNCT__
#define __FUNCT__ "STShellGetContext"
/*@C
STShellGetContext - Returns the user-provided context associated with a shell ST
 
Not Collective
 
Input Parameter:
. st - spectral transformation context
 
Output Parameter:
. ctx - the user provided context
 
Level: advanced
 
Notes:
This routine is intended for use within various shell routines
.seealso: STShellSetContext()
@*/
PetscErrorCode STShellGetContext(ST st,void **ctx)
{
PetscErrorCode ierr;
PetscTruth flg;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
PetscValidPointer(ctx,2);
ierr = PetscTypeCompare((PetscObject)st,STSHELL,&flg);CHKERRQ(ierr);
if (!flg) *ctx = 0;
else *ctx = ((ST_Shell*)(st->data))->ctx;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STShellSetContext"
/*@C
STShellSetContext - sets the context for a shell ST
 
Collective on ST
 
Input Parameters:
+ st - the shell ST
- ctx - the context
 
Level: advanced
 
Fortran Notes: The context can only be an integer or a PetscObject;
unfortunately it cannot be a Fortran array or derived type.
 
.seealso: STShellGetContext()
@*/
PetscErrorCode STShellSetContext(ST st,void *ctx)
{
ST_Shell *shell = (ST_Shell*)st->data;
PetscErrorCode ierr;
PetscTruth flg;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
ierr = PetscTypeCompare((PetscObject)st,STSHELL,&flg);CHKERRQ(ierr);
if (flg) {
shell->ctx = ctx;
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STApply_Shell"
PetscErrorCode STApply_Shell(ST st,Vec x,Vec y)
{
PetscErrorCode ierr;
ST_Shell *shell = (ST_Shell*)st->data;
 
PetscFunctionBegin;
if (!shell->apply) SETERRQ(PETSC_ERR_USER,"No apply() routine provided to Shell ST");
PetscStackPush("PCSHELL user function");
CHKMEMQ;
ierr = (*shell->apply)(shell->ctx,x,y);CHKERRQ(ierr);
CHKMEMQ;
PetscStackPop;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STApplyTranspose_Shell"
PetscErrorCode STApplyTranspose_Shell(ST st,Vec x,Vec y)
{
PetscErrorCode ierr;
ST_Shell *shell = (ST_Shell*)st->data;
 
PetscFunctionBegin;
if (!shell->applytrans) SETERRQ(PETSC_ERR_USER,"No applytranspose() routine provided to Shell ST");
ierr = (*shell->applytrans)(shell->ctx,x,y);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STBackTransform_Shell"
PetscErrorCode STBackTransform_Shell(ST st,PetscScalar *eigr,PetscScalar *eigi)
{
PetscErrorCode ierr;
ST_Shell *shell = (ST_Shell*)st->data;
 
PetscFunctionBegin;
if (shell->backtr) {
ierr = (*shell->backtr)(shell->ctx,eigr,eigi);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STDestroy_Shell"
PetscErrorCode STDestroy_Shell(ST st)
{
PetscErrorCode ierr;
ST_Shell *shell = (ST_Shell*)st->data;
 
PetscFunctionBegin;
ierr = PetscFree(shell->name);CHKERRQ(ierr);
ierr = PetscFree(shell);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STView_Shell"
PetscErrorCode STView_Shell(ST st,PetscViewer viewer)
{
PetscErrorCode ierr;
ST_Shell *ctx = (ST_Shell*)st->data;
PetscTruth isascii;
 
PetscFunctionBegin;
ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);CHKERRQ(ierr);
if (isascii) {
if (ctx->name) {ierr = PetscViewerASCIIPrintf(viewer," ST Shell: %s\n",ctx->name);CHKERRQ(ierr);}
else {ierr = PetscViewerASCIIPrintf(viewer," ST Shell: no name\n");CHKERRQ(ierr);}
} else {
SETERRQ1(1,"Viewer type %s not supported for STShell",((PetscObject)viewer)->type_name);
}
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STShellSetApply_Shell"
PetscErrorCode STShellSetApply_Shell(ST st,PetscErrorCode (*apply)(void*,Vec,Vec))
{
ST_Shell *shell = (ST_Shell*)st->data;
 
PetscFunctionBegin;
shell->apply = apply;
PetscFunctionReturn(0);
}
EXTERN_C_END
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STShellSetApplyTranspose_Shell"
PetscErrorCode STShellSetApplyTranspose_Shell(ST st,PetscErrorCode (*applytrans)(void*,Vec,Vec))
{
ST_Shell *shell = (ST_Shell*)st->data;
 
PetscFunctionBegin;
shell->applytrans = applytrans;
PetscFunctionReturn(0);
}
EXTERN_C_END
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STShellSetBackTransform_Shell"
PetscErrorCode STShellSetBackTransform_Shell(ST st,PetscErrorCode (*backtr)(void*,PetscScalar*,PetscScalar*))
{
ST_Shell *shell = (ST_Shell *) st->data;
 
PetscFunctionBegin;
shell->backtr = backtr;
PetscFunctionReturn(0);
}
EXTERN_C_END
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STShellSetName_Shell"
PetscErrorCode STShellSetName_Shell(ST st,const char name[])
{
ST_Shell *shell = (ST_Shell*)st->data;
PetscErrorCode ierr;
 
PetscFunctionBegin;
ierr = PetscStrfree(shell->name);CHKERRQ(ierr);
ierr = PetscStrallocpy(name,&shell->name);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
EXTERN_C_END
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STShellGetName_Shell"
PetscErrorCode STShellGetName_Shell(ST st,char *name[])
{
ST_Shell *shell = (ST_Shell*)st->data;
 
PetscFunctionBegin;
*name = shell->name;
PetscFunctionReturn(0);
}
EXTERN_C_END
 
#undef __FUNCT__
#define __FUNCT__ "STShellSetApply"
/*@C
STShellSetApply - Sets routine to use as the application of the
operator to a vector in the user-defined spectral transformation.
 
Collective on ST
 
Input Parameters:
+ st - the spectral transformation context
- apply - the application-provided transformation routine
 
Calling sequence of apply:
.vb
PetscErrorCode apply (void *ptr,Vec xin,Vec xout)
.ve
 
+ ptr - the application context
. xin - input vector
- xout - output vector
 
Level: developer
 
.seealso: STShellSetBackTransform(), STShellSetApplyTranspose()
@*/
PetscErrorCode STShellSetApply(ST st,PetscErrorCode (*apply)(void*,Vec,Vec))
{
PetscErrorCode ierr, (*f)(ST,PetscErrorCode (*)(void*,Vec,Vec));
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
ierr = PetscObjectQueryFunction((PetscObject)st,"STShellSetApply_C",(void (**)(void))&f);CHKERRQ(ierr);
if (f) {
ierr = (*f)(st,apply);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STShellSetApplyTranspose"
/*@C
STShellSetApplyTranspose - Sets routine to use as the application of the
transposed operator to a vector in the user-defined spectral transformation.
 
Collective on ST
 
Input Parameters:
+ st - the spectral transformation context
- applytrans - the application-provided transformation routine
 
Calling sequence of apply:
.vb
PetscErrorCode applytrans (void *ptr,Vec xin,Vec xout)
.ve
 
+ ptr - the application context
. xin - input vector
- xout - output vector
 
Level: developer
 
.seealso: STShellSetApply(), STShellSetBackTransform()
@*/
PetscErrorCode STShellSetApplyTranspose(ST st,PetscErrorCode (*applytrans)(void*,Vec,Vec))
{
PetscErrorCode ierr, (*f)(ST,PetscErrorCode (*)(void*,Vec,Vec));
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
ierr = PetscObjectQueryFunction((PetscObject)st,"STShellSetApplyTranspose_C",(void (**)(void))&f);CHKERRQ(ierr);
if (f) {
ierr = (*f)(st,applytrans);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STShellSetBackTransform"
/*@C
STShellSetBackTransform - Sets the routine to be called after the
eigensolution process has finished in order to transform back the
computed eigenvalues.
 
Collective on ST
 
Input Parameters:
+ st - the spectral transformation context
- backtr - the application-provided backtransform routine
 
Calling sequence of backtr:
.vb
PetscErrorCode backtr (void *ptr,PetscScalar *eigr,PetscScalar *eigi)
.ve
 
+ ptr - the application context
. eigr - pointer ot the real part of the eigenvalue to transform back
- eigi - pointer ot the imaginary part
 
Level: developer
 
.seealso: STShellSetApply(), STShellSetApplyTranspose()
@*/
PetscErrorCode STShellSetBackTransform(ST st,PetscErrorCode (*backtr)(void*,PetscScalar*,PetscScalar*))
{
PetscErrorCode ierr, (*f)(ST,PetscErrorCode (*)(void*,PetscScalar*,PetscScalar*));
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
ierr = PetscObjectQueryFunction((PetscObject)st,"STShellSetBackTransform_C",(void (**)(void))&f);CHKERRQ(ierr);
if (f) {
ierr = (*f)(st,(int (*)(void*,PetscScalar*,PetscScalar*))backtr);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STShellSetName"
/*@C
STShellSetName - Sets an optional name to associate with a shell
spectral transformation.
 
Not Collective
 
Input Parameters:
+ st - the spectral transformation context
- name - character string describing the shell spectral transformation
 
Level: developer
 
.seealso: STShellGetName()
@*/
PetscErrorCode STShellSetName(ST st,const char name[])
{
PetscErrorCode ierr, (*f)(ST,const char []);
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
ierr = PetscObjectQueryFunction((PetscObject)st,"STShellSetName_C",(void (**)(void))&f);CHKERRQ(ierr);
if (f) {
ierr = (*f)(st,name);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STShellGetName"
/*@C
STShellGetName - Gets an optional name that the user has set for a shell
spectral transformation.
 
Not Collective
 
Input Parameter:
. st - the spectral transformation context
 
Output Parameter:
. name - character string describing the shell spectral transformation
(you should not free this)
 
Level: developer
 
.seealso: STShellSetName()
@*/
PetscErrorCode STShellGetName(ST st,char *name[])
{
PetscErrorCode ierr, (*f)(ST,char *[]);
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE,1);
ierr = PetscObjectQueryFunction((PetscObject)st,"STShellGetName_C",(void (**)(void))&f);CHKERRQ(ierr);
if (f) {
ierr = (*f)(st,name);CHKERRQ(ierr);
} else {
SETERRQ(PETSC_ERR_ARG_WRONG,"Not shell spectral transformation, cannot get name");
}
PetscFunctionReturn(0);
}
 
/*MC
STSHELL - Creates a new spectral transformation class.
This is intended to provide a simple class to use with EPS.
You should not use this if you plan to make a complete class.
 
Level: advanced
 
Usage:
$ PetscErrorCode (*apply)(void*,Vec,Vec);
$ PetscErrorCode (*applytrans)(void*,Vec,Vec);
$ PetscErrorCode (*backtr)(void*,PetscScalar*,PetscScalar*);
$ STCreate(comm,&st);
$ STSetType(st,STSHELL);
$ STShellSetApply(st,apply);
$ STShellSetApplyTranspose(st,applytrans);
$ STShellSetBackTransform(st,backtr); (optional)
 
M*/
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STCreate_Shell"
PetscErrorCode STCreate_Shell(ST st)
{
PetscErrorCode ierr;
ST_Shell *shell;
 
PetscFunctionBegin;
st->ops->destroy = STDestroy_Shell;
ierr = PetscNew(ST_Shell,&shell);CHKERRQ(ierr);
ierr = PetscLogObjectMemory(st,sizeof(ST_Shell));CHKERRQ(ierr);
 
st->data = (void *) shell;
st->name = 0;
 
st->ops->apply = STApply_Shell;
st->ops->applytrans= STApplyTranspose_Shell;
st->ops->backtr = STBackTransform_Shell;
st->ops->view = STView_Shell;
 
shell->apply = 0;
shell->applytrans = 0;
shell->backtr = 0;
shell->name = 0;
shell->ctx = 0;
 
ierr = PetscObjectComposeFunctionDynamic((PetscObject)st,"STShellSetApply_C","STShellSetApply_Shell",
STShellSetApply_Shell);CHKERRQ(ierr);
ierr = PetscObjectComposeFunctionDynamic((PetscObject)st,"STShellSetApplyTranspose_C","STShellSetApplyTranspose_Shell",
STShellSetApplyTranspose_Shell);CHKERRQ(ierr);
ierr = PetscObjectComposeFunctionDynamic((PetscObject)st,"STShellSetBackTransform_C","STShellSetBackTransform_Shell",
STShellSetBackTransform_Shell);CHKERRQ(ierr);
ierr = PetscObjectComposeFunctionDynamic((PetscObject)st,"STShellSetName_C","STShellSetName_Shell",
STShellSetName_Shell);CHKERRQ(ierr);
ierr = PetscObjectComposeFunctionDynamic((PetscObject)st,"STShellGetName_C","STShellGetName_Shell",
STShellGetName_Shell);CHKERRQ(ierr);
 
PetscFunctionReturn(0);
}
EXTERN_C_END
 
tags/slepc-2_3_3-1/src/st/impls/shell/shell.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/impls/shell/makefile New file
0,0 → 1,26
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
ALL: lib
 
CFLAGS =
FFLAGS =
SOURCEC = shell.c
SOURCEF =
SOURCEH =
OBJSC = shell.o
LIBBASE = libslepc
DIRS =
MANSEC = ST
LOCDIR = src/st/impls/shell/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
tags/slepc-2_3_3-1/src/st/impls/shell/makefile Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/impls/sinvert/sinvert.c New file
0,0 → 1,222
/*
Implements the shift-and-invert technique for eigenvalue problems.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/st/stimpl.h" /*I "slepcst.h" I*/
 
#undef __FUNCT__
#define __FUNCT__ "STApply_Sinvert"
PetscErrorCode STApply_Sinvert(ST st,Vec x,Vec y)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
if (st->B) {
/* generalized eigenproblem: y = (A - sB)^-1 B x */
ierr = MatMult(st->B,x,st->w);CHKERRQ(ierr);
ierr = STAssociatedKSPSolve(st,st->w,y);CHKERRQ(ierr);
}
else {
/* standard eigenproblem: y = (A - sI)^-1 x */
ierr = STAssociatedKSPSolve(st,x,y);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STApplyTranspose_Sinvert"
PetscErrorCode STApplyTranspose_Sinvert(ST st,Vec x,Vec y)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
if (st->B) {
/* generalized eigenproblem: y = B^T (A - sB)^-T x */
ierr = STAssociatedKSPSolveTranspose(st,x,st->w);CHKERRQ(ierr);
ierr = MatMultTranspose(st->B,st->w,y);CHKERRQ(ierr);
}
else {
/* standard eigenproblem: y = (A - sI)^-T x */
ierr = STAssociatedKSPSolveTranspose(st,x,y);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STBackTransform_Sinvert"
PetscErrorCode STBackTransform_Sinvert(ST st,PetscScalar *eigr,PetscScalar *eigi)
{
#ifndef PETSC_USE_COMPLEX
PetscScalar t;
PetscFunctionBegin;
PetscValidPointer(eigr,2);
PetscValidPointer(eigi,3);
if (*eigi == 0) *eigr = 1.0 / *eigr + st->sigma;
else {
t = *eigr * *eigr + *eigi * *eigi;
*eigr = *eigr / t + st->sigma;
*eigi = - *eigi / t;
}
#else
PetscFunctionBegin;
PetscValidPointer(eigr,2);
*eigr = 1.0 / *eigr + st->sigma;
#endif
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STPostSolve_Sinvert"
PetscErrorCode STPostSolve_Sinvert(ST st)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
if (st->shift_matrix == STMATMODE_INPLACE) {
if( st->B ) {
ierr = MatAXPY(st->A,st->sigma,st->B,st->str);CHKERRQ(ierr);
} else {
ierr = MatShift(st->A,st->sigma); CHKERRQ(ierr);
}
st->setupcalled = 0;
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetUp_Sinvert"
PetscErrorCode STSetUp_Sinvert(ST st)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
if (st->mat) { ierr = MatDestroy(st->mat);CHKERRQ(ierr); }
 
switch (st->shift_matrix) {
case STMATMODE_INPLACE:
st->mat = PETSC_NULL;
if (st->sigma != 0.0) {
if (st->B) {
ierr = MatAXPY(st->A,-st->sigma,st->B,st->str);CHKERRQ(ierr);
} else {
ierr = MatShift(st->A,-st->sigma);CHKERRQ(ierr);
}
}
ierr = KSPSetOperators(st->ksp,st->A,st->A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
break;
case STMATMODE_SHELL:
ierr = STMatShellCreate(st,&st->mat);CHKERRQ(ierr);
ierr = KSPSetOperators(st->ksp,st->mat,st->mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
break;
default:
ierr = MatDuplicate(st->A,MAT_COPY_VALUES,&st->mat);CHKERRQ(ierr);
if (st->sigma != 0.0) {
if (st->B) {
ierr = MatAXPY(st->mat,-st->sigma,st->B,st->str);CHKERRQ(ierr);
} else {
ierr = MatShift(st->mat,-st->sigma);CHKERRQ(ierr);
}
ierr = KSPSetOperators(st->ksp,st->mat,st->mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
} else {
st->mat = PETSC_NULL;
ierr = KSPSetOperators(st->ksp,st->A,st->A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
}
}
 
ierr = KSPSetUp(st->ksp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetShift_Sinvert"
PetscErrorCode STSetShift_Sinvert(ST st,PetscScalar newshift)
{
PetscErrorCode ierr;
MatStructure flg;
 
PetscFunctionBegin;
 
/* Nothing to be done if STSetUp has not been called yet */
if (!st->setupcalled) PetscFunctionReturn(0);
/* Check if the new KSP matrix has the same zero structure */
if (st->B && st->str == DIFFERENT_NONZERO_PATTERN && (st->sigma == 0.0 || newshift == 0.0)) {
flg = DIFFERENT_NONZERO_PATTERN;
} else {
flg = SAME_NONZERO_PATTERN;
}
 
switch (st->shift_matrix) {
case STMATMODE_INPLACE:
/* Undo previous operations */
if (st->sigma != 0.0) {
if (st->B) {
ierr = MatAXPY(st->A,st->sigma,st->B,st->str);CHKERRQ(ierr);
} else {
ierr = MatShift(st->A,st->sigma);CHKERRQ(ierr);
}
}
/* Apply new shift */
if (newshift != 0.0) {
if (st->B) {
ierr = MatAXPY(st->A,-newshift,st->B,st->str);CHKERRQ(ierr);
} else {
ierr = MatShift(st->A,-newshift);CHKERRQ(ierr);
}
}
ierr = KSPSetOperators(st->ksp,st->A,st->A,flg);CHKERRQ(ierr);
break;
case STMATMODE_SHELL:
ierr = KSPSetOperators(st->ksp,st->mat,st->mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
break;
default:
if (st->mat) {
ierr = MatCopy(st->A,st->mat,SUBSET_NONZERO_PATTERN); CHKERRQ(ierr);
} else {
ierr = MatDuplicate(st->A,MAT_COPY_VALUES,&st->mat);CHKERRQ(ierr);
}
if (newshift != 0.0) {
if (st->B) {
ierr = MatAXPY(st->mat,-newshift,st->B,st->str);CHKERRQ(ierr);
} else {
ierr = MatShift(st->mat,-newshift);CHKERRQ(ierr);
}
}
ierr = KSPSetOperators(st->ksp,st->mat,st->mat,flg);CHKERRQ(ierr);
}
st->sigma = newshift;
ierr = KSPSetUp(st->ksp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STCreate_Sinvert"
PetscErrorCode STCreate_Sinvert(ST st)
{
PetscFunctionBegin;
st->data = 0;
 
st->ops->apply = STApply_Sinvert;
st->ops->getbilinearform = STGetBilinearForm_Default;
st->ops->applytrans = STApplyTranspose_Sinvert;
st->ops->postsolve = STPostSolve_Sinvert;
st->ops->backtr = STBackTransform_Sinvert;
st->ops->setup = STSetUp_Sinvert;
st->ops->setshift = STSetShift_Sinvert;
st->ops->view = STView_Default;
st->checknullspace = STCheckNullSpace_Default;
 
PetscFunctionReturn(0);
}
EXTERN_C_END
 
tags/slepc-2_3_3-1/src/st/impls/sinvert/sinvert.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/impls/sinvert/makefile New file
0,0 → 1,26
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
ALL: lib
 
CFLAGS =
FFLAGS =
SOURCEC = sinvert.c
SOURCEF =
SOURCEH =
OBJSC = sinvert.o
LIBBASE = libslepc
DIRS =
MANSEC = ST
LOCDIR = src/st/impls/sinvert/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
tags/slepc-2_3_3-1/src/st/impls/sinvert/makefile Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/impls/makefile New file
0,0 → 1,20
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
ALL: lib
 
LIBBASE = libslepc
DIRS = shell shift sinvert cayley fold
LOCDIR = src/st/impls/
MANSEC = ST
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
tags/slepc-2_3_3-1/src/st/impls/makefile Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/impls/shift/makefile New file
0,0 → 1,26
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
ALL: lib
 
CFLAGS =
FFLAGS =
SOURCEC = shift.c
SOURCEF =
SOURCEH =
OBJSC = shift.o
LIBBASE = libslepc
DIRS =
MANSEC = ST
LOCDIR = src/st/impls/shift/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
tags/slepc-2_3_3-1/src/st/impls/shift/makefile Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/impls/shift/shift.c New file
0,0 → 1,112
/*
Shift spectral transformation, applies (A + sigma I) as operator, or
inv(B)(A + sigma B) for generalized problems
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/st/stimpl.h" /*I "slepcst.h" I*/
 
#undef __FUNCT__
#define __FUNCT__ "STApply_Shift"
PetscErrorCode STApply_Shift(ST st,Vec x,Vec y)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
if (st->B) {
/* generalized eigenproblem: y = (B^-1 A + sI) x */
ierr = MatMult(st->A,x,st->w);CHKERRQ(ierr);
ierr = STAssociatedKSPSolve(st,st->w,y);CHKERRQ(ierr);
}
else {
/* standard eigenproblem: y = (A + sI) x */
ierr = MatMult(st->A,x,y);CHKERRQ(ierr);
}
if (st->sigma != 0.0) {
ierr = VecAXPY(y,st->sigma,x);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STApplyTranspose_Shift"
PetscErrorCode STApplyTranspose_Shift(ST st,Vec x,Vec y)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
if (st->B) {
/* generalized eigenproblem: y = (A^T B^-T + sI) x */
ierr = STAssociatedKSPSolveTranspose(st,x,st->w);CHKERRQ(ierr);
ierr = MatMultTranspose(st->A,st->w,y);CHKERRQ(ierr);
}
else {
/* standard eigenproblem: y = (A^T + sI) x */
ierr = MatMultTranspose(st->A,x,y);CHKERRQ(ierr);
}
if (st->sigma != 0.0) {
ierr = VecAXPY(y,st->sigma,x);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STBackTransform_Shift"
PetscErrorCode STBackTransform_Shift(ST st,PetscScalar *eigr,PetscScalar *eigi)
{
PetscFunctionBegin;
if (eigr) *eigr -= st->sigma;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetUp_Shift"
PetscErrorCode STSetUp_Shift(ST st)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
if (st->B) {
ierr = KSPSetOperators(st->ksp,st->B,st->B,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = KSPSetUp(st->ksp);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STView_Shift"
PetscErrorCode STView_Shift(ST st,PetscViewer viewer)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
if (st->B) {
ierr = STView_Default(st,viewer);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STCreate_Shift"
PetscErrorCode STCreate_Shift(ST st)
{
PetscFunctionBegin;
st->ops->apply = STApply_Shift;
st->ops->getbilinearform = STGetBilinearForm_Default;
st->ops->applytrans = STApplyTranspose_Shift;
st->ops->backtr = STBackTransform_Shift;
st->ops->setup = STSetUp_Shift;
st->ops->view = STView_Shift;
st->checknullspace = 0;
PetscFunctionReturn(0);
}
EXTERN_C_END
 
tags/slepc-2_3_3-1/src/st/impls/shift/shift.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/makefile New file
0,0 → 1,20
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
ALL: lib
 
SOURCEH = stimpl.h ../../include/slepcst.h
DIRS = interface impls
LOCDIR = src/st/
MANSEC = ST
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
tags/slepc-2_3_3-1/src/st/makefile Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/st/stimpl.h New file
0,0 → 1,64
/*
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
 
#ifndef _STIMPL
#define _STIMPL
 
#include "slepceps.h"
 
extern PetscEvent ST_SetUp, ST_Apply, ST_ApplyB, ST_ApplyTranspose;
extern PetscFList STList;
 
typedef struct _STOps *STOps;
 
struct _STOps {
int (*setup)(ST);
int (*apply)(ST,Vec,Vec);
int (*getbilinearform)(ST,Mat*);
int (*applytrans)(ST,Vec,Vec);
int (*setshift)(ST,PetscScalar);
int (*setfromoptions)(ST);
int (*postsolve)(ST);
int (*backtr)(ST,PetscScalar*,PetscScalar*);
int (*destroy)(ST);
int (*view)(ST,PetscViewer);
};
 
struct _p_ST {
PETSCHEADER(struct _STOps);
/*------------------------- User parameters --------------------------*/
Mat A,B; /* Matrices which define the eigensystem */
PetscScalar sigma; /* Value of the shift */
STMatMode shift_matrix;
MatStructure str; /* whether matrices have the same pattern or not */
Mat mat;
 
/*------------------------- Misc data --------------------------*/
KSP ksp;
Vec w;
void *data;
int setupcalled;
int lineariterations;
int applys;
int (*checknullspace)(ST,int,const Vec[]);
};
 
EXTERN PetscErrorCode STRegisterAll(char*);
 
EXTERN PetscErrorCode STGetBilinearForm_Default(ST,Mat*);
EXTERN PetscErrorCode STView_Default(ST,PetscViewer);
EXTERN PetscErrorCode STAssociatedKSPSolve(ST,Vec,Vec);
EXTERN PetscErrorCode STAssociatedKSPSolveTranspose(ST,Vec,Vec);
EXTERN PetscErrorCode STCheckNullSpace_Default(ST,int,const Vec[]);
EXTERN PetscErrorCode STMatShellCreate(ST st,Mat *mat);
 
#endif
 
tags/slepc-2_3_3-1/src/st/stimpl.h Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/epsimpl.h New file
0,0 → 1,124
/*
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
 
#ifndef _EPSIMPL
#define _EPSIMPL
 
#include "slepceps.h"
 
extern PetscFList EPSList;
extern PetscEvent EPS_SetUp, EPS_Solve, EPS_Dense;
 
typedef struct _EPSOps *EPSOps;
 
struct _EPSOps {
int (*solve)(EPS); /* one-sided solver */
int (*solvets)(EPS); /* two-sided solver */
int (*setup)(EPS);
int (*setfromoptions)(EPS);
int (*publishoptions)(EPS);
int (*destroy)(EPS);
int (*view)(EPS,PetscViewer);
int (*backtransform)(EPS);
int (*computevectors)(EPS);
};
 
/*
Maximum number of monitors you can run with a single EPS
*/
#define MAXEPSMONITORS 5
 
/*
Defines the EPS data structure.
*/
struct _p_EPS {
PETSCHEADER(struct _EPSOps);
/*------------------------- User parameters --------------------------*/
int max_it, /* maximum number of iterations */
nev, /* number of eigenvalues to compute */
ncv, /* number of basis vectors */
nv, /* number of available basis vectors (<= ncv) */
allocated_ncv, /* number of basis vectors allocated */
nds; /* number of basis vectors of deflation space */
PetscReal tol; /* tolerance */
EPSWhich which; /* which part of the spectrum to be sought */
PetscTruth evecsavailable; /* computed eigenvectors */
EPSProblemType problem_type; /* which kind of problem to be solved */
EPSClass solverclass; /* whether the selected solver is one- or two-sided */
 
/*------------------------- Working data --------------------------*/
Vec vec_initial, /* initial vector */
vec_initial_left, /* left initial vector for two-sided solvers */
*V, /* set of basis vectors */
*AV, /* computed eigenvectors */
*W, /* set of left basis vectors */
*AW, /* computed left eigenvectors */
*DS, /* deflation space */
*DSV; /* deflation space and basis vectors*/
PetscScalar *eigr, *eigi, /* real and imaginary parts of eigenvalues */
*T, *Tl; /* projected matrices */
PetscReal *errest, /* error estimates */
*errest_left; /* left error estimates */
ST OP; /* spectral transformation object */
IP ip; /* innerproduct object */
void *data; /* placeholder for misc stuff associated
with a particular solver */
int nconv, /* number of converged eigenvalues */
its, /* number of iterations so far computed */
*perm; /* permutation for eigenvalue ordering */
 
/* ---------------- Default work-area and status vars -------------------- */
int nwork;
Vec *work;
 
int setupcalled;
PetscTruth isgeneralized,
ispositive,
ishermitian;
EPSConvergedReason reason;
 
int (*monitor[MAXEPSMONITORS])(EPS,int,int,PetscScalar*,PetscScalar*,PetscReal*,int,void*);
int (*monitordestroy[MAXEPSMONITORS])(void*);
void *monitorcontext[MAXEPSMONITORS];
int numbermonitors;
 
PetscTruth ds_ortho; /* if vectors in DS have to be orthonormalized */
};
 
#define EPSMonitor(eps,it,nconv,eigr,eigi,errest,nest) \
{ int _ierr,_i,_im = eps->numbermonitors; \
for ( _i=0; _i<_im; _i++ ) {\
_ierr=(*eps->monitor[_i])(eps,it,nconv,eigr,eigi,errest,nest,eps->monitorcontext[_i]);\
CHKERRQ(_ierr); \
} \
}
 
EXTERN PetscErrorCode EPSRegisterAll(char *);
 
EXTERN PetscErrorCode EPSDestroy_Default(EPS);
EXTERN PetscErrorCode EPSDefaultGetWork(EPS,int);
EXTERN PetscErrorCode EPSDefaultFreeWork(EPS);
EXTERN PetscErrorCode EPSAllocateSolution(EPS);
EXTERN PetscErrorCode EPSFreeSolution(EPS);
EXTERN PetscErrorCode EPSAllocateSolutionContiguous(EPS);
EXTERN PetscErrorCode EPSFreeSolutionContiguous(EPS);
EXTERN PetscErrorCode EPSBackTransform_Default(EPS);
EXTERN PetscErrorCode EPSComputeVectors_Default(EPS);
EXTERN PetscErrorCode EPSComputeVectors_Hermitian(EPS);
EXTERN PetscErrorCode EPSComputeVectors_Schur(EPS);
 
/* Private functions of the solver implementations */
 
EXTERN PetscErrorCode EPSBasicArnoldi(EPS,PetscTruth,PetscScalar*,Vec*,int,int*,Vec,PetscReal*,PetscTruth*);
EXTERN PetscErrorCode EPSDelayedArnoldi(EPS,PetscScalar*,Vec*,int,int*,Vec,PetscReal*,PetscTruth*);
EXTERN PetscErrorCode EPSDelayedArnoldi1(EPS,PetscScalar*,Vec*,int,int*,Vec,PetscReal*,PetscTruth*);
EXTERN PetscErrorCode ArnoldiResiduals(PetscScalar*,int,PetscScalar*,PetscReal,int,int,PetscScalar*,PetscScalar*,PetscReal*,PetscScalar*);
 
#endif
tags/slepc-2_3_3-1/src/eps/epsimpl.h Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/interface/dense.c New file
0,0 → 1,707
/*
This file contains routines for handling small-size dense problems.
All routines are simply wrappers to LAPACK routines. Matrices passed in
as arguments are assumed to be square matrices stored in column-major
format with a leading dimension equal to the number of rows.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/eps/epsimpl.h" /*I "slepceps.h" I*/
#include "slepcblaslapack.h"
 
#undef __FUNCT__
#define __FUNCT__ "EPSDenseNHEP"
/*@
EPSDenseNHEP - Solves a dense standard non-Hermitian Eigenvalue Problem.
 
Not Collective
 
Input Parameters:
+ n - dimension of the eigenproblem
- A - pointer to the array containing the matrix values
 
Output Parameters:
+ w - pointer to the array to store the computed eigenvalues
. wi - imaginary part of the eigenvalues (only when using real numbers)
. V - pointer to the array to store right eigenvectors
- W - pointer to the array to store left eigenvectors
 
Notes:
If either V or W are PETSC_NULL then the corresponding eigenvectors are
not computed.
 
Matrix A is overwritten.
This routine uses LAPACK routines xGEEVX.
 
Level: developer
 
.seealso: EPSDenseGNHEP(), EPSDenseHEP(), EPSDenseGHEP()
@*/
PetscErrorCode EPSDenseNHEP(int n,PetscScalar *A,PetscScalar *w,PetscScalar *wi,PetscScalar *V,PetscScalar *W)
{
#if defined(SLEPC_MISSING_LAPACK_GEEVX)
PetscFunctionBegin;
SETERRQ(PETSC_ERR_SUP,"GEEVX - Lapack routine is unavailable.");
#else
PetscErrorCode ierr;
PetscReal abnrm,*scale,dummy;
PetscScalar *work;
int ilo,ihi,lwork = 4*n,info;
const char *jobvr,*jobvl;
#if defined(PETSC_USE_COMPLEX)
PetscReal *rwork;
#else
int idummy;
#endif
 
PetscFunctionBegin;
ierr = PetscLogEventBegin(EPS_Dense,0,0,0,0);CHKERRQ(ierr);
if (V) jobvr = "V";
else jobvr = "N";
if (W) jobvl = "V";
else jobvl = "N";
ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscReal),&scale);CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
ierr = PetscMalloc(2*n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
LAPACKgeevx_("B",jobvl,jobvr,"N",&n,A,&n,w,W,&n,V,&n,&ilo,&ihi,scale,&abnrm,&dummy,&dummy,work,&lwork,rwork,&info,1,1,1,1);
if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack ZGEEVX %d",info);
ierr = PetscFree(rwork);CHKERRQ(ierr);
#else
LAPACKgeevx_("B",jobvl,jobvr,"N",&n,A,&n,w,wi,W,&n,V,&n,&ilo,&ihi,scale,&abnrm,&dummy,&dummy,work,&lwork,&idummy,&info,1,1,1,1);
if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack DGEEVX %d",info);
#endif
ierr = PetscFree(work);CHKERRQ(ierr);
ierr = PetscFree(scale);CHKERRQ(ierr);
ierr = PetscLogEventEnd(EPS_Dense,0,0,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
#endif
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDenseGNHEP"
/*@
EPSDenseGNHEP - Solves a dense Generalized non-Hermitian Eigenvalue Problem.
 
Not Collective
 
Input Parameters:
+ n - dimension of the eigenproblem
. A - pointer to the array containing the matrix values for A
- B - pointer to the array containing the matrix values for B
 
Output Parameters:
+ w - pointer to the array to store the computed eigenvalues
. wi - imaginary part of the eigenvalues (only when using real numbers)
. V - pointer to the array to store right eigenvectors
- W - pointer to the array to store left eigenvectors
 
Notes:
If either V or W are PETSC_NULL then the corresponding eigenvectors are
not computed.
 
Matrices A and B are overwritten.
This routine uses LAPACK routines xGGEVX.
 
Level: developer
 
.seealso: EPSDenseNHEP(), EPSDenseHEP(), EPSDenseGHEP()
@*/
PetscErrorCode EPSDenseGNHEP(int n,PetscScalar *A,PetscScalar *B,PetscScalar *w,PetscScalar *wi,PetscScalar *V,PetscScalar *W)
{
#if defined(SLEPC_MISSING_LAPACK_GGEVX)
PetscFunctionBegin;
SETERRQ(PETSC_ERR_SUP,"GGEVX - Lapack routine is unavailable.");
#else
PetscErrorCode ierr;
PetscReal *rscale,*lscale,abnrm,bbnrm,dummy;
PetscScalar *alpha,*beta,*work;
int i,ilo,ihi,idummy,info;
const char *jobvr,*jobvl;
#if defined(PETSC_USE_COMPLEX)
PetscReal *rwork;
int lwork = 2*n;
#else
PetscReal *alphai;
int lwork = 6*n;
#endif
 
PetscFunctionBegin;
ierr = PetscLogEventBegin(EPS_Dense,0,0,0,0);CHKERRQ(ierr);
if (V) jobvr = "V";
else jobvr = "N";
if (W) jobvl = "V";
else jobvl = "N";
ierr = PetscMalloc(n*sizeof(PetscScalar),&alpha);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscScalar),&beta);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscReal),&rscale);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscReal),&lscale);CHKERRQ(ierr);
ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
ierr = PetscMalloc(6*n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
LAPACKggevx_("B",jobvl,jobvr,"N",&n,A,&n,B,&n,alpha,beta,W,&n,V,&n,&ilo,&ihi,lscale,rscale,&abnrm,&bbnrm,&dummy,&dummy,work,&lwork,rwork,&idummy,&idummy,&info,1,1,1,1);
if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack ZGGEVX %d",info);
for (i=0;i<n;i++) {
w[i] = alpha[i]/beta[i];
}
ierr = PetscFree(rwork);CHKERRQ(ierr);
#else
ierr = PetscMalloc(n*sizeof(PetscReal),&alphai);CHKERRQ(ierr);
LAPACKggevx_("B",jobvl,jobvr,"N",&n,A,&n,B,&n,alpha,alphai,beta,W,&n,V,&n,&ilo,&ihi,lscale,rscale,&abnrm,&bbnrm,&dummy,&dummy,work,&lwork,&idummy,&idummy,&info,1,1,1,1);
if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack DGGEVX %d",info);
for (i=0;i<n;i++) {
w[i] = alpha[i]/beta[i];
wi[i] = alphai[i]/beta[i];
}
ierr = PetscFree(alphai);CHKERRQ(ierr);
#endif
ierr = PetscFree(alpha);CHKERRQ(ierr);
ierr = PetscFree(beta);CHKERRQ(ierr);
ierr = PetscFree(rscale);CHKERRQ(ierr);
ierr = PetscFree(lscale);CHKERRQ(ierr);
ierr = PetscFree(work);CHKERRQ(ierr);
ierr = PetscLogEventEnd(EPS_Dense,0,0,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
#endif
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDenseHEP"
/*@
EPSDenseHEP - Solves a dense standard Hermitian Eigenvalue Problem.
 
Not Collective
 
Input Parameters:
+ n - dimension of the eigenproblem
. A - pointer to the array containing the matrix values
- lda - leading dimension of A
 
Output Parameters:
+ w - pointer to the array to store the computed eigenvalues
- V - pointer to the array to store the eigenvectors
 
Notes:
If V is PETSC_NULL then the eigenvectors are not computed.
 
Matrix A is overwritten.
This routine uses LAPACK routines DSYEVR or ZHEEVR.
 
Level: developer
 
.seealso: EPSDenseNHEP(), EPSDenseGNHEP(), EPSDenseGHEP()
@*/
PetscErrorCode EPSDenseHEP(int n,PetscScalar *A,int lda,PetscReal *w,PetscScalar *V)
{
#if defined(SLEPC_MISSING_LAPACK_SYEVR) || defined(SLEPC_MISSING_LAPACK_HEEVR)
PetscFunctionBegin;
SETERRQ(PETSC_ERR_SUP,"DSYEVR/ZHEEVR - Lapack routine is unavailable.");
#else
PetscErrorCode ierr;
PetscReal abstol = 0.0,vl,vu;
PetscScalar *work;
int il,iu,m,*isuppz,*iwork,liwork = 10*n,info;
const char *jobz;
#if defined(PETSC_USE_COMPLEX)
PetscReal *rwork;
int lwork = 18*n,lrwork = 24*n;
#else
int lwork = 26*n;
#endif
 
PetscFunctionBegin;
ierr = PetscLogEventBegin(EPS_Dense,0,0,0,0);CHKERRQ(ierr);
if (V) jobz = "V";
else jobz = "N";
ierr = PetscMalloc(2*n*sizeof(int),&isuppz);CHKERRQ(ierr);
ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
ierr = PetscMalloc(liwork*sizeof(int),&iwork);CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
ierr = PetscMalloc(lrwork*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
LAPACKsyevr_(jobz,"A","L",&n,A,&lda,&vl,&vu,&il,&iu,&abstol,&m,w,V,&n,isuppz,work,&lwork,rwork,&lrwork,iwork,&liwork,&info,1,1,1);
if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack ZHEEVR %d",info);
ierr = PetscFree(rwork);CHKERRQ(ierr);
#else
LAPACKsyevr_(jobz,"A","L",&n,A,&lda,&vl,&vu,&il,&iu,&abstol,&m,w,V,&n,isuppz,work,&lwork,iwork,&liwork,&info,1,1,1);
if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack DSYEVR %d",info);
#endif
ierr = PetscFree(isuppz);CHKERRQ(ierr);
ierr = PetscFree(work);CHKERRQ(ierr);
ierr = PetscFree(iwork);CHKERRQ(ierr);
ierr = PetscLogEventEnd(EPS_Dense,0,0,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
#endif
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDenseGHEP"
/*@
EPSDenseGHEP - Solves a dense Generalized Hermitian Eigenvalue Problem.
 
Not Collective
 
Input Parameters:
+ n - dimension of the eigenproblem
. A - pointer to the array containing the matrix values for A
- B - pointer to the array containing the matrix values for B
 
Output Parameters:
+ w - pointer to the array to store the computed eigenvalues
- V - pointer to the array to store the eigenvectors
 
Notes:
If V is PETSC_NULL then the eigenvectors are not computed.
 
Matrices A and B are overwritten.
This routine uses LAPACK routines DSYGVD or ZHEGVD.
 
Level: developer
 
.seealso: EPSDenseNHEP(), EPSDenseGNHEP(), EPSDenseHEP()
@*/
PetscErrorCode EPSDenseGHEP(int n,PetscScalar *A,PetscScalar *B,PetscReal *w,PetscScalar *V)
{
#if defined(SLEPC_MISSING_LAPACK_SYGVD) || defined(SLEPC_MISSING_LAPACK_HEGVD)
PetscFunctionBegin;
SETERRQ(PETSC_ERR_SUP,"DSYGVD/ZHEGVD - Lapack routine is unavailable.");
#else
PetscErrorCode ierr;
PetscScalar *work;
int itype = 1,*iwork,info,
liwork = V ? 5*n+3 : 1;
const char *jobz;
#if defined(PETSC_USE_COMPLEX)
PetscReal *rwork;
int lwork = V ? n*n+2*n : n+1,
lrwork = V ? 2*n*n+5*n+1 : n;
#else
int lwork = V ? 2*n*n+6*n+1 : 2*n+1;
#endif
 
PetscFunctionBegin;
ierr = PetscLogEventBegin(EPS_Dense,0,0,0,0);CHKERRQ(ierr);
if (V) jobz = "V";
else jobz = "N";
ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
ierr = PetscMalloc(liwork*sizeof(int),&iwork);CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
ierr = PetscMalloc(lrwork*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
LAPACKsygvd_(&itype,jobz,"U",&n,A,&n,B,&n,w,work,&lwork,rwork,&lrwork,iwork,&liwork,&info,1,1);
if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack ZHEGVD %d",info);
ierr = PetscFree(rwork);CHKERRQ(ierr);
#else
LAPACKsygvd_(&itype,jobz,"U",&n,A,&n,B,&n,w,work,&lwork,iwork,&liwork,&info,1,1);
if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack DSYGVD %d",info);
#endif
if (V) {
ierr = PetscMemcpy(V,A,n*n*sizeof(PetscScalar));CHKERRQ(ierr);
}
ierr = PetscFree(work);CHKERRQ(ierr);
ierr = PetscFree(iwork);CHKERRQ(ierr);
ierr = PetscLogEventEnd(EPS_Dense,0,0,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
#endif
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDenseHessenberg"
/*@
EPSDenseHessenberg - Computes the Hessenberg form of a dense matrix.
 
Not Collective
 
Input Parameters:
+ n - dimension of the matrix
. k - first active column
- lda - leading dimension of A
 
Input/Output Parameters:
+ A - on entry, the full matrix; on exit, the upper Hessenberg matrix (H)
- Q - on exit, orthogonal matrix of vectors A = Q*H*Q'
 
Notes:
Only active columns (from k to n) are computed.
 
Both A and Q are overwritten.
This routine uses LAPACK routines xGEHRD and xORGHR/xUNGHR.
 
Level: developer
 
.seealso: EPSDenseSchur(), EPSSortDenseSchur(), EPSDenseTridiagonal()
@*/
PetscErrorCode EPSDenseHessenberg(int n,int k,PetscScalar *A,int lda,PetscScalar *Q)
{
#if defined(SLEPC_MISSING_LAPACK_GEHRD) || defined(SLEPC_MISSING_LAPACK_ORGHR) || defined(SLEPC_MISSING_LAPACK_UNGHR)
PetscFunctionBegin;
SETERRQ(PETSC_ERR_SUP,"GEHRD,ORGHR/UNGHR - Lapack routines are unavailable.");
#else
PetscScalar *tau,*work;
PetscErrorCode ierr;
int i,j,ilo,lwork,info;
 
PetscFunctionBegin;
ierr = PetscLogEventBegin(EPS_Dense,0,0,0,0);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscScalar),&tau);CHKERRQ(ierr);
lwork = n;
ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
ilo = k+1;
LAPACKgehrd_(&n,&ilo,&n,A,&lda,tau,work,&lwork,&info);
if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack xGEHRD %d",info);
for (j=0;j<n-1;j++) {
for (i=j+2;i<n;i++) {
Q[i+j*n] = A[i+j*lda];
A[i+j*lda] = 0.0;
}
}
LAPACKorghr_(&n,&ilo,&n,Q,&n,tau,work,&lwork,&info);
if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack xORGHR %d",info);
ierr = PetscFree(tau);CHKERRQ(ierr);
ierr = PetscFree(work);CHKERRQ(ierr);
ierr = PetscLogEventEnd(EPS_Dense,0,0,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
#endif
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDenseSchur"
/*@
EPSDenseSchur - Computes the upper (quasi-)triangular form of a dense
upper Hessenberg matrix.
 
Not Collective
 
Input Parameters:
+ n - dimension of the matrix
. k - first active column
- ldh - leading dimension of H
 
Input/Output Parameters:
+ H - on entry, the upper Hessenber matrix; on exit, the upper
(quasi-)triangular matrix (T)
- Z - on entry, initial transformation matrix; on exit, orthogonal
matrix of Schur vectors
 
Output Parameters:
+ wr - pointer to the array to store the computed eigenvalues
- wi - imaginary part of the eigenvalues (only when using real numbers)
 
Notes:
This function computes the (real) Schur decomposition of an upper
Hessenberg matrix H: H*Z = Z*T, where T is an upper (quasi-)triangular
matrix (returned in H), and Z is the orthogonal matrix of Schur vectors.
Eigenvalues are extracted from the diagonal blocks of T and returned in
wr,wi. Transformations are accumulated in Z so that on entry it can
contain the transformation matrix associated to the Hessenberg reduction.
 
Only active columns (from k to n) are computed.
 
Both H and Z are overwritten.
This routine uses LAPACK routines xHSEQR.
 
Level: developer
 
.seealso: EPSDenseHessenberg(), EPSSortDenseSchur(), EPSDenseTridiagonal()
@*/
PetscErrorCode EPSDenseSchur(int n,int k,PetscScalar *H,int ldh,PetscScalar *Z,PetscScalar *wr,PetscScalar *wi)
{
#if defined(SLEPC_MISSING_LAPACK_HSEQR)
PetscFunctionBegin;
SETERRQ(PETSC_ERR_SUP,"HSEQR - Lapack routine is unavailable.");
#else
PetscErrorCode ierr;
int ilo,lwork,info;
PetscScalar *work;
#if !defined(PETSC_USE_COMPLEX)
int j;
#endif
PetscFunctionBegin;
ierr = PetscLogEventBegin(EPS_Dense,0,0,0,0);CHKERRQ(ierr);
lwork = n;
ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
ilo = k+1;
#if !defined(PETSC_USE_COMPLEX)
LAPACKhseqr_("S","V",&n,&ilo,&n,H,&ldh,wr,wi,Z,&n,work,&lwork,&info,1,1);
for (j=0;j<k;j++) {
if (j==n-1 || H[j*ldh+j+1] == 0.0) {
/* real eigenvalue */
wr[j] = H[j*ldh+j];
wi[j] = 0.0;
} else {
/* complex eigenvalue */
wr[j] = H[j*ldh+j];
wr[j+1] = H[j*ldh+j];
wi[j] = sqrt(PetscAbsReal(H[j*ldh+j+1])) *
sqrt(PetscAbsReal(H[(j+1)*ldh+j]));
wi[j+1] = -wi[j];
j++;
}
}
#else
LAPACKhseqr_("S","V",&n,&ilo,&n,H,&ldh,wr,Z,&n,work,&lwork,&info,1,1);
#endif
if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack xHSEQR %d",info);
 
ierr = PetscFree(work);CHKERRQ(ierr);
ierr = PetscLogEventEnd(EPS_Dense,0,0,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
#endif
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSortDenseSchur"
/*@
EPSSortDenseSchur - Reorders the Schur decomposition computed by
EPSDenseSchur().
 
Not Collective
 
Input Parameters:
+ n - dimension of the matrix
. k - first active column
. ldt - leading dimension of T
- which - eigenvalue sort order
 
Input/Output Parameters:
+ T - the upper (quasi-)triangular matrix
- Z - the orthogonal matrix of Schur vectors
 
Output Parameters:
+ wr - pointer to the array to store the computed eigenvalues
- wi - imaginary part of the eigenvalues (only when using real numbers)
 
Notes:
This function reorders the eigenvalues in wr,wi located in positions k
to n according to the sort order specified in which. The Schur
decomposition Z*T*Z^T, is also reordered by means of rotations so that
eigenvalues in the diagonal blocks of T follow the same order.
 
Both T and Z are overwritten.
This routine uses LAPACK routines xTREXC.
 
Level: developer
 
.seealso: EPSDenseHessenberg(), EPSDenseSchur(), EPSDenseTridiagonal()
@*/
PetscErrorCode EPSSortDenseSchur(int n,int k,PetscScalar *T,int ldt,PetscScalar *Z,PetscScalar *wr,PetscScalar *wi,EPSWhich which)
{
#if defined(SLEPC_MISSING_LAPACK_TREXC)
PetscFunctionBegin;
SETERRQ(PETSC_ERR_SUP,"TREXC - Lapack routine is unavailable.");
#else
int i,j,ifst,ilst,info,pos;
#if !defined(PETSC_USE_COMPLEX)
PetscScalar *work;
#endif
PetscReal value,v;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscLogEventBegin(EPS_Dense,0,0,0,0);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
ierr = PetscMalloc(n*sizeof(PetscScalar),&work);CHKERRQ(ierr);
#endif
for (i=k;i<n-1;i++) {
switch(which) {
case EPS_LARGEST_MAGNITUDE:
case EPS_SMALLEST_MAGNITUDE:
value = SlepcAbsEigenvalue(wr[i],wi[i]);
break;
case EPS_LARGEST_REAL:
case EPS_SMALLEST_REAL:
value = PetscRealPart(wr[i]);
break;
case EPS_LARGEST_IMAGINARY:
case EPS_SMALLEST_IMAGINARY:
#if !defined(PETSC_USE_COMPLEX)
value = PetscAbsReal(wi[i]);
#else
value = PetscImaginaryPart(wr[i]);
#endif
break;
default: SETERRQ(1,"Wrong value of which");
}
pos = 0;
for (j=i+1;j<n;j++) {
switch(which) {
case EPS_LARGEST_MAGNITUDE:
case EPS_SMALLEST_MAGNITUDE:
v = SlepcAbsEigenvalue(wr[j],wi[j]);
break;
case EPS_LARGEST_REAL:
case EPS_SMALLEST_REAL:
v = PetscRealPart(wr[j]);
break;
case EPS_LARGEST_IMAGINARY:
case EPS_SMALLEST_IMAGINARY:
#if !defined(PETSC_USE_COMPLEX)
v = PetscAbsReal(wi[j]);
#else
v = PetscImaginaryPart(wr[j]);
#endif
break;
default: SETERRQ(1,"Wrong value of which");
}
switch(which) {
case EPS_LARGEST_MAGNITUDE:
case EPS_LARGEST_REAL:
case EPS_LARGEST_IMAGINARY:
if (v > value) {
value = v;
pos = j;
}
break;
case EPS_SMALLEST_MAGNITUDE:
case EPS_SMALLEST_REAL:
case EPS_SMALLEST_IMAGINARY:
if (v < value) {
value = v;
pos = j;
}
break;
default: SETERRQ(1,"Wrong value of which");
}
#if !defined(PETSC_USE_COMPLEX)
if (wi[j] != 0) j++;
#endif
}
if (pos) {
ifst = pos + 1;
ilst = i + 1;
#if !defined(PETSC_USE_COMPLEX)
LAPACKtrexc_("V",&n,T,&ldt,Z,&n,&ifst,&ilst,work,&info,1);
#else
LAPACKtrexc_("V",&n,T,&ldt,Z,&n,&ifst,&ilst,&info,1);
#endif
if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack xTREXC %d",info);
for (j=k;j<n;j++) {
#if !defined(PETSC_USE_COMPLEX)
if (j==n-1 || T[j*ldt+j+1] == 0.0) {
/* real eigenvalue */
wr[j] = T[j*ldt+j];
wi[j] = 0.0;
} else {
/* complex eigenvalue */
wr[j] = T[j*ldt+j];
wr[j+1] = T[j*ldt+j];
wi[j] = sqrt(PetscAbsReal(T[j*ldt+j+1])) *
sqrt(PetscAbsReal(T[(j+1)*ldt+j]));
wi[j+1] = -wi[j];
j++;
}
#else
wr[j] = T[j*(ldt+1)];
#endif
}
}
#if !defined(PETSC_USE_COMPLEX)
if (wi[i] != 0) i++;
#endif
}
#if !defined(PETSC_USE_COMPLEX)
ierr = PetscFree(work);CHKERRQ(ierr);
#endif
ierr = PetscLogEventEnd(EPS_Dense,0,0,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
 
#endif
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDenseTridiagonal"
/*@
EPSDenseTridiagonal - Solves a real tridiagonal Hermitian Eigenvalue Problem.
 
Not Collective
 
Input Parameters:
+ n - dimension of the eigenproblem
. A - pointer to the array containing the matrix values
- lda - leading dimension of A
 
Output Parameters:
+ w - pointer to the array to store the computed eigenvalues
- V - pointer to the array to store the eigenvectors
 
Notes:
If V is PETSC_NULL then the eigenvectors are not computed.
 
This routine use LAPACK routines DSTEVR.
 
Level: developer
 
.seealso: EPSDenseNHEP(), EPSDenseHEP(), EPSDenseGNHEP(), EPSDenseGHEP()
@*/
PetscErrorCode EPSDenseTridiagonal(int n,PetscScalar *A,int lda,PetscReal *w,PetscScalar *V)
{
#if defined(SLEPC_MISSING_LAPACK_DSTEVR)
PetscFunctionBegin;
SETERRQ(PETSC_ERR_SUP,"DSTEVR - Lapack routine is unavailable.");
#else
PetscErrorCode ierr;
PetscReal abstol = 0.0,vl,vu,*D,*E,*work;
int i,il,iu,m,*isuppz,lwork = 20*n,*iwork,liwork = 10*n,info;
const char *jobz;
#if defined(PETSC_USE_COMPLEX)
int j;
PetscReal *VV;
#endif
PetscFunctionBegin;
ierr = PetscLogEventBegin(EPS_Dense,0,0,0,0);CHKERRQ(ierr);
if (V) {
jobz = "V";
#if defined(PETSC_USE_COMPLEX)
ierr = PetscMalloc(n*n*sizeof(PetscReal),&VV);CHKERRQ(ierr);
#endif
} else jobz = "N";
ierr = PetscMalloc(n*sizeof(PetscReal),&D);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscReal),&E);CHKERRQ(ierr);
ierr = PetscMalloc(2*n*sizeof(int),&isuppz);CHKERRQ(ierr);
ierr = PetscMalloc(lwork*sizeof(PetscReal),&work);CHKERRQ(ierr);
ierr = PetscMalloc(liwork*sizeof(int),&iwork);CHKERRQ(ierr);
for (i=0;i<n-1;i++) {
D[i] = PetscRealPart(A[i*(lda+1)]);
E[i] = PetscRealPart(A[i*(lda+1)+1]);
}
D[n-1] = PetscRealPart(A[(n-1)*(lda+1)]);
#if defined(PETSC_USE_COMPLEX)
LAPACKstevr_(jobz,"A",&n,D,E,&vl,&vu,&il,&iu,&abstol,&m,w,VV,&n,isuppz,work,&lwork,iwork,&liwork,&info,1,1);
#else
LAPACKstevr_(jobz,"A",&n,D,E,&vl,&vu,&il,&iu,&abstol,&m,w,V,&n,isuppz,work,&lwork,iwork,&liwork,&info,1,1);
#endif
if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack DSTEVR %d",info);
#if defined(PETSC_USE_COMPLEX)
if (V) {
for (i=0;i<n;i++)
for (j=0;j<n;j++)
V[i*n+j] = VV[i*n+j];
ierr = PetscFree(VV);CHKERRQ(ierr);
}
#endif
ierr = PetscFree(D);CHKERRQ(ierr);
ierr = PetscFree(E);CHKERRQ(ierr);
ierr = PetscFree(isuppz);CHKERRQ(ierr);
ierr = PetscFree(work);CHKERRQ(ierr);
ierr = PetscFree(iwork);CHKERRQ(ierr);
ierr = PetscLogEventEnd(EPS_Dense,0,0,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
#endif
}
tags/slepc-2_3_3-1/src/eps/interface/dense.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/interface/ftn-custom/zepsf.c New file
0,0 → 1,220
/*
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "slepceps.h"
#include "src/eps/epsimpl.h"
 
#ifdef PETSC_HAVE_FORTRAN_CAPS
#define epsview_ EPSVIEW
#define epssetoptionsprefix_ EPSSETOPTIONSPREFIX
#define epsappendoptionsprefix_ EPSAPPENDOPTIONSPREFIX
#define epsgetoptionsprefix_ EPSGETOPTIONSPREFIX
#define epscreate_ EPSCREATE
#define epssettype_ EPSSETTYPE
#define epsgettype_ EPSGETTYPE
#define epsmonitordefault_ EPSMONITORDEFAULT
#define epsmonitorlg_ EPSMONITORLG
#define epsmonitorset_ EPSMONITORSET
#define epsgetst_ EPSGETST
#define epsgetip_ EPSGETIP
#define epsgetwhicheigenpairs_ EPSGETWHICHEIGENPAIRS
#define epsgetproblemtype_ EPSGETPROBLEMTYPE
#define epsgetclass_ EPSGETCLASS
#define epsgetconvergedreason_ EPSGETCONVERGEDREASON
#define epspowergetshifttype_ EPSPOWERGETSHIFTTYPE
#define epslanczosgetreorthog_ EPSLANCZOSGETREORTHOG
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
#define epsview_ epsview
#define epssetoptionsprefix_ epssetoptionsprefix
#define epsappendoptionsprefix_ epsappendoptionsprefix
#define epsgetoptionsprefix_ epsgetoptionsprefix
#define epscreate_ epscreate
#define epssettype_ epssettype
#define epsgettype_ epsgettype
#define epsmonitordefault_ epsmonitordefault
#define epsmonitorlg_ epsmonitorlg
#define epsmonitorset_ epsmonitorset
#define epsgetst_ epsgetst
#define epsgetip_ epsgetip
#define epsgetwhicheigenpairs_ epsgetwhicheigenpairs
#define epsgetproblemtype_ epsgetproblemtype
#define epsgetclass_ epsgetclass
#define epsgetconvergedreason_ epsgetconvergedreason
#define epspowergetshifttype_ epspowergetshifttype
#define epslanczosgetreorthog_ epslanczosgetreorthog
#endif
 
EXTERN_C_BEGIN
static void (PETSC_STDCALL *f1)(EPS*,int*,int*,PetscScalar*,PetscScalar*,PetscReal*,int*,void*,PetscErrorCode*);
static void (PETSC_STDCALL *f2)(void*,PetscErrorCode*);
 
/*
These are not usually called from Fortran but allow Fortran users
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)
{
*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)
{
*ierr = EPSMonitorLG(*eps,*it,*nconv,eigr,eigi,errest,*nest,ctx);
}
EXTERN_C_END
/* 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)
{
PetscErrorCode ierr = 0;
(*f1)(&eps,&i,&nc,er,ei,d,&l,ctx,&ierr);CHKERRQ(ierr);
return 0;
}
 
static PetscErrorCode ourdestroy(void* ctx)
{
PetscErrorCode ierr = 0;
(*f2)(ctx,&ierr);CHKERRQ(ierr);
return 0;
}
 
EXTERN_C_BEGIN
 
void PETSC_STDCALL epsview_(EPS *eps,PetscViewer *viewer, PetscErrorCode *ierr)
{
PetscViewer v;
PetscPatchDefaultViewers_Fortran(viewer,v);
*ierr = EPSView(*eps,v);
}
 
void PETSC_STDCALL epssettype_(EPS *eps,CHAR type PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
{
char *t;
 
FIXCHAR(type,len,t);
*ierr = EPSSetType(*eps,t);
FREECHAR(type,t);
}
 
void PETSC_STDCALL epsgettype_(EPS *eps,CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
{
const char *tname;
 
*ierr = EPSGetType(*eps,&tname);if (*ierr) return;
#if defined(PETSC_USES_CPTOFCD)
{
char *t = _fcdtocp(name); int len1 = _fcdlen(name);
*ierr = PetscStrncpy(t,tname,len1);
}
#else
*ierr = PetscStrncpy(name,tname,len);
#endif
FIXRETURNCHAR(name,len);
}
 
void PETSC_STDCALL epssetoptionsprefix_(EPS *eps,CHAR prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
{
char *t;
 
FIXCHAR(prefix,len,t);
*ierr = EPSSetOptionsPrefix(*eps,t);
FREECHAR(prefix,t);
}
 
void PETSC_STDCALL epsappendoptionsprefix_(EPS *eps,CHAR prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
{
char *t;
 
FIXCHAR(prefix,len,t);
*ierr = EPSAppendOptionsPrefix(*eps,t);
FREECHAR(prefix,t);
}
 
void PETSC_STDCALL epscreate_(MPI_Fint *comm,EPS *eps,PetscErrorCode *ierr)
{
*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 *mctx,void (PETSC_STDCALL *monitordestroy)(void *,PetscErrorCode *),PetscErrorCode *ierr)
{
if ((void(*)())monitor == (void(*)())epsmonitordefault_) {
*ierr = EPSMonitorSet(*eps,EPSMonitorDefault,0,0);
} else if ((void(*)())monitor == (void(*)())epsmonitorlg_) {
*ierr = EPSMonitorSet(*eps,EPSMonitorLG,0,0);
} else {
f1 = monitor;
if (FORTRANNULLFUNCTION(monitordestroy)) {
*ierr = EPSMonitorSet(*eps,ourmonitor,mctx,0);
} else {
f2 = monitordestroy;
*ierr = EPSMonitorSet(*eps,ourmonitor,mctx,ourdestroy);
}
}
}
 
void PETSC_STDCALL epsgetoptionsprefix_(EPS *eps,CHAR prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
{
const char *tname;
 
*ierr = EPSGetOptionsPrefix(*eps,&tname);
#if defined(PETSC_USES_CPTOFCD)
{
char *t = _fcdtocp(prefix); int len1 = _fcdlen(prefix);
*ierr = PetscStrncpy(t,tname,len1); if (*ierr) return;
}
#else
*ierr = PetscStrncpy(prefix,tname,len); if (*ierr) return;
#endif
FIXRETURNCHAR(prefix,len);
}
 
void PETSC_STDCALL epsgetst_(EPS *eps,ST *st,int *ierr)
{
*ierr = EPSGetST(*eps,st);
}
 
void PETSC_STDCALL epsgetip_(EPS *eps,IP *ip,int *ierr)
{
*ierr = EPSGetIP(*eps,ip);
}
 
void PETSC_STDCALL epsgetwhicheigenpairs_(EPS *eps,EPSWhich *which,int *ierr)
{
*ierr = EPSGetWhichEigenpairs(*eps,which);
}
 
void PETSC_STDCALL epsgetproblemtype_(EPS *eps,EPSProblemType *type,int *ierr)
{
*ierr = EPSGetProblemType(*eps,type);
}
 
void PETSC_STDCALL epsgetclass_(EPS *eps,EPSClass *cl,int *ierr)
{
*ierr = EPSGetClass(*eps,cl);
}
 
void PETSC_STDCALL epsgetconvergedreason_(EPS *eps,EPSConvergedReason *reason,int *ierr)
{
*ierr = EPSGetConvergedReason(*eps,reason);
}
 
void PETSC_STDCALL epspowergetshifttype_(EPS *eps,EPSPowerShiftType *shift,int *ierr)
{
*ierr = EPSPowerGetShiftType(*eps,shift);
}
 
void PETSC_STDCALL epslanczosgetreorthog_(EPS *eps,EPSLanczosReorthogType *reorthog,int *ierr)
{
*ierr = EPSLanczosGetReorthog(*eps,reorthog);
}
EXTERN_C_END
 
tags/slepc-2_3_3-1/src/eps/interface/ftn-custom/zepsf.c Property changes : Added: svn:keywords
+ Author Date Id Revision
Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/interface/ftn-custom/makefile New file
0,0 → 1,22
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
#requirespackage 'PETSC_HAVE_FORTRAN'
ALL: lib
CFLAGS =
FFLAGS =
SOURCEC = zepsf.c
OBJSC = zepsf.o
SOURCEF =
SOURCEH =
DIRS =
LIBBASE = libslepc
LOCDIR = src/eps/interface/ftn-custom/
include ${SLEPC_DIR}/bmake/slepc_common
tags/slepc-2_3_3-1/src/eps/interface/ftn-custom/makefile Property changes : Added: svn:keywords
+ Author Date Id Revision
Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/interface/mem.c New file
0,0 → 1,212
/*
EPS routines related to memory management.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/eps/epsimpl.h" /*I "slepceps.h" I*/
 
#undef __FUNCT__
#define __FUNCT__ "EPSAllocateSolution"
/*
EPSAllocateSolution - Allocate memory storage for common variables such
as eigenvalues and eigenvectors.
*/
PetscErrorCode EPSAllocateSolution(EPS eps)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
if (eps->allocated_ncv != eps->ncv) {
if (eps->allocated_ncv > 0) {
ierr = PetscFree(eps->eigr);CHKERRQ(ierr);
ierr = PetscFree(eps->eigi);CHKERRQ(ierr);
ierr = PetscFree(eps->errest);CHKERRQ(ierr);
ierr = PetscFree(eps->errest_left);CHKERRQ(ierr);
ierr = VecDestroyVecs(eps->V,eps->allocated_ncv);CHKERRQ(ierr);
ierr = VecDestroyVecs(eps->AV,eps->allocated_ncv);CHKERRQ(ierr);
if (eps->solverclass == EPS_TWO_SIDE) {
ierr = VecDestroyVecs(eps->W,eps->allocated_ncv);CHKERRQ(ierr);
ierr = VecDestroyVecs(eps->AW,eps->allocated_ncv);CHKERRQ(ierr);
}
}
ierr = PetscMalloc(eps->ncv*sizeof(PetscScalar),&eps->eigr);CHKERRQ(ierr);
ierr = PetscMalloc(eps->ncv*sizeof(PetscScalar),&eps->eigi);CHKERRQ(ierr);
ierr = PetscMalloc(eps->ncv*sizeof(PetscReal),&eps->errest);CHKERRQ(ierr);
ierr = PetscMalloc(eps->ncv*sizeof(PetscReal),&eps->errest_left);CHKERRQ(ierr);
ierr = VecDuplicateVecs(eps->vec_initial,eps->ncv,&eps->V);CHKERRQ(ierr);
ierr = VecDuplicateVecs(eps->vec_initial,eps->ncv,&eps->AV);CHKERRQ(ierr);
if (eps->solverclass == EPS_TWO_SIDE) {
ierr = VecDuplicateVecs(eps->vec_initial,eps->ncv,&eps->W);CHKERRQ(ierr);
ierr = VecDuplicateVecs(eps->vec_initial,eps->ncv,&eps->AW);CHKERRQ(ierr);
}
eps->allocated_ncv = eps->ncv;
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSFreeSolution"
/*
EPSFreeSolution - Free memory storage. This routine is related to
EPSAllocateSolution().
*/
PetscErrorCode EPSFreeSolution(EPS eps)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
if (eps->allocated_ncv > 0) {
ierr = PetscFree(eps->eigr);CHKERRQ(ierr);
ierr = PetscFree(eps->eigi);CHKERRQ(ierr);
ierr = PetscFree(eps->errest);CHKERRQ(ierr);
ierr = PetscFree(eps->errest_left);CHKERRQ(ierr);
ierr = VecDestroyVecs(eps->V,eps->allocated_ncv);CHKERRQ(ierr);
ierr = VecDestroyVecs(eps->AV,eps->allocated_ncv);CHKERRQ(ierr);
if (eps->solverclass == EPS_TWO_SIDE) {
ierr = VecDestroyVecs(eps->W,eps->allocated_ncv);CHKERRQ(ierr);
ierr = VecDestroyVecs(eps->AW,eps->allocated_ncv);CHKERRQ(ierr);
}
eps->allocated_ncv = 0;
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSAllocateSolutionContiguous"
/*
EPSAllocateSolutionContiguous - Allocate memory storage for common
variables such as eigenvalues and eigenvectors. In this version, all
vectors in V (and AV) share a contiguous chunk of memory. This is
necessary for external packages such as Arpack.
*/
PetscErrorCode EPSAllocateSolutionContiguous(EPS eps)
{
PetscErrorCode ierr;
int i;
PetscInt nloc;
PetscScalar *pV,*pW;
 
PetscFunctionBegin;
if (eps->allocated_ncv != eps->ncv) {
if (eps->allocated_ncv > 0) {
ierr = PetscFree(eps->eigr);CHKERRQ(ierr);
ierr = PetscFree(eps->eigi);CHKERRQ(ierr);
ierr = PetscFree(eps->errest);CHKERRQ(ierr);
ierr = PetscFree(eps->errest_left);CHKERRQ(ierr);
ierr = VecGetArray(eps->V[0],&pV);CHKERRQ(ierr);
for (i=0;i<eps->allocated_ncv;i++) {
ierr = VecDestroy(eps->V[i]);CHKERRQ(ierr);
}
ierr = PetscFree(pV);CHKERRQ(ierr);
ierr = PetscFree(eps->V);CHKERRQ(ierr);
ierr = VecGetArray(eps->AV[0],&pV);CHKERRQ(ierr);
for (i=0;i<eps->allocated_ncv;i++) {
ierr = VecDestroy(eps->AV[i]);CHKERRQ(ierr);
}
ierr = PetscFree(pV);CHKERRQ(ierr);
ierr = PetscFree(eps->AV);CHKERRQ(ierr);
if (eps->solverclass == EPS_TWO_SIDE) {
ierr = VecGetArray(eps->W[0],&pW);CHKERRQ(ierr);
for (i=0;i<eps->allocated_ncv;i++) {
ierr = VecDestroy(eps->W[i]);CHKERRQ(ierr);
}
ierr = PetscFree(pW);CHKERRQ(ierr);
ierr = PetscFree(eps->W);CHKERRQ(ierr);
ierr = VecGetArray(eps->AW[0],&pW);CHKERRQ(ierr);
for (i=0;i<eps->allocated_ncv;i++) {
ierr = VecDestroy(eps->AW[i]);CHKERRQ(ierr);
}
ierr = PetscFree(pW);CHKERRQ(ierr);
ierr = PetscFree(eps->AW);CHKERRQ(ierr);
}
}
ierr = PetscMalloc(eps->ncv*sizeof(PetscScalar),&eps->eigr);CHKERRQ(ierr);
ierr = PetscMalloc(eps->ncv*sizeof(PetscScalar),&eps->eigi);CHKERRQ(ierr);
ierr = PetscMalloc(eps->ncv*sizeof(PetscReal),&eps->errest);CHKERRQ(ierr);
ierr = PetscMalloc(eps->ncv*sizeof(PetscReal),&eps->errest_left);CHKERRQ(ierr);
ierr = VecGetLocalSize(eps->vec_initial,&nloc);CHKERRQ(ierr);
ierr = PetscMalloc(eps->ncv*sizeof(Vec),&eps->V);CHKERRQ(ierr);
ierr = PetscMalloc(eps->ncv*nloc*sizeof(PetscScalar),&pV);CHKERRQ(ierr);
for (i=0;i<eps->ncv;i++) {
ierr = VecCreateMPIWithArray(eps->comm,nloc,PETSC_DECIDE,pV+i*nloc,&eps->V[i]);CHKERRQ(ierr);
}
ierr = PetscMalloc(eps->ncv*sizeof(Vec),&eps->AV);CHKERRQ(ierr);
ierr = PetscMalloc(eps->ncv*nloc*sizeof(PetscScalar),&pV);CHKERRQ(ierr);
for (i=0;i<eps->ncv;i++) {
ierr = VecCreateMPIWithArray(eps->comm,nloc,PETSC_DECIDE,pV+i*nloc,&eps->AV[i]);CHKERRQ(ierr);
}
if (eps->solverclass == EPS_TWO_SIDE) {
ierr = PetscMalloc(eps->ncv*sizeof(Vec),&eps->W);CHKERRQ(ierr);
ierr = PetscMalloc(eps->ncv*nloc*sizeof(PetscScalar),&pW);CHKERRQ(ierr);
for (i=0;i<eps->ncv;i++) {
ierr = VecCreateMPIWithArray(eps->comm,nloc,PETSC_DECIDE,pW+i*nloc,&eps->W[i]);CHKERRQ(ierr);
}
ierr = PetscMalloc(eps->ncv*sizeof(Vec),&eps->AW);CHKERRQ(ierr);
ierr = PetscMalloc(eps->ncv*nloc*sizeof(PetscScalar),&pW);CHKERRQ(ierr);
for (i=0;i<eps->ncv;i++) {
ierr = VecCreateMPIWithArray(eps->comm,nloc,PETSC_DECIDE,pW+i*nloc,&eps->AW[i]);CHKERRQ(ierr);
}
}
eps->allocated_ncv = eps->ncv;
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSFreeSolutionContiguous"
/*
EPSFreeSolution - Free memory storage. This routine is related to
EPSAllocateSolutionContiguous().
*/
PetscErrorCode EPSFreeSolutionContiguous(EPS eps)
{
PetscErrorCode ierr;
int i;
PetscScalar *pV,*pW;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
if (eps->allocated_ncv > 0) {
ierr = PetscFree(eps->eigr);CHKERRQ(ierr);
ierr = PetscFree(eps->eigi);CHKERRQ(ierr);
ierr = PetscFree(eps->errest);CHKERRQ(ierr);
ierr = PetscFree(eps->errest_left);CHKERRQ(ierr);
ierr = VecGetArray(eps->V[0],&pV);CHKERRQ(ierr);
for (i=0;i<eps->allocated_ncv;i++) {
ierr = VecDestroy(eps->V[i]);CHKERRQ(ierr);
}
ierr = PetscFree(pV);CHKERRQ(ierr);
ierr = PetscFree(eps->V);CHKERRQ(ierr);
ierr = VecGetArray(eps->AV[0],&pV);CHKERRQ(ierr);
for (i=0;i<eps->allocated_ncv;i++) {
ierr = VecDestroy(eps->AV[i]);CHKERRQ(ierr);
}
ierr = PetscFree(pV);CHKERRQ(ierr);
ierr = PetscFree(eps->AV);CHKERRQ(ierr);
if (eps->solverclass == EPS_TWO_SIDE) {
ierr = VecGetArray(eps->W[0],&pW);CHKERRQ(ierr);
for (i=0;i<eps->allocated_ncv;i++) {
ierr = VecDestroy(eps->W[i]);CHKERRQ(ierr);
}
ierr = PetscFree(pW);CHKERRQ(ierr);
ierr = PetscFree(eps->W);CHKERRQ(ierr);
ierr = VecGetArray(eps->AW[0],&pW);CHKERRQ(ierr);
for (i=0;i<eps->allocated_ncv;i++) {
ierr = VecDestroy(eps->AW[i]);CHKERRQ(ierr);
}
ierr = PetscFree(pW);CHKERRQ(ierr);
ierr = PetscFree(eps->AW);CHKERRQ(ierr);
}
eps->allocated_ncv = 0;
}
PetscFunctionReturn(0);
}
tags/slepc-2_3_3-1/src/eps/interface/mem.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/interface/setup.c New file
0,0 → 1,383
/*
EPS routines related to problem setup.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/eps/epsimpl.h" /*I "slepceps.h" I*/
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetUp"
/*@
EPSSetUp - Sets up all the internal data structures necessary for the
execution of the eigensolver. Then calls STSetUp() for any set-up
operations associated to the ST object.
 
Collective on EPS
 
Input Parameter:
. eps - eigenproblem solver context
 
Level: advanced
 
Notes:
This function need not be called explicitly in most cases, since EPSSolve()
calls it. It can be useful when one wants to measure the set-up time
separately from the solve time.
 
This function sets a random initial vector if none has been provided.
 
.seealso: EPSCreate(), EPSSolve(), EPSDestroy(), STSetUp()
@*/
PetscErrorCode EPSSetUp(EPS eps)
{
PetscErrorCode ierr;
int i;
Vec v0,w0;
Mat A,B;
PetscInt N;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
 
if (eps->setupcalled) PetscFunctionReturn(0);
 
ierr = PetscLogEventBegin(EPS_SetUp,eps,0,0,0);CHKERRQ(ierr);
 
/* Set default solver type */
if (!eps->type_name) {
ierr = EPSSetType(eps,EPSKRYLOVSCHUR);CHKERRQ(ierr);
}
ierr = STGetOperators(eps->OP,&A,&B);CHKERRQ(ierr);
/* Set default problem type */
if (!eps->problem_type) {
if (B==PETSC_NULL) {
ierr = EPSSetProblemType(eps,EPS_NHEP);CHKERRQ(ierr);
}
else {
ierr = EPSSetProblemType(eps,EPS_GNHEP);CHKERRQ(ierr);
}
} else if ((B && !eps->isgeneralized) || (!B && eps->isgeneralized)) {
SETERRQ(0,"Warning: Inconsistent EPS state");
}
if (eps->ispositive) {
ierr = STGetBilinearForm(eps->OP,&B);CHKERRQ(ierr);
ierr = IPSetBilinearForm(eps->ip,B,IPINNER_HERMITIAN);CHKERRQ(ierr);
ierr = MatDestroy(B);CHKERRQ(ierr);
} else {
ierr = IPSetBilinearForm(eps->ip,PETSC_NULL,IPINNER_HERMITIAN);CHKERRQ(ierr);
}
/* Create random initial vectors if not set */
/* right */
ierr = EPSGetInitialVector(eps,&v0);CHKERRQ(ierr);
if (!v0) {
ierr = MatGetVecs(A,&v0,PETSC_NULL);CHKERRQ(ierr);
ierr = SlepcVecSetRandom(v0);CHKERRQ(ierr);
eps->vec_initial = v0;
}
/* left */
ierr = EPSGetLeftInitialVector(eps,&w0);CHKERRQ(ierr);
if (!w0) {
ierr = MatGetVecs(A,PETSC_NULL,&w0);CHKERRQ(ierr);
ierr = SlepcVecSetRandom(w0);CHKERRQ(ierr);
eps->vec_initial_left = w0;
}
 
ierr = VecGetSize(eps->vec_initial,&N);CHKERRQ(ierr);
if (eps->nev > N) eps->nev = N;
if (eps->ncv > N) eps->ncv = N;
 
ierr = (*eps->ops->setup)(eps);CHKERRQ(ierr);
ierr = STSetUp(eps->OP); CHKERRQ(ierr);
 
/* DSV is equal to the columns of DS followed by the ones in V */
ierr = PetscFree(eps->DSV);CHKERRQ(ierr);
ierr = PetscMalloc((eps->ncv+eps->nds)*sizeof(Vec),&eps->DSV);CHKERRQ(ierr);
for (i = 0; i < eps->nds; i++) eps->DSV[i] = eps->DS[i];
for (i = 0; i < eps->ncv; i++) eps->DSV[i+eps->nds] = eps->V[i];
if (eps->nds>0) {
if (!eps->ds_ortho) {
/* orthonormalize vectors in DS if necessary */
ierr = IPQRDecomposition(eps->ip,eps->DS,0,eps->nds,PETSC_NULL,0,PETSC_NULL);CHKERRQ(ierr);
}
ierr = IPOrthogonalize(eps->ip,eps->nds,PETSC_NULL,eps->DS,eps->vec_initial,PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
}
 
ierr = STCheckNullSpace(eps->OP,eps->nds,eps->DS);CHKERRQ(ierr);
ierr = PetscLogEventEnd(EPS_SetUp,eps,0,0,0);CHKERRQ(ierr);
eps->setupcalled = 1;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetInitialVector"
/*@
EPSSetInitialVector - Sets the initial vector from which the
eigensolver starts to iterate.
 
Collective on EPS and Vec
 
Input Parameters:
+ eps - the eigensolver context
- vec - the vector
 
Level: intermediate
 
.seealso: EPSGetInitialVector(), EPSSetLeftInitialVector()
 
@*/
PetscErrorCode EPSSetInitialVector(EPS eps,Vec vec)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidHeaderSpecific(vec,VEC_COOKIE,2);
PetscCheckSameComm(eps,1,vec,2);
ierr = PetscObjectReference((PetscObject)vec);CHKERRQ(ierr);
if (eps->vec_initial) {
ierr = VecDestroy(eps->vec_initial); CHKERRQ(ierr);
}
eps->vec_initial = vec;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetInitialVector"
/*@
EPSGetInitialVector - Gets the initial vector associated with the
eigensolver; if the vector was not set it will return a 0 pointer or
a vector randomly generated by EPSSetUp().
 
Not collective, but vector is shared by all processors that share the EPS
 
Input Parameter:
. eps - the eigensolver context
 
Output Parameter:
. vec - the vector
 
Level: intermediate
 
.seealso: EPSSetInitialVector(), EPSGetLeftInitialVector()
 
@*/
PetscErrorCode EPSGetInitialVector(EPS eps,Vec *vec)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidPointer(vec,2);
*vec = eps->vec_initial;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetLeftInitialVector"
/*@
EPSSetLeftInitialVector - Sets the initial vector from which the eigensolver
starts to iterate, corresponding to the left recurrence (two-sided solvers).
 
Collective on EPS and Vec
 
Input Parameters:
+ eps - the eigensolver context
- vec - the vector
 
Level: intermediate
 
.seealso: EPSGetLeftInitialVector(), EPSSetInitialVector()
 
@*/
PetscErrorCode EPSSetLeftInitialVector(EPS eps,Vec vec)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidHeaderSpecific(vec,VEC_COOKIE,2);
PetscCheckSameComm(eps,1,vec,2);
ierr = PetscObjectReference((PetscObject)vec);CHKERRQ(ierr);
if (eps->vec_initial_left) {
ierr = VecDestroy(eps->vec_initial_left); CHKERRQ(ierr);
}
eps->vec_initial_left = vec;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetLeftInitialVector"
/*@
EPSGetLeftInitialVector - Gets the left initial vector associated with the
eigensolver; if the vector was not set it will return a 0 pointer or
a vector randomly generated by EPSSetUp().
 
Not collective, but vector is shared by all processors that share the EPS
 
Input Parameter:
. eps - the eigensolver context
 
Output Parameter:
. vec - the vector
 
Level: intermediate
 
.seealso: EPSSetLeftInitialVector(), EPSGetLeftInitialVector()
 
@*/
PetscErrorCode EPSGetLeftInitialVector(EPS eps,Vec *vec)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidPointer(vec,2);
*vec = eps->vec_initial_left;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetOperators"
/*@
EPSSetOperators - Sets the matrices associated with the eigenvalue problem.
 
Collective on EPS and Mat
 
Input Parameters:
+ eps - the eigenproblem solver context
. A - the matrix associated with the eigensystem
- B - the second matrix in the case of generalized eigenproblems
 
Notes:
To specify a standard eigenproblem, use PETSC_NULL for parameter B.
 
Level: beginner
 
.seealso: EPSSolve(), EPSGetST(), STGetOperators()
@*/
PetscErrorCode EPSSetOperators(EPS eps,Mat A,Mat B)
{
PetscErrorCode ierr;
PetscInt m,n;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidHeaderSpecific(A,MAT_COOKIE,2);
if (B) PetscValidHeaderSpecific(B,MAT_COOKIE,3);
PetscCheckSameComm(eps,1,A,2);
if (B) PetscCheckSameComm(eps,1,B,3);
 
/* Check for square matrices */
ierr = MatGetSize(A,&m,&n);CHKERRQ(ierr);
if (m!=n) { SETERRQ(1,"A is a non-square matrix"); }
if (B) {
ierr = MatGetSize(B,&m,&n);CHKERRQ(ierr);
if (m!=n) { SETERRQ(1,"B is a non-square matrix"); }
}
 
ierr = STSetOperators(eps->OP,A,B);CHKERRQ(ierr);
eps->setupcalled = 0; /* so that next solve call will call setup */
 
/* Destroy randomly generated initial vectors */
if (eps->vec_initial) {
ierr = VecDestroy(eps->vec_initial);CHKERRQ(ierr);
eps->vec_initial = PETSC_NULL;
}
if (eps->vec_initial_left) {
ierr = VecDestroy(eps->vec_initial_left);CHKERRQ(ierr);
eps->vec_initial_left = PETSC_NULL;
}
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSAttachDeflationSpace"
/*@
EPSAttachDeflationSpace - Add vectors to the basis of the deflation space.
 
Not Collective
 
Input Parameter:
+ eps - the eigenproblem solver context
. n - number of vectors to add
. ds - set of basis vectors of the deflation space
- ortho - PETSC_TRUE if basis vectors of deflation space are orthonormal
 
Notes:
When a deflation space is given, the eigensolver seeks the eigensolution
in the restriction of the problem to the orthogonal complement of this
space. This can be used for instance in the case that an invariant
subspace is known beforehand (such as the nullspace of the matrix).
 
The basis vectors can be provided all at once or incrementally with
several calls to EPSAttachDeflationSpace().
 
Use a value of PETSC_TRUE for parameter ortho if all the vectors passed
in are known to be mutually orthonormal.
 
Level: intermediate
 
.seealso: EPSRemoveDeflationSpace()
@*/
PetscErrorCode EPSAttachDeflationSpace(EPS eps,int n,Vec *ds,PetscTruth ortho)
{
PetscErrorCode ierr;
int i;
Vec *tvec;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
tvec = eps->DS;
if (n+eps->nds > 0) {
ierr = PetscMalloc((n+eps->nds)*sizeof(Vec), &eps->DS);CHKERRQ(ierr);
}
if (eps->nds > 0) {
for (i=0; i<eps->nds; i++) eps->DS[i] = tvec[i];
ierr = PetscFree(tvec);CHKERRQ(ierr);
}
for (i=0; i<n; i++) {
ierr = VecDuplicate(ds[i],&eps->DS[i + eps->nds]);CHKERRQ(ierr);
ierr = VecCopy(ds[i],eps->DS[i + eps->nds]);CHKERRQ(ierr);
}
eps->nds += n;
if (!ortho) eps->ds_ortho = PETSC_FALSE;
eps->setupcalled = 0;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSRemoveDeflationSpace"
/*@
EPSRemoveDeflationSpace - Removes the deflation space.
 
Not Collective
 
Input Parameter:
. eps - the eigenproblem solver context
 
Level: intermediate
 
.seealso: EPSAttachDeflationSpace()
@*/
PetscErrorCode EPSRemoveDeflationSpace(EPS eps)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
if (eps->nds > 0) {
ierr = VecDestroyVecs(eps->DS, eps->nds);CHKERRQ(ierr);
}
eps->ds_ortho = PETSC_TRUE;
eps->setupcalled = 0;
PetscFunctionReturn(0);
}
tags/slepc-2_3_3-1/src/eps/interface/setup.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/interface/basic.c New file
0,0 → 1,673
/*
The basic EPS routines, Create, View, etc. are here.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/eps/epsimpl.h" /*I "slepceps.h" I*/
 
PetscFList EPSList = 0;
PetscCookie EPS_COOKIE = 0;
PetscEvent EPS_SetUp = 0, EPS_Solve = 0, EPS_Dense = 0;
 
#undef __FUNCT__
#define __FUNCT__ "EPSInitializePackage"
/*@C
EPSInitializePackage - This function initializes everything in the EPS package. It is called
from PetscDLLibraryRegister() when using dynamic libraries, and on the first call to EPSCreate()
when using static libraries.
 
Input Parameter:
path - The dynamic library path, or PETSC_NULL
 
Level: developer
 
.seealso: SlepcInitialize()
@*/
PetscErrorCode EPSInitializePackage(char *path) {
static PetscTruth initialized = PETSC_FALSE;
char logList[256];
char *className;
PetscTruth opt;
PetscErrorCode ierr;
 
PetscFunctionBegin;
if (initialized) PetscFunctionReturn(0);
initialized = PETSC_TRUE;
/* Register Classes */
ierr = PetscLogClassRegister(&EPS_COOKIE,"Eigenproblem Solver");CHKERRQ(ierr);
/* Register Constructors */
ierr = EPSRegisterAll(path);CHKERRQ(ierr);
/* Register Events */
ierr = PetscLogEventRegister(&EPS_SetUp,"EPSSetUp",EPS_COOKIE);CHKERRQ(ierr);
ierr = PetscLogEventRegister(&EPS_Solve,"EPSSolve",EPS_COOKIE);CHKERRQ(ierr);
ierr = PetscLogEventRegister(&EPS_Dense,"EPSDense",EPS_COOKIE); CHKERRQ(ierr);
/* Process info exclusions */
ierr = PetscOptionsGetString(PETSC_NULL, "-log_info_exclude", logList, 256, &opt);CHKERRQ(ierr);
if (opt) {
ierr = PetscStrstr(logList, "eps", &className);CHKERRQ(ierr);
if (className) {
ierr = PetscInfoDeactivateClass(EPS_COOKIE);CHKERRQ(ierr);
}
}
/* Process summary exclusions */
ierr = PetscOptionsGetString(PETSC_NULL, "-log_summary_exclude", logList, 256, &opt);CHKERRQ(ierr);
if (opt) {
ierr = PetscStrstr(logList, "eps", &className);CHKERRQ(ierr);
if (className) {
ierr = PetscLogEventDeactivateClass(EPS_COOKIE);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSView"
/*@C
EPSView - Prints the EPS data structure.
 
Collective on EPS
 
Input Parameters:
+ eps - the eigenproblem solver context
- viewer - optional visualization context
 
Options Database Key:
. -eps_view - Calls EPSView() at end of EPSSolve()
 
Note:
The available visualization contexts include
+ PETSC_VIEWER_STDOUT_SELF - standard output (default)
- PETSC_VIEWER_STDOUT_WORLD - synchronized standard
output where only the first processor opens
the file. All other processors send their
data to the first processor to print.
 
The user can open an alternative visualization context with
PetscViewerASCIIOpen() - output to a specified file.
 
Level: beginner
 
.seealso: STView(), PetscViewerASCIIOpen()
@*/
PetscErrorCode EPSView(EPS eps,PetscViewer viewer)
{
PetscErrorCode ierr;
const char *type, *which;
PetscTruth isascii;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
if (!viewer) viewer = PETSC_VIEWER_STDOUT_(eps->comm);
PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE,2);
PetscCheckSameComm(eps,1,viewer,2);
 
#if defined(PETSC_USE_COMPLEX)
#define HERM "hermitian"
#else
#define HERM "symmetric"
#endif
ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);CHKERRQ(ierr);
if (isascii) {
ierr = PetscViewerASCIIPrintf(viewer,"EPS Object:\n");CHKERRQ(ierr);
switch (eps->problem_type) {
case EPS_HEP: type = HERM " eigenvalue problem"; break;
case EPS_GHEP: type = "generalized " HERM " eigenvalue problem"; break;
case EPS_NHEP: type = "non-" HERM " eigenvalue problem"; break;
case EPS_GNHEP: type = "generalized non-" HERM " eigenvalue problem"; break;
case 0: type = "not yet set"; break;
default: SETERRQ(1,"Wrong value of eps->problem_type");
}
ierr = PetscViewerASCIIPrintf(viewer," problem type: %s\n",type);CHKERRQ(ierr);
ierr = EPSGetType(eps,&type);CHKERRQ(ierr);
if (type) {
ierr = PetscViewerASCIIPrintf(viewer," method: %s",type);CHKERRQ(ierr);
switch (eps->solverclass) {
case EPS_ONE_SIDE:
ierr = PetscViewerASCIIPrintf(viewer,"\n",type);CHKERRQ(ierr); break;
case EPS_TWO_SIDE:
ierr = PetscViewerASCIIPrintf(viewer," (two-sided)\n",type);CHKERRQ(ierr); break;
default: SETERRQ(1,"Wrong value of eps->solverclass");
}
} else {
ierr = PetscViewerASCIIPrintf(viewer," method: not yet set\n");CHKERRQ(ierr);
}
if (eps->ops->view) {
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = (*eps->ops->view)(eps,viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
}
switch (eps->which) {
case EPS_LARGEST_MAGNITUDE: which = "largest eigenvalues in magnitude"; break;
case EPS_SMALLEST_MAGNITUDE: which = "smallest eigenvalues in magnitude"; break;
case EPS_LARGEST_REAL: which = "largest real parts"; break;
case EPS_SMALLEST_REAL: which = "smallest real parts"; break;
case EPS_LARGEST_IMAGINARY: which = "largest imaginary parts"; break;
case EPS_SMALLEST_IMAGINARY: which = "smallest imaginary parts"; break;
default: SETERRQ(1,"Wrong value of eps->which");
}
ierr = PetscViewerASCIIPrintf(viewer," selected portion of the spectrum: %s\n",which);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer," number of eigenvalues (nev): %d\n",eps->nev);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer," number of column vectors (ncv): %d\n",eps->ncv);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer," maximum number of iterations: %d\n", eps->max_it);
ierr = PetscViewerASCIIPrintf(viewer," tolerance: %g\n",eps->tol);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer," dimension of user-provided deflation space: %d\n",eps->nds);CHKERRQ(ierr);
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = IPView(eps->ip,viewer); CHKERRQ(ierr);
ierr = STView(eps->OP,viewer); CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
} else {
if (eps->ops->view) {
ierr = (*eps->ops->view)(eps,viewer);CHKERRQ(ierr);
}
ierr = STView(eps->OP,viewer); CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSPublish_Petsc"
static PetscErrorCode EPSPublish_Petsc(PetscObject object)
{
PetscFunctionBegin;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSCreate"
/*@C
EPSCreate - Creates the default EPS context.
 
Collective on MPI_Comm
 
Input Parameter:
. comm - MPI communicator
 
Output Parameter:
. eps - location to put the EPS context
 
Note:
The default EPS type is EPSKRYLOVSCHUR
 
Level: beginner
 
.seealso: EPSSetUp(), EPSSolve(), EPSDestroy(), EPS
@*/
PetscErrorCode EPSCreate(MPI_Comm comm,EPS *outeps)
{
PetscErrorCode ierr;
EPS eps;
 
PetscFunctionBegin;
PetscValidPointer(outeps,2);
*outeps = 0;
 
PetscHeaderCreate(eps,_p_EPS,struct _EPSOps,EPS_COOKIE,-1,"EPS",comm,EPSDestroy,EPSView);
*outeps = eps;
 
eps->bops->publish = EPSPublish_Petsc;
ierr = PetscMemzero(eps->ops,sizeof(struct _EPSOps));CHKERRQ(ierr);
 
eps->type = -1;
eps->max_it = 0;
eps->nev = 1;
eps->ncv = 0;
eps->allocated_ncv = 0;
eps->nds = 0;
eps->tol = 1e-7;
eps->which = EPS_LARGEST_MAGNITUDE;
eps->evecsavailable = PETSC_FALSE;
eps->problem_type = (EPSProblemType)0;
eps->solverclass = (EPSClass)0;
 
eps->vec_initial = 0;
eps->vec_initial_left= 0;
eps->V = 0;
eps->AV = 0;
eps->W = 0;
eps->AW = 0;
eps->T = 0;
eps->DS = 0;
eps->ds_ortho = PETSC_TRUE;
eps->eigr = 0;
eps->eigi = 0;
eps->errest = 0;
eps->errest_left = 0;
eps->OP = 0;
eps->ip = 0;
eps->data = 0;
eps->nconv = 0;
eps->its = 0;
eps->perm = PETSC_NULL;
 
eps->nwork = 0;
eps->work = 0;
eps->isgeneralized = PETSC_FALSE;
eps->ishermitian = PETSC_FALSE;
eps->ispositive = PETSC_FALSE;
eps->setupcalled = 0;
eps->reason = EPS_CONVERGED_ITERATING;
 
eps->numbermonitors = 0;
 
ierr = STCreate(comm,&eps->OP); CHKERRQ(ierr);
PetscLogObjectParent(eps,eps->OP);
ierr = IPCreate(comm,&eps->ip); CHKERRQ(ierr);
ierr = IPSetOptionsPrefix(eps->ip,eps->prefix);
ierr = IPAppendOptionsPrefix(eps->ip,"eps_");
PetscLogObjectParent(eps,eps->ip);
ierr = PetscPublishAll(eps);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
#undef __FUNCT__
#define __FUNCT__ "EPSSetType"
/*@C
EPSSetType - Selects the particular solver to be used in the EPS object.
 
Collective on EPS
 
Input Parameters:
+ eps - the eigensolver context
- type - a known method
 
Options Database Key:
. -eps_type <method> - Sets the method; use -help for a list
of available methods
Notes:
See "slepc/include/slepceps.h" for available methods. The default
is EPSKRYLOVSCHUR.
 
Normally, it is best to use the EPSSetFromOptions() command and
then set the EPS type from the options database rather than by using
this routine. Using the options database provides the user with
maximum flexibility in evaluating the different available methods.
The EPSSetType() routine is provided for those situations where it
is necessary to set the iterative solver independently of the command
line or options database.
 
Level: intermediate
 
.seealso: STSetType(), EPSType
@*/
PetscErrorCode EPSSetType(EPS eps,EPSType type)
{
PetscErrorCode ierr,(*r)(EPS);
PetscTruth match;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidCharPointer(type,2);
 
ierr = PetscTypeCompare((PetscObject)eps,type,&match);CHKERRQ(ierr);
if (match) PetscFunctionReturn(0);
 
if (eps->data) {
/* destroy the old private EPS context */
ierr = (*eps->ops->destroy)(eps); CHKERRQ(ierr);
eps->data = 0;
}
 
ierr = PetscFListFind(EPSList,eps->comm,type,(void (**)(void)) &r);CHKERRQ(ierr);
 
if (!r) SETERRQ1(1,"Unknown EPS type given: %s",type);
 
eps->setupcalled = 0;
ierr = PetscMemzero(eps->ops,sizeof(struct _EPSOps));CHKERRQ(ierr);
ierr = (*r)(eps); CHKERRQ(ierr);
 
ierr = PetscObjectChangeTypeName((PetscObject)eps,type);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetType"
/*@C
EPSGetType - Gets the EPS type as a string from the EPS object.
 
Not Collective
 
Input Parameter:
. eps - the eigensolver context
 
Output Parameter:
. name - name of EPS method
 
Level: intermediate
 
.seealso: EPSSetType()
@*/
PetscErrorCode EPSGetType(EPS eps,EPSType *type)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
*type = eps->type_name;
PetscFunctionReturn(0);
}
 
/*MC
EPSRegisterDynamic - Adds a method to the eigenproblem solver package.
 
Synopsis:
EPSRegisterDynamic(char *name_solver,char *path,char *name_create,int (*routine_create)(EPS))
 
Not Collective
 
Input Parameters:
+ name_solver - name of a new user-defined solver
. path - path (either absolute or relative) the library containing this solver
. name_create - name of routine to create the solver context
- routine_create - routine to create the solver context
 
Notes:
EPSRegisterDynamic() may be called multiple times to add several user-defined solvers.
 
If dynamic libraries are used, then the fourth input argument (routine_create)
is ignored.
 
Sample usage:
.vb
EPSRegisterDynamic("my_solver",/home/username/my_lib/lib/libO/solaris/mylib.a,
"MySolverCreate",MySolverCreate);
.ve
 
Then, your solver can be chosen with the procedural interface via
$ EPSSetType(eps,"my_solver")
or at runtime via the option
$ -eps_type my_solver
 
Level: advanced
 
Environmental variables such as ${PETSC_ARCH}, ${PETSC_DIR}, ${PETSC_LIB_DIR},
and others of the form ${any_environmental_variable} occuring in pathname will be
replaced with appropriate values.
 
.seealso: EPSRegisterDestroy(), EPSRegisterAll()
 
M*/
 
#undef __FUNCT__
#define __FUNCT__ "EPSRegister"
/*@C
EPSRegister - See EPSRegisterDynamic()
 
Level: advanced
@*/
PetscErrorCode EPSRegister(const char *sname,const char *path,const char *name,int (*function)(EPS))
{
PetscErrorCode ierr;
char fullname[256];
 
PetscFunctionBegin;
ierr = PetscFListConcat(path,name,fullname);CHKERRQ(ierr);
ierr = PetscFListAdd(&EPSList,sname,fullname,(void (*)(void))function);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSRegisterDestroy"
/*@
EPSRegisterDestroy - Frees the list of EPS methods that were
registered by EPSRegisterDynamic().
 
Not Collective
 
Level: advanced
 
.seealso: EPSRegisterDynamic(), EPSRegisterAll()
@*/
PetscErrorCode EPSRegisterDestroy(void)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
ierr = PetscFListDestroy(&EPSList);CHKERRQ(ierr);
ierr = EPSRegisterAll(PETSC_NULL);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDestroy"
/*@
EPSDestroy - Destroys the EPS context.
 
Collective on EPS
 
Input Parameter:
. eps - eigensolver context obtained from EPSCreate()
 
Level: beginner
 
.seealso: EPSCreate(), EPSSetUp(), EPSSolve()
@*/
PetscErrorCode EPSDestroy(EPS eps)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
if (--eps->refct > 0) PetscFunctionReturn(0);
 
/* if memory was published with AMS then destroy it */
ierr = PetscObjectDepublish(eps);CHKERRQ(ierr);
 
ierr = STDestroy(eps->OP);CHKERRQ(ierr);
ierr = IPDestroy(eps->ip);CHKERRQ(ierr);
 
if (eps->ops->destroy) {
ierr = (*eps->ops->destroy)(eps); CHKERRQ(ierr);
}
ierr = PetscFree(eps->T);CHKERRQ(ierr);
ierr = PetscFree(eps->Tl);CHKERRQ(ierr);
ierr = PetscFree(eps->perm);CHKERRQ(ierr);
 
if (eps->vec_initial) {
ierr = VecDestroy(eps->vec_initial);CHKERRQ(ierr);
}
 
if (eps->vec_initial_left) {
ierr = VecDestroy(eps->vec_initial_left);CHKERRQ(ierr);
}
 
if (eps->nds > 0) {
ierr = VecDestroyVecs(eps->DS, eps->nds);CHKERRQ(ierr);
}
ierr = PetscFree(eps->DSV);CHKERRQ(ierr);
 
ierr = EPSMonitorCancel(eps);CHKERRQ(ierr);
 
PetscHeaderDestroy(eps);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetST"
/*@
EPSSetST - Associates a spectral transformation object to the
eigensolver.
 
Collective on EPS
 
Input Parameters:
+ eps - eigensolver context obtained from EPSCreate()
- st - the spectral transformation object
 
Note:
Use EPSGetST() to retrieve the spectral transformation context (for example,
to free it at the end of the computations).
 
Level: advanced
 
.seealso: EPSGetST()
@*/
PetscErrorCode EPSSetST(EPS eps,ST st)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidHeaderSpecific(st,ST_COOKIE,2);
PetscCheckSameComm(eps,1,st,2);
ierr = PetscObjectReference((PetscObject)st);CHKERRQ(ierr);
ierr = STDestroy(eps->OP); CHKERRQ(ierr);
eps->OP = st;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetST"
/*@C
EPSGetST - Obtain the spectral transformation (ST) object associated
to the eigensolver object.
 
Not Collective
 
Input Parameters:
. eps - eigensolver context obtained from EPSCreate()
 
Output Parameter:
. st - spectral transformation context
 
Level: beginner
 
.seealso: EPSSetST()
@*/
PetscErrorCode EPSGetST(EPS eps, ST *st)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidPointer(st,2);
*st = eps->OP;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetIP"
/*@
EPSSetIP - Associates an inner product object to the
eigensolver.
 
Collective on EPS
 
Input Parameters:
+ eps - eigensolver context obtained from EPSCreate()
- ip - the inner product object
 
Note:
Use EPSGetIP() to retrieve the inner product context (for example,
to free it at the end of the computations).
 
Level: advanced
 
.seealso: EPSGetIP()
@*/
PetscErrorCode EPSSetIP(EPS eps,IP ip)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidHeaderSpecific(ip,IP_COOKIE,2);
PetscCheckSameComm(eps,1,ip,2);
ierr = PetscObjectReference((PetscObject)ip);CHKERRQ(ierr);
ierr = IPDestroy(eps->ip); CHKERRQ(ierr);
eps->ip = ip;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetIP"
/*@C
EPSGetIP - Obtain the inner product object associated
to the eigensolver object.
 
Not Collective
 
Input Parameters:
. eps - eigensolver context obtained from EPSCreate()
 
Output Parameter:
. ip - inner product context
 
Level: advanced
 
.seealso: EPSSetIP()
@*/
PetscErrorCode EPSGetIP(EPS eps,IP *ip)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidPointer(ip,2);
*ip = eps->ip;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSIsGeneralized"
/*@
EPSIsGeneralized - Ask if the EPS object corresponds to a generalized
eigenvalue problem.
 
Not collective
 
Input Parameter:
. eps - the eigenproblem solver context
 
Output Parameter:
. is - the answer
 
Level: intermediate
 
@*/
PetscErrorCode EPSIsGeneralized(EPS eps,PetscTruth* is)
{
PetscErrorCode ierr;
Mat B;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
ierr = STGetOperators(eps->OP,PETSC_NULL,&B);CHKERRQ(ierr);
if( B ) *is = PETSC_TRUE;
else *is = PETSC_FALSE;
if( eps->setupcalled ) {
if( eps->isgeneralized != *is ) {
SETERRQ(0,"Warning: Inconsistent EPS state");
}
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSIsHermitian"
/*@
EPSIsHermitian - Ask if the EPS object corresponds to a Hermitian
eigenvalue problem.
 
Not collective
 
Input Parameter:
. eps - the eigenproblem solver context
 
Output Parameter:
. is - the answer
 
Level: intermediate
 
@*/
PetscErrorCode EPSIsHermitian(EPS eps,PetscTruth* is)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
if( eps->ishermitian ) *is = PETSC_TRUE;
else *is = PETSC_FALSE;
PetscFunctionReturn(0);
}
tags/slepc-2_3_3-1/src/eps/interface/basic.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/interface/default.c New file
0,0 → 1,240
/*
This file contains some simple default routines for common operations.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/eps/epsimpl.h" /*I "slepceps.h" I*/
#include "slepcblaslapack.h"
 
#undef __FUNCT__
#define __FUNCT__ "EPSDestroy_Default"
PetscErrorCode EPSDestroy_Default(EPS eps)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
ierr = PetscFree(eps->data);CHKERRQ(ierr);
 
/* free work vectors */
ierr = EPSDefaultFreeWork(eps);CHKERRQ(ierr);
ierr = EPSFreeSolution(eps);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSBackTransform_Default"
PetscErrorCode EPSBackTransform_Default(EPS eps)
{
PetscErrorCode ierr;
int i;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
for (i=0;i<eps->nconv;i++) {
ierr = STBackTransform(eps->OP,&eps->eigr[i],&eps->eigi[i]);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSComputeVectors_Default"
/*
EPSComputeVectors_Default - Compute eigenvectors from the vectors
provided by the eigensolver. This version just copies the vectors
and is intended for solvers such as power that provide the eigenvector.
*/
PetscErrorCode EPSComputeVectors_Default(EPS eps)
{
PetscErrorCode ierr;
int i;
 
PetscFunctionBegin;
for (i=0;i<eps->nconv;i++) {
ierr = VecCopy(eps->V[i],eps->AV[i]);CHKERRQ(ierr);
if (eps->solverclass == EPS_TWO_SIDE) {
ierr = VecCopy(eps->W[i],eps->AW[i]);CHKERRQ(ierr);
}
}
eps->evecsavailable = PETSC_TRUE;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSComputeVectors_Hermitian"
/*
EPSComputeVectors_Hermitian - Copies the Lanczos vectors as eigenvectors
using purification for generalized eigenproblems.
*/
PetscErrorCode EPSComputeVectors_Hermitian(EPS eps)
{
PetscErrorCode ierr;
int i;
PetscReal norm;
 
PetscFunctionBegin;
for (i=0;i<eps->nconv;i++) {
if (eps->isgeneralized) {
/* Purify eigenvectors */
ierr = STApply(eps->OP,eps->V[i],eps->AV[i]);CHKERRQ(ierr);
ierr = VecNormalize(eps->AV[i],&norm);CHKERRQ(ierr);
} else {
ierr = VecCopy(eps->V[i],eps->AV[i]);CHKERRQ(ierr);
}
if (eps->solverclass == EPS_TWO_SIDE) {
ierr = VecCopy(eps->W[i],eps->AW[i]);CHKERRQ(ierr);
}
}
eps->evecsavailable = PETSC_TRUE;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSComputeVectors_Schur"
/*
EPSComputeVectors_Schur - Compute eigenvectors from the vectors
provided by the eigensolver. This version is intended for solvers
that provide Schur vectors. Given the partial Schur decomposition
OP*V=V*T, the following steps are performed:
1) compute eigenvectors of T: T*Z=Z*D
2) compute eigenvectors of OP: X=V*Z
If left eigenvectors are required then also do Z'*Tl=D*Z', Y=W*Z
*/
PetscErrorCode EPSComputeVectors_Schur(EPS eps)
{
#if defined(SLEPC_MISSING_LAPACK_TREVC)
SETERRQ(PETSC_ERR_SUP,"TREVC - Lapack routine is unavailable.");
#else
PetscErrorCode ierr;
int i,mout,info,nv=eps->nv;
PetscScalar *Z,*work;
#if defined(PETSC_USE_COMPLEX)
PetscReal *rwork;
#endif
PetscReal norm;
Vec w;
PetscFunctionBegin;
if (eps->ishermitian) {
ierr = EPSComputeVectors_Hermitian(eps);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
if (eps->ispositive) {
ierr = VecDuplicate(eps->V[0],&w);CHKERRQ(ierr);
}
 
ierr = PetscMalloc(nv*nv*sizeof(PetscScalar),&Z);CHKERRQ(ierr);
ierr = PetscMalloc(3*nv*sizeof(PetscScalar),&work);CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
ierr = PetscMalloc(nv*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
#endif
 
/* right eigenvectors */
#if !defined(PETSC_USE_COMPLEX)
LAPACKtrevc_("R","A",PETSC_NULL,&nv,eps->T,&eps->ncv,PETSC_NULL,&nv,Z,&nv,&nv,&mout,work,&info,1,1);
#else
LAPACKtrevc_("R","A",PETSC_NULL,&nv,eps->T,&eps->ncv,PETSC_NULL,&nv,Z,&nv,&nv,&mout,work,rwork,&info,1,1);
#endif
if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack xTREVC %i",info);
 
/* AV = V * Z */
for (i=0;i<eps->nconv;i++) {
if (eps->ispositive) {
/* Purify eigenvectors */
ierr = VecSet(w,0.0);CHKERRQ(ierr);
ierr = VecMAXPY(w,nv,Z+nv*i,eps->V);CHKERRQ(ierr);
ierr = STApply(eps->OP,w,eps->AV[i]);CHKERRQ(ierr);
ierr = VecNormalize(eps->AV[i],&norm);CHKERRQ(ierr);
} else {
ierr = VecSet(eps->AV[i],0.0);CHKERRQ(ierr);
ierr = VecMAXPY(eps->AV[i],nv,Z+nv*i,eps->V);CHKERRQ(ierr);
}
}
/* left eigenvectors */
if (eps->solverclass == EPS_TWO_SIDE) {
#if !defined(PETSC_USE_COMPLEX)
LAPACKtrevc_("R","A",PETSC_NULL,&nv,eps->Tl,&eps->nv,PETSC_NULL,&nv,Z,&nv,&nv,&mout,work,&info,1,1);
#else
LAPACKtrevc_("R","A",PETSC_NULL,&nv,eps->Tl,&eps->nv,PETSC_NULL,&nv,Z,&nv,&nv,&mout,work,rwork,&info,1,1);
#endif
if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack xTREVC %i",info);
 
/* AW = W * Z */
for (i=0;i<eps->nconv;i++) {
ierr = VecSet(eps->AW[i],0.0);CHKERRQ(ierr);
ierr = VecMAXPY(eps->AW[i],nv,Z+nv*i,eps->W);CHKERRQ(ierr);
}
}
ierr = PetscFree(Z);CHKERRQ(ierr);
ierr = PetscFree(work);CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
ierr = PetscFree(rwork);CHKERRQ(ierr);
#endif
if (eps->ispositive) {
ierr = VecDestroy(w);CHKERRQ(ierr);
}
eps->evecsavailable = PETSC_TRUE;
PetscFunctionReturn(0);
#endif
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDefaultGetWork"
/*
EPSDefaultGetWork - Gets a number of work vectors.
 
Input Parameters:
+ eps - eigensolver context
- nw - number of work vectors to allocate
 
Notes:
Call this only if no work vectors have been allocated.
 
*/
PetscErrorCode EPSDefaultGetWork(EPS eps, int nw)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
 
if (eps->nwork != nw) {
if (eps->nwork > 0) {
ierr = VecDestroyVecs(eps->work,eps->nwork); CHKERRQ(ierr);
}
eps->nwork = nw;
ierr = VecDuplicateVecs(eps->vec_initial,nw,&eps->work); CHKERRQ(ierr);
ierr = PetscLogObjectParents(eps,nw,eps->work);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDefaultFreeWork"
/*
EPSDefaultFreeWork - Free work vectors.
 
Input Parameters:
. eps - eigensolver context
 
*/
PetscErrorCode EPSDefaultFreeWork(EPS eps)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
if (eps->work) {
ierr = VecDestroyVecs(eps->work,eps->nwork); CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
tags/slepc-2_3_3-1/src/eps/interface/default.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/interface/opts.c New file
0,0 → 1,668
/*
EPS routines related to options that can be set via the command-line
or procedurally.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/eps/epsimpl.h" /*I "slepceps.h" I*/
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetFromOptions"
/*@
EPSSetFromOptions - Sets EPS options from the options database.
This routine must be called before EPSSetUp() if the user is to be
allowed to set the solver type.
 
Collective on EPS
 
Input Parameters:
. eps - the eigensolver context
 
Notes:
To see all options, run your program with the -help option.
 
Level: beginner
 
.seealso:
@*/
PetscErrorCode EPSSetFromOptions(EPS eps)
{
PetscErrorCode ierr;
char type[256],monfilename[PETSC_MAX_PATH_LEN];
PetscTruth flg;
PetscReal r;
PetscInt i,j;
PetscViewer monviewer;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
ierr = PetscOptionsBegin(eps->comm,eps->prefix,"Eigenproblem Solver (EPS) Options","EPS");CHKERRQ(ierr);
ierr = PetscOptionsList("-eps_type","Eigenproblem Solver method","EPSSetType",EPSList,(char*)(eps->type_name?eps->type_name:EPSKRYLOVSCHUR),type,256,&flg);CHKERRQ(ierr);
if (flg) {
ierr = EPSSetType(eps,type);CHKERRQ(ierr);
}
 
ierr = PetscOptionsTruthGroupBegin("-eps_hermitian","hermitian eigenvalue problem","EPSSetProblemType",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetProblemType(eps,EPS_HEP);CHKERRQ(ierr);}
ierr = PetscOptionsTruthGroup("-eps_gen_hermitian","generalized hermitian eigenvalue problem","EPSSetProblemType",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetProblemType(eps,EPS_GHEP);CHKERRQ(ierr);}
ierr = PetscOptionsTruthGroup("-eps_non_hermitian","non-hermitian eigenvalue problem","EPSSetProblemType",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetProblemType(eps,EPS_NHEP);CHKERRQ(ierr);}
ierr = PetscOptionsTruthGroup("-eps_gen_non_hermitian","generalized non-hermitian eigenvalue problem","EPSSetProblemType",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetProblemType(eps,EPS_GNHEP);CHKERRQ(ierr);}
ierr = PetscOptionsTruthGroupEnd("-eps_pos_gen_non_hermitian","generalized non-hermitian eigenvalue problem with positive semi-definite B","EPSSetProblemType",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetProblemType(eps,EPS_PGNHEP);CHKERRQ(ierr);}
 
/*
Set the type if it was never set.
*/
if (!eps->type_name) {
ierr = EPSSetType(eps,EPSKRYLOVSCHUR);CHKERRQ(ierr);
}
 
ierr = PetscOptionsTruthGroupBegin("-eps_oneside","one-sided eigensolver","EPSSetClass",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetClass(eps,EPS_ONE_SIDE);CHKERRQ(ierr);}
ierr = PetscOptionsTruthGroupEnd("-eps_twoside","two-sided eigensolver","EPSSetClass",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetClass(eps,EPS_TWO_SIDE);CHKERRQ(ierr);}
 
r = i = PETSC_IGNORE;
ierr = PetscOptionsInt("-eps_max_it","Maximum number of iterations","EPSSetTolerances",eps->max_it,&i,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-eps_tol","Tolerance","EPSSetTolerances",eps->tol,&r,PETSC_NULL);CHKERRQ(ierr);
ierr = EPSSetTolerances(eps,r,i);CHKERRQ(ierr);
 
i = j = PETSC_IGNORE;
ierr = PetscOptionsInt("-eps_nev","Number of eigenvalues to compute","EPSSetDimensions",eps->nev,&i,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsInt("-eps_ncv","Number of basis vectors","EPSSetDimensions",eps->ncv,&j,PETSC_NULL);CHKERRQ(ierr);
ierr = EPSSetDimensions(eps,i,j);CHKERRQ(ierr);
/* -----------------------------------------------------------------------*/
/*
Cancels all monitors hardwired into code before call to EPSSetFromOptions()
*/
ierr = PetscOptionsName("-eps_monitor_cancel","Remove any hardwired monitor routines","EPSMonitorCancel",&flg);CHKERRQ(ierr);
if (flg) {
ierr = EPSMonitorCancel(eps); CHKERRQ(ierr);
}
/*
Prints approximate eigenvalues and error estimates at each iteration
*/
ierr = PetscOptionsString("-eps_monitor","Monitor approximate eigenvalues and error estimates","EPSMonitorSet","stdout",monfilename,PETSC_MAX_PATH_LEN,&flg);CHKERRQ(ierr);
if (flg) {
ierr = PetscViewerASCIIOpen(eps->comm,monfilename,&monviewer);CHKERRQ(ierr);
ierr = EPSMonitorSet(eps,EPSMonitorDefault,monviewer,(PetscErrorCode (*)(void*))PetscViewerDestroy);CHKERRQ(ierr);
}
ierr = PetscOptionsName("-eps_monitor_draw","Monitor error estimates graphically","EPSMonitorSet",&flg);CHKERRQ(ierr);
if (flg) {
ierr = EPSMonitorSet(eps,EPSMonitorLG,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
}
/* -----------------------------------------------------------------------*/
ierr = PetscOptionsTruthGroupBegin("-eps_largest_magnitude","compute largest eigenvalues in magnitude","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_LARGEST_MAGNITUDE);CHKERRQ(ierr);}
ierr = PetscOptionsTruthGroup("-eps_smallest_magnitude","compute smallest eigenvalues in magnitude","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_SMALLEST_MAGNITUDE);CHKERRQ(ierr);}
ierr = PetscOptionsTruthGroup("-eps_largest_real","compute largest real parts","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_LARGEST_REAL);CHKERRQ(ierr);}
ierr = PetscOptionsTruthGroup("-eps_smallest_real","compute smallest real parts","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_SMALLEST_REAL);CHKERRQ(ierr);}
ierr = PetscOptionsTruthGroup("-eps_largest_imaginary","compute largest imaginary parts","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_LARGEST_IMAGINARY);CHKERRQ(ierr);}
ierr = PetscOptionsTruthGroupEnd("-eps_smallest_imaginary","compute smallest imaginary parts","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_SMALLEST_IMAGINARY);CHKERRQ(ierr);}
 
ierr = PetscOptionsName("-eps_view","Print detailed information on solver used","EPSView",0);CHKERRQ(ierr);
ierr = PetscOptionsName("-eps_view_binary","Save the matrices associated to the eigenproblem","EPSSetFromOptions",0);CHKERRQ(ierr);
ierr = PetscOptionsName("-eps_plot_eigs","Make a plot of the computed eigenvalues","EPSSolve",0);CHKERRQ(ierr);
if (eps->ops->setfromoptions) {
ierr = (*eps->ops->setfromoptions)(eps);CHKERRQ(ierr);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
 
ierr = IPSetFromOptions(eps->ip); CHKERRQ(ierr);
ierr = STSetFromOptions(eps->OP); CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetTolerances"
/*@
EPSGetTolerances - Gets the tolerance and maximum
iteration count used by the default EPS convergence tests.
 
Not Collective
 
Input Parameter:
. eps - the eigensolver context
Output Parameters:
+ tol - the convergence tolerance
- maxits - maximum number of iterations
 
Notes:
The user can specify PETSC_NULL for any parameter that is not needed.
 
Level: intermediate
 
.seealso: EPSSetTolerances()
@*/
PetscErrorCode EPSGetTolerances(EPS eps,PetscReal *tol,int *maxits)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
if (tol) *tol = eps->tol;
if (maxits) *maxits = eps->max_it;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetTolerances"
/*@
EPSSetTolerances - Sets the tolerance and maximum
iteration count used by the default EPS convergence testers.
 
Collective on EPS
 
Input Parameters:
+ eps - the eigensolver context
. tol - the convergence tolerance
- maxits - maximum number of iterations to use
 
Options Database Keys:
+ -eps_tol <tol> - Sets the convergence tolerance
- -eps_max_it <maxits> - Sets the maximum number of iterations allowed
 
Notes:
Use PETSC_IGNORE for an argument that need not be changed.
 
Use PETSC_DECIDE for maxits to assign a reasonably good value, which is
dependent on the solution method.
 
Level: intermediate
 
.seealso: EPSGetTolerances()
@*/
PetscErrorCode EPSSetTolerances(EPS eps,PetscReal tol,int maxits)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
if (tol != PETSC_IGNORE) {
if (tol == PETSC_DEFAULT) {
eps->tol = 1e-7;
} else {
if (tol < 0.0) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of tol. Must be > 0");
eps->tol = tol;
}
}
if (maxits != PETSC_IGNORE) {
if (maxits == PETSC_DEFAULT || maxits == PETSC_DECIDE) {
eps->max_it = 0;
} else {
if (maxits < 0) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of maxits. Must be > 0");
eps->max_it = maxits;
}
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetDimensions"
/*@
EPSGetDimensions - Gets the number of eigenvalues to compute
and the dimension of the subspace.
 
Not Collective
 
Input Parameter:
. eps - the eigensolver context
Output Parameters:
+ nev - number of eigenvalues to compute
- ncv - the maximum dimension of the subspace to be used by the solver
 
Notes:
The user can specify PETSC_NULL for any parameter that is not needed.
 
Level: intermediate
 
.seealso: EPSSetDimensions()
@*/
PetscErrorCode EPSGetDimensions(EPS eps,int *nev,int *ncv)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
if( nev ) *nev = eps->nev;
if( ncv ) *ncv = eps->ncv;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetDimensions"
/*@
EPSSetDimensions - Sets the number of eigenvalues to compute
and the dimension of the subspace.
 
Collective on EPS
 
Input Parameters:
+ eps - the eigensolver context
. nev - number of eigenvalues to compute
- ncv - the maximum dimension of the subspace to be used by the solver
 
Options Database Keys:
+ -eps_nev <nev> - Sets the number of eigenvalues
- -eps_ncv <ncv> - Sets the dimension of the subspace
 
Notes:
Use PETSC_IGNORE to retain the previous value of any parameter.
 
Use PETSC_DECIDE for ncv to assign a reasonably good value, which is
dependent on the solution method.
 
Level: intermediate
 
.seealso: EPSGetDimensions()
@*/
PetscErrorCode EPSSetDimensions(EPS eps,int nev,int ncv)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
 
if( nev != PETSC_IGNORE ) {
if (nev<1) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of nev. Must be > 0");
eps->nev = nev;
eps->setupcalled = 0;
}
if( ncv != PETSC_IGNORE ) {
if (ncv == PETSC_DECIDE || ncv == PETSC_DEFAULT) {
eps->ncv = 0;
} else {
if (ncv<1) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of ncv. Must be > 0");
eps->ncv = ncv;
}
eps->setupcalled = 0;
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetWhichEigenpairs"
/*@
EPSSetWhichEigenpairs - Specifies which portion of the spectrum is
to be sought.
 
Collective on EPS
 
Input Parameter:
. eps - eigensolver context obtained from EPSCreate()
 
Output Parameter:
. which - the portion of the spectrum to be sought
 
Possible values:
The parameter 'which' can have one of these values:
+ EPS_LARGEST_MAGNITUDE - largest eigenvalues in magnitude (default)
. EPS_SMALLEST_MAGNITUDE - smallest eigenvalues in magnitude
. EPS_LARGEST_REAL - largest real parts
. EPS_SMALLEST_REAL - smallest real parts
. EPS_LARGEST_IMAGINARY - largest imaginary parts
- EPS_SMALLEST_IMAGINARY - smallest imaginary parts
 
Options Database Keys:
+ -eps_largest_magnitude - Sets largest eigenvalues in magnitude
. -eps_smallest_magnitude - Sets smallest eigenvalues in magnitude
. -eps_largest_real - Sets largest real parts
. -eps_smallest_real - Sets smallest real parts
. -eps_largest_imaginary - Sets largest imaginary parts in magnitude
- -eps_smallest_imaginary - Sets smallest imaginary parts in magnitude
 
Notes:
Not all eigensolvers implemented in EPS account for all the possible values
stated above. Also, some values make sense only for certain types of
problems. If SLEPc is compiled for real numbers EPS_LARGEST_IMAGINARY
and EPS_SMALLEST_IMAGINARY use the absolute value of the imaginary part
for eigenvalue selection.
Level: intermediate
 
.seealso: EPSGetWhichEigenpairs(), EPSSortEigenvalues(), EPSWhich
@*/
PetscErrorCode EPSSetWhichEigenpairs(EPS eps,EPSWhich which)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
switch (which) {
case EPS_LARGEST_MAGNITUDE:
case EPS_SMALLEST_MAGNITUDE:
case EPS_LARGEST_REAL:
case EPS_SMALLEST_REAL:
case EPS_LARGEST_IMAGINARY:
case EPS_SMALLEST_IMAGINARY:
if (eps->which != which) {
eps->setupcalled = 0;
eps->which = which;
}
break;
default:
SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Invalid 'which' value");
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetWhichEigenpairs"
/*@C
EPSGetWhichEigenpairs - Returns which portion of the spectrum is to be
sought.
 
Not Collective
 
Input Parameter:
. eps - eigensolver context obtained from EPSCreate()
 
Output Parameter:
. which - the portion of the spectrum to be sought
 
Notes:
See EPSSetWhichEigenpairs() for possible values of which
 
Level: intermediate
 
.seealso: EPSSetWhichEigenpairs(), EPSWhich
@*/
PetscErrorCode EPSGetWhichEigenpairs(EPS eps,EPSWhich *which)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidPointer(which,2);
*which = eps->which;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetProblemType"
/*@
EPSSetProblemType - Specifies the type of the eigenvalue problem.
 
Collective on EPS
 
Input Parameters:
+ eps - the eigensolver context
- type - a known type of eigenvalue problem
 
Options Database Keys:
+ -eps_hermitian - Hermitian eigenvalue problem
. -eps_gen_hermitian - generalized Hermitian eigenvalue problem
. -eps_non_hermitian - non-Hermitian eigenvalue problem
- -eps_gen_non_hermitian - generalized non-Hermitian eigenvalue problem
Note:
Allowed values for the problem type are: Hermitian (EPS_HEP), non-Hermitian
(EPS_NHEP), generalized Hermitian (EPS_GHEP) and generalized non-Hermitian
(EPS_GNHEP).
 
This function must be used to instruct SLEPc to exploit symmetry. If no
problem type is specified, by default a non-Hermitian problem is assumed
(either standard or generalized). If the user knows that the problem is
Hermitian (i.e. A=A^H) of generalized Hermitian (i.e. A=A^H, B=B^H, and
B positive definite) then it is recommended to set the problem type so
that eigensolver can exploit these properties.
 
Level: beginner
 
.seealso: EPSSetOperators(), EPSSetType(), EPSGetProblemType(), EPSProblemType
@*/
PetscErrorCode EPSSetProblemType(EPS eps,EPSProblemType type)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
 
switch (type) {
case EPS_HEP:
eps->isgeneralized = PETSC_FALSE;
eps->ishermitian = PETSC_TRUE;
eps->ispositive = PETSC_FALSE;
break;
case EPS_NHEP:
eps->isgeneralized = PETSC_FALSE;
eps->ishermitian = PETSC_FALSE;
eps->ispositive = PETSC_FALSE;
break;
case EPS_GHEP:
eps->isgeneralized = PETSC_TRUE;
eps->ishermitian = PETSC_TRUE;
eps->ispositive = PETSC_TRUE;
break;
case EPS_GNHEP:
eps->isgeneralized = PETSC_TRUE;
eps->ishermitian = PETSC_FALSE;
eps->ispositive = PETSC_FALSE;
break;
case EPS_PGNHEP:
eps->isgeneralized = PETSC_TRUE;
eps->ishermitian = PETSC_FALSE;
eps->ispositive = PETSC_TRUE;
break;
/*
case EPS_CSEP:
eps->isgeneralized = PETSC_FALSE;
eps->ishermitian = PETSC_FALSE;
ierr = STSetBilinearForm(eps->OP,STINNER_SYMMETRIC);CHKERRQ(ierr);
break;
case EPS_GCSEP:
eps->isgeneralized = PETSC_TRUE;
eps->ishermitian = PETSC_FALSE;
ierr = STSetBilinearForm(eps->OP,STINNER_B_SYMMETRIC);CHKERRQ(ierr);
break;
*/
default:
SETERRQ(PETSC_ERR_ARG_WRONG,"Unknown eigenvalue problem type");
}
eps->problem_type = type;
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetProblemType"
/*@C
EPSGetProblemType - Gets the problem type from the EPS object.
 
Not Collective
 
Input Parameter:
. eps - the eigensolver context
 
Output Parameter:
. type - name of EPS problem type
 
Level: intermediate
 
.seealso: EPSSetProblemType(), EPSProblemType
@*/
PetscErrorCode EPSGetProblemType(EPS eps,EPSProblemType *type)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidPointer(type,2);
*type = eps->problem_type;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetClass"
/*@
EPSSetClass - Specifies the eigensolver class: either one-sided or two-sided.
 
Collective on EPS
 
Input Parameters:
+ eps - the eigensolver context
- class - the class of solver
 
Options Database Keys:
+ -eps_oneside - one-sided solver
- -eps_twoside - two-sided solver
Note:
Allowed solver classes are: one-sided (EPS_ONE_SIDE) and two-sided (EPS_TWO_SIDE).
One-sided eigensolvers are the standard ones, which allow the computation of
eigenvalues and (right) eigenvectors, whereas two-sided eigensolvers compute
left eigenvectors as well.
 
Level: intermediate
 
.seealso: EPSGetLeftVector(), EPSComputeRelativeErrorLeft(), EPSSetLeftInitialVector(),
EPSGetClass(), EPSClass
@*/
PetscErrorCode EPSSetClass(EPS eps,EPSClass cl)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
 
if (cl != EPS_ONE_SIDE && cl != EPS_TWO_SIDE) SETERRQ(PETSC_ERR_ARG_WRONG,"Unknown eigensolver class");
if (eps->solverclass!=cl) {
if (eps->solverclass == EPS_TWO_SIDE) { ierr = EPSFreeSolution(eps);CHKERRQ(ierr); }
eps->solverclass = cl;
}
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetClass"
/*@C
EPSGetClass - Gets the eigensolver class from the EPS object.
 
Not Collective
 
Input Parameter:
. eps - the eigensolver context
 
Output Parameter:
. class - class of EPS solver (either one-sided or two-sided)
 
Level: intermediate
 
.seealso: EPSSetClass(), EPSClass
@*/
PetscErrorCode EPSGetClass(EPS eps,EPSClass *cl)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidPointer(cl,2);
*cl = eps->solverclass;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetOptionsPrefix"
/*@C
EPSSetOptionsPrefix - Sets the prefix used for searching for all
EPS options in the database.
 
Collective on EPS
 
Input Parameters:
+ eps - the eigensolver context
- prefix - the prefix string to prepend to all EPS option requests
 
Notes:
A hyphen (-) must NOT be given at the beginning of the prefix name.
The first character of all runtime options is AUTOMATICALLY the
hyphen.
 
For example, to distinguish between the runtime options for two
different EPS contexts, one could call
.vb
EPSSetOptionsPrefix(eps1,"eig1_")
EPSSetOptionsPrefix(eps2,"eig2_")
.ve
 
Level: advanced
 
.seealso: EPSAppendOptionsPrefix(), EPSGetOptionsPrefix()
@*/
PetscErrorCode EPSSetOptionsPrefix(EPS eps,const char *prefix)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
ierr = PetscObjectSetOptionsPrefix((PetscObject)eps, prefix);CHKERRQ(ierr);
ierr = STSetOptionsPrefix(eps->OP,prefix);CHKERRQ(ierr);
ierr = IPSetOptionsPrefix(eps->ip,prefix);CHKERRQ(ierr);
ierr = IPAppendOptionsPrefix(eps->ip,"eps_");CHKERRQ(ierr);
PetscFunctionReturn(0);
}
#undef __FUNCT__
#define __FUNCT__ "EPSAppendOptionsPrefix"
/*@C
EPSAppendOptionsPrefix - Appends to the prefix used for searching for all
EPS options in the database.
 
Collective on EPS
 
Input Parameters:
+ eps - the eigensolver context
- prefix - the prefix string to prepend to all EPS option requests
 
Notes:
A hyphen (-) must NOT be given at the beginning of the prefix name.
The first character of all runtime options is AUTOMATICALLY the hyphen.
 
Level: advanced
 
.seealso: EPSSetOptionsPrefix(), EPSGetOptionsPrefix()
@*/
PetscErrorCode EPSAppendOptionsPrefix(EPS eps,const char *prefix)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
ierr = PetscObjectAppendOptionsPrefix((PetscObject)eps, prefix);CHKERRQ(ierr);
ierr = STAppendOptionsPrefix(eps->OP,prefix); CHKERRQ(ierr);
ierr = IPSetOptionsPrefix(eps->ip,prefix);CHKERRQ(ierr);
ierr = IPAppendOptionsPrefix(eps->ip,"eps_");CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetOptionsPrefix"
/*@C
EPSGetOptionsPrefix - Gets the prefix used for searching for all
EPS options in the database.
 
Not Collective
 
Input Parameters:
. eps - the eigensolver context
 
Output Parameters:
. prefix - pointer to the prefix string used is returned
 
Notes: On the fortran side, the user should pass in a string 'prefix' of
sufficient length to hold the prefix.
 
Level: advanced
 
.seealso: EPSSetOptionsPrefix(), EPSAppendOptionsPrefix()
@*/
PetscErrorCode EPSGetOptionsPrefix(EPS eps,const char *prefix[])
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidPointer(prefix,2);
ierr = PetscObjectGetOptionsPrefix((PetscObject)eps, prefix);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
tags/slepc-2_3_3-1/src/eps/interface/opts.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/interface/itregis.c New file
0,0 → 1,87
/*
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/eps/epsimpl.h" /*I "slepceps.h" I*/
 
EXTERN_C_BEGIN
EXTERN PetscErrorCode EPSCreate_POWER(EPS);
EXTERN PetscErrorCode EPSCreate_SUBSPACE(EPS);
EXTERN PetscErrorCode EPSCreate_ARNOLDI(EPS);
EXTERN PetscErrorCode EPSCreate_LANCZOS(EPS);
EXTERN PetscErrorCode EPSCreate_KRYLOVSCHUR(EPS);
#if defined(SLEPC_HAVE_ARPACK)
EXTERN PetscErrorCode EPSCreate_ARPACK(EPS);
#endif
EXTERN PetscErrorCode EPSCreate_LAPACK(EPS);
#if defined(SLEPC_HAVE_BLZPACK) && !defined(PETSC_USE_COMPLEX)
EXTERN PetscErrorCode EPSCreate_BLZPACK(EPS);
#endif
#if defined(SLEPC_HAVE_TRLAN) && !defined(PETSC_USE_COMPLEX)
EXTERN PetscErrorCode EPSCreate_TRLAN(EPS);
#endif
#if defined(PETSC_HAVE_BLOPEX) && !defined(PETSC_USE_COMPLEX)
EXTERN PetscErrorCode EPSCreate_BLOPEX(EPS);
#endif
#if defined(SLEPC_HAVE_PRIMME)
EXTERN PetscErrorCode EPSCreate_PRIMME(EPS eps);
#endif
EXTERN_C_END
#undef __FUNCT__
#define __FUNCT__ "EPSRegisterAll"
/*@C
EPSRegisterAll - Registers all the eigenvalue solvers in the EPS package.
 
Not Collective
 
Level: advanced
 
.seealso: EPSRegisterDynamic()
@*/
PetscErrorCode EPSRegisterAll(char *path)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
 
ierr = EPSRegisterDynamic(EPSPOWER, path,"EPSCreate_POWER",
EPSCreate_POWER);CHKERRQ(ierr);
ierr = EPSRegisterDynamic(EPSSUBSPACE, path,"EPSCreate_SUBSPACE",
EPSCreate_SUBSPACE);CHKERRQ(ierr);
ierr = EPSRegisterDynamic(EPSARNOLDI, path,"EPSCreate_ARNOLDI",
EPSCreate_ARNOLDI);CHKERRQ(ierr);
ierr = EPSRegisterDynamic(EPSLANCZOS, path,"EPSCreate_LANCZOS",
EPSCreate_LANCZOS);CHKERRQ(ierr);
ierr = EPSRegisterDynamic(EPSKRYLOVSCHUR, path,"EPSCreate_KRYLOVSCHUR",
EPSCreate_KRYLOVSCHUR);CHKERRQ(ierr);
#if defined(SLEPC_HAVE_ARPACK)
ierr = EPSRegisterDynamic(EPSARPACK, path,"EPSCreate_ARPACK",
EPSCreate_ARPACK);CHKERRQ(ierr);
#endif
ierr = EPSRegisterDynamic(EPSLAPACK, path,"EPSCreate_LAPACK",
EPSCreate_LAPACK);CHKERRQ(ierr);
#if defined(SLEPC_HAVE_BLZPACK) && !defined(PETSC_USE_COMPLEX)
ierr = EPSRegisterDynamic(EPSBLZPACK, path,"EPSCreate_BLZPACK",
EPSCreate_BLZPACK);CHKERRQ(ierr);
#endif
#if defined(SLEPC_HAVE_TRLAN) && !defined(PETSC_USE_COMPLEX)
ierr = EPSRegisterDynamic(EPSTRLAN, path,"EPSCreate_TRLAN",
EPSCreate_TRLAN);CHKERRQ(ierr);
#endif
#if defined(PETSC_HAVE_BLOPEX) && !defined(PETSC_USE_COMPLEX)
ierr = EPSRegisterDynamic(EPSBLOPEX, path,"EPSCreate_BLOPEX",
EPSCreate_BLOPEX);CHKERRQ(ierr);
#endif
#if defined(SLEPC_HAVE_PRIMME)
ierr = EPSRegisterDynamic(EPSPRIMME, path, "EPSCreate_PRIMME",
EPSCreate_PRIMME);CHKERRQ(ierr);
#endif
PetscFunctionReturn(0);
}
tags/slepc-2_3_3-1/src/eps/interface/itregis.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/interface/monitor.c New file
0,0 → 1,245
/*
EPS routines related to monitors.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/eps/epsimpl.h" /*I "slepceps.h" I*/
 
#undef __FUNCT__
#define __FUNCT__ "EPSMonitorSet"
/*@C
EPSMonitorSet - Sets an ADDITIONAL function to be called at every
iteration to monitor the error estimates for each requested eigenpair.
Collective on EPS
 
Input Parameters:
+ eps - eigensolver context obtained from EPSCreate()
. monitor - pointer to function (if this is PETSC_NULL, it turns off monitoring)
. mctx - [optional] context for private data for the
monitor routine (use PETSC_NULL if no context is desired)
- monitordestroy - [optional] routine that frees monitor context
(may be PETSC_NULL)
 
Calling Sequence of monitor:
$ monitor (EPS eps, int its, int nconv, PetscScalar *eigr, PetscScalar *eigi, PetscReal* errest, int nest, void *mctx)
 
+ eps - eigensolver context obtained from EPSCreate()
. its - iteration number
. nconv - number of converged eigenpairs
. eigr - real part of the eigenvalues
. eigi - imaginary part of the eigenvalues
. errest - relative error estimates for each eigenpair
. nest - number of error estimates
- mctx - optional monitoring context, as set by EPSMonitorSet()
 
Options Database Keys:
+ -eps_monitor - print error estimates at each iteration
. -eps_monitor_draw - sets line graph monitor
- -eps_monitor_cancel - cancels all monitors that have been hardwired into
a code by calls to EPSMonitorSet(), but does not cancel those set via
the options database.
 
Notes:
Several different monitoring routines may be set by calling
EPSMonitorSet() multiple times; all will be called in the
order in which they were set.
 
Level: intermediate
 
.seealso: EPSMonitorDefault(), EPSMonitorCancel()
@*/
PetscErrorCode EPSMonitorSet(EPS eps,PetscErrorCode (*monitor)(EPS,int,int,PetscScalar*,PetscScalar*,PetscReal*,int,void*),
void *mctx,PetscErrorCode (*monitordestroy)(void*))
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
if (eps->numbermonitors >= MAXEPSMONITORS) {
SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Too many EPS monitors set");
}
eps->monitor[eps->numbermonitors] = monitor;
eps->monitorcontext[eps->numbermonitors] = (void*)mctx;
eps->monitordestroy[eps->numbermonitors++] = monitordestroy;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSMonitorCancel"
/*@
EPSMonitorCancel - Clears all monitors for an EPS object.
 
Collective on EPS
 
Input Parameters:
. eps - eigensolver context obtained from EPSCreate()
 
Options Database Key:
. -eps_monitor_cancel - Cancels all monitors that have been hardwired
into a code by calls to EPSMonitorSet(),
but does not cancel those set via the options database.
 
Level: intermediate
 
.seealso: EPSMonitorSet()
@*/
PetscErrorCode EPSMonitorCancel(EPS eps)
{
PetscErrorCode ierr;
PetscInt i;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
for (i=0; i<eps->numbermonitors; i++) {
if (eps->monitordestroy[i]) {
ierr = (*eps->monitordestroy[i])(eps->monitorcontext[i]);CHKERRQ(ierr);
}
}
eps->numbermonitors = 0;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetMonitorContext"
/*@C
EPSGetMonitorContext - Gets the monitor context, as set by
EPSSetMonitor() for the FIRST monitor only.
 
Not Collective
 
Input Parameter:
. eps - eigensolver context obtained from EPSCreate()
 
Output Parameter:
. ctx - monitor context
 
Level: intermediate
 
.seealso: EPSSetMonitor(), EPSDefaultMonitor()
@*/
PetscErrorCode EPSGetMonitorContext(EPS eps, void **ctx)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
*ctx = (eps->monitorcontext[0]);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSMonitorDefault"
/*@C
EPSMonitorDefault - Print the current approximate values and
error estimates at each iteration of the eigensolver.
 
Collective on EPS
 
Input Parameters:
+ eps - eigensolver context
. its - iteration number
. nconv - number of converged eigenpairs so far
. eigr - real part of the eigenvalues
. eigi - imaginary part of the eigenvalues
. errest - error estimates
. nest - number of error estimates to display
- dummy - unused monitor context
 
Level: intermediate
 
.seealso: EPSMonitorSet()
@*/
PetscErrorCode EPSMonitorDefault(EPS eps,int its,int nconv,PetscScalar *eigr,PetscScalar *eigi,PetscReal *errest,int nest,void *dummy)
{
PetscErrorCode ierr;
int i;
PetscViewer viewer = (PetscViewer) dummy;
 
PetscFunctionBegin;
if (its) {
if (!viewer) viewer = PETSC_VIEWER_STDOUT_(eps->comm);
ierr = PetscViewerASCIIPrintf(viewer,"%3d EPS nconv=%d Values (Errors)",its,nconv);CHKERRQ(ierr);
for (i=0;i<nest;i++) {
#if defined(PETSC_USE_COMPLEX)
ierr = PetscViewerASCIIPrintf(viewer," %g%+gi",PetscRealPart(eigr[i]),PetscImaginaryPart(eigr[i]));CHKERRQ(ierr);
#else
ierr = PetscViewerASCIIPrintf(viewer," %g",eigr[i]);CHKERRQ(ierr);
if (eigi[i]!=0.0) { ierr = PetscViewerASCIIPrintf(viewer,"%+gi",eigi[i]);CHKERRQ(ierr); }
#endif
ierr = PetscViewerASCIIPrintf(viewer," (%10.8e)",errest[i]);CHKERRQ(ierr);
}
ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSMonitorLG"
PetscErrorCode EPSMonitorLG(EPS eps,int its,int nconv,PetscScalar *eigr,PetscScalar *eigi,PetscReal *errest,int nest,void *monctx)
{
PetscViewer viewer = (PetscViewer) monctx;
PetscDraw draw;
PetscDrawLG lg;
PetscErrorCode ierr;
PetscReal *x,*y;
int i,n = eps->nev;
#if !defined(PETSC_USE_COMPLEX)
int p;
PetscDraw draw1;
PetscDrawLG lg1;
#endif
 
PetscFunctionBegin;
 
if (!viewer) { viewer = PETSC_VIEWER_DRAW_(eps->comm); }
 
ierr = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr);
ierr = PetscViewerDrawGetDrawLG(viewer,0,&lg);CHKERRQ(ierr);
if (!its) {
ierr = PetscDrawSetTitle(draw,"Error estimates");CHKERRQ(ierr);
ierr = PetscDrawSetDoubleBuffer(draw);CHKERRQ(ierr);
ierr = PetscDrawLGSetDimension(lg,n);CHKERRQ(ierr);
ierr = PetscDrawLGReset(lg);CHKERRQ(ierr);
ierr = PetscDrawLGSetLimits(lg,0,1.0,log10(eps->tol)-2,0.0);CHKERRQ(ierr);
}
 
#if !defined(PETSC_USE_COMPLEX)
if (eps->ishermitian) {
ierr = PetscViewerDrawGetDraw(viewer,1,&draw1);CHKERRQ(ierr);
ierr = PetscViewerDrawGetDrawLG(viewer,1,&lg1);CHKERRQ(ierr);
if (!its) {
ierr = PetscDrawSetTitle(draw1,"Approximate eigenvalues");CHKERRQ(ierr);
ierr = PetscDrawSetDoubleBuffer(draw1);CHKERRQ(ierr);
ierr = PetscDrawLGSetDimension(lg1,n);CHKERRQ(ierr);
ierr = PetscDrawLGReset(lg1);CHKERRQ(ierr);
ierr = PetscDrawLGSetLimits(lg1,0,1.0,1.e20,-1.e20);CHKERRQ(ierr);
}
}
#endif
 
ierr = PetscMalloc(sizeof(PetscReal)*n,&x);CHKERRQ(ierr);
ierr = PetscMalloc(sizeof(PetscReal)*n,&y);CHKERRQ(ierr);
for (i=0;i<n;i++) {
x[i] = (PetscReal) its;
if (errest[i] > 0.0) y[i] = log10(errest[i]); else y[i] = 0.0;
}
ierr = PetscDrawLGAddPoint(lg,x,y);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
if (eps->ishermitian) {
ierr = PetscDrawLGAddPoint(lg1,x,eps->eigr);CHKERRQ(ierr);
ierr = PetscDrawGetPause(draw1,&p);CHKERRQ(ierr);
ierr = PetscDrawSetPause(draw1,0);CHKERRQ(ierr);
ierr = PetscDrawLGDraw(lg1);CHKERRQ(ierr);
ierr = PetscDrawSetPause(draw1,p);CHKERRQ(ierr);
}
#endif
ierr = PetscDrawLGDraw(lg);CHKERRQ(ierr);
ierr = PetscFree(x);CHKERRQ(ierr);
ierr = PetscFree(y);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
tags/slepc-2_3_3-1/src/eps/interface/monitor.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/interface/solve.c New file
0,0 → 1,1283
/*
EPS routines related to the solution process.
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/eps/epsimpl.h" /*I "slepceps.h" I*/
 
#undef __FUNCT__
#define __FUNCT__ "EPSSolve"
/*@
EPSSolve - Solves the eigensystem.
 
Collective on EPS
 
Input Parameter:
. eps - eigensolver context obtained from EPSCreate()
 
Options Database:
+ -eps_view - print information about the solver used
. -eps_view_binary - save the matrices to the default binary file
- -eps_plot_eigs - plot computed eigenvalues
 
Level: beginner
 
.seealso: EPSCreate(), EPSSetUp(), EPSDestroy(), EPSSetTolerances()
@*/
PetscErrorCode EPSSolve(EPS eps)
{
PetscErrorCode ierr;
int i;
PetscReal re,im;
PetscTruth flg;
PetscViewer viewer;
PetscDraw draw;
PetscDrawSP drawsp;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
 
ierr = PetscOptionsHasName(eps->prefix,"-eps_view_binary",&flg);CHKERRQ(ierr);
if (flg) {
Mat A,B;
ierr = STGetOperators(eps->OP,&A,&B);CHKERRQ(ierr);
ierr = MatView(A,PETSC_VIEWER_BINARY_(eps->comm));CHKERRQ(ierr);
if (B) ierr = MatView(B,PETSC_VIEWER_BINARY_(eps->comm));CHKERRQ(ierr);
}
 
/* reset the convergence flag from the previous solves */
eps->reason = EPS_CONVERGED_ITERATING;
 
if (!eps->setupcalled){ ierr = EPSSetUp(eps);CHKERRQ(ierr); }
ierr = STResetOperationCounters(eps->OP);
eps->nv = eps->ncv;
eps->evecsavailable = PETSC_FALSE;
eps->nconv = 0;
eps->its = 0;
for (i=0;i<eps->ncv;i++) eps->eigr[i]=eps->eigi[i]=eps->errest[i]=0.0;
EPSMonitor(eps,eps->its,eps->nconv,eps->eigr,eps->eigi,eps->errest,eps->nv);
 
ierr = PetscLogEventBegin(EPS_Solve,eps,eps->V[0],eps->V[0],0);CHKERRQ(ierr);
 
switch (eps->solverclass) {
case EPS_ONE_SIDE:
ierr = (*eps->ops->solve)(eps);CHKERRQ(ierr); break;
case EPS_TWO_SIDE:
if (eps->ops->solvets) {
ierr = (*eps->ops->solvets)(eps);CHKERRQ(ierr); break;
} else {
SETERRQ(1,"Two-sided version unavailable for this solver");
}
default:
SETERRQ(1,"Wrong value of eps->solverclass");
}
 
ierr = STPostSolve(eps->OP);CHKERRQ(ierr);
ierr = PetscLogEventEnd(EPS_Solve,eps,eps->V[0],eps->V[0],0);CHKERRQ(ierr);
 
if (!eps->reason) {
SETERRQ(1,"Internal error, solver returned without setting converged reason");
}
 
/* Map eigenvalues back to the original problem, necessary in some
* spectral transformations */
ierr = (*eps->ops->backtransform)(eps);CHKERRQ(ierr);
 
/* Adjust left eigenvectors in generalized problems: y = B^T y */
if (eps->isgeneralized && eps->solverclass == EPS_TWO_SIDE) {
Mat B;
KSP ksp;
Vec w;
ierr = STGetOperators(eps->OP,PETSC_NULL,&B);CHKERRQ(ierr);
ierr = KSPCreate(eps->comm,&ksp);CHKERRQ(ierr);
ierr = KSPSetOperators(ksp,B,B,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
ierr = MatGetVecs(B,PETSC_NULL,&w);CHKERRQ(ierr);
for (i=0;i<eps->nconv;i++) {
ierr = VecCopy(eps->W[i],w);CHKERRQ(ierr);
ierr = KSPSolveTranspose(ksp,w,eps->W[i]);CHKERRQ(ierr);
}
ierr = KSPDestroy(ksp);CHKERRQ(ierr);
ierr = VecDestroy(w);CHKERRQ(ierr);
}
 
#ifndef PETSC_USE_COMPLEX
/* reorder conjugate eigenvalues (positive imaginary first) */
for (i=0; i<eps->nconv-1; i++) {
if (eps->eigi[i] != 0) {
if (eps->eigi[i] < 0) {
eps->eigi[i] = -eps->eigi[i];
eps->eigi[i+1] = -eps->eigi[i+1];
ierr = VecScale(eps->V[i+1],-1.0); CHKERRQ(ierr);
}
i++;
}
}
#endif
 
/* sort eigenvalues according to eps->which parameter */
ierr = PetscFree(eps->perm);CHKERRQ(ierr);
if (eps->nconv > 0) {
ierr = PetscMalloc(sizeof(int)*eps->nconv, &eps->perm); CHKERRQ(ierr);
ierr = EPSSortEigenvalues(eps->nconv, eps->eigr, eps->eigi, eps->which, eps->nconv, eps->perm); CHKERRQ(ierr);
}
 
ierr = PetscOptionsHasName(eps->prefix,"-eps_view",&flg);CHKERRQ(ierr);
if (flg && !PetscPreLoadingOn) { ierr = EPSView(eps,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); }
 
ierr = PetscOptionsHasName(eps->prefix,"-eps_plot_eigs",&flg);CHKERRQ(ierr);
if (flg) {
ierr = PetscViewerDrawOpen(PETSC_COMM_SELF,0,"Computed Eigenvalues",
PETSC_DECIDE,PETSC_DECIDE,300,300,&viewer);CHKERRQ(ierr);
ierr = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr);
ierr = PetscDrawSPCreate(draw,1,&drawsp);CHKERRQ(ierr);
for( i=0; i<eps->nconv; i++ ) {
#if defined(PETSC_USE_COMPLEX)
re = PetscRealPart(eps->eigr[i]);
im = PetscImaginaryPart(eps->eigi[i]);
#else
re = eps->eigr[i];
im = eps->eigi[i];
#endif
ierr = PetscDrawSPAddPoint(drawsp,&re,&im);CHKERRQ(ierr);
}
ierr = PetscDrawSPDraw(drawsp);CHKERRQ(ierr);
ierr = PetscDrawSPDestroy(drawsp);CHKERRQ(ierr);
ierr = PetscViewerDestroy(viewer);CHKERRQ(ierr);
}
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetIterationNumber"
/*@
EPSGetIterationNumber - Gets the current iteration number. If the
call to EPSSolve() is complete, then it returns the number of iterations
carried out by the solution method.
Not Collective
 
Input Parameter:
. eps - the eigensolver context
 
Output Parameter:
. its - number of iterations
 
Level: intermediate
 
Note:
During the i-th iteration this call returns i-1. If EPSSolve() is
complete, then parameter "its" contains either the iteration number at
which convergence was successfully reached, or failure was detected.
Call EPSGetConvergedReason() to determine if the solver converged or
failed and why.
 
.seealso: EPSGetConvergedReason(), EPSSetTolerances()
@*/
PetscErrorCode EPSGetIterationNumber(EPS eps,int *its)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidIntPointer(its,2);
*its = eps->its;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetOperationCounters"
/*@
EPSGetOperationCounters - Gets the total number of operator applications,
inner product operations and linear iterations used by the ST object
during the last EPSSolve() call.
 
Not Collective
 
Input Parameter:
. eps - EPS context
 
Output Parameter:
+ ops - number of operator applications
. dots - number of inner product operations
- lits - number of linear iterations
 
Notes:
When the eigensolver algorithm invokes STApply() then a linear system
must be solved (except in the case of standard eigenproblems and shift
transformation). The number of iterations required in this solve is
accumulated into a counter whose value is returned by this function.
 
These counters are reset to zero at each successive call to EPSSolve().
 
Level: intermediate
 
@*/
PetscErrorCode EPSGetOperationCounters(EPS eps,int* ops,int* dots,int* lits)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
ierr = STGetOperationCounters(eps->OP,ops,lits);CHKERRQ(ierr);
if (dots) {
ierr = IPGetOperationCounters(eps->ip,dots);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetConverged"
/*@
EPSGetConverged - Gets the number of converged eigenpairs.
 
Not Collective
 
Input Parameter:
. eps - the eigensolver context
Output Parameter:
. nconv - number of converged eigenpairs
 
Note:
This function should be called after EPSSolve() has finished.
 
Level: beginner
 
.seealso: EPSSetDimensions()
@*/
PetscErrorCode EPSGetConverged(EPS eps,int *nconv)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidIntPointer(nconv,2);
*nconv = eps->nconv;
PetscFunctionReturn(0);
}
 
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetConvergedReason"
/*@C
EPSGetConvergedReason - Gets the reason why the EPSSolve() iteration was
stopped.
 
Not Collective
 
Input Parameter:
. eps - the eigensolver context
 
Output Parameter:
. reason - negative value indicates diverged, positive value converged
(see EPSConvergedReason)
 
Possible values for reason:
+ EPS_CONVERGED_TOL - converged up to tolerance
. EPS_DIVERGED_ITS - required more than its to reach convergence
. EPS_DIVERGED_BREAKDOWN - generic breakdown in method
- EPS_DIVERGED_NONSYMMETRIC - The operator is nonsymmetric
 
Level: intermediate
 
Notes: Can only be called after the call to EPSSolve() is complete.
 
.seealso: EPSSetTolerances(), EPSSolve(), EPSConvergedReason
@*/
PetscErrorCode EPSGetConvergedReason(EPS eps,EPSConvergedReason *reason)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidIntPointer(reason,2);
*reason = eps->reason;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetInvariantSubspace"
/*@
EPSGetInvariantSubspace - Gets an orthonormal basis of the computed invariant
subspace.
 
Not Collective
 
Input Parameter:
. eps - the eigensolver context
Output Parameter:
. v - an array of vectors
 
Notes:
This function should be called after EPSSolve() has finished.
 
The user should provide in v an array of nconv vectors, where nconv is
the value returned by EPSGetConverged().
 
The first k vectors returned in v span an invariant subspace associated
with the first k computed eigenvalues (note that this is not true if the
k-th eigenvalue is complex and matrix A is real; in this case the first
k+1 vectors should be used). An invariant subspace X of A satisfies Ax
in X for all x in X (a similar definition applies for generalized
eigenproblems).
 
Level: intermediate
 
.seealso: EPSGetEigenpair(), EPSGetConverged(), EPSSolve(), EPSGetLeftInvariantSubspace()
@*/
PetscErrorCode EPSGetInvariantSubspace(EPS eps, Vec *v)
{
PetscErrorCode ierr;
int i;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidPointer(v,2);
PetscValidHeaderSpecific(*v,VEC_COOKIE,2);
if (!eps->V) {
SETERRQ(PETSC_ERR_ARG_WRONGSTATE, "EPSSolve must be called first");
}
for (i=0;i<eps->nconv;i++) {
ierr = VecCopy(eps->V[i],v[i]);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetLeftInvariantSubspace"
/*@
EPSGetLeftInvariantSubspace - Gets an orthonormal basis of the computed left
invariant subspace (only available in two-sided eigensolvers).
 
Not Collective
 
Input Parameter:
. eps - the eigensolver context
Output Parameter:
. v - an array of vectors
 
Notes:
This function should be called after EPSSolve() has finished.
 
The user should provide in v an array of nconv vectors, where nconv is
the value returned by EPSGetConverged().
 
The first k vectors returned in v span a left invariant subspace associated
with the first k computed eigenvalues (note that this is not true if the
k-th eigenvalue is complex and matrix A is real; in this case the first
k+1 vectors should be used). A left invariant subspace Y of A satisfies y'A
in Y for all y in Y (a similar definition applies for generalized
eigenproblems).
 
Level: intermediate
 
.seealso: EPSGetEigenpair(), EPSGetConverged(), EPSSolve(), EPSGetInvariantSubspace
@*/
PetscErrorCode EPSGetLeftInvariantSubspace(EPS eps, Vec *v)
{
PetscErrorCode ierr;
int i;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidPointer(v,2);
PetscValidHeaderSpecific(*v,VEC_COOKIE,2);
if (!eps->W) {
if (eps->solverclass!=EPS_TWO_SIDE) {
SETERRQ(PETSC_ERR_ARG_WRONGSTATE, "Only available for two-sided solvers");
} else {
SETERRQ(PETSC_ERR_ARG_WRONGSTATE, "EPSSolve must be called first");
}
}
for (i=0;i<eps->nconv;i++) {
ierr = VecCopy(eps->W[i],v[i]);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetEigenpair"
/*@
EPSGetEigenpair - Gets the i-th solution of the eigenproblem as computed by
EPSSolve(). The solution consists in both the eigenvalue and the eigenvector.
 
Not Collective
 
Input Parameters:
+ eps - eigensolver context
- i - index of the solution
 
Output Parameters:
+ eigr - real part of eigenvalue
. eigi - imaginary part of eigenvalue
. Vr - real part of eigenvector
- Vi - imaginary part of eigenvector
 
Notes:
If the eigenvalue is real, then eigi and Vi are set to zero. If PETSc is
configured with complex scalars the eigenvalue is stored
directly in eigr (eigi is set to zero) and the eigenvector in Vr (Vi is
set to zero).
 
The index i should be a value between 0 and nconv-1 (see EPSGetConverged()).
Eigenpairs are indexed according to the ordering criterion established
with EPSSetWhichEigenpairs().
 
Level: beginner
 
.seealso: EPSGetValue(), EPSGetRightVector(), EPSGetLeftVector(), EPSSolve(),
EPSGetConverged(), EPSSetWhichEigenpairs(), EPSGetInvariantSubspace()
@*/
PetscErrorCode EPSGetEigenpair(EPS eps, int i, PetscScalar *eigr, PetscScalar *eigi, Vec Vr, Vec Vi)
{
PetscErrorCode ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
if (!eps->eigr || !eps->eigi || !eps->V) {
SETERRQ(PETSC_ERR_ARG_WRONGSTATE, "EPSSolve must be called first");
}
if (i<0 || i>=eps->nconv) {
SETERRQ(PETSC_ERR_ARG_OUTOFRANGE, "Argument 2 out of range");
}
ierr = EPSGetValue(eps,i,eigr,eigi);CHKERRQ(ierr);
ierr = EPSGetRightVector(eps,i,Vr,Vi);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetValue"
/*@
EPSGetValue - Gets the i-th eigenvalue as computed by EPSSolve().
 
Not Collective
 
Input Parameters:
+ eps - eigensolver context
- i - index of the solution
 
Output Parameters:
+ eigr - real part of eigenvalue
- eigi - imaginary part of eigenvalue
 
Notes:
If the eigenvalue is real, then eigi is set to zero. If PETSc is
configured with complex scalars the eigenvalue is stored
directly in eigr (eigi is set to zero).
 
The index i should be a value between 0 and nconv-1 (see EPSGetConverged()).
Eigenpairs are indexed according to the ordering criterion established
with EPSSetWhichEigenpairs().
 
Level: beginner
 
.seealso: EPSSolve(), EPSGetConverged(), EPSSetWhichEigenpairs(),
EPSGetEigenpair()
@*/
PetscErrorCode EPSGetValue(EPS eps, int i, PetscScalar *eigr, PetscScalar *eigi)
{
int k;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
if (!eps->eigr || !eps->eigi) {
SETERRQ(PETSC_ERR_ARG_WRONGSTATE, "EPSSolve must be called first");
}
if (i<0 || i>=eps->nconv) {
SETERRQ(PETSC_ERR_ARG_OUTOFRANGE, "Argument 2 out of range");
}
 
if (!eps->perm) k = i;
else k = eps->perm[i];
#ifdef PETSC_USE_COMPLEX
if (eigr) *eigr = eps->eigr[k];
if (eigi) *eigi = 0;
#else
if (eigr) *eigr = eps->eigr[k];
if (eigi) *eigi = eps->eigi[k];
#endif
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetRightVector"
/*@
EPSGetRightVector - Gets the i-th right eigenvector as computed by EPSSolve().
 
Not Collective
 
Input Parameters:
+ eps - eigensolver context
- i - index of the solution
 
Output Parameters:
+ Vr - real part of eigenvector
- Vi - imaginary part of eigenvector
 
Notes:
If the corresponding eigenvalue is real, then Vi is set to zero. If PETSc is
configured with complex scalars the eigenvector is stored
directly in Vr (Vi is set to zero).
 
The index i should be a value between 0 and nconv-1 (see EPSGetConverged()).
Eigenpairs are indexed according to the ordering criterion established
with EPSSetWhichEigenpairs().
 
Level: beginner
 
.seealso: EPSSolve(), EPSGetConverged(), EPSSetWhichEigenpairs(),
EPSGetEigenpair(), EPSGetLeftVector()
@*/
PetscErrorCode EPSGetRightVector(EPS eps, int i, Vec Vr, Vec Vi)
{
PetscErrorCode ierr;
int k;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
if (!eps->V) {
SETERRQ(PETSC_ERR_ARG_WRONGSTATE, "EPSSolve must be called first");
}
if (i<0 || i>=eps->nconv) {
SETERRQ(PETSC_ERR_ARG_OUTOFRANGE, "Argument 2 out of range");
}
if (!eps->evecsavailable && (Vr || Vi) ) {
ierr = (*eps->ops->computevectors)(eps);CHKERRQ(ierr);
}
 
if (!eps->perm) k = i;
else k = eps->perm[i];
#ifdef PETSC_USE_COMPLEX
if (Vr) { ierr = VecCopy(eps->AV[k], Vr); CHKERRQ(ierr); }
if (Vi) { ierr = VecSet(Vi,0.0); CHKERRQ(ierr); }
#else
if (eps->eigi[k] > 0) { /* first value of conjugate pair */
if (Vr) { ierr = VecCopy(eps->AV[k], Vr); CHKERRQ(ierr); }
if (Vi) { ierr = VecCopy(eps->AV[k+1], Vi); CHKERRQ(ierr); }
} else if (eps->eigi[k] < 0) { /* second value of conjugate pair */
if (Vr) { ierr = VecCopy(eps->AV[k-1], Vr); CHKERRQ(ierr); }
if (Vi) {
ierr = VecCopy(eps->AV[k], Vi); CHKERRQ(ierr);
ierr = VecScale(Vi,-1.0); CHKERRQ(ierr);
}
} else { /* real eigenvalue */
if (Vr) { ierr = VecCopy(eps->AV[k], Vr); CHKERRQ(ierr); }
if (Vi) { ierr = VecSet(Vi,0.0); CHKERRQ(ierr); }
}
#endif
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetLeftVector"
/*@
EPSGetLeftVector - Gets the i-th left eigenvector as computed by EPSSolve()
(only available in two-sided eigensolvers).
 
Not Collective
 
Input Parameters:
+ eps - eigensolver context
- i - index of the solution
 
Output Parameters:
+ Wr - real part of eigenvector
- Wi - imaginary part of eigenvector
 
Notes:
If the corresponding eigenvalue is real, then Wi is set to zero. If PETSc is
configured with complex scalars the eigenvector is stored
directly in Wr (Wi is set to zero).
 
The index i should be a value between 0 and nconv-1 (see EPSGetConverged()).
Eigenpairs are indexed according to the ordering criterion established
with EPSSetWhichEigenpairs().
 
Level: beginner
 
.seealso: EPSSolve(), EPSGetConverged(), EPSSetWhichEigenpairs(),
EPSGetEigenpair(), EPSGetLeftVector()
@*/
PetscErrorCode EPSGetLeftVector(EPS eps, int i, Vec Wr, Vec Wi)
{
PetscErrorCode ierr;
int k;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
if (!eps->W) {
if (eps->solverclass!=EPS_TWO_SIDE) {
SETERRQ(PETSC_ERR_ARG_WRONGSTATE, "Only available for two-sided solvers");
} else {
SETERRQ(PETSC_ERR_ARG_WRONGSTATE, "EPSSolve must be called first");
}
}
if (i<0 || i>=eps->nconv) {
SETERRQ(PETSC_ERR_ARG_OUTOFRANGE, "Argument 2 out of range");
}
if (!eps->evecsavailable && (Wr || Wi) ) {
ierr = (*eps->ops->computevectors)(eps);CHKERRQ(ierr);
}
 
if (!eps->perm) k = i;
else k = eps->perm[i];
#ifdef PETSC_USE_COMPLEX
if (Wr) { ierr = VecCopy(eps->AW[k], Wr); CHKERRQ(ierr); }
if (Wi) { ierr = VecSet(Wi,0.0); CHKERRQ(ierr); }
#else
if (eps->eigi[k] > 0) { /* first value of conjugate pair */
if (Wr) { ierr = VecCopy(eps->AW[k], Wr); CHKERRQ(ierr); }
if (Wi) { ierr = VecCopy(eps->AW[k+1], Wi); CHKERRQ(ierr); }
} else if (eps->eigi[k] < 0) { /* second value of conjugate pair */
if (Wr) { ierr = VecCopy(eps->AW[k-1], Wr); CHKERRQ(ierr); }
if (Wi) {
ierr = VecCopy(eps->AW[k], Wi); CHKERRQ(ierr);
ierr = VecScale(Wi,-1.0); CHKERRQ(ierr);
}
} else { /* real eigenvalue */
if (Wr) { ierr = VecCopy(eps->AW[k], Wr); CHKERRQ(ierr); }
if (Wi) { ierr = VecSet(Wi,0.0); CHKERRQ(ierr); }
}
#endif
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetErrorEstimate"
/*@
EPSGetErrorEstimate - Returns the error estimate associated to the i-th
computed eigenpair.
 
Not Collective
 
Input Parameter:
+ eps - eigensolver context
- i - index of eigenpair
 
Output Parameter:
. errest - the error estimate
 
Notes:
This is the error estimate used internally by the eigensolver. The actual
error bound can be computed with EPSComputeRelativeError(). See also the user's
manual for details.
 
Level: advanced
 
.seealso: EPSComputeRelativeError()
@*/
PetscErrorCode EPSGetErrorEstimate(EPS eps, int i, PetscReal *errest)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
if (!eps->eigr || !eps->eigi) {
SETERRQ(PETSC_ERR_ARG_WRONGSTATE, "EPSSolve must be called first");
}
if (i<0 || i>=eps->nconv) {
SETERRQ(PETSC_ERR_ARG_OUTOFRANGE, "Argument 2 out of range");
}
if (eps->perm) i = eps->perm[i];
if (errest) *errest = eps->errest[i];
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetErrorEstimateLeft"
/*@
EPSGetErrorEstimateLeft - Returns the left error estimate associated to the i-th
computed eigenpair (only available in two-sided eigensolvers).
 
Not Collective
 
Input Parameter:
+ eps - eigensolver context
- i - index of eigenpair
 
Output Parameter:
. errest - the left error estimate
 
Notes:
This is the error estimate used internally by the eigensolver. The actual
error bound can be computed with EPSComputeRelativeErrorLeft(). See also the user's
manual for details.
 
Level: advanced
 
.seealso: EPSComputeRelativeErrorLeft()
@*/
PetscErrorCode EPSGetErrorEstimateLeft(EPS eps, int i, PetscReal *errest)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
if (!eps->eigr || !eps->eigi) {
SETERRQ(PETSC_ERR_ARG_WRONGSTATE, "EPSSolve must be called first");
}
if (eps->solverclass!=EPS_TWO_SIDE) {
SETERRQ(PETSC_ERR_ARG_WRONGSTATE, "Only available for two-sided solvers");
}
if (i<0 || i>=eps->nconv) {
SETERRQ(PETSC_ERR_ARG_OUTOFRANGE, "Argument 2 out of range");
}
if (eps->perm) i = eps->perm[i];
if (errest) *errest = eps->errest_left[i];
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSComputeResidualNorm"
/*@
EPSComputeResidualNorm - Computes the norm of the residual vector associated with
the i-th computed eigenpair.
 
Collective on EPS
 
Input Parameter:
. eps - the eigensolver context
. i - the solution index
 
Output Parameter:
. norm - the residual norm, computed as ||Ax-kBx||_2 where k is the
eigenvalue and x is the eigenvector.
If k=0 then the residual norm is computed as ||Ax||_2.
 
Notes:
The index i should be a value between 0 and nconv-1 (see EPSGetConverged()).
Eigenpairs are indexed according to the ordering criterion established
with EPSSetWhichEigenpairs().
 
Level: beginner
 
.seealso: EPSSolve(), EPSGetConverged(), EPSSetWhichEigenpairs()
@*/
PetscErrorCode EPSComputeResidualNorm(EPS eps, int i, PetscReal *norm)
{
PetscErrorCode ierr;
Vec u, v, w, xr, xi;
Mat A, B;
PetscScalar kr, ki;
#ifndef PETSC_USE_COMPLEX
PetscReal ni, nr;
#endif
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
ierr = STGetOperators(eps->OP,&A,&B);CHKERRQ(ierr);
ierr = VecDuplicate(eps->vec_initial,&u); CHKERRQ(ierr);
ierr = VecDuplicate(eps->vec_initial,&v); CHKERRQ(ierr);
ierr = VecDuplicate(eps->vec_initial,&w); CHKERRQ(ierr);
ierr = VecDuplicate(eps->vec_initial,&xr); CHKERRQ(ierr);
ierr = VecDuplicate(eps->vec_initial,&xi); CHKERRQ(ierr);
ierr = EPSGetEigenpair(eps,i,&kr,&ki,xr,xi); CHKERRQ(ierr);
 
#ifndef PETSC_USE_COMPLEX
if (ki == 0 ||
PetscAbsScalar(ki) < PetscAbsScalar(kr*PETSC_MACHINE_EPSILON)) {
#endif
ierr = MatMult( A, xr, u ); CHKERRQ(ierr); /* u=A*x */
if (PetscAbsScalar(kr) > PETSC_MACHINE_EPSILON) {
if (eps->isgeneralized) { ierr = MatMult( B, xr, w ); CHKERRQ(ierr); }
else { ierr = VecCopy( xr, w ); CHKERRQ(ierr); } /* w=B*x */
ierr = VecAXPY( u, -kr, w ); CHKERRQ(ierr); /* u=A*x-k*B*x */
}
ierr = VecNorm( u, NORM_2, norm); CHKERRQ(ierr);
#ifndef PETSC_USE_COMPLEX
} else {
ierr = MatMult( A, xr, u ); CHKERRQ(ierr); /* u=A*xr */
if (eps->isgeneralized) { ierr = MatMult( B, xr, v ); CHKERRQ(ierr); }
else { ierr = VecCopy( xr, v ); CHKERRQ(ierr); } /* v=B*xr */
ierr = VecAXPY( u, -kr, v ); CHKERRQ(ierr); /* u=A*xr-kr*B*xr */
if (eps->isgeneralized) { ierr = MatMult( B, xi, w ); CHKERRQ(ierr); }
else { ierr = VecCopy( xi, w ); CHKERRQ(ierr); } /* w=B*xi */
ierr = VecAXPY( u, ki, w ); CHKERRQ(ierr); /* u=A*xr-kr*B*xr+ki*B*xi */
ierr = VecNorm( u, NORM_2, &nr ); CHKERRQ(ierr);
ierr = MatMult( A, xi, u ); CHKERRQ(ierr); /* u=A*xi */
ierr = VecAXPY( u, -kr, w ); CHKERRQ(ierr); /* u=A*xi-kr*B*xi */
ierr = VecAXPY( u, -ki, v ); CHKERRQ(ierr); /* u=A*xi-kr*B*xi-ki*B*xr */
ierr = VecNorm( u, NORM_2, &ni ); CHKERRQ(ierr);
*norm = SlepcAbsEigenvalue( nr, ni );
}
#endif
 
ierr = VecDestroy(w); CHKERRQ(ierr);
ierr = VecDestroy(v); CHKERRQ(ierr);
ierr = VecDestroy(u); CHKERRQ(ierr);
ierr = VecDestroy(xr); CHKERRQ(ierr);
ierr = VecDestroy(xi); CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSComputeResidualNormLeft"
/*@
EPSComputeResidualNormLeft - Computes the norm of the residual vector associated with
the i-th computed left eigenvector (only available in two-sided eigensolvers).
 
Collective on EPS
 
Input Parameter:
. eps - the eigensolver context
. i - the solution index
 
Output Parameter:
. norm - the residual norm, computed as ||y'A-ky'B||_2 where k is the
eigenvalue and y is the left eigenvector.
If k=0 then the residual norm is computed as ||y'A||_2.
 
Notes:
The index i should be a value between 0 and nconv-1 (see EPSGetConverged()).
Eigenpairs are indexed according to the ordering criterion established
with EPSSetWhichEigenpairs().
 
Level: beginner
 
.seealso: EPSSolve(), EPSGetConverged(), EPSSetWhichEigenpairs()
@*/
PetscErrorCode EPSComputeResidualNormLeft(EPS eps, int i, PetscReal *norm)
{
PetscErrorCode ierr;
Vec u, v, w, xr, xi;
Mat A, B;
PetscScalar kr, ki;
#ifndef PETSC_USE_COMPLEX
PetscReal ni, nr;
#endif
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
ierr = STGetOperators(eps->OP,&A,&B);CHKERRQ(ierr);
ierr = VecDuplicate(eps->vec_initial_left,&u); CHKERRQ(ierr);
ierr = VecDuplicate(eps->vec_initial_left,&v); CHKERRQ(ierr);
ierr = VecDuplicate(eps->vec_initial_left,&w); CHKERRQ(ierr);
ierr = VecDuplicate(eps->vec_initial_left,&xr); CHKERRQ(ierr);
ierr = VecDuplicate(eps->vec_initial_left,&xi); CHKERRQ(ierr);
ierr = EPSGetValue(eps,i,&kr,&ki); CHKERRQ(ierr);
ierr = EPSGetLeftVector(eps,i,xr,xi); CHKERRQ(ierr);
 
#ifndef PETSC_USE_COMPLEX
if (ki == 0 ||
PetscAbsScalar(ki) < PetscAbsScalar(kr*PETSC_MACHINE_EPSILON)) {
#endif
ierr = MatMultTranspose( A, xr, u ); CHKERRQ(ierr); /* u=A'*x */
if (PetscAbsScalar(kr) > PETSC_MACHINE_EPSILON) {
if (eps->isgeneralized) { ierr = MatMultTranspose( B, xr, w ); CHKERRQ(ierr); }
else { ierr = VecCopy( xr, w ); CHKERRQ(ierr); } /* w=B'*x */
ierr = VecAXPY( u, -kr, w); CHKERRQ(ierr); /* u=A'*x-k*B'*x */
}
ierr = VecNorm( u, NORM_2, norm); CHKERRQ(ierr);
#ifndef PETSC_USE_COMPLEX
} else {
ierr = MatMultTranspose( A, xr, u ); CHKERRQ(ierr); /* u=A'*xr */
if (eps->isgeneralized) { ierr = MatMultTranspose( B, xr, v ); CHKERRQ(ierr); }
else { ierr = VecCopy( xr, v ); CHKERRQ(ierr); } /* v=B'*xr */
ierr = VecAXPY( u, -kr, v ); CHKERRQ(ierr); /* u=A'*xr-kr*B'*xr */
if (eps->isgeneralized) { ierr = MatMultTranspose( B, xi, w ); CHKERRQ(ierr); }
else { ierr = VecCopy( xi, w ); CHKERRQ(ierr); } /* w=B'*xi */
ierr = VecAXPY( u, ki, w ); CHKERRQ(ierr); /* u=A'*xr-kr*B'*xr+ki*B'*xi */
ierr = VecNorm( u, NORM_2, &nr ); CHKERRQ(ierr);
ierr = MatMultTranspose( A, xi, u ); CHKERRQ(ierr); /* u=A'*xi */
ierr = VecAXPY( u, -kr, w ); CHKERRQ(ierr); /* u=A'*xi-kr*B'*xi */
ierr = VecAXPY( u, -ki, v ); CHKERRQ(ierr); /* u=A'*xi-kr*B'*xi-ki*B'*xr */
ierr = VecNorm( u, NORM_2, &ni ); CHKERRQ(ierr);
*norm = SlepcAbsEigenvalue( nr, ni );
}
#endif
 
ierr = VecDestroy(w); CHKERRQ(ierr);
ierr = VecDestroy(v); CHKERRQ(ierr);
ierr = VecDestroy(u); CHKERRQ(ierr);
ierr = VecDestroy(xr); CHKERRQ(ierr);
ierr = VecDestroy(xi); CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSComputeRelativeError"
/*@
EPSComputeRelativeError - Computes the relative error bound associated
with the i-th computed eigenpair.
 
Collective on EPS
 
Input Parameter:
. eps - the eigensolver context
. i - the solution index
 
Output Parameter:
. error - the relative error bound, computed as ||Ax-kBx||_2/||kx||_2 where
k is the eigenvalue and x is the eigenvector.
If k=0 the relative error is computed as ||Ax||_2/||x||_2.
 
Level: beginner
 
.seealso: EPSSolve(), EPSComputeResidualNorm(), EPSGetErrorEstimate()
@*/
PetscErrorCode EPSComputeRelativeError(EPS eps, int i, PetscReal *error)
{
PetscErrorCode ierr;
Vec xr, xi;
PetscScalar kr, ki;
PetscReal norm, er;
#ifndef PETSC_USE_COMPLEX
Vec u;
PetscReal ei;
#endif
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
ierr = EPSComputeResidualNorm(eps,i,&norm); CHKERRQ(ierr);
ierr = VecDuplicate(eps->vec_initial,&xr); CHKERRQ(ierr);
ierr = VecDuplicate(eps->vec_initial,&xi); CHKERRQ(ierr);
ierr = EPSGetEigenpair(eps,i,&kr,&ki,xr,xi); CHKERRQ(ierr);
 
#ifndef PETSC_USE_COMPLEX
if (ki == 0 ||
PetscAbsScalar(ki) < PetscAbsScalar(kr*PETSC_MACHINE_EPSILON)) {
#endif
ierr = VecNorm(xr, NORM_2, &er); CHKERRQ(ierr);
if (PetscAbsScalar(kr) > norm) {
*error = norm / (PetscAbsScalar(kr) * er);
} else {
*error = norm / er;
}
#ifndef PETSC_USE_COMPLEX
} else {
if (SlepcAbsEigenvalue(kr,ki) > norm) {
ierr = VecDuplicate(xi, &u); CHKERRQ(ierr);
ierr = VecCopy(xi, u); CHKERRQ(ierr);
ierr = VecAXPBY(u, kr, -ki, xr); CHKERRQ(ierr);
ierr = VecNorm(u, NORM_2, &er); CHKERRQ(ierr);
ierr = VecAXPBY(xi, kr, ki, xr); CHKERRQ(ierr);
ierr = VecNorm(xi, NORM_2, &ei); CHKERRQ(ierr);
ierr = VecDestroy(u); CHKERRQ(ierr);
} else {
ierr = VecDot(xr, xr, &er); CHKERRQ(ierr);
ierr = VecDot(xi, xi, &ei); CHKERRQ(ierr);
}
*error = norm / SlepcAbsEigenvalue(er, ei);
}
#endif
ierr = VecDestroy(xr); CHKERRQ(ierr);
ierr = VecDestroy(xi); CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSComputeRelativeErrorLeft"
/*@
EPSComputeRelativeErrorLeft - Computes the relative error bound associated
with the i-th computed eigenvalue and left eigenvector (only available in
two-sided eigensolvers).
 
Collective on EPS
 
Input Parameter:
. eps - the eigensolver context
. i - the solution index
 
Output Parameter:
. error - the relative error bound, computed as ||y'A-ky'B||_2/||ky||_2 where
k is the eigenvalue and y is the left eigenvector.
If k=0 the relative error is computed as ||y'A||_2/||y||_2.
 
Level: beginner
 
.seealso: EPSSolve(), EPSComputeResidualNormLeft(), EPSGetErrorEstimateLeft()
@*/
PetscErrorCode EPSComputeRelativeErrorLeft(EPS eps, int i, PetscReal *error)
{
PetscErrorCode ierr;
Vec xr, xi;
PetscScalar kr, ki;
PetscReal norm, er;
#ifndef PETSC_USE_COMPLEX
Vec u;
PetscReal ei;
#endif
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
ierr = EPSComputeResidualNormLeft(eps,i,&norm); CHKERRQ(ierr);
ierr = VecDuplicate(eps->vec_initial_left,&xr); CHKERRQ(ierr);
ierr = VecDuplicate(eps->vec_initial_left,&xi); CHKERRQ(ierr);
ierr = EPSGetValue(eps,i,&kr,&ki); CHKERRQ(ierr);
ierr = EPSGetLeftVector(eps,i,xr,xi); CHKERRQ(ierr);
 
#ifndef PETSC_USE_COMPLEX
if (ki == 0 ||
PetscAbsScalar(ki) < PetscAbsScalar(kr*PETSC_MACHINE_EPSILON)) {
#endif
ierr = VecNorm(xr, NORM_2, &er); CHKERRQ(ierr);
if (PetscAbsScalar(kr) > PETSC_MACHINE_EPSILON) {
*error = norm / (PetscAbsScalar(kr) * er);
} else {
*error = norm / er;
}
#ifndef PETSC_USE_COMPLEX
} else {
ierr = VecDuplicate(xi, &u); CHKERRQ(ierr);
ierr = VecCopy(xi, u); CHKERRQ(ierr);
ierr = VecAXPBY(u, kr, -ki, xr); CHKERRQ(ierr);
ierr = VecNorm(u, NORM_2, &er); CHKERRQ(ierr);
ierr = VecAXPBY(xi, kr, ki, xr); CHKERRQ(ierr);
ierr = VecNorm(xi, NORM_2, &ei); CHKERRQ(ierr);
ierr = VecDestroy(u); CHKERRQ(ierr);
*error = norm / SlepcAbsEigenvalue(er, ei);
}
#endif
ierr = VecDestroy(xr); CHKERRQ(ierr);
ierr = VecDestroy(xi); CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#define SWAP(a,b,t) {t=a;a=b;b=t;}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSortEigenvalues"
/*@
EPSSortEigenvalues - Sorts a list of eigenvalues according to a certain
criterion.
 
Not Collective
 
Input Parameters:
+ n - number of eigenvalue in the list
. eig - pointer to the array containing the eigenvalues
. eigi - imaginary part of the eigenvalues (only when using real numbers)
. which - sorting criterion
- nev - number of wanted eigenvalues
 
Output Parameter:
. permout - resulting permutation
 
Notes:
The result is a list of indices in the original eigenvalue array
corresponding to the first nev eigenvalues sorted in the specified
criterion
 
Level: developer
 
.seealso: EPSDenseNHEPSorted(), EPSSetWhichEigenpairs()
@*/
PetscErrorCode EPSSortEigenvalues(int n,PetscScalar *eig,PetscScalar *eigi,EPSWhich which,int nev,int *permout)
{
PetscErrorCode ierr;
int i;
PetscInt *perm;
PetscReal *values;
 
PetscFunctionBegin;
ierr = PetscMalloc(n*sizeof(PetscInt),&perm);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscReal),&values);CHKERRQ(ierr);
for (i=0; i<n; i++) { perm[i] = i;}
 
switch(which) {
case EPS_LARGEST_MAGNITUDE:
case EPS_SMALLEST_MAGNITUDE:
for (i=0; i<n; i++) { values[i] = SlepcAbsEigenvalue(eig[i],eigi[i]); }
break;
case EPS_LARGEST_REAL:
case EPS_SMALLEST_REAL:
for (i=0; i<n; i++) { values[i] = PetscRealPart(eig[i]); }
break;
case EPS_LARGEST_IMAGINARY:
case EPS_SMALLEST_IMAGINARY:
#if defined(PETSC_USE_COMPLEX)
for (i=0; i<n; i++) { values[i] = PetscImaginaryPart(eig[i]); }
#else
for (i=0; i<n; i++) { values[i] = PetscAbsReal(eigi[i]); }
#endif
break;
default: SETERRQ(1,"Wrong value of which");
}
 
ierr = PetscSortRealWithPermutation(n,values,perm);CHKERRQ(ierr);
 
switch(which) {
case EPS_LARGEST_MAGNITUDE:
case EPS_LARGEST_REAL:
case EPS_LARGEST_IMAGINARY:
for (i=0; i<nev; i++) { permout[i] = perm[n-1-i]; }
break;
case EPS_SMALLEST_MAGNITUDE:
case EPS_SMALLEST_REAL:
case EPS_SMALLEST_IMAGINARY:
for (i=0; i<nev; i++) { permout[i] = perm[i]; }
break;
default: SETERRQ(1,"Wrong value of which");
}
 
#if !defined(PETSC_USE_COMPLEX)
for (i=0; i<nev-1; i++) {
if (eigi[permout[i]] != 0.0) {
if (eig[permout[i]] == eig[permout[i+1]] &&
eigi[permout[i]] == -eigi[permout[i+1]] &&
eigi[permout[i]] < 0.0) {
int tmp;
SWAP(permout[i], permout[i+1], tmp);
}
i++;
}
}
#endif
 
ierr = PetscFree(values);CHKERRQ(ierr);
ierr = PetscFree(perm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetStartVector"
/*@
EPSGetStartVector - Gets a vector to be used as the starting vector
in an Arnoldi or Lanczos reduction.
 
Collective on EPS and Vec
 
Input Parameters:
+ eps - the eigensolver context
- i - index of the Arnoldi/Lanczos step
 
Output Parameters:
+ vec - the start vector
- breakdown - flag indicating that a breakdown has occurred
 
Notes:
The start vector is computed from another vector: for the first step (i=0),
the initial vector is used (see EPSGetInitialVector()); otherwise a random
vector is created. Then this vector is forced to be in the range of OP (only
for generalized definite problems) and orthonormalized with respect to all
V-vectors up to i-1.
 
The flag breakdown is set to true if either i=0 and the vector belongs to the
deflation space, or i>0 and the vector is linearly dependent with respect
to the V-vectors.
 
The caller must pass a vector already allocated with dimensions conforming
to the initial vector. This vector is overwritten.
 
Level: developer
 
.seealso: EPSGetInitialVector()
 
@*/
PetscErrorCode EPSGetStartVector(EPS eps,int i,Vec vec,PetscTruth *breakdown)
{
PetscErrorCode ierr;
PetscReal norm;
PetscTruth lindep;
Vec w;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidHeaderSpecific(vec,VEC_COOKIE,3);
 
/* For the first step, use the initial vector, otherwise a random one */
if (i==0) {
w = eps->vec_initial;
} else {
ierr = VecDuplicate(eps->vec_initial,&w);CHKERRQ(ierr);
ierr = SlepcVecSetRandom(w);CHKERRQ(ierr);
}
 
/* Force the vector to be in the range of OP for definite generalized problems */
if (eps->ispositive) {
ierr = STApply(eps->OP,w,vec);CHKERRQ(ierr);
} else {
ierr = VecCopy(w,vec);CHKERRQ(ierr);
}
 
/* Orthonormalize the vector with respect to previous vectors */
ierr = IPOrthogonalize(eps->ip,i+eps->nds,PETSC_NULL,eps->DSV,vec,PETSC_NULL,&norm,&lindep,PETSC_NULL);CHKERRQ(ierr);
if (breakdown) *breakdown = lindep;
else if (lindep || norm == 0.0) {
if (i==0) { SETERRQ(1,"Initial vector is zero or belongs to the deflation space"); }
else { SETERRQ(1,"Unable to generate more start vectors"); }
}
ierr = VecScale(vec,1/norm);CHKERRQ(ierr);
 
if (i!=0) {
ierr = VecDestroy(w);CHKERRQ(ierr);
}
 
PetscFunctionReturn(0);
}
#undef __FUNCT__
#define __FUNCT__ "EPSGetLeftStartVector"
/*@
EPSGetLeftStartVector - Gets a vector to be used as the starting vector
in the left recurrence of a two-sided eigensolver.
 
Collective on EPS and Vec
 
Input Parameters:
+ eps - the eigensolver context
- i - index of the Arnoldi/Lanczos step
 
Output Parameter:
. vec - the start vector
 
Notes:
The start vector is computed from another vector: for the first step (i=0),
the left initial vector is used (see EPSGetLeftInitialVector()); otherwise
a random vector is created. Then this vector is forced to be in the range
of OP' and orthonormalized with respect to all W-vectors up to i-1.
 
The caller must pass a vector already allocated with dimensions conforming
to the left initial vector. This vector is overwritten.
 
Level: developer
 
.seealso: EPSGetLeftInitialVector()
 
@*/
PetscErrorCode EPSGetLeftStartVector(EPS eps,int i,Vec vec)
{
PetscErrorCode ierr;
PetscTruth breakdown;
PetscReal norm;
Vec w;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
PetscValidHeaderSpecific(vec,VEC_COOKIE,3);
 
/* For the first step, use the initial vector, otherwise a random one */
if (i==0) {
w = eps->vec_initial_left;
}
else {
ierr = VecDuplicate(eps->vec_initial_left,&w);CHKERRQ(ierr);
ierr = SlepcVecSetRandom(w);CHKERRQ(ierr);
}
 
/* Force the vector to be in the range of OP */
ierr = STApplyTranspose(eps->OP,w,vec);CHKERRQ(ierr);
 
/* Orthonormalize the vector with respect to previous vectors */
ierr = IPOrthogonalize(eps->ip,i,PETSC_NULL,eps->W,vec,PETSC_NULL,&norm,&breakdown,PETSC_NULL);CHKERRQ(ierr);
if (breakdown) {
if (i==0) { SETERRQ(1,"Left initial vector is zero"); }
else { SETERRQ(1,"Unable to generate more left start vectors"); }
}
ierr = VecScale(vec,1/norm);CHKERRQ(ierr);
 
if (i!=0) {
ierr = VecDestroy(w);CHKERRQ(ierr);
}
 
PetscFunctionReturn(0);
}
 
tags/slepc-2_3_3-1/src/eps/interface/solve.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/interface/makefile New file
0,0 → 1,26
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
ALL: lib
 
CFLAGS =
FFLAGS =
SOURCEC = monitor.c basic.c default.c itregis.c opts.c setup.c solve.c dense.c mem.c
SOURCEF =
SOURCEH =
OBJSC = monitor.o basic.o default.o itregis.o opts.o setup.o solve.o dense.o mem.o
LIBBASE = libslepc
DIRS =
MANSEC = EPS
LOCDIR = src/eps/interface/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
tags/slepc-2_3_3-1/src/eps/interface/makefile Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/impls/trlan/trlan.c New file
0,0 → 1,166
/*
This file implements a wrapper to the TRLAN package
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/eps/impls/trlan/trlanp.h"
 
/* Nasty global variable to access EPS data from TRLan_ */
static EPS globaleps;
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetUp_TRLAN"
PetscErrorCode EPSSetUp_TRLAN(EPS eps)
{
PetscErrorCode ierr;
PetscInt n;
EPS_TRLAN *tr = (EPS_TRLAN *)eps->data;
 
PetscFunctionBegin;
ierr = VecGetSize(eps->vec_initial,&n);CHKERRQ(ierr);
if (eps->ncv) {
if (eps->ncv<eps->nev) SETERRQ(1,"The value of ncv must be at least nev");
}
else eps->ncv = eps->nev;
if (!eps->max_it) eps->max_it = PetscMax(1000,n);
if (!eps->ishermitian)
SETERRQ(PETSC_ERR_SUP,"Requested method is only available for Hermitian problems");
 
if (eps->isgeneralized)
SETERRQ(PETSC_ERR_SUP,"Requested method is not available for generalized problems");
 
tr->restart = 0;
ierr = VecGetLocalSize(eps->vec_initial,&n); CHKERRQ(ierr);
tr->maxlan = eps->nev+PetscMin(eps->nev,6);
if (tr->maxlan+1-eps->ncv<=0) tr->lwork = tr->maxlan*(tr->maxlan+10);
else tr->lwork = n*(tr->maxlan+1-eps->ncv) + tr->maxlan*(tr->maxlan+10);
ierr = PetscMalloc(tr->lwork*sizeof(PetscReal),&tr->work);CHKERRQ(ierr);
 
ierr = EPSAllocateSolutionContiguous(eps);CHKERRQ(ierr);
ierr = EPSDefaultGetWork(eps,1);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "MatMult_TRLAN"
static int MatMult_TRLAN(int *n,int *m,PetscReal *xin,int *ldx,PetscReal *yout,int *ldy)
{
PetscErrorCode ierr;
Vec x,y;
int i;
 
PetscFunctionBegin;
ierr = VecCreateMPIWithArray(globaleps->comm,*n,PETSC_DECIDE,PETSC_NULL,&x);CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(globaleps->comm,*n,PETSC_DECIDE,PETSC_NULL,&y);CHKERRQ(ierr);
for (i=0;i<*m;i++) {
ierr = VecPlaceArray(x,(PetscScalar*)xin+i*(*ldx));CHKERRQ(ierr);
ierr = VecPlaceArray(y,(PetscScalar*)yout+i*(*ldy));CHKERRQ(ierr);
ierr = STApply(globaleps->OP,x,y);CHKERRQ(ierr);
ierr = IPOrthogonalize(globaleps->ip,globaleps->nds,PETSC_NULL,globaleps->DS,y,PETSC_NULL,PETSC_NULL,PETSC_NULL,globaleps->work[0]);CHKERRQ(ierr);
ierr = VecResetArray(x);CHKERRQ(ierr);
ierr = VecResetArray(y);CHKERRQ(ierr);
}
ierr = VecDestroy(x);CHKERRQ(ierr);
ierr = VecDestroy(y);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSolve_TRLAN"
PetscErrorCode EPSSolve_TRLAN(EPS eps)
{
PetscErrorCode ierr;
PetscInt nn;
int ipar[32], i, n, lohi, stat;
EPS_TRLAN *tr = (EPS_TRLAN *)eps->data;
PetscScalar *pV;
PetscFunctionBegin;
 
ierr = VecGetLocalSize(eps->vec_initial,&nn); CHKERRQ(ierr);
n = nn;
if (eps->which==EPS_LARGEST_REAL) lohi = 1;
else if (eps->which==EPS_SMALLEST_REAL) lohi = -1;
else SETERRQ(1,"Wrong value of eps->which");
 
globaleps = eps;
 
ipar[0] = 0; /* stat: error flag */
ipar[1] = lohi; /* smallest (lohi<0) or largest eigenvalues (lohi>0) */
ipar[2] = eps->nev; /* number of desired eigenpairs */
ipar[3] = 0; /* number of eigenpairs already converged */
ipar[4] = tr->maxlan; /* maximum Lanczos basis size */
ipar[5] = tr->restart; /* restarting scheme */
ipar[6] = eps->max_it; /* maximum number of MATVECs */
ipar[7] = MPI_Comm_c2f(eps->comm); /* communicator */
ipar[8] = 0; /* verboseness */
ipar[9] = 99; /* Fortran IO unit number used to write log messages */
ipar[10] = 1; /* use supplied starting vector */
ipar[11] = 0; /* checkpointing flag */
ipar[12] = 98; /* Fortran IO unit number used to write checkpoint files */
ipar[13] = 0; /* number of flops per matvec per PE (not used) */
tr->work[0] = eps->tol; /* relative tolerance on residual norms */
 
for (i=0;i<eps->ncv;i++) eps->eigr[i]=0.0;
ierr = EPSGetStartVector(eps,0,eps->V[0],PETSC_NULL);CHKERRQ(ierr);
ierr = VecGetArray(eps->V[0],&pV);CHKERRQ(ierr);
 
TRLan_ ( MatMult_TRLAN, ipar, &n, &eps->ncv, eps->eigr, pV, &n, tr->work, &tr->lwork );
 
ierr = VecRestoreArray( eps->V[0], &pV );CHKERRQ(ierr);
 
stat = ipar[0];
eps->nconv = ipar[3];
eps->its = ipar[25];
eps->reason = EPS_CONVERGED_TOL;
if (stat!=0) { SETERRQ1(PETSC_ERR_LIB,"Error in TRLAN (code=%d)",stat);}
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDestroy_TRLAN"
PetscErrorCode EPSDestroy_TRLAN(EPS eps)
{
PetscErrorCode ierr;
EPS_TRLAN *tr = (EPS_TRLAN *)eps->data;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
ierr = PetscFree(tr->work);CHKERRQ(ierr);
ierr = PetscFree(eps->data);CHKERRQ(ierr);
ierr = EPSFreeSolutionContiguous(eps);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "EPSCreate_TRLAN"
PetscErrorCode EPSCreate_TRLAN(EPS eps)
{
PetscErrorCode ierr;
EPS_TRLAN *trlan;
 
PetscFunctionBegin;
ierr = PetscNew(EPS_TRLAN,&trlan);CHKERRQ(ierr);
PetscLogObjectMemory(eps,sizeof(EPS_TRLAN));
eps->data = (void *) trlan;
eps->ops->solve = EPSSolve_TRLAN;
eps->ops->setup = EPSSetUp_TRLAN;
eps->ops->destroy = EPSDestroy_TRLAN;
eps->ops->backtransform = EPSBackTransform_Default;
eps->ops->computevectors = EPSComputeVectors_Default;
eps->which = EPS_LARGEST_REAL;
PetscFunctionReturn(0);
}
EXTERN_C_END
tags/slepc-2_3_3-1/src/eps/impls/trlan/trlan.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/impls/trlan/trlanp.h New file
0,0 → 1,47
/*
Private data structure used by the TRLAN interface
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
 
#if !defined(__TRLANP_H)
#define __TRLANP_H
 
#include "src/eps/epsimpl.h"
 
typedef struct {
int maxlan;
int restart;
PetscReal *work;
int lwork;
} EPS_TRLAN;
 
/*
Definition of routines from the TRLAN package
These are real case. TRLAN currently only has DOUBLE PRECISION version
*/
 
#if defined(SLEPC_TRLAN_HAVE_UNDERSCORE)
#define TRLan_ trlan77_
#elif defined(SLEPC_TRLAN_HAVE_CAPS)
#define TRLan_ TRLAN77
#else
#define TRLan_ trlan77
#endif
 
EXTERN_C_BEGIN
 
extern void TRLan_ (int(*op)(int*,int*,PetscReal*,int*,PetscReal*,int*),
int*,int*,int*,PetscScalar*,PetscScalar*,int*,PetscReal*,
int*);
 
EXTERN_C_END
 
#endif
 
tags/slepc-2_3_3-1/src/eps/impls/trlan/trlanp.h Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/impls/trlan/makefile New file
0,0 → 1,29
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
ALL: lib
 
#requirespackage 'SLEPC_HAVE_TRLAN'
#requiresscalar real
 
CFLAGS =
FFLAGS =
SOURCEC = trlan.c
SOURCEF =
SOURCEH = trlanp.h
OBJSC = trlan.o
LIBBASE = libslepc
DIRS =
MANSEC = EPS
LOCDIR = src/eps/impls/trlan/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
tags/slepc-2_3_3-1/src/eps/impls/trlan/makefile Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/impls/arpack/arpack.c New file
0,0 → 1,328
/*
This file implements a wrapper to the ARPACK package
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/eps/impls/arpack/arpackp.h"
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetUp_ARPACK"
PetscErrorCode EPSSetUp_ARPACK(EPS eps)
{
PetscErrorCode ierr;
PetscInt N, n;
int ncv;
EPS_ARPACK *ar = (EPS_ARPACK *)eps->data;
 
PetscFunctionBegin;
ierr = VecGetSize(eps->vec_initial,&N);CHKERRQ(ierr);
if (eps->ncv) {
if (eps->ncv<eps->nev+2) SETERRQ(1,"The value of ncv must be at least nev+2");
} else /* set default value of ncv */
eps->ncv = PetscMin(PetscMax(20,2*eps->nev+1),N);
if (!eps->max_it) eps->max_it = PetscMax(300,(int)(2*N/eps->ncv));
 
ncv = eps->ncv;
#if defined(PETSC_USE_COMPLEX)
ierr = PetscFree(ar->rwork);CHKERRQ(ierr);
ierr = PetscMalloc(ncv*sizeof(PetscReal),&ar->rwork);CHKERRQ(ierr);
ar->lworkl = 3*ncv*ncv+5*ncv;
ierr = PetscFree(ar->workev);CHKERRQ(ierr);
ierr = PetscMalloc(3*ncv*sizeof(PetscScalar),&ar->workev);CHKERRQ(ierr);
#else
if( eps->ishermitian ) {
ar->lworkl = ncv*(ncv+8);
} else {
ar->lworkl = 3*ncv*ncv+6*ncv;
ierr = PetscFree(ar->workev);CHKERRQ(ierr);
ierr = PetscMalloc(3*ncv*sizeof(PetscScalar),&ar->workev);CHKERRQ(ierr);
}
#endif
ierr = PetscFree(ar->workl);CHKERRQ(ierr);
ierr = PetscMalloc(ar->lworkl*sizeof(PetscScalar),&ar->workl);CHKERRQ(ierr);
ierr = PetscFree(ar->select);CHKERRQ(ierr);
ierr = PetscMalloc(ncv*sizeof(PetscTruth),&ar->select);CHKERRQ(ierr);
ierr = VecGetLocalSize(eps->vec_initial,&n); CHKERRQ(ierr);
ierr = PetscFree(ar->workd);CHKERRQ(ierr);
ierr = PetscMalloc(3*n*sizeof(PetscScalar),&ar->workd);CHKERRQ(ierr);
 
ierr = EPSDefaultGetWork(eps,2);CHKERRQ(ierr);
ierr = EPSAllocateSolutionContiguous(eps);CHKERRQ(ierr);
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSolve_ARPACK"
PetscErrorCode EPSSolve_ARPACK(EPS eps)
{
PetscErrorCode ierr;
EPS_ARPACK *ar = (EPS_ARPACK *)eps->data;
char bmat[1], howmny[] = "A";
const char *which;
PetscInt nn;
int n, iparam[11], ipntr[14], ido, info;
PetscScalar sigmar, *pV, *resid;
Vec x, y, w = eps->work[0];
Mat A;
PetscTruth isSinv, isShift, rvec;
MPI_Fint fcomm;
#if !defined(PETSC_USE_COMPLEX)
PetscScalar sigmai = 0.0;
#endif
PetscFunctionBegin;
 
fcomm = MPI_Comm_c2f(eps->comm);
ierr = VecGetLocalSize(eps->vec_initial,&nn); CHKERRQ(ierr);
n = nn;
ierr = VecCreateMPIWithArray(eps->comm,n,PETSC_DECIDE,PETSC_NULL,&x);CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(eps->comm,n,PETSC_DECIDE,PETSC_NULL,&y);CHKERRQ(ierr);
ierr = VecGetArray(eps->V[0],&pV);CHKERRQ(ierr);
ierr = VecCopy(eps->vec_initial,eps->work[1]);CHKERRQ(ierr);
ierr = VecGetArray(eps->work[1],&resid);CHKERRQ(ierr);
ido = 0; /* first call to reverse communication interface */
info = 1; /* indicates a initial vector is provided */
iparam[0] = 1; /* use exact shifts */
iparam[2] = eps->max_it; /* maximum number of Arnoldi update iterations */
iparam[3] = 1; /* blocksize */
iparam[4] = 0; /* number of converged Ritz values */
/*
Computational modes ([]=not supported):
symmetric non-symmetric complex
1 1 'I' 1 'I' 1 'I'
2 3 'I' 3 'I' 3 'I'
3 2 'G' 2 'G' 2 'G'
4 3 'G' 3 'G' 3 'G'
5 [ 4 'G' ] [ 3 'G' ]
6 [ 5 'G' ] [ 4 'G' ]
*/
ierr = PetscTypeCompare((PetscObject)eps->OP,STSINV,&isSinv);CHKERRQ(ierr);
ierr = PetscTypeCompare((PetscObject)eps->OP,STSHIFT,&isShift);CHKERRQ(ierr);
ierr = STGetShift(eps->OP,&sigmar);CHKERRQ(ierr);
ierr = STGetOperators(eps->OP,&A,PETSC_NULL);CHKERRQ(ierr);
 
if (isSinv) {
/* shift-and-invert mode */
iparam[6] = 3;
if (eps->ispositive) bmat[0] = 'G';
else bmat[0] = 'I';
} else if (isShift && eps->ispositive) {
/* generalized shift mode with B positive definite */
iparam[6] = 2;
bmat[0] = 'G';
} else {
/* regular mode */
if (eps->ishermitian && eps->isgeneralized)
SETERRQ(PETSC_ERR_SUP,"Spectral transformation not supported by ARPACK hermitian solver");
iparam[6] = 1;
bmat[0] = 'I';
}
#if !defined(PETSC_USE_COMPLEX)
if (eps->ishermitian) {
switch(eps->which) {
case EPS_LARGEST_MAGNITUDE: which = "LM"; break;
case EPS_SMALLEST_MAGNITUDE: which = "SM"; break;
case EPS_LARGEST_REAL: which = "LA"; break;
case EPS_SMALLEST_REAL: which = "SA"; break;
default: SETERRQ(1,"Wrong value of eps->which");
}
} else {
#endif
switch(eps->which) {
case EPS_LARGEST_MAGNITUDE: which = "LM"; break;
case EPS_SMALLEST_MAGNITUDE: which = "SM"; break;
case EPS_LARGEST_REAL: which = "LR"; break;
case EPS_SMALLEST_REAL: which = "SR"; break;
case EPS_LARGEST_IMAGINARY: which = "LI"; break;
case EPS_SMALLEST_IMAGINARY: which = "SI"; break;
default: SETERRQ(1,"Wrong value of eps->which");
}
#if !defined(PETSC_USE_COMPLEX)
}
#endif
 
do {
 
#if !defined(PETSC_USE_COMPLEX)
if (eps->ishermitian) {
ARsaupd_( &fcomm, &ido, bmat, &n, which, &eps->nev, &eps->tol,
resid, &eps->ncv, pV, &n, iparam, ipntr, ar->workd,
ar->workl, &ar->lworkl, &info, 1, 2 );
}
else {
ARnaupd_( &fcomm, &ido, bmat, &n, which, &eps->nev, &eps->tol,
resid, &eps->ncv, pV, &n, iparam, ipntr, ar->workd,
ar->workl, &ar->lworkl, &info, 1, 2 );
}
#else
ARnaupd_( &fcomm, &ido, bmat, &n, which, &eps->nev, &eps->tol,
resid, &eps->ncv, pV, &n, iparam, ipntr, ar->workd,
ar->workl, &ar->lworkl, ar->rwork, &info, 1, 2 );
#endif
if (ido == -1 || ido == 1 || ido == 2) {
if (ido == 1 && iparam[6] == 3 && bmat[0] == 'G') {
/* special case for shift-and-invert with B semi-positive definite*/
ierr = VecPlaceArray(x,&ar->workd[ipntr[2]-1]); CHKERRQ(ierr);
} else {
ierr = VecPlaceArray(x,&ar->workd[ipntr[0]-1]); CHKERRQ(ierr);
}
ierr = VecPlaceArray(y,&ar->workd[ipntr[1]-1]); CHKERRQ(ierr);
if (ido == -1) {
/* Y = OP * X for for the initialization phase to
force the starting vector into the range of OP */
ierr = STApply(eps->OP,x,y); CHKERRQ(ierr);
} else if (ido == 2) {
/* Y = B * X */
ierr = IPApplyMatrix(eps->ip,x,y); CHKERRQ(ierr);
} else { /* ido == 1 */
if (iparam[6] == 3 && bmat[0] == 'G') {
/* Y = OP * X for shift-and-invert with B semi-positive definite */
ierr = STAssociatedKSPSolve(eps->OP,x,y);CHKERRQ(ierr);
} else if (iparam[6] == 2) {
/* X=A*X Y=B^-1*X for shift with B positive definite */
ierr = MatMult(A,x,y);CHKERRQ(ierr);
if (sigmar != 0.0) {
ierr = IPApplyMatrix(eps->ip,x,w);CHKERRQ(ierr);
ierr = VecAXPY(y,sigmar,w);CHKERRQ(ierr);
}
ierr = VecCopy(y,x); CHKERRQ(ierr);
ierr = STAssociatedKSPSolve(eps->OP,x,y);CHKERRQ(ierr);
} else {
/* Y = OP * X */
ierr = STApply(eps->OP,x,y); CHKERRQ(ierr);
}
ierr = IPOrthogonalize(eps->ip,eps->nds,PETSC_NULL,eps->DS,y,PETSC_NULL,PETSC_NULL,PETSC_NULL,w);CHKERRQ(ierr);
}
ierr = VecResetArray(x); CHKERRQ(ierr);
ierr = VecResetArray(y); CHKERRQ(ierr);
} else if (ido != 99) {
SETERRQ1(1,"Internal error in ARPACK reverse comunication interface (ido=%i)\n",ido);
}
} while (ido != 99);
 
eps->nconv = iparam[4];
eps->its = iparam[2];
if (info==3) { SETERRQ(1,"No shift could be applied in xxAUPD.\n"
"Try increasing the size of NCV relative to NEV."); }
else if (info!=0 && info!=1) { SETERRQ1(PETSC_ERR_LIB,"Error reported by ARPACK subroutine xxAUPD (%d)",info);}
 
rvec = PETSC_TRUE;
 
if (eps->nconv > 0) {
#if !defined(PETSC_USE_COMPLEX)
if (eps->ishermitian) {
EPSMonitor(eps,iparam[2],iparam[4],&ar->workl[ipntr[5]-1],eps->eigi,&ar->workl[ipntr[6]-1],eps->ncv);
ARseupd_ ( &fcomm, &rvec, howmny, ar->select, eps->eigr,
pV, &n, &sigmar,
bmat, &n, which, &eps->nev, &eps->tol,
resid, &eps->ncv, pV, &n, iparam, ipntr, ar->workd,
ar->workl, &ar->lworkl, &info, 1, 1, 2 );
}
else {
EPSMonitor(eps,iparam[2],iparam[4],&ar->workl[ipntr[5]-1],&ar->workl[ipntr[6]-1],&ar->workl[ipntr[7]-1],eps->ncv);
ARneupd_ ( &fcomm, &rvec, howmny, ar->select, eps->eigr, eps->eigi,
pV, &n, &sigmar, &sigmai, ar->workev,
bmat, &n, which, &eps->nev, &eps->tol,
resid, &eps->ncv, pV, &n, iparam, ipntr, ar->workd,
ar->workl, &ar->lworkl, &info, 1, 1, 2 );
}
#else
EPSMonitor(eps,eps->its,iparam[4],&ar->workl[ipntr[5]-1],eps->eigi,(PetscReal*)&ar->workl[ipntr[7]-1],eps->ncv);
ARneupd_ ( &fcomm, &rvec, howmny, ar->select, eps->eigr,
pV, &n, &sigmar, ar->workev,
bmat, &n, which, &eps->nev, &eps->tol,
resid, &eps->ncv, pV, &n, iparam, ipntr, ar->workd,
ar->workl, &ar->lworkl, ar->rwork, &info, 1, 1, 2 );
#endif
if (info!=0) { SETERRQ1(PETSC_ERR_LIB,"Error reported by ARPACK subroutine xxEUPD (%d)",info); }
}
 
ierr = VecRestoreArray( eps->V[0], &pV ); CHKERRQ(ierr);
ierr = VecRestoreArray( eps->work[1], &resid ); CHKERRQ(ierr);
if( eps->nconv >= eps->nev ) eps->reason = EPS_CONVERGED_TOL;
else eps->reason = EPS_DIVERGED_ITS;
 
if (eps->ishermitian) {
ierr = PetscMemcpy(eps->errest,&ar->workl[ipntr[8]-1],eps->nconv);CHKERRQ(ierr);
} else {
ierr = PetscMemcpy(eps->errest,&ar->workl[ipntr[10]-1],eps->nconv);CHKERRQ(ierr);
}
 
ierr = VecDestroy(x);CHKERRQ(ierr);
ierr = VecDestroy(y);CHKERRQ(ierr);
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSBackTransform_ARPACK"
PetscErrorCode EPSBackTransform_ARPACK(EPS eps)
{
PetscErrorCode ierr;
PetscTruth isSinv;
 
PetscFunctionBegin;
ierr = PetscTypeCompare((PetscObject)eps->OP,STSINV,&isSinv);CHKERRQ(ierr);
if (!isSinv) {
ierr = EPSBackTransform_Default(eps);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDestroy_ARPACK"
PetscErrorCode EPSDestroy_ARPACK(EPS eps)
{
PetscErrorCode ierr;
EPS_ARPACK *ar = (EPS_ARPACK *)eps->data;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
ierr = PetscFree(ar->workev);CHKERRQ(ierr);
ierr = PetscFree(ar->workl);CHKERRQ(ierr);
ierr = PetscFree(ar->select);CHKERRQ(ierr);
ierr = PetscFree(ar->workd);CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
ierr = PetscFree(ar->rwork);CHKERRQ(ierr);
#endif
ierr = PetscFree(eps->data);CHKERRQ(ierr);
ierr = EPSDefaultFreeWork(eps);CHKERRQ(ierr);
ierr = EPSFreeSolutionContiguous(eps);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "EPSCreate_ARPACK"
PetscErrorCode EPSCreate_ARPACK(EPS eps)
{
PetscErrorCode ierr;
EPS_ARPACK *arpack;
 
PetscFunctionBegin;
ierr = PetscNew(EPS_ARPACK,&arpack);CHKERRQ(ierr);
PetscLogObjectMemory(eps,sizeof(EPS_ARPACK));
eps->data = (void *) arpack;
eps->ops->solve = EPSSolve_ARPACK;
eps->ops->setup = EPSSetUp_ARPACK;
eps->ops->destroy = EPSDestroy_ARPACK;
eps->ops->backtransform = EPSBackTransform_ARPACK;
eps->ops->computevectors = EPSComputeVectors_Default;
PetscFunctionReturn(0);
}
EXTERN_C_END
tags/slepc-2_3_3-1/src/eps/impls/arpack/arpack.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/impls/arpack/arpackp.h New file
0,0 → 1,200
/*
Private data structure used by the ARPACK interface
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
 
#if !defined(__ARPACKP_H)
#define __ARPACKP_H
 
#include "src/eps/epsimpl.h"
 
typedef struct {
PetscTruth *select;
PetscScalar *workev;
PetscScalar *workd;
PetscScalar *workl;
int lworkl;
#if defined(PETSC_USE_COMPLEX)
PetscReal *rwork;
#endif
} EPS_ARPACK;
 
/*
Definition of routines from the ARPACK package
*/
 
#if defined(SLEPC_ARPACK_HAVE_UNDERSCORE)
#define SLEPC_ARPACK(lcase,ucase) lcase##_
#elif defined(SLEPC_ARPACK_HAVE_CAPS)
#define SLEPC_ARPACK(lcase,ucase) ucase
#else
#define SLEPC_ARPACK(lcase,ucase) lcase
#endif
 
#if !defined(_petsc_mpi_uni)
 
#if !defined(PETSC_USE_COMPLEX)
 
/*
These are real case
*/
 
#if defined(PETSC_USES_FORTRAN_SINGLE)
/*
For these machines we must call the single precision Fortran version
*/
#define ARnaupd_ SLEPC_ARPACK(psnaupd,PSNAUPD)
#define ARneupd_ SLEPC_ARPACK(psneupd,PSNEUPD)
#define ARsaupd_ SLEPC_ARPACK(pssaupd,PSSAUPD)
#define ARseupd_ SLEPC_ARPACK(psseupd,PSSEUPD)
 
#else
 
#define ARnaupd_ SLEPC_ARPACK(pdnaupd,PDNAUPD)
#define ARneupd_ SLEPC_ARPACK(pdneupd,PDNEUPD)
#define ARsaupd_ SLEPC_ARPACK(pdsaupd,PDSAUPD)
#define ARseupd_ SLEPC_ARPACK(pdseupd,PDSEUPD)
 
#endif
 
#else
/*
Complex
*/
#if defined(PETSC_USE_SINGLE)
 
#define ARnaupd_ SLEPC_ARPACK(pcnaupd,PCNAUPD)
#define ARneupd_ SLEPC_ARPACK(pcneupd,PCNEUPD)
 
#else
 
#define ARnaupd_ SLEPC_ARPACK(pznaupd,PZNAUPD)
#define ARneupd_ SLEPC_ARPACK(pzneupd,PZNEUPD)
 
#endif
 
#endif
 
#else
/* _petsc_mpi_uni */
 
#if !defined(PETSC_USE_COMPLEX)
 
/*
These are real case
*/
 
#if defined(PETSC_USE_SINGLE)
/*
For these machines we must call the single precision Fortran version
*/
#define ARnaupd__ SLEPC_ARPACK(snaupd,SNAUPD)
#define ARneupd__ SLEPC_ARPACK(sneupd,SNEUPD)
#define ARsaupd__ SLEPC_ARPACK(ssaupd,SSAUPD)
#define ARseupd__ SLEPC_ARPACK(sseupd,SSEUPD)
 
#else
 
#define ARnaupd__ SLEPC_ARPACK(dnaupd,DNAUPD)
#define ARneupd__ SLEPC_ARPACK(dneupd,DNEUPD)
#define ARsaupd__ SLEPC_ARPACK(dsaupd,DSAUPD)
#define ARseupd__ SLEPC_ARPACK(dseupd,DSEUPD)
 
#endif
 
#else
/*
Complex
*/
#if defined(PETSC_USE_SINGLE)
 
#define ARnaupd__ SLEPC_ARPACK(cnaupd,CNAUPD)
#define ARneupd__ SLEPC_ARPACK(cneupd,CNEUPD)
 
#else
 
#define ARnaupd__ SLEPC_ARPACK(znaupd,ZNAUPD)
#define ARneupd__ SLEPC_ARPACK(zneupd,ZNEUPD)
 
#endif
 
#endif
 
#endif
 
EXTERN_C_BEGIN
 
#if !defined(_petsc_mpi_uni)
 
EXTERN void ARsaupd_(MPI_Fint*,int*,char*,int*,const char*,int*,PetscReal*,PetscScalar*,
int*,PetscScalar*,int*,int*,int*,PetscScalar*,PetscScalar*,int*,int*,int,int);
EXTERN void ARseupd_(MPI_Fint*,PetscTruth*,char*,PetscTruth*,PetscReal*,PetscReal*,
int*,PetscReal*,
char*,int*,const char*,int*,PetscReal*,PetscScalar*,
int*,PetscScalar*,int*,int*,int*,PetscScalar*,PetscScalar*,int*,int*,int,int,int);
 
#if !defined(PETSC_USE_COMPLEX)
EXTERN void ARnaupd_(MPI_Fint*,int*,char*,int*,const char*,int*,PetscReal*,PetscScalar*,
int*,PetscScalar*,int*,int*,int*,PetscScalar*,PetscScalar*,int*,int*,int,int);
EXTERN void ARneupd_(MPI_Fint*,PetscTruth*,char*,PetscTruth*,PetscReal*,PetscReal*,
PetscReal*,int*,PetscReal*,PetscReal*,PetscReal*,
char*,int*,const char*,int*,PetscReal*,PetscScalar*,
int*,PetscScalar*,int*,int*,int*,PetscScalar*,PetscScalar*,int*,int*,int,int,int);
#else
EXTERN void ARnaupd_(MPI_Fint*,int*,char*,int*,const char*,int*,PetscReal*,PetscScalar*,
int*,PetscScalar*,int*,int*,int*,PetscScalar*,PetscScalar*,int*,PetscReal*,int*,
int,int);
EXTERN void ARneupd_(MPI_Fint*,PetscTruth*,char*,PetscTruth*,PetscScalar*,PetscScalar*,
int*,PetscScalar*,PetscScalar*,
char*,int*,const char*,int*,PetscReal*,PetscScalar*,
int*,PetscScalar*,int*,int*,int*,PetscScalar*,PetscScalar*,int*,PetscReal*,int*,
int,int,int);
#endif
 
#else
/* _petsc_mpi_uni */
 
EXTERN void ARsaupd__(int*,char*,int*,const char*,int*,PetscReal*,PetscScalar*,
int*,PetscScalar*,int*,int*,int*,PetscScalar*,PetscScalar*,int*,int*,int,int);
#define ARsaupd_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) ARsaupd__(b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s)
EXTERN void ARseupd__(PetscTruth*,char*,PetscTruth*,PetscReal*,PetscReal*,
int*,PetscReal*,
char*,int*,const char*,int*,PetscReal*,PetscScalar*,
int*,PetscScalar*,int*,int*,int*,PetscScalar*,PetscScalar*,int*,int*,int,int,int);
#define ARseupd_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z) ARseupd__(b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z)
 
#if !defined(PETSC_USE_COMPLEX)
EXTERN void ARnaupd__(int*,char*,int*,const char*,int*,PetscReal*,PetscScalar*,
int*,PetscScalar*,int*,int*,int*,PetscScalar*,PetscScalar*,int*,int*,int,int);
#define ARnaupd_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) ARnaupd__(b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s)
EXTERN void ARneupd__(PetscTruth*,char*,PetscTruth*,PetscReal*,PetscReal*,
PetscReal*,int*,PetscReal*,PetscReal*,PetscReal*,
char*,int*,const char*,int*,PetscReal*,PetscScalar*,
int*,PetscScalar*,int*,int*,int*,PetscScalar*,PetscScalar*,int*,int*,int,int,int);
#define ARneupd_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,a2,a3) ARneupd__(b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,a2,a3)
#else
EXTERN void ARnaupd__(int*,char*,int*,const char*,int*,PetscReal*,PetscScalar*,
int*,PetscScalar*,int*,int*,int*,PetscScalar*,PetscScalar*,int*,PetscReal*,int*,
int,int);
#define ARnaupd_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) ARnaupd__(b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t)
EXTERN void ARneupd__(PetscTruth*,char*,PetscTruth*,PetscScalar*,PetscScalar*,
int*,PetscScalar*,PetscScalar*,
char*,int*,const char*,int*,PetscReal*,PetscScalar*,
int*,PetscScalar*,int*,int*,int*,PetscScalar*,PetscScalar*,int*,PetscReal*,int*,
int,int,int);
#define ARneupd_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,a2) ARneupd__(b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,a2)
#endif
 
#endif
 
EXTERN_C_END
 
#endif
 
tags/slepc-2_3_3-1/src/eps/impls/arpack/arpackp.h Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/impls/arpack/makefile New file
0,0 → 1,28
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
ALL: lib
 
#requirespackage 'SLEPC_HAVE_ARPACK'
 
CFLAGS =
FFLAGS =
SOURCEC = arpack.c
SOURCEF =
SOURCEH = arpackp.h
OBJSC = arpack.o
LIBBASE = libslepc
DIRS =
MANSEC = EPS
LOCDIR = src/eps/impls/arpack/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
tags/slepc-2_3_3-1/src/eps/impls/arpack/makefile Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/impls/subspace/subspace.c New file
0,0 → 1,378
/*
 
SLEPc eigensolver: "subspace"
 
Method: Subspace Iteration
 
Algorithm:
 
Subspace iteration with Rayleigh-Ritz projection and locking,
based on the SRRIT implementation.
 
References:
 
[1] "Subspace Iteration in SLEPc", SLEPc Technical Report STR-3,
available at http://www.grycap.upv.es/slepc.
 
Last update: June 2004
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/eps/epsimpl.h" /*I "slepceps.h" I*/
#include "slepcblaslapack.h"
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetUp_SUBSPACE"
PetscErrorCode EPSSetUp_SUBSPACE(EPS eps)
{
PetscErrorCode ierr;
PetscInt N;
 
PetscFunctionBegin;
ierr = VecGetSize(eps->vec_initial,&N);CHKERRQ(ierr);
if (eps->ncv) {
if (eps->ncv<eps->nev) SETERRQ(1,"The value of ncv must be at least nev");
}
else eps->ncv = PetscMin(N,PetscMax(2*eps->nev,eps->nev+15));
if (!eps->max_it) eps->max_it = PetscMax(100,2*N/eps->ncv);
if (eps->which!=EPS_LARGEST_MAGNITUDE)
SETERRQ(1,"Wrong value of eps->which");
ierr = EPSAllocateSolution(eps);CHKERRQ(ierr);
ierr = PetscFree(eps->T);CHKERRQ(ierr);
ierr = PetscMalloc(eps->ncv*eps->ncv*sizeof(PetscScalar),&eps->T);CHKERRQ(ierr);
ierr = EPSDefaultGetWork(eps,eps->ncv);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSHessCond"
/*
EPSHessCond - Compute the inf-norm condition number of the upper
Hessenberg matrix H: cond(H) = norm(H)*norm(inv(H)).
This routine uses Gaussian elimination with partial pivoting to
compute the inverse explicitly.
*/
static PetscErrorCode EPSHessCond(PetscScalar* H,int n, PetscReal* cond)
{
#if defined(PETSC_MISSING_LAPACK_GETRF) || defined(SLEPC_MISSING_LAPACK_GETRI) || defined(SLEPC_MISSING_LAPACK_LANGE) || defined(SLEPC_MISSING_LAPACK_LANHS)
PetscFunctionBegin;
SETERRQ(PETSC_ERR_SUP,"GETRF,GETRI - Lapack routines are unavailable.");
#else
PetscErrorCode ierr;
int *ipiv,lwork,info;
PetscScalar *work;
PetscReal hn,hin,*rwork;
PetscFunctionBegin;
ierr = PetscLogEventBegin(EPS_Dense,0,0,0,0);CHKERRQ(ierr);
ierr = PetscMalloc(sizeof(int)*n,&ipiv);CHKERRQ(ierr);
lwork = n*n;
ierr = PetscMalloc(sizeof(PetscScalar)*lwork,&work);CHKERRQ(ierr);
ierr = PetscMalloc(sizeof(PetscReal)*n,&rwork);CHKERRQ(ierr);
hn = LAPACKlanhs_("I",&n,H,&n,rwork,1);
LAPACKgetrf_(&n,&n,H,&n,ipiv,&info);
if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack xGETRF %d",info);
LAPACKgetri_(&n,H,&n,ipiv,work,&lwork,&info);
if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack xGETRI %d",info);
hin = LAPACKlange_("I",&n,&n,H,&n,rwork,1);
*cond = hn * hin;
ierr = PetscFree(ipiv);CHKERRQ(ierr);
ierr = PetscFree(work);CHKERRQ(ierr);
ierr = PetscFree(rwork);CHKERRQ(ierr);
ierr = PetscLogEventEnd(EPS_Dense,0,0,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
#endif
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSFindGroup"
/*
EPSFindGroup - Find a group of nearly equimodular eigenvalues, provided
in arrays wr and wi, according to the tolerance grptol. Also the 2-norms
of the residuals must be passed-in (rsd). Arrays are processed from index
l to index m only. The output information is:
 
ngrp - number of entries of the group
ctr - (w(l)+w(l+ngrp-1))/2
ae - average of wr(l),...,wr(l+ngrp-1)
arsd - average of rsd(l),...,rsd(l+ngrp-1)
*/
static PetscErrorCode EPSFindGroup(int l,int m,PetscScalar *wr,PetscScalar *wi,PetscReal *rsd,
PetscReal grptol,int *ngrp,PetscReal *ctr,PetscReal *ae,PetscReal *arsd)
{
int i;
PetscReal rmod,rmod1;
 
PetscFunctionBegin;
*ngrp = 0;
*ctr = 0;
rmod = SlepcAbsEigenvalue(wr[l],wi[l]);
 
for (i=l;i<m;) {
rmod1 = SlepcAbsEigenvalue(wr[i],wi[i]);
if (PetscAbsReal(rmod-rmod1) > grptol*(rmod+rmod1)) break;
*ctr = (rmod+rmod1)/2.0;
if (wi[i] != 0.0) {
(*ngrp)+=2;
i+=2;
} else {
(*ngrp)++;
i++;
}
}
 
*ae = 0;
*arsd = 0;
 
if (*ngrp) {
for (i=l;i<l+*ngrp;i++) {
(*ae) += PetscRealPart(wr[i]);
(*arsd) += rsd[i]*rsd[i];
}
*ae = *ae / *ngrp;
*arsd = PetscSqrtScalar(*arsd / *ngrp);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSchurResidualNorms"
/*
EPSSchurResidualNorms - Computes the column norms of residual vectors
OP*V(1:n,l:m) - V*T(1:m,l:m) were on entry, OP*V has been computed and
stored in AV. ldt is the leading dimension of T. On exit, rsd(l) to
rsd(m) contain the computed norms.
*/
static PetscErrorCode EPSSchurResidualNorms(EPS eps,Vec *V,Vec *AV,PetscScalar *T,int l,int m,int ldt,PetscReal *rsd)
{
PetscErrorCode ierr;
int i;
#if defined(PETSC_USE_COMPLEX)
PetscScalar t;
#endif
 
PetscFunctionBegin;
for (i=l;i<m;i++) {
ierr = VecSet(eps->work[0],0.0);CHKERRQ(ierr);
ierr = VecMAXPY(eps->work[0],m,T+ldt*i,V);CHKERRQ(ierr);
ierr = VecWAXPY(eps->work[1],-1.0,eps->work[0],AV[i]);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
ierr = VecDot(eps->work[1],eps->work[1],rsd+i);CHKERRQ(ierr);
#else
ierr = VecDot(eps->work[1],eps->work[1],&t);CHKERRQ(ierr);
rsd[i] = PetscRealPart(t);
#endif
}
 
for (i=l;i<m;i++) {
if (i == m-1) {
rsd[i] = sqrt(rsd[i]);
} else if (T[i+1+(ldt*i)]==0.0) {
rsd[i] = sqrt(rsd[i]);
} else {
rsd[i] = sqrt(rsd[i]+rsd[i+1])/2.0;
rsd[i+1] = rsd[i];
i++;
}
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSolve_SUBSPACE"
PetscErrorCode EPSSolve_SUBSPACE(EPS eps)
{
PetscErrorCode ierr;
int i,ngrp,nogrp,*itrsd,*itrsdold,
nxtsrr,idsrr,idort,nxtort,ncv = eps->ncv,its;
PetscScalar *T=eps->T,*U;
PetscReal arsd,oarsd,ctr,octr,ae,oae,*rsd,*rsdold,norm,tcond;
PetscTruth breakdown;
/* Parameters */
int init = 5; /* Number of initial iterations */
PetscReal stpfac = 1.5, /* Max num of iter before next SRR step */
alpha = 1.0, /* Used to predict convergence of next residual */
beta = 1.1, /* Used to predict convergence of next residual */
grptol = 1e-8, /* Tolerance for EPSFindGroup */
cnvtol = 1e-6; /* Convergence criterion for cnv */
int orttol = 2; /* Number of decimal digits whose loss
can be tolerated in orthogonalization */
 
PetscFunctionBegin;
its = 0;
ierr = PetscMalloc(sizeof(PetscScalar)*ncv*ncv,&U);CHKERRQ(ierr);
ierr = PetscMalloc(sizeof(PetscReal)*ncv,&rsd);CHKERRQ(ierr);
ierr = PetscMalloc(sizeof(PetscReal)*ncv,&rsdold);CHKERRQ(ierr);
ierr = PetscMalloc(sizeof(int)*ncv,&itrsd);CHKERRQ(ierr);
ierr = PetscMalloc(sizeof(int)*ncv,&itrsdold);CHKERRQ(ierr);
 
/* Generate a set of random initial vectors and orthonormalize them */
for (i=0;i<ncv;i++) {
ierr = SlepcVecSetRandom(eps->V[i]);CHKERRQ(ierr);
rsd[i] = 0.0;
itrsd[i] = -1;
}
ierr = IPQRDecomposition(eps->ip,eps->V,0,ncv,PETSC_NULL,0,eps->work[0]);CHKERRQ(ierr);
while (eps->its<eps->max_it) {
eps->its++;
/* Find group in previously computed eigenvalues */
ierr = EPSFindGroup(eps->nconv,ncv,eps->eigr,eps->eigi,rsd,grptol,&nogrp,&octr,&oae,&oarsd);CHKERRQ(ierr);
 
/* Compute a Rayleigh-Ritz projection step
on the active columns (idx) */
 
/* 1. AV(:,idx) = OP * V(:,idx) */
for (i=eps->nconv;i<ncv;i++) {
ierr = STApply(eps->OP,eps->V[i],eps->AV[i]);CHKERRQ(ierr);
}
 
/* 2. T(:,idx) = V' * AV(:,idx) */
for (i=eps->nconv;i<ncv;i++) {
ierr = VecMDot(eps->AV[i],ncv,eps->V,T+i*ncv);CHKERRQ(ierr);
}
 
/* 3. Reduce projected matrix to Hessenberg form: [U,T] = hess(T) */
ierr = EPSDenseHessenberg(ncv,eps->nconv,T,ncv,U);CHKERRQ(ierr);
/* 4. Reduce T to quasi-triangular (Schur) form */
ierr = EPSDenseSchur(ncv,eps->nconv,T,ncv,U,eps->eigr,eps->eigi);CHKERRQ(ierr);
 
/* 5. Sort diagonal elements in T and accumulate rotations on U */
ierr = EPSSortDenseSchur(ncv,eps->nconv,T,ncv,U,eps->eigr,eps->eigi,eps->which);CHKERRQ(ierr);
/* 6. AV(:,idx) = AV * U(:,idx) */
for (i=eps->nconv;i<ncv;i++) {
ierr = VecSet(eps->work[i],0.0);CHKERRQ(ierr);
ierr = VecMAXPY(eps->work[i],ncv,U+ncv*i,eps->AV);CHKERRQ(ierr);
}
for (i=eps->nconv;i<ncv;i++) {
ierr = VecCopy(eps->work[i],eps->AV[i]);CHKERRQ(ierr);
}
/* 7. V(:,idx) = V * U(:,idx) */
for (i=eps->nconv;i<ncv;i++) {
ierr = VecSet(eps->work[i],0.0);CHKERRQ(ierr);
ierr = VecMAXPY(eps->work[i],ncv,U+ncv*i,eps->V);CHKERRQ(ierr);
}
for (i=eps->nconv;i<ncv;i++) {
ierr = VecCopy(eps->work[i],eps->V[i]);CHKERRQ(ierr);
}
/* Compute residuals */
for (i=0;i<ncv;i++) { rsdold[i] = rsd[i]; }
 
ierr = EPSSchurResidualNorms(eps,eps->V,eps->AV,T,eps->nconv,ncv,ncv,rsd);CHKERRQ(ierr);
 
for (i=0;i<ncv;i++) {
eps->errest[i] = rsd[i] / SlepcAbsEigenvalue(eps->eigr[i],eps->eigi[i]);
}
EPSMonitor(eps,eps->its,eps->nconv,eps->eigr,eps->eigi,eps->errest,ncv);
/* Convergence check */
for (i=0;i<ncv;i++) { itrsdold[i] = itrsd[i]; }
for (i=eps->nconv;i<ncv;i++) { itrsd[i] = its; }
for (;;) {
/* Find group in currently computed eigenvalues */
ierr = EPSFindGroup(eps->nconv,ncv,eps->eigr,eps->eigi,rsd,grptol,&ngrp,&ctr,&ae,&arsd);CHKERRQ(ierr);
if (ngrp!=nogrp) break;
if (ngrp==0) break;
if (PetscAbsScalar(ae-oae)>ctr*cnvtol*(itrsd[eps->nconv]-itrsdold[eps->nconv])) break;
if (arsd>ctr*eps->tol) break;
eps->nconv = eps->nconv + ngrp;
if (eps->nconv>=ncv) break;
}
if (eps->nconv>=eps->nev) break;
/* Compute nxtsrr (iteration of next projection step) */
nxtsrr = PetscMin(eps->max_it,PetscMax((int)floor(stpfac*its), init));
if (ngrp!=nogrp || ngrp==0 || arsd>=oarsd) {
idsrr = nxtsrr - its;
} else {
idsrr = (int)floor(alpha+beta*(itrsdold[eps->nconv]-itrsd[eps->nconv])*log(arsd/eps->tol)/log(arsd/oarsd));
idsrr = PetscMax(1,idsrr);
}
nxtsrr = PetscMin(nxtsrr,its+idsrr);
 
/* Compute nxtort (iteration of next orthogonalization step) */
ierr = PetscMemcpy(U,T,sizeof(PetscScalar)*ncv);CHKERRQ(ierr);
ierr = EPSHessCond(U,ncv,&tcond);CHKERRQ(ierr);
idort = PetscMax(1,(int)floor(orttol/PetscMax(1,log10(tcond))));
nxtort = PetscMin(its+idort, nxtsrr);
 
/* V(:,idx) = AV(:,idx) */
for (i=eps->nconv;i<ncv;i++) {
ierr = VecCopy(eps->AV[i],eps->V[i]);CHKERRQ(ierr);
}
its++;
 
/* Orthogonalization loop */
do {
while (its<nxtort) {
/* AV(:,idx) = OP * V(:,idx) */
for (i=eps->nconv;i<ncv;i++) {
ierr = STApply(eps->OP,eps->V[i],eps->AV[i]);CHKERRQ(ierr);
}
/* V(:,idx) = AV(:,idx) with normalization */
for (i=eps->nconv;i<ncv;i++) {
ierr = VecCopy(eps->AV[i],eps->V[i]);CHKERRQ(ierr);
ierr = VecNorm(eps->V[i],NORM_INFINITY,&norm);CHKERRQ(ierr);
ierr = VecScale(eps->V[i],1/norm);CHKERRQ(ierr);
}
its++;
}
/* Orthonormalize vectors */
for (i=eps->nconv;i<ncv;i++) {
ierr = IPOrthogonalize(eps->ip,i+eps->nds,PETSC_NULL,eps->DSV,eps->V[i],PETSC_NULL,&norm,&breakdown,eps->work[0]);CHKERRQ(ierr);
if (breakdown) {
ierr = SlepcVecSetRandom(eps->V[i]);CHKERRQ(ierr);
ierr = IPOrthogonalize(eps->ip,i+eps->nds,PETSC_NULL,eps->DSV,eps->V[i],PETSC_NULL,&norm,&breakdown,eps->work[0]);CHKERRQ(ierr);
}
ierr = VecScale(eps->V[i],1/norm);CHKERRQ(ierr);
}
nxtort = PetscMin(its+idort,nxtsrr);
} while (its<nxtsrr);
}
 
ierr = PetscFree(U);CHKERRQ(ierr);
ierr = PetscFree(rsd);CHKERRQ(ierr);
ierr = PetscFree(rsdold);CHKERRQ(ierr);
ierr = PetscFree(itrsd);CHKERRQ(ierr);
ierr = PetscFree(itrsdold);CHKERRQ(ierr);
 
if( eps->nconv == eps->nev ) eps->reason = EPS_CONVERGED_TOL;
else eps->reason = EPS_DIVERGED_ITS;
 
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "EPSCreate_SUBSPACE"
PetscErrorCode EPSCreate_SUBSPACE(EPS eps)
{
PetscFunctionBegin;
eps->ops->solve = EPSSolve_SUBSPACE;
eps->ops->setup = EPSSetUp_SUBSPACE;
eps->ops->destroy = EPSDestroy_Default;
eps->ops->backtransform = EPSBackTransform_Default;
eps->ops->computevectors = EPSComputeVectors_Schur;
PetscFunctionReturn(0);
}
EXTERN_C_END
 
tags/slepc-2_3_3-1/src/eps/impls/subspace/subspace.c Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/impls/subspace/makefile New file
0,0 → 1,26
#
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#
 
ALL: lib
 
CFLAGS =
FFLAGS =
SOURCEC = subspace.c
SOURCEF =
SOURCEH =
OBJSC = subspace.o
LIBBASE = libslepc
DIRS =
MANSEC = EPS
LOCDIR = src/eps/impls/subspace/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
tags/slepc-2_3_3-1/src/eps/impls/subspace/makefile Property changes : Added: svn:eol-style
+ native
/tags/slepc-2_3_3-1/src/eps/impls/blzpack/blzpack.c New file
0,0 → 1,532
/*
This file implements a wrapper to the BLZPACK package
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 "src/eps/impls/blzpack/blzpackp.h" /*I "slepceps.h" I*/
 
const char* blzpack_error[33] = {
"",
"illegal data, LFLAG ",
"illegal data, dimension of (U), (V), (X) ",
"illegal data, leading dimension of (U), (V), (X) ",
"illegal data, leading dimension of (EIG) ",
"illegal data, number of required eigenpairs ",
"illegal data, Lanczos algorithm block size ",
"illegal data, maximum number of steps ",
"illegal data, number of starting vectors ",
"illegal data, number of eigenpairs provided ",
"illegal data, problem type flag ",
"illegal data, spectrum slicing flag ",
"illegal data, eigenvectors purification flag ",
"illegal data, level of output ",
"illegal data, output file unit ",
"illegal data, LCOMM (MPI or PVM) ",
"illegal data, dimension of ISTOR ",
"illegal data, convergence threshold ",
"illegal data, dimension of RSTOR ",
"illegal data on at least one PE ",
"ISTOR(3:14) must be equal on all PEs ",
"RSTOR(1:3) must be equal on all PEs ",
"not enough space in ISTOR to start eigensolution ",
"not enough space in RSTOR to start eigensolution ",
"illegal data, number of negative eigenvalues ",
"illegal data, entries of V ",
"illegal data, entries of X ",
"failure in computational subinterval ",
"file I/O error, blzpack.__.BQ ",
"file I/O error, blzpack.__.BX ",
"file I/O error, blzpack.__.Q ",
"file I/O error, blzpack.__.X ",
"parallel interface error "
};
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetUp_BLZPACK"
PetscErrorCode EPSSetUp_BLZPACK(EPS eps)
{
PetscErrorCode ierr;
PetscInt N, n;
int listor, lrstor, ncuv, k1, k2, k3, k4;
EPS_BLZPACK *blz = (EPS_BLZPACK *)eps->data;
PetscTruth flg;
KSP ksp;
PC pc;
 
PetscFunctionBegin;
ierr = VecGetSize(eps->vec_initial,&N);CHKERRQ(ierr);
ierr = VecGetLocalSize(eps->vec_initial,&n);CHKERRQ(ierr);
if (eps->ncv) {
if( eps->ncv < PetscMin(eps->nev+10,eps->nev*2) )
SETERRQ(0,"Warning: BLZpack recommends that ncv be larger than min(nev+10,nev*2)");
}
else eps->ncv = PetscMin(eps->nev+10,eps->nev*2);
if (!eps->max_it) eps->max_it = PetscMax(1000,N);
 
if (!eps->ishermitian)
SETERRQ(PETSC_ERR_SUP,"Requested method is only available for Hermitian problems");
if (blz->slice || eps->isgeneralized) {
ierr = PetscTypeCompare((PetscObject)eps->OP,STSINV,&flg);CHKERRQ(ierr);
if (!flg)
SETERRQ(PETSC_ERR_SUP,"Shift-and-invert ST is needed for generalized problems or spectrum slicing");
ierr = STGetKSP(eps->OP,&ksp);CHKERRQ(ierr);
ierr = PetscTypeCompare((PetscObject)ksp,KSPPREONLY,&flg);CHKERRQ(ierr);
if (!flg)
SETERRQ(PETSC_ERR_SUP,"Preonly KSP is needed for generalized problems or spectrum slicing");
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PetscTypeCompare((PetscObject)pc,PCCHOLESKY,&flg);CHKERRQ(ierr);
if (!flg)
SETERRQ(PETSC_ERR_SUP,"Cholesky PC is needed for generalized problems or spectrum slicing");
}
if (eps->which!=EPS_SMALLEST_REAL)
SETERRQ(1,"Wrong value of eps->which");
 
k1 = PetscMin(N,180);
k2 = blz->block_size;
k4 = PetscMin(eps->ncv,N);
k3 = 484+k1*(13+k1*2+k2+PetscMax(18,k2+2))+k2*k2*3+k4*2;
 
listor = 123+k1*12;
ierr = PetscFree(blz->istor);CHKERRQ(ierr);
ierr = PetscMalloc((17+listor)*sizeof(int),&blz->istor);CHKERRQ(ierr);
blz->istor[14] = listor;
 
if (blz->slice) lrstor = n*(k2*4+k1*2+k4)+k3;
else lrstor = n*(k2*4+k1)+k3;
ierr = PetscFree(blz->rstor);CHKERRQ(ierr);
ierr = PetscMalloc((4+lrstor)*sizeof(PetscReal),&blz->rstor);CHKERRQ(ierr);
blz->rstor[3] = lrstor;
 
ncuv = PetscMax(3,blz->block_size);
ierr = PetscFree(blz->u);CHKERRQ(ierr);
ierr = PetscMalloc(ncuv*n*sizeof(PetscScalar),&blz->u);CHKERRQ(ierr);
ierr = PetscFree(blz->v);CHKERRQ(ierr);
ierr = PetscMalloc(ncuv*n*sizeof(PetscScalar),&blz->v);CHKERRQ(ierr);
 
ierr = PetscFree(blz->eig);CHKERRQ(ierr);
ierr = PetscMalloc(2*eps->ncv*sizeof(PetscReal),&blz->eig);CHKERRQ(ierr);
 
ierr = EPSAllocateSolutionContiguous(eps);CHKERRQ(ierr);
ierr = EPSDefaultGetWork(eps,1);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSolve_BLZPACK"
PetscErrorCode EPSSolve_BLZPACK(EPS eps)
{
PetscErrorCode ierr;
EPS_BLZPACK *blz = (EPS_BLZPACK *)eps->data;
PetscInt n, nn;
int i, nneig, lflag, nvopu;
Vec x, y;
PetscScalar sigma,*pV;
Mat A;
KSP ksp;
PC pc;
PetscFunctionBegin;
 
ierr = VecGetLocalSize(eps->vec_initial,&n); CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(eps->comm,n,PETSC_DECIDE,PETSC_NULL,&x);CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(eps->comm,n,PETSC_DECIDE,PETSC_NULL,&y);CHKERRQ(ierr);
ierr = VecGetArray(eps->V[0],&pV);CHKERRQ(ierr);
if (eps->isgeneralized && !blz->slice) {
ierr = STGetShift(eps->OP,&sigma);CHKERRQ(ierr); /* shift of origin */
blz->rstor[0] = sigma; /* lower limit of eigenvalue interval */
blz->rstor[1] = sigma; /* upper limit of eigenvalue interval */
} else {
sigma = 0.0;
blz->rstor[0] = blz->initial; /* lower limit of eigenvalue interval */
blz->rstor[1] = blz->final; /* upper limit of eigenvalue interval */
}
nneig = 0; /* no. of eigs less than sigma */
 
blz->istor[0] = n; /* number of rows of U, V, X*/
blz->istor[1] = n; /* leading dimension of U, V, X */
blz->istor[2] = eps->nev; /* number of required eigenpairs */
blz->istor[3] = eps->ncv; /* number of working eigenpairs */
blz->istor[4] = blz->block_size; /* number of vectors in a block */
blz->istor[5] = blz->nsteps; /* maximun number of steps per run */
blz->istor[6] = 1; /* number of starting vectors as input */
blz->istor[7] = 0; /* number of eigenpairs given as input */
blz->istor[8] = (blz->slice || eps->isgeneralized) ? 1 : 0; /* problem type */
blz->istor[9] = blz->slice; /* spectrum slicing */
blz->istor[10] = eps->isgeneralized ? 1 : 0; /* solutions refinement (purify) */
blz->istor[11] = 0; /* level of printing */
blz->istor[12] = 6; /* file unit for output */
blz->istor[13] = MPI_Comm_c2f(eps->comm); /* communicator */
 
blz->rstor[2] = eps->tol; /* threshold for convergence */
 
lflag = 0; /* reverse communication interface flag */
 
do {
 
BLZpack_( blz->istor, blz->rstor, &sigma, &nneig, blz->u, blz->v,
&lflag, &nvopu, blz->eig, pV );
 
switch (lflag) {
case 1:
/* compute v = OP u */
for (i=0;i<nvopu;i++) {
ierr = VecPlaceArray( x, blz->u+i*n );CHKERRQ(ierr);
ierr = VecPlaceArray( y, blz->v+i*n );CHKERRQ(ierr);
if (blz->slice || eps->isgeneralized) {
ierr = STAssociatedKSPSolve( eps->OP, x, y );CHKERRQ(ierr);
} else {
ierr = STApply( eps->OP, x, y ); CHKERRQ(ierr);
}
ierr = IPOrthogonalize(eps->ip,eps->nds,PETSC_NULL,eps->DS,y,PETSC_NULL,PETSC_NULL,PETSC_NULL,eps->work[0]);CHKERRQ(ierr);
ierr = VecResetArray(x);CHKERRQ(ierr);
ierr = VecResetArray(y);CHKERRQ(ierr);
}
/* monitor */
eps->nconv = BLZistorr_(blz->istor,"NTEIG",5);
EPSMonitor(eps,eps->its,eps->nconv,
blz->rstor+BLZistorr_(blz->istor,"IRITZ",5),
eps->eigi,
blz->rstor+BLZistorr_(blz->istor,"IRITZ",5)+BLZistorr_(blz->istor,"JT",2),
BLZistorr_(blz->istor,"NRITZ",5));
eps->its = eps->its + 1;
if (eps->its >= eps->max_it || eps->nconv >= eps->nev) lflag = 5;
break;
case 2:
/* compute v = B u */
for (i=0;i<nvopu;i++) {
ierr = VecPlaceArray( x, blz->u+i*n );CHKERRQ(ierr);
ierr = VecPlaceArray( y, blz->v+i*n );CHKERRQ(ierr);
ierr = IPApplyMatrix(eps->ip, x, y ); CHKERRQ(ierr);
ierr = VecResetArray(x);CHKERRQ(ierr);
ierr = VecResetArray(y);CHKERRQ(ierr);
}
break;
case 3:
/* update shift */
PetscInfo1(eps,"Factorization update (sigma=%g)\n",sigma);
ierr = STSetShift(eps->OP,sigma);CHKERRQ(ierr);
ierr = STGetKSP(eps->OP,&ksp);CHKERRQ(ierr);
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCGetFactoredMatrix(pc,&A);CHKERRQ(ierr);
ierr = MatGetInertia(A,&nn,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
nneig = nn;
break;
case 4:
/* copy the initial vector */
ierr = VecPlaceArray(x,blz->v);CHKERRQ(ierr);
ierr = EPSGetStartVector(eps,0,x,PETSC_NULL);CHKERRQ(ierr);
ierr = VecResetArray(x);CHKERRQ(ierr);
break;
}
} while (lflag > 0);
 
ierr = VecRestoreArray( eps->V[0], &pV ); CHKERRQ(ierr);
 
eps->nconv = BLZistorr_(blz->istor,"NTEIG",5);
eps->reason = EPS_CONVERGED_TOL;
 
for (i=0;i<eps->nconv;i++) {
eps->eigr[i]=blz->eig[i];
}
 
if (lflag!=0) {
char msg[2048] = "";
for (i = 0; i < 33; i++) {
if (blz->istor[15] & (1 << i)) PetscStrcat(msg, blzpack_error[i]);
}
SETERRQ2(PETSC_ERR_LIB,"Error in BLZPACK (code=%d): '%s'",blz->istor[15], msg);
}
ierr = VecDestroy(x);CHKERRQ(ierr);
ierr = VecDestroy(y);CHKERRQ(ierr);
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSBackTransform_BLZPACK"
PetscErrorCode EPSBackTransform_BLZPACK(EPS eps)
{
PetscErrorCode ierr;
EPS_BLZPACK *blz = (EPS_BLZPACK *)eps->data;
 
PetscFunctionBegin;
if (!blz->slice && !eps->isgeneralized) {
ierr = EPSBackTransform_Default(eps);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDestroy_BLZPACK"
PetscErrorCode EPSDestroy_BLZPACK(EPS eps)
{
PetscErrorCode ierr;
EPS_BLZPACK *blz = (EPS_BLZPACK *)eps->data;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
ierr = PetscFree(blz->istor);CHKERRQ(ierr);
ierr = PetscFree(blz->rstor);CHKERRQ(ierr);
ierr = PetscFree(blz->u);CHKERRQ(ierr);
ierr = PetscFree(blz->v);CHKERRQ(ierr);
ierr = PetscFree(blz->eig);CHKERRQ(ierr);
ierr = PetscFree(eps->data);CHKERRQ(ierr);
ierr = EPSFreeSolutionContiguous(eps);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSView_BLZPACK"
PetscErrorCode EPSView_BLZPACK(EPS eps,PetscViewer viewer)
{
PetscErrorCode ierr;
EPS_BLZPACK *blz = (EPS_BLZPACK *) eps->data;
PetscTruth isascii;
 
PetscFunctionBegin;
ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);CHKERRQ(ierr);
if (!isascii) {
SETERRQ1(1,"Viewer type %s not supported for EPSBLZPACK",((PetscObject)viewer)->type_name);
}
ierr = PetscViewerASCIIPrintf(viewer,"block size of the block-Lanczos algorithm: %d\n",blz->block_size);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"computational interval: [%f,%f]\n",blz->initial,blz->final);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetFromOptions_BLZPACK"
PetscErrorCode EPSSetFromOptions_BLZPACK(EPS eps)
{
PetscErrorCode ierr;
EPS_BLZPACK *blz = (EPS_BLZPACK *)eps->data;
PetscInt bs,n;
PetscReal interval[2];
PetscTruth flg;
KSP ksp;
PC pc;
 
PetscFunctionBegin;
ierr = PetscOptionsHead("BLZPACK options");CHKERRQ(ierr);
 
bs = blz->block_size;
ierr = PetscOptionsInt("-eps_blzpack_block_size","Block size","EPSBlzpackSetBlockSize",bs,&bs,&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSBlzpackSetBlockSize(eps,bs);CHKERRQ(ierr);}
 
n = blz->nsteps;
ierr = PetscOptionsInt("-eps_blzpack_nsteps","Number of steps","EPSBlzpackSetNSteps",n,&n,&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSBlzpackSetNSteps(eps,n);CHKERRQ(ierr);}
 
interval[0] = blz->initial;
interval[1] = blz->final;
n = 2;
ierr = PetscOptionsRealArray("-eps_blzpack_interval","Computational interval","EPSBlzpackSetInterval",interval,&n,&flg);CHKERRQ(ierr);
if (flg) {
if (n==1) interval[1]=interval[0];
ierr = EPSBlzpackSetInterval(eps,interval[0],interval[1]);CHKERRQ(ierr);
}
 
if (blz->slice || eps->isgeneralized) {
ierr = STSetType(eps->OP,STSINV);CHKERRQ(ierr);
ierr = STGetKSP(eps->OP,&ksp);CHKERRQ(ierr);
ierr = KSPSetType(ksp,KSPPREONLY);CHKERRQ(ierr);
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCCHOLESKY);CHKERRQ(ierr);
}
 
ierr = PetscOptionsTail();CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "EPSBlzpackSetBlockSize_BLZPACK"
PetscErrorCode EPSBlzpackSetBlockSize_BLZPACK(EPS eps,int bs)
{
EPS_BLZPACK *blz = (EPS_BLZPACK *) eps->data;;
 
PetscFunctionBegin;
if (bs == PETSC_DEFAULT) blz->block_size = 3;
else if (bs <= 0) {
SETERRQ(1, "Incorrect block size");
} else blz->block_size = bs;
PetscFunctionReturn(0);
}
EXTERN_C_END
 
#undef __FUNCT__
#define __FUNCT__ "EPSBlzpackSetBlockSize"
/*@
EPSBlzpackSetBlockSize - Sets the block size for the BLZPACK package.
 
Collective on EPS
 
Input Parameters:
+ eps - the eigenproblem solver context
- bs - block size
 
Options Database Key:
. -eps_blzpack_block_size - Sets the value of the block size
 
Level: advanced
 
.seealso: EPSBlzpackSetInterval()
@*/
PetscErrorCode EPSBlzpackSetBlockSize(EPS eps,int bs)
{
PetscErrorCode ierr, (*f)(EPS,int);
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
ierr = PetscObjectQueryFunction((PetscObject)eps,"EPSBlzpackSetBlockSize_C",(void (**)())&f);CHKERRQ(ierr);
if (f) {
ierr = (*f)(eps,bs);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "EPSBlzpackSetInterval_BLZPACK"
PetscErrorCode EPSBlzpackSetInterval_BLZPACK(EPS eps,PetscReal initial,PetscReal final)
{
PetscErrorCode ierr;
EPS_BLZPACK *blz = (EPS_BLZPACK *) eps->data;;
 
PetscFunctionBegin;
blz->initial = initial;
blz->final = final;
blz->slice = 1;
ierr = STSetShift(eps->OP,initial);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
EXTERN_C_END
 
#undef __FUNCT__
#define __FUNCT__ "EPSBlzpackSetInterval"
/*@
EPSBlzpackSetInterval - Sets the computational interval for the BLZPACK
package.
 
Collective on EPS
 
Input Parameters:
+ eps - the eigenproblem solver context
. initial - lower bound of the interval
- final - upper bound of the interval
 
Options Database Key:
. -eps_blzpack_interval - Sets the bounds of the interval (two values
separated by commas)
 
Note:
The following possibilities are accepted (see Blzpack user's guide for
details).
initial>final: start seeking for eigenpairs in the upper bound
initial<final: start in the lower bound
initial=final: run around a single value (no interval)
Level: advanced
 
.seealso: EPSBlzpackSetBlockSize()
@*/
PetscErrorCode EPSBlzpackSetInterval(EPS eps,PetscReal initial,PetscReal final)
{
PetscErrorCode ierr, (*f)(EPS,PetscReal,PetscReal);
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE,1);
ierr = PetscObjectQueryFunction((PetscObject)eps,"EPSBlzpackSetInterval_C",(void (**)())&f);CHKERRQ(ierr);
if (f) {
ierr = (*f)(eps,initial,final);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "EPSBlzpackSetNSteps_BLZPACK"
PetscErrorCode EPSBlzpackSetNSteps_BLZPACK(EPS eps,int nsteps)
{
EPS_BLZPACK *blz = (EPS_BLZPACK *) eps->data;
 
PetscFunctionBegin;
blz->nsteps = nsteps == PETSC_DEFAULT ? 0 : nsteps;
PetscFunctionReturn(0);
}
EXTERN_C_END
 
#undef __FUNCT__
#define __FUNCT__ "EPSBlzpackSetNSteps"
/*@
EPSBlzpackSetNSteps - Sets the maximum number of steps per run for the BLZPACK
package.
 
Collective on EPS