Subversion Repositories slepc-dev

Compare Revisions

Ignore whitespace Rev 5 → Rev 6

/trunk/bmake/linux/packages
0,0 → 1,38
 
#
# This file contains site-specific information. The definitions below
# should be changed to match the locations of libraries at your site.
# The following naming convention is used:
# XXX_LIB - location of library XXX
# XXX_INCLUDE - directory for include files needed for library XXX
#
# ----------------------------------------------------------------------------------------
# Locations of OPTIONAL packages. Comment out those you do not have.
# ----------------------------------------------------------------------------------------
#
# Location of ARPACK (MPI version)
#
ARPACK_INCLUDE =
ARPACK_LIB = -L/usr/local/soft/ARPACK/lib/lib${BOPT}/${PETSC_ARCH} -lparpack -larpack
SLEPC_HAVE_ARPACK = -DSLEPC_HAVE_ARPACK
 
#
# Location of BLZPACK
#
#BLZPACK_INCLUDE =
#BLZPACK_LIB = -L/home/jroman/soft/blzpack/lib/${PETSC_ARCH} -lblzpack
#SLEPC_HAVE_BLZPACK = -DSLEPC_HAVE_BLZPACK
 
#
# Location of PLANSO
#
#PLANSO_INCLUDE =
#PLANSO_LIB = -L/home/jroman/soft/PLAN/lib/${PETSC_ARCH} -lplan -llanso
#SLEPC_HAVE_PLANSO = -DSLEPC_HAVE_PLANSO
 
#
# Location of TRLAN
#
#TRLAN_INCLUDE =
#TRLAN_LIB = -L/home/jroman/soft/TRLan/lib/${PETSC_ARCH} -ltrlan_mpi -L${PGI}/linux86/lib -lpgf90 -lpgf90_rpm1 -lpgf902 -lpgftnrtl -lpgc
#SLEPC_HAVE_TRLAN = -DSLEPC_HAVE_TRLAN
/trunk/bmake/slepc_common_basic
0,0 → 1,208
 
slepc_oshared: slepc_chk_dir
-@echo "BEGINNING TO BUILD SLEPC SHARED LIBRARIES"
-@echo "========================================="
@for LIBNAME in ${SLEPC_SHLIBS}; do \
cd ${SLEPC_PDIR}; ${OMAKE} -f ${SLEPC_DIR}/makefile oshared LIBNAME=$$LIBNAME; \
done
-@echo "Completed building SLEPC shared libraries"
-@echo "========================================="
 
#
# Builds Fortran-77 wrappers
#
slepc_fortranstubs:
@-bfort -dir ${SLEPC_DIR}/src/fortran/auto \
-mnative -ansi -nomsgs -anyname -mapptr -mpi -ferr -ptrprefix Petsc\
-ptr64 PETSC_USE_POINTER_CONVERSION -fcaps PETSC_HAVE_FORTRAN_CAPS \
-fuscore PETSC_HAVE_FORTRAN_UNDERSCORE ${SOURCEC}
slepc_fixfortran:
@echo "Fixing pointers in src/fortran/auto"
-@for FILENAME in ${SOURCEC} ; do \
if [ ! -f $$FILENAME ]; then \
echo "Error: file $$FILENAME specified in SOURCEC does not exist."; \
else \
cat $$FILENAME | \
sed "s/^void /void PETSC_STDCALL /" | \
sed "s/PetscToPointer(int)/PetscToPointer(void *)/" | \
sed "s/PetscRmPointer(int)/PetscRmPointer(void *)/" | \
sed "s/PetscToPointer(a) (a)/PetscToPointer(a) (*(long *)(a))/" | \
sed "s/PetscFromPointer(a) (int)(a)/PetscFromPointer(a) (long)(a)/" | \
sed "s/PetscToPointer( \*(int\*)/PetscToPointer( /" >_$$FILENAME; \
/bin/mv _$$FILENAME $$FILENAME ;\
fi; \
done
 
#
#
slepc_deleteshared: chkopts_basic
${RM} ${SLEPC_LDIR}/*.${SLSUFFIX} ${SLEPC_LDIR}/so_locations
 
slepc_noshared:
 
# ---------------------------------------------------------------------------------------
# Rules for the automatic generation of documentation, tutorials etc
# See rule for allmanualpages and allhtml in ${PETSC_DIR}/makefile
#
# Builds manual pages in HTML in two stages
# 1.) manualpages_buildcite: builds the file manualpages.cit for hyperlinks
# 2.) manualpages: builds the html pages, complete with hyperlinks
 
slepc_chk_manualpage_dir:
@if [ ! -d "${SLEPC_DIR}/docs/manualpages/${MANSEC}" ]; then \
echo Making directory ${SLEPC_DIR}/docs/manualpages/${MANSEC} for library; \
${MKDIR} ${SLEPC_DIR}/docs/manualpages/${MANSEC}; fi
 
slepc_manualpages_buildcite: slepc_chk_manualpage_dir
@-if [ "${MANSEC}" != "" ] ; then \
doctext -html -indexdir ../${MANSEC} \
-index ${SLEPC_DIR}/docs/manualpages/manualpages.cit \
-mpath ${SLEPC_DIR}/docs/manualpages/${MANSEC} ${SOURCEC} ${SOURCEH}; fi
#
#
slepc_manualpages:
-@if [ "${MANSEC}" != "" ] ; then \
doctext -html \
-mpath ${LOC}/docs/manualpages/${MANSEC} -heading SLEPc \
-defn ${SLEPC_DIR}/docs/tex/doctext/html.def \
-locdir ${LOCDIR} -mapref ${LOC}/docs/manualpages/manualpages.cit \
${SOURCEC} ${SOURCEH}; fi
#
# Example usage for manual pages; adds each example that uses a function to that functions
# manual page up to a limit of 10 examples.
#
slepc_manexamples:
-@base=`basename ${LOCDIR}`; \
if [ "$${base}" = "tutorials" ] ; then \
echo "Generating manual example links" ; \
for i in ${EXAMPLESC} ${EXAMPLESF} foo ; do \
if [ "$$i" != "foo" ] ; then \
a=`cat $$i | mapnames -map ${LOC}/docs/manualpages/manualpages.cit \
-printmatch -o /dev/null | sort | uniq` ; \
for j in $$a ; do \
b=`ls ${LOC}/docs/manualpages/*/$${j}.html | cut -f9` ; \
l=`grep tutorials $${b} | wc -l`; \
if [ $$l -le 10 ] ; then \
if [ $$l -eq 0 ] ; then \
echo "<P><H3><FONT COLOR=\"#CC3333\">Examples</FONT></H3>" >> $$b; \
fi; \
echo "<A HREF=\"../../../BB\">BB</A><BR>" | sed s?BB?${LOCDIR}$$i.html?g >> $$b; \
grep -v /BODY $$b > ltmp; \
echo "</BODY></HTML>" >> ltmp; \
mv -f ltmp $$b; \
fi; \
done; \
fi; \
done; \
fi
 
#
# Goes through all examples adding the Concepts: to the /tmp/exampleconcepts file
#
slepc_exampleconcepts:
-@base=`basename ${LOCDIR}`; \
if [ "$${base}" = "tutorials" ] ; then \
echo "Generating concepts list" ; \
for i in ${EXAMPLESC} ${EXAMPLESF} foo ; do \
if [ "$$i" != "foo" ] ; then \
grep Concepts: $$i | sed -e s?Concepts:??g -e s?\!??g > ltmp; \
line=`cat ltmp | wc -l`; \
line=`expr $$line - 1` ; \
line=`expr $$line + 1` ; \
while [ $$line -gt 0 ] ; do \
a=`head -$$line ltmp | tail -1`; \
echo ${LOCDIR}$$i $$a >> ${LOC}/docs/tex/exampleconcepts; \
line=`expr $$line - 1` ; \
done; \
${RM} ltmp; \
fi; \
done; \
fi
#
# Goes through all manual pages removing the Concepts: field and adding the
# concepts to the /tmp/manconcepts file
#
slepc_manconcepts:
-@${RM} ${LOC}/docs/tex/manconcepts ${LOC}/docs/tex/exampleconcepts
-@for i in docs/manualpages/*/*.html ; do \
${RM} ltmp; \
grep Concepts: $$i | sed s?Concepts:??g > ltmp; \
line=`cat ltmp | wc -l`; \
line=`expr $$line - 1` ; \
line=`expr $$line + 1` ; \
if [ $$line -gt 0 ] ; then \
while [ $$line -gt 0 ] ; do \
a=`head -$$line ltmp | tail -1`; \
echo $$i $$a >> ${LOC}/docs/tex/manconcepts; \
line=`expr $$line - 1` ; \
done; \
grep -v Concepts: $$i > tmp; \
mv tmp $$i; \
fi; \
${RM} ltmp; \
done
 
slepc_getexlist:
-${SLEPC_DIR}/maint/getexlist -locdir ${LOCDIR} -byfile -destdir ${LOC}/docs/manualpages/concepts/ ${EXAMPLESC$ {EXAMPLESF}
-@rm -f logfile.txt
#
# Rules for generating html code from C and Fortran
#
slepc_html:
-@sed -e s?man+../?man+ROOT/docs/manualpages/? ${LOC}/docs/manualpages/manualpages.cit > /tmp/$$USER.htmlmap
-@cat /home/jroman/tmp/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`; \
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; \
grep -v __FUNCT__ $$i | sed -e "s/CHKERRQ(ierr);//g" -e "s/PetscFunctionReturn(0)/return(0)/g" \
-e "s/ierr = //g" | c2html -n | ${PETSC_DIR}/maint/fixinclude $$i $${ROOT} | \
grep -v PetscValid | grep -v PetscFunctionBegin | grep -v PetscCheck | grep -v "int ierr;" |\
grep -v '#if !defined(__' | grep -v '#define __' | \
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 ${PETSC_DIR}/docs/manualpages/sec/bop.${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
 
slepc_cleanhtml:
-@${RM} makefile.html *.c.html *.F.html *.h.html *.h90.html inex.html *.m.html
 
 
/trunk/bmake/slepc_common_variables
0,0 → 1,77
#
# SLEPc-specific definitions:
#
# SLEPC_LIB_DIR (defined from $SLEPC_DIR) determines the libraries that are linked.
# SLEPC_PDIR (defined from $SLEPC_DIR) determines where the libraries are built.
# SLEPC_LIB_DIR and SLEPC_PDIR will usually be identical.
#
# If you change SLEPC_PDIR in your makefile you MUST put it after the
# include line.
#
# LIBNAME - library name
# SLEPC_INCLUDE - locations of include files
#
# Definitions from the PETSc makefile system:
#
# SOURCE - source files
# SSOURCE - single precision versions of some source code
# OBJS - object files
# SOBJS - single precision versions of some object files
# DOCS - files that contain documentation, readmes etc.
# CPPFLAGS - preprocessor flags for *.c, *.F preprocessing
# PETSC_PARCH - corresponds to the PARCH_arch in the source files, set in
# the file bmake/${PETSC_ARCH}/base
#
INSTALL_LIB_DIR = ${SLEPC_DIR}/lib/lib${BOPT}/${PETSC_ARCH}
SLEPC_LIB_DIR = ${SLEPC_DIR}/lib/lib${BOPT}/${PETSC_ARCH}
SLEPC_INCLUDE = -I${SLEPC_DIR} -I${SLEPC_DIR}/include
CCPPFLAGS = ${SLEPC_INCLUDE} ${PETSC_CCPPFLAGS}
FCPPFLAGS = ${SLEPC_INCLUDE} ${PETSC_FCPPFLAGS}
 
C_SH_LIB_PATH = ${CLINKER_SLFLAG}${SLEPC_LIB_DIR} ${PETSC_C_SH_LIB_PATH}
F_SH_LIB_PATH = ${FLINKER_SLFLAG}${SLEPC_LIB_DIR} ${PETSC_F_SH_LIB_PATH}
#
# Defines all libraries needed for using SLEPC as well as all lower-level PETSc
# components (such as vectors and matrices). The order of listing these libraries
# is important!
#
SLEPC_LIB = -L${SLEPC_LIB_DIR} -lslepc ${SLEPC_EXTERNAL_LIB} ${PETSC_SLES_LIB}
# SLEPC_LIB = -L${SLEPC_LIB_DIR} -lslepc
# SLEPC_LIB = -L${SLEPC_LIB_DIR} -lslepc ${PETSC_SYS_LIB}
# SLEPC_LIB = -L${SLEPC_LIB_DIR} -lslepc ${PETSC_SLES_LIB}
# SLEPC_LIB = ${SLEPC_LIB_DIR}/libslepc.a ${PETSC_SLES_LIB}
#
# Link if you are using the SLEPC Fortran interface.
#
#SLEPC_FORTRAN_LIB = -L${SLEPC_LIB_DIR} -lslepcfortran
SLEPC_FORTRAN_LIB = -L${SLEPC_LIB_DIR} -lslepcfortran ${PETSC_FORTRAN_LIB}
#
# Link if you are using code from the contributed part of SLEPC
#
SLEPC_CONTRIB = -L${SLEPC_LIB_DIR} -lslepccontrib
# ---------------------------------------------------------------------------------------
#
# PCONF - indicates which OPTIONAL external packages are available at your site; appropriate
# ones are defined in bmake/${PETSC_ARCH}/packages (as are the library locations).
# Ones that are not defined are ignored. You only need to edit this to add a new
# package that SLEPc has never seen before. Never remove any of these, rather remove
# them from the appropriate bmake/${PETSC_ARCH}/packages
#
#
PCONF_PETSC = ${PETSC_HAVE_MPE} ${PETSC_HAVE_BLOCKSOLVE} ${PETSC_HAVE_PVODE} ${PETSC_HAVE_PARMETIS} ${PETSC_HAVE_AMS} ${PETSC_HAVE_SPAI} ${PETSC_HAVE_X11} ${PETSC_HAVE_MATLAB_ENGINE} ${PETSC_HAVE_ADIC} ${PETSC_HAVE_JAVA} ${PETSC_HAVE_LUSOL} ${PETSC_HAVE_DSCPACK} ${PETSC_HAVE_RAMG} ${PETSC_HAVE_MATLAB} ${PETSC_HAVE_ESSL} ${PETSC_HAVE_ADIFOR} ${PETSC_HAVE_SUPERLUDIST} ${PETSC_HAVE_SUPERLU} ${PETSC_HAVE_SPOOLES} ${PETSC_HAVE_UMFPACK} ${PETSC_HAVE_CCA} ${PETSC_HAVE_TRILINOS} ${PETSC_HAVE_HYPRE} ${PETSC_HAVE_MATHEMATICA} ${PETSC_HAVE_TRIANGLE} ${PETSC_HAVE_PLAPACK} ${PETSC_HAVE_SAMG}
 
PCONF = ${PCONF_PETSC} ${SLEPC_HAVE_ARPACK} ${SLEPC_HAVE_BLZPACK} ${SLEPC_HAVE_PLANSO} ${SLEPC_HAVE_TRLAN}
SLEPC_EXTERNAL_LIB = ${ARPACK_LIB} ${BLZPACK_LIB} ${PLANSO_LIB} ${TRLAN_LIB}
#
# Some variables used to build shared libraries
#
SHLIBS = libslepc libslepcfortran
 
# The following include file defines the packages installed in your system.
#
include ${SLEPC_DIR}/bmake/${PETSC_ARCH}/packages
 
slepc_clean: clean
slepc_chkopts: chkopts
slepc_testexamples_1: testexamples_1
 
/trunk/bmake/linux_intel/packages
0,0 → 1,38
 
#
# This file contains site-specific information. The definitions below
# should be changed to match the locations of libraries at your site.
# The following naming convention is used:
# XXX_LIB - location of library XXX
# XXX_INCLUDE - directory for include files needed for library XXX
#
# ----------------------------------------------------------------------------------------
# Locations of OPTIONAL packages. Comment out those you do not have.
# ----------------------------------------------------------------------------------------
#
# Location of ARPACK (MPI version)
#
ARPACK_INCLUDE =
ARPACK_LIB = -L/usr/local/soft/ARPACK/lib/lib${BOPT}/${PETSC_ARCH} -lparpack -larpack
SLEPC_HAVE_ARPACK = -DSLEPC_HAVE_ARPACK
 
#
# Location of BLZPACK
#
#BLZPACK_INCLUDE =
#BLZPACK_LIB = -L/home/jroman/soft/blzpack/lib/${PETSC_ARCH} -lblzpack
#SLEPC_HAVE_BLZPACK = -DSLEPC_HAVE_BLZPACK
 
#
# Location of PLANSO
#
#PLANSO_INCLUDE =
#PLANSO_LIB = -L/home/jroman/soft/PLAN/lib/${PETSC_ARCH} -lplan -llanso
#SLEPC_HAVE_PLANSO = -DSLEPC_HAVE_PLANSO
 
#
# Location of TRLAN
#
#TRLAN_INCLUDE =
#TRLAN_LIB = -L/home/jroman/soft/TRLan/lib/${PETSC_ARCH} -ltrlan_mpi -L${PGI}/linux86/lib -lpgf90 -lpgf90_rpm1 -lpgf902 -lpgftnrtl -lpgc
#SLEPC_HAVE_TRLAN = -DSLEPC_HAVE_TRLAN
/trunk/bmake/linux_pgi/packages
0,0 → 1,38
 
#
# This file contains site-specific information. The definitions below
# should be changed to match the locations of libraries at your site.
# The following naming convention is used:
# XXX_LIB - location of library XXX
# XXX_INCLUDE - directory for include files needed for library XXX
#
# ----------------------------------------------------------------------------------------
# Locations of OPTIONAL packages. Comment out those you do not have.
# ----------------------------------------------------------------------------------------
#
# Location of ARPACK (MPI version)
#
#ARPACK_INCLUDE =
#ARPACK_LIB = -L/home/jroman/soft/ARPACK/lib/${PETSC_ARCH} -lparpack -larpack
#SLEPC_HAVE_ARPACK = -DSLEPC_HAVE_ARPACK
 
#
# Location of BLZPACK
#
#BLZPACK_INCLUDE =
#BLZPACK_LIB = -L/home/jroman/soft/blzpack/lib/${PETSC_ARCH} -lblzpack
#SLEPC_HAVE_BLZPACK = -DSLEPC_HAVE_BLZPACK
 
#
# Location of PLANSO
#
#PLANSO_INCLUDE =
#PLANSO_LIB = -L/home/jroman/soft/PLAN/lib/${PETSC_ARCH} -lplan -llanso
#SLEPC_HAVE_PLANSO = -DSLEPC_HAVE_PLANSO
 
#
# Location of TRLAN
#
#TRLAN_INCLUDE =
#TRLAN_LIB = -L/home/jroman/soft/TRLan/lib/${PETSC_ARCH} -ltrlan_mpi
#SLEPC_HAVE_TRLAN = -DSLEPC_HAVE_TRLAN
/trunk/bmake/linux_smp/packages
0,0 → 1,38
 
#
# This file contains site-specific information. The definitions below
# should be changed to match the locations of libraries at your site.
# The following naming convention is used:
# XXX_LIB - location of library XXX
# XXX_INCLUDE - directory for include files needed for library XXX
#
# ----------------------------------------------------------------------------------------
# Locations of OPTIONAL packages. Comment out those you do not have.
# ----------------------------------------------------------------------------------------
#
# Location of ARPACK (MPI version)
#
#ARPACK_INCLUDE =
#ARPACK_LIB = -L/usr/local/soft/ARPACK/lib/lib${BOPT}/${PETSC_ARCH} -lparpack -larpack
#SLEPC_HAVE_ARPACK = -DSLEPC_HAVE_ARPACK
 
#
# Location of BLZPACK
#
#BLZPACK_INCLUDE =
#BLZPACK_LIB = -L/home/jroman/soft/blzpack/lib/${PETSC_ARCH} -lblzpack
#SLEPC_HAVE_BLZPACK = -DSLEPC_HAVE_BLZPACK
 
#
# Location of PLANSO
#
#PLANSO_INCLUDE =
#PLANSO_LIB = -L/home/jroman/soft/PLAN/lib/${PETSC_ARCH} -lplan -llanso
#SLEPC_HAVE_PLANSO = -DSLEPC_HAVE_PLANSO
 
#
# Location of TRLAN
#
#TRLAN_INCLUDE =
#TRLAN_LIB = -L/home/jroman/soft/TRLan/lib/${PETSC_ARCH} -ltrlan_mpi -L${PGI}/linux86/lib -lpgf90 -lpgf90_rpm1 -lpgf902 -lpgftnrtl -lpgc
#SLEPC_HAVE_TRLAN = -DSLEPC_HAVE_TRLAN
/trunk/bmake/slepc_common
0,0 → 1,14
#
# 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.
#
include ${PETSC_DIR}/bmake/common/base
 
include ${SLEPC_DIR}/bmake/slepc_common_variables
 
include ${SLEPC_DIR}/bmake/slepc_common_basic
 
include ${PETSC_DIR}/bmake/common/test
/trunk/include/slepcversion.h
0,0 → 1,17
#if !defined(__SLEPCVERSION_H)
#define __SLEPCVERSION_H
 
/* ========================================================================== */
/*
Current SLEPC version number and release date
*/
#define SLEPC_VERSION_NUMBER "SLEPc Version 2.1.5-3, Released Sep 25, 2003"
#define SLEPC_VERSION_MAJOR 2
#define SLEPC_VERSION_MINOR 1
#define SLEPC_VERSION_SUBMINOR 5
#define SLEPC_VERSION_PATCH 3
#define SLEPC_VERSION_DATE "Sep 25, 2003"
#define SLEPC_AUTHOR_INFO "The SLEPc Team\n\
Bug reports, questions: slepc-maint@grycap.upv.es\n\
Web page: http://www.grycap.upv.es/slepc\n"
#endif
/trunk/include/slepcst.h
0,0 → 1,70
 
/*
Spectral transformation module for eigenvalue problems.
*/
#if !defined(__SLEPCST_H)
#define __SLEPCST_H
#include "petscsles.h"
 
extern int ST_COOKIE;
 
typedef struct _p_ST* ST;
 
#define STNONE "none"
#define STSHELL "shell"
#define STSHIFT "shift"
#define STSINV "sinvert"
typedef char *STType;
 
extern int STCreate(MPI_Comm,ST*);
extern int STDestroy(ST);
extern int STSetType(ST,STType);
extern int STGetType(ST,STType*);
extern int STSetOperators(ST,Mat,Mat);
extern int STGetOperators(ST,Mat*,Mat*);
extern int STSetUp(ST);
extern int STSetFromOptions(ST);
extern int STView(ST,PetscViewer);
 
extern int STApply(ST,Vec,Vec);
extern int STApplyB(ST,Vec,Vec);
extern int STApplyNoB(ST,Vec,Vec);
 
extern PetscFList STList;
extern int STRegisterAll(char*);
extern int STRegisterDestroy(void);
extern int STRegister(char*,char*,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 int STSetSLES(ST,SLES);
extern int STGetSLES(ST,SLES*);
extern int STSetShift(ST,PetscScalar);
extern int STGetShift(ST,PetscScalar*);
extern int STGetNumberOfShifts(ST,int*);
 
extern int STSetVector(ST,Vec);
extern int STGetVector(ST,Vec*);
 
extern int STSetOptionsPrefix(ST,char*);
extern int STAppendOptionsPrefix(ST,char*);
extern int STGetOptionsPrefix(ST,char**);
 
extern int STBackTransform(ST,PetscScalar*,PetscScalar*);
extern int STAssociatedSLESSolve(ST,Vec,Vec);
 
/* --------- options specific to particular spectral transformations-------- */
 
extern int STSinvertSetShiftMat(ST);
extern int STSinvertSetMatStructure(ST,MatStructure);
 
extern int STShellSetApply(ST, int (*)(void*,Vec,Vec), void*);
extern int STShellSetBackTransform(ST, int (*)(void*,PetscScalar*,PetscScalar*));
extern int STShellSetName(ST,char*);
extern int STShellGetName(ST,char**);
 
#endif
 
/trunk/include/slepceps.h
0,0 → 1,138
/*
User interface for the SLEPC eigenproblem solvers.
*/
#if !defined(__SLEPCEPS_H)
#define __SLEPCEPS_H
#include "slepc.h"
#include "slepcst.h"
 
extern int EPS_COOKIE;
 
/*S
EPS - Abstract SLEPc object that manages all the eigenvalue
problem solvers.
 
Level: beginner
 
Concepts: eigen solvers
 
.seealso: EPSCreate(), ST
S*/
typedef struct _p_EPS* EPS;
 
#define EPSPOWER "power"
#define EPSRQI "rqi"
#define EPSSUBSPACE "subspace"
#define EPSARNOLDI "arnoldi"
#define EPSLAPACK "lapack"
/* the next ones are interfaces to external libraries */
#define EPSARPACK "arpack"
#define EPSBLZPACK "blzpack"
#define EPSPLANSO "planso"
#define EPSTRLAN "trlan"
 
typedef char * EPSType;
 
typedef enum { EPS_HEP=1, EPS_GHEP,
EPS_NHEP, EPS_GNHEP } EPSProblemType;
 
typedef enum { EPS_LARGEST_MAGNITUDE, EPS_SMALLEST_MAGNITUDE,
EPS_LARGEST_ALGEBRAIC, EPS_SMALLEST_ALGEBRAIC,
EPS_LARGEST_REAL, EPS_SMALLEST_REAL,
EPS_LARGEST_IMAGINARY, EPS_SMALLEST_IMAGINARY,
EPS_BOTH_ENDS } EPSWhich;
 
typedef enum { EPS_MGS_ORTH, EPS_CGS_ORTH,
EPS_IR_ORTH } EPSOrthogonalizationType;
 
extern int EPSCreate(MPI_Comm,EPS *);
extern int EPSDestroy(EPS);
extern int EPSSetType(EPS,EPSType);
extern int EPSGetType(EPS,EPSType*);
extern int EPSSetProblemType(EPS,EPSProblemType);
extern int EPSGetProblemType(EPS,EPSProblemType*);
extern int EPSSetOperators(EPS,Mat,Mat);
extern int EPSSetFromOptions(EPS);
extern int EPSSetUp(EPS);
extern int EPSSolve(EPS,int*);
extern int EPSView(EPS,PetscViewer);
 
extern PetscFList EPSList;
extern int EPSRegisterAll(char *);
extern int EPSRegisterDestroy(void);
extern int EPSRegister(char*,char*,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 int EPSSetST(EPS,ST);
extern int EPSGetST(EPS,ST*);
extern int EPSSetTolerances(EPS,PetscReal,int);
extern int EPSGetTolerances(EPS,PetscReal*,int*);
extern int EPSSetDimensions(EPS,int,int);
extern int EPSGetDimensions(EPS,int*,int*);
 
extern int EPSGetConverged(EPS,int*);
extern int EPSGetSolution(EPS,PetscScalar**,PetscScalar**,Vec**);
extern int EPSComputeError(EPS,PetscReal*);
extern int EPSGetErrorEstimates(EPS,PetscReal**);
 
extern int EPSSetMonitor(EPS,int (*)(EPS,int,int,PetscReal*,int,void*),void*);
extern int EPSSetValuesMonitor(EPS,int (*)(EPS,int,int,PetscScalar*,PetscScalar*,int,void*),void*);
extern int EPSClearMonitor(EPS);
extern int EPSGetMonitorContext(EPS,void **);
extern int EPSGetIterationNumber(EPS,int*);
 
extern int EPSSetInitialVector(EPS,Vec);
extern int EPSGetInitialVector(EPS,Vec*);
extern int EPSSetDropEigenvectors(EPS);
extern int EPSSetWhichEigenpairs(EPS,EPSWhich);
extern int EPSGetWhichEigenpairs(EPS,EPSWhich*);
extern int EPSSetOrthogonalization(EPS,EPSOrthogonalizationType);
extern int EPSGetOrthogonalization(EPS,EPSOrthogonalizationType*);
 
extern int EPSIsGeneralized(EPS,PetscTruth*);
extern int EPSIsHermitian(EPS,PetscTruth*);
 
extern int EPSDefaultEstimatesMonitor(EPS,int,int,PetscReal*,int,void*);
extern int EPSDefaultValuesMonitor(EPS,int,int,PetscScalar*,PetscScalar*,int,void*);
 
extern int EPSSetOptionsPrefix(EPS,char*);
extern int EPSAppendOptionsPrefix(EPS,char*);
extern int EPSGetOptionsPrefix(EPS,char**);
 
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 int EPSGetConvergedReason(EPS,EPSConvergedReason *);
 
extern int EPSBackTransform(EPS);
extern int EPSComputeExplicitOperator(EPS,Mat*);
extern int EPSSortEigenvalues(int,PetscScalar*,PetscScalar*,EPSWhich,int,int*);
extern int EPSDenseNHEP(int,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*);
extern int EPSDenseNHEPSorted(int,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,int,EPSWhich);
extern int EPSQRDecomposition(EPS,int,int,PetscScalar*,int);
extern int EPSReverseProjection(EPS,int,int,PetscScalar*);
extern int EPSSwapEigenpairs(EPS,int,int);
 
extern int STPreSolve(ST,EPS);
extern int STPostSolve(ST,EPS);
extern int EPSSetDefaults(EPS eps);
 
/* --------- options specific to particular eigensolvers -------- */
 
extern int EPSSubspaceSetInner(EPS,int);
 
extern int EPSBlzpackSetBlockSize(EPS,int);
extern int EPSBlzpackSetInterval(EPS,PetscReal,PetscReal);
extern int EPSBlzpackSetMatGetInertia(EPS,int (*f)(Mat,int*,int*,int*));
 
#endif
 
/trunk/include/finclude/slepcst.h
0,0 → 1,16
 
!
! Include file for Fortran use of the ST object in SLEPc
!
#if !defined(__SLEPCST_H)
#define __SLEPCST_H
 
#define ST PetscFortranAddr
#define STType character*(80)
 
#define STNONE 'none'
#define STSHELL 'shell'
#define STSHIFT 'shift'
#define STSINV 'sinvert'
 
#endif
/trunk/include/finclude/slepceps.h
0,0 → 1,37
 
!
! Include file for Fortran use of the EPS object in SLEPc
!
#if !defined(__SLEPCEPS_H)
#define __SLEPCEPS_H
 
#define EPS PetscFortranAddr
#define EPSType character*(80)
#define EPSConvergedReason integer
 
#define EPSPOWER 'power'
#define EPSRQI 'rqi'
#define EPSSUBSPACE 'subspace'
#define EPSARNOLDI 'arnoldi'
#define EPSLAPACK 'lapack'
#define EPSARPACK 'arpack'
#define EPSBLZPACK 'blzpack'
#define EPSPLANSO 'planso'
#define EPSTRLAN 'trlan'
 
! 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)
 
#endif
/trunk/include/finclude/slepc.h
0,0 → 1,36
!
! Include file for Fortran use of the SLEPc package
 
#include "petscconf.h"
#include "finclude/petscdef.h"
 
#if !defined (PETSC_AVOID_DECLARATIONS)
! ------------------------------------------------------------------------
! BEGIN COMMON-BLOCK VARIABLES
 
! Fortran Null
!
character*(80) SLEPC_NULL_CHARACTER
PetscFortranInt SLEPC_NULL_INTEGER
PetscFortranDouble SLEPC_NULL_DOUBLE
PetscScalar SLEPC_NULL_SCALAR
!
! A SLEPC_NULL_FUNCTION pointer
!
! external SLEPC_NULL_FUNCTION
!
! Common block to store some of the SLEPc constants,
! which can be set only at runtime.
! (A string should be in a different common block.)
!
common /slepcfortran1/ SLEPC_NULL_CHARACTER
common /slepcfortran2/ SLEPC_NULL_INTEGER
common /slepcfortran3/ SLEPC_NULL_SCALAR
common /slepcfortran4/ SLEPC_NULL_DOUBLE
 
! END COMMON-BLOCK VARIABLES
! ----------------------------------------------------------------------------
!
! End of Fortran include file for the SLEPc package
 
#endif
/trunk/include/finclude/makefile
0,0 → 1,20
 
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:
 
 
 
 
/trunk/include/slepcblaslapack.h
0,0 → 1,120
/*
Necessary routines in BLAS and LAPACK not included in petscblaslapack.f
 
*/
#if !defined(_SLEPCBLASLAPACK_H)
#define _SLEPCBLASLAPACK_H
 
#include "petscblaslapack.h"
 
#if !defined(PETSC_USE_COMPLEX)
 
/*
These are real case with no character string arguments
*/
 
#if defined(PETSC_USES_FORTRAN_SINGLE)
/*
For these machines we must call the single precision Fortran version
*/
#define DLARNV SLARNV
#define DLAPY2 SLAPY2
#define DGELQF SGELQF
#define DORMLQ SORMLQ
#define DHSEQR SHSEQR
#define DTREVC STREVC
#define DGEHRD SGEHRD
#define DGEES SGEES
#endif
 
#if defined(PETSC_HAVE_FORTRAN_UNDERSCORE) || defined(PETSC_BLASLAPACK_F2C)
#define LArnv_ dlarnv_
#define LAlapy2_ dlapy2_
#define LAgelqf_ dgelqf_
#define LAormlq_ dormlq_
#define LAhseqr_ dhseqr_
#define LAtrevc_ dtrevc_
#define LAgehrd_ dgehrd_
#define LAgees_ dgees_
#elif defined(PETSC_HAVE_FORTRAN_CAPS)
#define LArnv_ DLARNV
#define LAlapy2_ DLAPY2
#define LAgelqf_ DGELQF
#define LAormlq_ DORMLQ
#define LAhseqr_ DHSEQR
#define LAtrevc_ DTREVC
#define LAgehrd_ DGEHRD
#define LAgees_ DGEES
#else
#define LArnv_ dlarnv
#define LAlapy2_ dlapy2
#define LAgelqf_ dgelqf
#define LAormlq_ dormlq
#define LAhseqr_ dhseqr
#define LAtrevc_ dtrevc
#define LAgehrd_ dgehrd
#define LAgees_ dgees
#endif
 
#else
/*
Complex with no character string arguments
*/
#if defined(PETSC_USES_FORTRAN_SINGLE)
#define ZLARNV CLARNV
#define ZGELQF CGELQF
#define ZUNMLQ CUNMLQ
#define ZHSEQR CHSEQR
#define ZTREVC CTREVC
#define ZGEHRD CGEHRD
#define ZGEES CGEES
#endif
 
#if defined(PETSC_HAVE_FORTRAN_UNDERSCORE) || defined(PETSC_BLASLAPACK_F2C)
#define LArnv_ zlarnv_
#define LAgelqf_ zgelqf_
#define LAormlq_ zunmlq_
#define LAhseqr_ zhseqr_
#define LAtrevc_ ztrevc_
#define LAgehrd_ zgehrd_
#define LAgees_ zgees_
#elif defined(PETSC_HAVE_FORTRAN_CAPS)
#define LArnv_ ZLARNV
#define LAgelqf_ ZGELQF
#define LAormlq_ ZUNMLQ
#define LAhseqr_ ZHSEQR
#define LAtrevc_ ZTREVC
#define LAgehrd_ ZGEHRD
#define LAgees_ ZGEES
#else
#define LArnv_ zlarnv
#define LAgelqf_ zgelqf
#define LAormlq_ zunmlq
#define LAhseqr_ zhseqr
#define LAtrevc_ ztrevc
#define LAgehrd_ zgehrd
#define LAgees_ zgees
#endif
 
#endif
 
EXTERN_C_BEGIN
 
extern void LArnv_(int*,int*,int*,PetscScalar*);
extern double LAlapy2_(double*,double*);
extern void LAgelqf_(int*,int*,PetscScalar*,int*,PetscScalar*,PetscScalar*,int*,int*);
extern void LAormlq_(char*,char*,int*,int*,int*,PetscScalar*,int*,PetscScalar*,PetscScalar*,int*,PetscScalar*,int*,int*,int,int);
extern void LAtrevc_(char*,char*,int*,int*,PetscScalar*,int*,PetscScalar*,int*,PetscScalar*,int*,int*,int*,PetscScalar*,int*,int,int);
extern void LAgehrd_(int*,int*,int*,PetscScalar*,int*,PetscScalar*,PetscScalar*,int*,int*);
#if !defined(PETSC_USE_COMPLEX)
extern void LAhseqr_(char*,char*,int*,int*,int*,PetscScalar*,int*,PetscScalar*,PetscScalar*,PetscScalar*,int*,PetscScalar*,int*,int*,int,int);
extern void LAgees_(char*,char*,int*,int*,PetscScalar*,int*,int*,PetscScalar*,PetscScalar*,PetscScalar*,int*,PetscScalar*,int*,int*,int*);
#else
extern void LAhseqr_(char*,char*,int*,int*,int*,PetscScalar*,int*,PetscScalar*,PetscScalar*,int*,PetscScalar*,int*,int*,int,int);
extern void LAgees_(char*,char*,int*,int*,PetscScalar*,int*,int*,PetscScalar*,PetscScalar*,int*,PetscScalar*,int*,PetscReal*,int*,int*);
#endif
 
EXTERN_C_END
 
#endif
 
/trunk/include/slepc.h
0,0 → 1,42
/*
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.
*/
#if !defined(__SLEPC_H)
#define __SLEPC_H
 
/* ========================================================================== */
/*
Current SLEPc version number and release date
*/
#include "slepcversion.h"
 
/* ========================================================================== */
/*
SLEPc logging/profiling information
*/
#include "slepclog.h"
#include <limits.h>
#include <float.h>
 
/* ========================================================================== */
/*
The PETSc include files.
*/
#include "petsc.h"
#include "petscvec.h"
#include "petscmat.h"
 
/*
Initialization of SLEPc and other system routines
*/
extern int SlepcInitialize(int*,char***,char[],const char[]);
extern int SlepcFinalize(void);
extern int SlepcInitializeFortran(void);
 
extern int SlepcVecSetRandom(Vec);
extern int SlepcIsHermitian(Mat,PetscTruth*);
 
#endif
 
/trunk/include/README
0,0 → 1,4
 
This is a directory for public include files. Subdirectories are:
- finclude - Fortran interface include files
 
/trunk/include/makefile
0,0 → 1,19
 
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:
 
 
 
/trunk/include/slepclog.h
0,0 → 1,15
/*
Defines profile/logging in SLEPc.
*/
 
#if !defined(__SLEPCLOG_H)
#define __SLEPCLOG_H
#include "slepc.h"
 
/*
Lists all SLEPC events for profiling.
*/
 
extern int EPS_SetUp, EPS_Solve, ST_SetUp, ST_Apply, ST_ApplyB, ST_ApplyNoB, EPS_Orthogonalization;
 
#endif
/trunk/src/mat/examples/rdb200.petsc Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/trunk/src/mat/examples/odep400a.petsc
0,0 → 1,13
{P´ 

  ! !"!"#"#$#$%$%&%&'&'('()()*)*+*+,+,-,-.-././0/0101212323434545656767878989:9:;:;<;<=<=>=>?>?@?@A@ABABCBCDCDEDEFEFGFGHGHIHIJIJKJKLKLMLMNMNONOPOPQPQRQRSRSTSTUTUVUVWVWXWXYXYZYZ[Z[\[\]\]^]^_^_`_`a`ababcbcdcdedefefgfghghihijijkjklklmlmnmnonopopqpqrqrsrststutuvuvwvwxwxyxyzyz{z{|{|}|}~}~~€€€‚‚ƒ‚ƒ„ƒ„…„…†…†‡†‡ˆ‡ˆ‰ˆ‰Š‰Š‹Š‹Œ‹ŒŒŽŽŽ‘‘’‘’“’“”“”•”•–•–—–—˜—˜™˜™š™š›š›œ›œœžžŸžŸ Ÿ ¡ ¡¢¡¢£¢£¤£¤¥¤¥¦¥¦§¦§¨§¨©¨©ª©ª«ª«¬«¬­¬­®­®¯®¯°¯°±°±²±²³²³´³´µ´µ¶µ¶·¶·¸·¸¹¸¹º¹º»º»¼»¼½¼½¾½¾¿¾¿À¿ÀÁÀÁÂÁÂÃÂÃÄÃÄÅÄÅÆÅÆÇÆÇÈÇÈÉÈÉÊÉÊËÊËÌËÌÍÌÍÎÍÎÏÎÏÐÏÐÑÐÑÒÑÒÓÒÓÔÓÔÕÔÕÖÕÖ×Ö×Ø×ØÙØÙÚÙÚÛÚÛÜÛÜÝÜÝÞÝÞßÞßàßàáàáâáâãâãäãäåäåæåæçæçèçèéèéêéêëêëìëìíìíîíîïîïðïðñðñòñòóòóôóôõôõöõö÷ö÷ø÷øùøùúùúûúûüûüýüýþýþÿþÿÿ  
 
 
    
 

  ! !"!"#"#$#$%$%&%&'&'('()()*)*+*+,+,-,-.-././0/0101212323434545656767878989:9:;:;<;<=<=>=>?>?@?@A@ABABCBCDCDEDEFEFGFGHGHIHIJIJKJKLKLMLMNMNONOPOPQPQRQRSRSTSTUTUVUVWVWXWXYXYZYZ[Z[\[\]\]^]^_^_`_`a`ababcbcdcdedefefgfghghihijijkjklklmlmnmnonopopqpqrqrsrststutuvuvwvwxwxyxyzyz{z{|{|}|}~}~~€€€‚‚ƒ‚ƒ„ƒ„…„…†…†‡†‡ˆ‡ˆ‰ˆ‰Š‰Š‹Š‹Œ‹ŒŒŽŽŽÀ?ð@?ðÀ?ð¿ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?ðÀ?ð?„záG®{?ðÀ?ð@¿ð?„záG®{?ð?ž¸Që…¸
/trunk/src/mat/examples/odep400b.petsc
0,0 → 1,30
{P
 !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~€‚ƒ„…†‡ˆ‰Š‹ŒŽ‘’“”•–—˜™š›œžŸ ¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ 
  
 !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~€‚ƒ„…†‡ˆ‰Š‹ŒŽ=,’öö°1=
òí‘Æÿ=,’öö°1=f8\&aD=,’öö°1=f8\&aD=ŸÝÁVX=f8\&aD=ŸÝÁVX=ك&…Ãk=ŸÝÁVX=ك&…Ãk=(‹µt=ك&…Ãk=(‹µt=LÍðå%’=(‹µt=LÍðå%’=†sVÖ¦=LÍðå%’=†sVÖ¦=À»D‡¹=†sVÖ¦=À»D‡¹=ù¾ t8Í=À»D‡¹=ù¾ t8Í=±ÂÑôð=ù¾ t8Í=±ÂÑôð=6„uiÍz=±ÂÑôð=6„uiÍz=SW(¦=6„uiÍz=SW(¦=p)ڙ~=SW(¦=p)ڙ~=Œü1W=p)ڙ~=Œü1W=©Ï?É/¡=Œü1W=©Ï?É/¡=Æ¡òa+=©Ï?É/¡=Æ¡òa+=ãt¤øà´=Æ¡òa+=ãt¤øà´=GW¹>=ãt¤øà´=GW¹>=
(‘È=GW¹>=
(‘È=9ì¼ÀjQ=
(‘È=9ì¼ÀjQ=V¿oXBÛ=9ì¼ÀjQ=V¿oXBÛ=s’!ðe=V¿oXBÛ=s’!ðe=dԇóï=s’!ðe=dԇóï=­7‡Ìx=dԇóï=­7‡Ìx=Ê
9·¥=­7‡Ìx=Ê
9·¥=æÜìO}Œ=Ê
9·¥=æÜìO}Œ=¯žçV=æÜìO}Œ=¯žçV= ‚Q.Ÿ=¯žçV= ‚Q.Ÿ==U)= ‚Q.Ÿ==U)=Z'¶®ß³==U)=Z'¶®ß³=vúiF¸==Z'¶®ß³=vúiF¸==“ÍސÆ=vúiF¸==“ÍސÆ=°ŸÎviP=“ÍސÆ=°ŸÎviP=ÍrAÚ=°ŸÎviP=ÍrAÚ=êE3¦c=ÍrAÚ=êE3¦c=æ=òí=êE3¦c=æ=òí=#ê˜ÕËw=æ=òí=#ê˜ÕËw=@½Km¤=#ê˜ÕËw=@½Km¤=]þ|Š=@½Km¤=]þ|Š=zb°U=]þ|Š=zb°U=—5c5-ž=zb°U=—5c5-ž=´Í(=—5c5-ž=´Í(=ÐÚÈdÞ±=´Í(=ÐÚÈdÞ±=í­zü·;=ÐÚÈdÞ±=í­zü·;=
€-”Å=í­zü·;=
€-”Å='Rà,hO=
€-”Å='Rà,hO=D%’Ä@Ø='Rà,hO=D%’Ä@Ø=`øE\b=D%’Ä@Ø=`øE\b=}Ê÷óñì=`øE\b=}Ê÷óñì=šª‹Êv=}Ê÷óñì=šª‹Êv=·p]#¢ÿ=šª‹Êv=·p]#¢ÿ=ÔC»{‰=·p]#¢ÿ=ÔC»{‰=ñÂST=ÔC»{‰=ñÂST=
ètë,œ=ñÂST=
ètë,œ=*»'ƒ&=
ètë,œ=*»'ƒ&=GÚÝ°=*»'ƒ&=GÚÝ°=d`Œ²¶:=GÚÝ°=d`Œ²¶:=3?JŽÃ=d`Œ²¶:=3?JŽÃ=žñâgM=3?JŽÃ=žñâgM=ºØ¤z?×=žñâgM=ºØ¤z?×=׫Wa=ºØ¤z?×=׫Wa=ô~ ©ðê=׫Wa=ô~ ©ðê=P¼AÉt=ô~ ©ðê=P¼AÉt=.#nÙ¡þ=P¼AÉt=.#nÙ¡þ=Jö!qzˆ=.#nÙ¡þ=Jö!qzˆ=gÈÔ S=Jö!qzˆ=gÈÔ S=„›†¡+›=gÈÔ S=„›†¡+›=¡n99%=„›†¡+›=¡n99%=¾@ëÐÜ®=¡n99%=¾@ëÐÜ®=Ûžhµ8=¾@ëÐÜ®=Ûžhµ8=÷æQÂ=Ûžhµ8=÷æQÂ=¹˜fL=÷æQÂ=¹˜fL=1‹¶0>Õ=¹˜fL=1‹¶0>Õ=N^hÈ_=1‹¶0>Õ=N^hÈ_=k1_ïé=N^hÈ_=k1_ïé=ˆÍ÷Ès=k1_ïé=ˆÍ÷Ès=¤Ö€ ü=ˆÍ÷Ès=¤Ö€ ü=Á©3'y†=¤Ö€ ü=Á©3'y†=Þ{å¿R=Á©3'y†=Þ{å¿R=ûN˜W*š=Þ{å¿R=ûN˜W*š=!Jï#=ûN˜W*š=!Jï#=4óý†Û­=!Jï#=4óý†Û­=QÆ°´7=4óý†Û­=QÆ°´7=n™b¶ŒÁ=QÆ°´7=n™b¶ŒÁ=‹lNeJ=n™b¶ŒÁ=‹lNeJ=¨>Çæ=Ô=‹lNeJ=¨>Çæ=Ô=Åz~^=¨>Çæ=Ô=Åz~^=áä-îç=Åz~^=áä-îç=þ¶ß­Çq=áä-îç=þ¶ß­Çq=‰’EŸû=þ¶ß­Çq=‰’EŸû=8\DÝx…=‰’EŸû=8\DÝx…=U.÷uQ=8\DÝx…=U.÷uQ=rª
)˜=U.÷uQ=rª
)˜=ŽÔ\¥"=rª
)˜=ŽÔ\¥"=«§<Ú¬=ŽÔ\¥"=«§<Ú¬=ÈyÁÔ³5=«§<Ú¬=ÈyÁÔ³5=åLtl‹¿=ÈyÁÔ³5=åLtl‹¿='dI=åLtl‹¿='dI=ñٜ<Ó='dI=ñٜ<Ó=;Č4\=ñٜ<Ó=;Č4\=X—>Ëíæ=;Č4\=X—>Ëíæ=uiñcÆp=X—>Ëíæ=uiñcÆp=’<£ûžù=uiñcÆp=’<£ûžù=¯V“wƒ=’<£ûžù=¯V“wƒ=Ëâ +P
=¯V“wƒ=Ëâ +P
=è´»Ã(—=Ëâ +P
=è´»Ã(—=‡n[ =è´»Ã(—=‡n[ ="Z òÙª=‡n[ ="Z òÙª=?,ӊ²4="Z òÙª=?,ӊ²4=[ÿ†"Š¾=?,ӊ²4=[ÿ†"Š¾=xÒ8ºcG=[ÿ†"Š¾=xÒ8ºcG=•¤ëR;Ñ=xÒ8ºcG=•¤ëR;Ñ=²wê[=•¤ëR;Ñ=²wê[=ÏJPìå=²wê[=ÏJPìå=ìÅn=ÏJPìå=ìÅn=ïµ±ø=ìÅn=ïµ±ø=%ÂhIv‚=ïµ±ø=%ÂhIv‚=B•áO =%ÂhIv‚=B•áO =_gÍy'•=B•áO =_gÍy'•=|:€=_gÍy'•=|:€=™
2¨Ø©=|:€=™
2¨Ø©=µßå@±2=™
2¨Ø©=µßå@±2=Ò²—؉¼=µßå@±2=Ò²—؉¼=ï…JpbF=Ò²—؉¼=ï…JpbF= Wý:Ð=ï…JpbF= Wý:Ð=)*¯ Y= Wý:Ð=)*¯ Y=Eýb7ëã=)*¯ Y=Eýb7ëã=bÐÏÄm=Eýb7ëã=bÐÏÄm=¢Çgœ÷=bÐÏÄm=¢Çgœ÷=œuyÿu€=¢Çgœ÷=œuyÿu€=¹H,—N
=œuyÿu€=¹H,—N
=Öß/&”=¹H,—N
=Öß/&”=òí‘Æÿ=Öß/&”=òí‘Æÿ
/trunk/src/mat/examples/readme
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
 
odep400a ODE problem real unsymmetric, 400 by 400, 1201 entries
odep400b real symmetric indefinite, 400 by 400, 399 entries
 
/trunk/src/st/interface/stsolve.c
0,0 → 1,272
 
/*
The ST (spectral transformation) interface routines, callable by users.
*/
 
#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: STApplyB(), STApplyNoB()
@*/
int STApply(ST st,Vec x,Vec y)
{
int ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
PetscValidHeaderSpecific(x,VEC_COOKIE);
PetscValidHeaderSpecific(y,VEC_COOKIE);
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);
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__ "STApplyB"
/*@
STApplyB - Applies the B matrix to a vector.
 
Collective on ST and Vec
 
Input Parameters:
+ st - the spectral transformation context
- x - input vector
 
Output Parameter:
. y - output vector
 
Level: developer
 
.seealso: STApply(), STApplyNoB()
@*/
int STApplyB(ST st,Vec x,Vec y)
{
int ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
PetscValidHeaderSpecific(x,VEC_COOKIE);
PetscValidHeaderSpecific(y,VEC_COOKIE);
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_ApplyB,st,x,y,0);CHKERRQ(ierr);
ierr = (*st->ops->applyB)(st,x,y);CHKERRQ(ierr);
ierr = PetscLogEventEnd(ST_ApplyB,st,x,y,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STApplyNoB"
/*@
STApplyNoB - Applies the spectral transformation operator to a vector
which has already been multiplied by matrix B. For instance, this routine
would perform the operation y =(A - sB)^-1 x 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, where it is assumed that x=Bw for some vector w
 
Output Parameter:
. y - output vector
 
Level: developer
 
.seealso: STApply(), STApplyB()
@*/
int STApplyNoB(ST st,Vec x,Vec y)
{
int ierr;
PetscTruth isSinv;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
PetscValidHeaderSpecific(x,VEC_COOKIE);
PetscValidHeaderSpecific(y,VEC_COOKIE);
if (x == y) SETERRQ(PETSC_ERR_ARG_IDN,"x and y must be different vectors");
 
if (!st->setupcalled) { ierr = STSetUp(st); CHKERRQ(ierr); }
 
ierr = PetscTypeCompare((PetscObject)st,STSINV,&isSinv);CHKERRQ(ierr);
if (!isSinv) { SETERRQ(1,"Function only available in Shift-and-Invert"); }
 
ierr = PetscLogEventBegin(ST_ApplyNoB,st,x,y,0);CHKERRQ(ierr);
ierr = (*st->ops->applynoB)(st,x,y);CHKERRQ(ierr);
ierr = PetscLogEventEnd(ST_ApplyNoB,st,x,y,0);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()
@*/
int STSetUp(ST st)
{
int ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
 
PetscLogInfo(st,"STSetUp:Setting up new ST\n");
if (st->setupcalled) PetscFunctionReturn(0);
ierr = PetscLogEventBegin(ST_SetUp,st,0,0,0);CHKERRQ(ierr);
if (!st->vec) {SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Vector must be set first");}
if (!st->A) {SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Matrix must be set first");}
if (!st->type_name) {
ierr = STSetType(st,STNONE);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__ "STPreSolve"
/*
STPreSolve - Optional pre-solve phase, intended for any actions that
must be performed on the ST object before the eigensolver starts iterating.
 
Collective on ST
 
Input Parameters:
st - the spectral transformation context
eps - the eigenproblem solver context
 
Level: developer
 
Sample of Usage:
 
STPreSolve(st,eps);
EPSSolve(eps,its);
STPostSolve(st,eps);
*/
int STPreSolve(ST st,EPS eps)
{
int ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
 
if (st->ops->presolve) {
ierr = (*st->ops->presolve)(st);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
eps - the eigenproblem solver context
 
Sample of Usage:
 
STPreSolve(st,eps);
EPSSolve(eps,its);
STPostSolve(st,eps);
*/
int STPostSolve(ST st,EPS eps)
{
int ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
if (st->ops->postsolve) {
ierr = (*st->ops->postsolve)(st);CHKERRQ(ierr);
}
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STBackTransform"
/*
STBackTransform - Optional back-transformation phase, intended for
spectral transformation 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()
*/
int STBackTransform(ST st,PetscScalar* eigr,PetscScalar* eigi)
{
int ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
if (st->ops->backtr) {
ierr = (*st->ops->backtr)(st,eigr,eigi);CHKERRQ(ierr);
}
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STDefaultApplyB"
int STDefaultApplyB(ST st,Vec x,Vec y)
{
int ierr;
 
PetscFunctionBegin;
if( st->B ) {
ierr = MatMult( st->B, x, y ); CHKERRQ(ierr);
}
else {
ierr = VecCopy( x, y ); CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
/trunk/src/st/interface/stregis.c
0,0 → 1,41
 
#include "src/st/stimpl.h" /*I "slepcst.h" I*/
 
EXTERN_C_BEGIN
extern int STCreate_None(ST);
extern int STCreate_Shell(ST);
extern int STCreate_Shift(ST);
extern int STCreate_Sinvert(ST);
EXTERN_C_END
 
extern PetscTruth STRegisterAllCalled;
 
#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(), STRegisterDestroy()
@*/
int STRegisterAll(char *path)
{
int ierr;
 
PetscFunctionBegin;
STRegisterAllCalled = PETSC_TRUE;
 
ierr = STRegisterDynamic(STNONE ,path,"STCreate_None",STCreate_None);CHKERRQ(ierr);
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);
PetscFunctionReturn(0);
}
 
 
/trunk/src/st/interface/stfunc.c
0,0 → 1,537
 
/*
The ST (spectral transformation) interface routines, callable by users.
*/
 
#include "src/st/stimpl.h" /*I "slepcst.h" I*/
 
#undef __FUNCT__
#define __FUNCT__ "STDestroy"
/*@C
STDestroy - Destroys ST context that was created with STCreate().
 
Collective on ST
 
Input Parameter:
. st - the spectral transformation context
 
Level: beginner
 
.seealso: STCreate(), STSetUp()
@*/
int STDestroy(ST st)
{
int ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
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->sles) { ierr = SLESDestroy(st->sles);CHKERRQ(ierr); }
 
PetscLogObjectDestroy(st);
PetscHeaderDestroy(st);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STPublish_Petsc"
static int STPublish_Petsc(PetscObject object)
{
#if defined(PETSC_HAVE_AMS)
ST v = (ST) object;
int ierr;
#endif
PetscFunctionBegin;
 
#if defined(PETSC_HAVE_AMS)
/* if it is already published then return */
if (v->amem >=0 ) PetscFunctionReturn(0);
 
ierr = PetscObjectPublishBaseBegin(object);CHKERRQ(ierr);
ierr = PetscObjectPublishBaseEnd(object);CHKERRQ(ierr);
#endif
 
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()
@*/
int STCreate(MPI_Comm comm,ST *newst)
{
ST st;
int ierr;
 
PetscFunctionBegin;
*newst = 0;
 
PetscHeaderCreate(st,_p_ST,struct _STOps,ST_COOKIE,-1,"ST",comm,STDestroy,STView);
PetscLogObjectCreate(st);
st->bops->publish = STPublish_Petsc;
st->ops->destroy = 0;
st->ops->apply = 0;
st->ops->applyB = STDefaultApplyB;
st->ops->applynoB = 0;
st->ops->setshift = 0;
st->ops->view = 0;
 
st->A = 0;
st->B = 0;
st->sigma = 1.0;
st->vec = 0;
st->sles = 0;
st->data = 0;
st->setupcalled = 0;
*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()
@*/
int STSetOperators(ST st,Mat A,Mat B)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
PetscValidHeaderSpecific(A,MAT_COOKIE);
if (B) PetscValidHeaderSpecific(B,MAT_COOKIE);
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()
@*/
int STGetOperators(ST st,Mat *A,Mat *B)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
if (A) *A = st->A;
if (B) *B = st->B;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetVector"
/*@
STSetVector - Sets a vector associated with the ST object.
 
Collective on ST and Vec
 
Input Parameters:
+ st - the spectral transformation context
- vec - the vector
 
Notes:
The vector must be set so that the ST object knows what type
of vector to allocate if necessary.
 
Level: intermediate
 
.seealso: STGetVector()
 
@*/
int STSetVector(ST st,Vec vec)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
PetscValidHeaderSpecific(vec,VEC_COOKIE);
PetscCheckSameComm(st,vec);
st->vec = vec;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STGetVector"
/*@
STGetVector - Gets a vector associated with the ST object; if the
vector was not yet set it will return a nul pointer.
 
Not collective, but vector is shared by all processors that share the ST
 
Input Parameter:
. st - the spectral transformation context
 
Output Parameter:
. vec - the vector
 
Level: intermediate
 
.seealso: STSetVector()
 
@*/
int STGetVector(ST st,Vec *vec)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
*vec = st->vec;
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
 
@*/
int STSetShift(ST st,PetscScalar shift)
{
int ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
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
 
@*/
int STGetShift(ST st,PetscScalar* shift)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
if (shift) *shift = st->sigma;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STGetNumberOfShifts"
/*@
STGetNumberOfShifts - Returns the number of shifts used in this
spectral transformation type.
 
Not collective
 
Input Parameter:
. st - the spectral transformation context
 
Output Parameter:
. nshifts - the number of shifts
 
Note:
The returned value will be either 0 (for STNONE and STSHELL)
or 1 (for STSHIFT and STSINV). Future versions of SLEPc may
provide other ST which requires more than one shift.
 
Level: advanced
 
@*/
int STGetNumberOfShifts(ST st,int* nshifts)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
if (nshifts) *nshifts = st->numberofshifts;
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()
@*/
int STSetOptionsPrefix(ST st,char *prefix)
{
int ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
ierr = PetscObjectSetOptionsPrefix((PetscObject)st, prefix);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()
@*/
int STAppendOptionsPrefix(ST st,char *prefix)
{
int ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
ierr = PetscObjectAppendOptionsPrefix((PetscObject)st, prefix);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()
@*/
int STGetOptionsPrefix(ST st,char **prefix)
{
int ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
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()
@*/
int STView(ST st,PetscViewer viewer)
{
STType cstr;
int ierr;
PetscTruth isascii,isstring;
PetscViewerFormat format;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
if (!viewer) viewer = PETSC_VIEWER_STDOUT_(st->comm);
PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE);
PetscCheckSameComm(st,viewer);
 
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 (st->numberofshifts>0) {
#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
}
if (st->ops->view) {
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = (*st->ops->view)(st,viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
}
if (st->sles) {
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"Associated SLES object\n");CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"------------------------------\n");CHKERRQ(ierr);
ierr = SLESView(st->sles,viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"------------------------------\n");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->sles) {ierr = SLESView(st->sles,viewer);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);
}
 
/*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
 
$SLEPC_DIR, $PETSC_ARCH and $BOPT occuring in pathname will be replaced with appropriate values.
 
.seealso: STRegisterAll(), STRegisterDestroy(), STRegister()
M*/
 
#undef __FUNCT__
#define __FUNCT__ "STRegister"
int STRegister(char *sname,char *path,char *name,int (*function)(ST))
{
int ierr;
char fullname[256];
 
PetscFunctionBegin;
ierr = PetscFListConcat(path,name,fullname);CHKERRQ(ierr);
ierr = PetscFListAdd(&STList,sname,fullname,(void (*)(void))function);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
/trunk/src/st/interface/stset.c
0,0 → 1,195
 
/*
Routines to set ST methods and options.
*/
 
#include "src/st/stimpl.h" /*I "slepcst.h" I*/
#include "petscsys.h"
 
PetscTruth STRegisterAllCalled = PETSC_FALSE;
/*
Contains the list of registered EPS 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 methods
 
Notes:
See "slepc/include/slepcst.h" for available methods
 
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()
 
@*/
int STSetType(ST st,STType type)
{
int ierr,(*r)(ST);
PetscTruth match;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
PetscValidCharPointer(type);
 
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;
st->sles = 0;
 
/* Get the function pointers for the method requested */
if (!STRegisterAllCalled) {ierr = STRegisterAll(0); CHKERRQ(ierr);}
 
/* Determine the STCreateXXX routine for a particular type */
ierr = PetscFListFind(st->comm, STList, type,(void (**)(void)) &r );CHKERRQ(ierr);
if (!r) SETERRQ1(1,"Unable to find requested ST type %s",type);
if (st->data) {ierr = PetscFree(st->data);CHKERRQ(ierr);}
 
st->ops->destroy = (int (*)(ST )) 0;
st->ops->view = (int (*)(ST,PetscViewer) ) 0;
st->ops->apply = (int (*)(ST,Vec,Vec) ) 0;
st->ops->applyB = STDefaultApplyB;
st->ops->applynoB = (int (*)(ST,Vec,Vec) ) 0;
st->ops->setup = (int (*)(ST) ) 0;
st->ops->setfromoptions = (int (*)(ST) ) 0;
st->ops->presolve = (int (*)(ST) ) 0;
st->ops->postsolve = (int (*)(ST) ) 0;
st->ops->backtr = (int (*)(ST,PetscScalar*,PetscScalar*) ) 0;
 
/* 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__ "STRegisterDestroy"
/*@C
STRegisterDestroy - Frees the list of spectral transformations that were
registered by STRegisterDynamic().
 
Not Collective
 
Level: advanced
 
.seealso: STRegisterAll(), STRegisterAll()
 
@*/
int STRegisterDestroy(void)
{
int ierr;
 
PetscFunctionBegin;
if (STList) {
ierr = PetscFListDestroy(&STList);CHKERRQ(ierr);
STList = 0;
}
STRegisterAllCalled = PETSC_FALSE;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STGetType"
/*@C
STGetType - Gets the ST method type and 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()
 
@*/
int 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:
 
@*/
int STSetFromOptions(ST st)
{
int ierr;
char type[256];
PetscTruth flg;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
 
if (!STRegisterAllCalled) {ierr = STRegisterAll(PETSC_NULL);CHKERRQ(ierr);}
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:STNONE),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,STNONE);CHKERRQ(ierr);
}
 
if (st->numberofshifts>0) {
ierr = PetscOptionsScalar("-st_shift","Value of the shift","STSetShift",st->sigma,&st->sigma,PETSC_NULL); CHKERRQ(ierr);
}
 
if (st->ops->setfromoptions) {
ierr = (*st->ops->setfromoptions)(st);CHKERRQ(ierr);
}
if (st->sles) {
ierr = PetscOptionsHead("Associated Linear Solver options ------------");CHKERRQ(ierr);
ierr = SLESSetFromOptions(st->sles);CHKERRQ(ierr);
ierr = PetscOptionsTail();CHKERRQ(ierr);
}
 
ierr = PetscOptionsEnd();CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
/trunk/src/st/interface/makefile
0,0 → 1,17
 
ALL: lib
 
CFLAGS =
FFLAGS =
SOURCEC = stfunc.c stset.c stsolve.c stsles.c stregis.c
SOURCEF =
SOURCEH =
OBJSC = stfunc.o stset.o stsolve.o stsles.o stregis.o
LIBBASE = libslepc
DIRS =
MANSEC = ST
LOCDIR = src/st/interface/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
/trunk/src/st/interface/stsles.c
0,0 → 1,103
 
/*
The ST (spectral transformation) interface routines related to the
SLES object associated to it.
*/
 
#include "src/st/stimpl.h" /*I "slepcst.h" I*/
 
#undef __FUNCT__
#define __FUNCT__ "STAssociatedSLESSolve"
/*@C
STAssociatedSLESSolve - Solve the linear system of equations associated
to the spectral transformation.
 
Collective on ST
 
Input Parameters:
. st - the spectral transformation context
. b - right hand side vector
 
Output Parameter:
. x - computed solution
 
Level: developer
 
.seealso: STGetSLES(), SLESSolve()
@*/
int STAssociatedSLESSolve(ST st,Vec b,Vec x)
{
int its,ierr;
KSP ksp;
KSPConvergedReason reason;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
PetscValidHeaderSpecific(b,VEC_COOKIE);
PetscValidHeaderSpecific(x,VEC_COOKIE);
if (!st->sles) { SETERRQ(PETSC_ERR_SUP,"ST has no associated SLES"); }
ierr = SLESSolve(st->sles,b,x,&its);CHKERRQ(ierr);
ierr = SLESGetKSP(st->sles,&ksp);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(ksp,&reason);CHKERRQ(ierr);
if (reason<0) { SETERRQ1(0,"Warning: SLES did not converge (%d)",reason); }
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetSLES"
/*@
STSetSLES - Sets the SLES object associated with the spectral
transformation.
 
Not collective
 
Input Parameters:
+ st - the spectral transformation context
- sles - the linear system context
 
Level: advanced
 
@*/
int STSetSLES(ST st,SLES sles)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
PetscValidHeaderSpecific(sles,SLES_COOKIE);
PetscCheckSameComm(st,sles);
st->sles = sles;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STGetSLES"
/*@
STGetSLES - Gets the SLES object associated with the spectral
transformation.
 
Not collective
 
Input Parameter:
. st - the spectral transformation context
 
Output Parameter:
. sles - the linear system context
 
Notes:
On output, the value of sles 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
 
@*/
int STGetSLES(ST st,SLES* sles)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
if (!st->type_name) { SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Must call STSetType first"); }
if (sles) *sles = st->sles;
PetscFunctionReturn(0);
}
 
 
/trunk/src/st/impls/none/none.c
0,0 → 1,84
/*
Identity transformation, simply applies the matrix A as operator
in the case of standard eigenproblems, or B^-1A in the case of
generalized eigenproblems
*/
#include "src/st/stimpl.h" /*I "slepcst.h" I*/
 
#undef __FUNCT__
#define __FUNCT__ "STApply_None"
int STApply_None(ST st,Vec x,Vec y)
{
int ierr;
Vec w;
 
PetscFunctionBegin;
if (st->B) {
/* generalized eigenproblem: y = B^-1 A x */
w = (Vec) st->data;
ierr = MatMult(st->A,x,w);CHKERRQ(ierr);
ierr = STAssociatedSLESSolve(st,w,y);CHKERRQ(ierr);
}
else {
/* standard eigenproblem: y = A x */
ierr = MatMult(st->A,x,y);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetUp_None"
static int STSetUp_None(ST st)
{
int ierr;
Vec w;
 
PetscFunctionBegin;
if (st->sles) {
ierr = VecDuplicate(st->vec,&w);CHKERRQ(ierr);
st->data = (void *) w;
ierr = SLESSetUp(st->sles,st->vec,st->vec);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STDestroy_None"
static int STDestroy_None(ST st)
{
int ierr;
Vec w;
 
PetscFunctionBegin;
if (st->data) {
w = (Vec) st->data;
ierr = VecDestroy(w);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STCreate_None"
int STCreate_None(ST st)
{
int ierr;
char *prefix;
 
PetscFunctionBegin;
st->numberofshifts = 0;
st->ops->apply = STApply_None;
st->ops->destroy = STDestroy_None;
st->ops->setup = STSetUp_None;
 
if (st->B) {
ierr = SLESCreate(st->comm,&st->sles);CHKERRQ(ierr);
ierr = STGetOptionsPrefix(st,&prefix);CHKERRQ(ierr);
ierr = SLESSetOptionsPrefix(st->sles,prefix);CHKERRQ(ierr);
ierr = SLESAppendOptionsPrefix(st->sles,"st_");CHKERRQ(ierr);
ierr = SLESSetOperators(st->sles,st->B,st->B,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
}
 
PetscFunctionReturn(0);
}
EXTERN_C_END
/trunk/src/st/impls/none/makefile
0,0 → 1,17
 
ALL: lib
 
CFLAGS =
FFLAGS =
SOURCEC = none.c
SOURCEF =
SOURCEH =
OBJSC = none.o
LIBBASE = libslepc
DIRS =
MANSEC = ST
LOCDIR = src/st/impls/none/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
/trunk/src/st/impls/shell/shell.c
0,0 → 1,327
 
/*
This provides a simple shell interface for programmers to
create their own spectral transformations without writing much
interface code.
*/
 
#include "src/st/stimpl.h" /*I "slepcst.h" I*/
#include "slepceps.h"
 
typedef struct {
void *ctx; /* user provided context */
int (*apply)(void *,Vec,Vec);
int (*backtr)(void *,PetscScalar*,PetscScalar*);
char *name;
} ST_Shell;
 
#undef __FUNCT__
#define __FUNCT__ "STApply_Shell"
static int STApply_Shell(ST st,Vec x,Vec y)
{
ST_Shell *shell;
int ierr;
 
PetscFunctionBegin;
shell = (ST_Shell *) st->data;
if (!shell->apply) SETERRQ(1,"No apply() routine provided to Shell ST");
ierr = (*shell->apply)(shell->ctx,x,y); CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STBackTransform_Shell"
static int STBackTransform_Shell(ST st,PetscScalar *eigr,PetscScalar *eigi)
{
ST_Shell *shell;
int ierr;
 
PetscFunctionBegin;
shell = (ST_Shell *) st->data;
if (shell->backtr) {
ierr = (*shell->backtr)(shell->ctx,eigr,eigi); CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STDestroy_Shell"
static int STDestroy_Shell(ST st)
{
ST_Shell *shell = (ST_Shell *) st->data;
int ierr;
 
PetscFunctionBegin;
ierr = PetscFree(shell);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STView_Shell"
static int STView_Shell(ST st,PetscViewer viewer)
{
ST_Shell *ctx = (ST_Shell*)st->data;
int ierr;
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"
int STShellSetApply_Shell(ST st, int (*apply)(void*,Vec,Vec),void *ptr)
{
ST_Shell *shell;
 
PetscFunctionBegin;
shell = (ST_Shell *) st->data;
shell->apply = apply;
shell->ctx = ptr;
PetscFunctionReturn(0);
}
EXTERN_C_END
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STShellSetBackTransform_Shell"
int STShellSetBackTransform_Shell(ST st, int (*backtr)(void*,PetscScalar*,PetscScalar*))
{
ST_Shell *shell;
 
PetscFunctionBegin;
shell = (ST_Shell *) st->data;
shell->backtr = backtr;
PetscFunctionReturn(0);
}
EXTERN_C_END
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STShellSetName_Shell"
int STShellSetName_Shell(ST st,char *name)
{
ST_Shell *shell;
 
PetscFunctionBegin;
shell = (ST_Shell *) st->data;
shell->name = name;
PetscFunctionReturn(0);
}
EXTERN_C_END
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STShellGetName_Shell"
int STShellGetName_Shell(ST st,char **name)
{
ST_Shell *shell;
 
PetscFunctionBegin;
shell = (ST_Shell *) st->data;
*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
- ptr - pointer to data needed by this routine
 
Calling sequence of apply:
.vb
int apply (void *ptr,Vec xin,Vec xout)
.ve
 
+ ptr - the application context
. xin - input vector
- xout - output vector
 
Level: developer
 
.seealso: STShellSetBackTransform()
@*/
int STShellSetApply(ST st, int (*apply)(void*,Vec,Vec),void *ptr)
{
int ierr, (*f)(ST,int (*)(void*,Vec,Vec),void *);
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
ierr = PetscObjectQueryFunction((PetscObject)st,"STShellSetApply_C",(void (**)(void))&f);CHKERRQ(ierr);
if (f) {
ierr = (*f)(st,apply,ptr);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 routine
 
Calling sequence of backtr:
.vb
int 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()
@*/
int STShellSetBackTransform(ST st, int (*backtr)(void*,PetscScalar*,PetscScalar*))
{
int ierr, (*f)(ST,int (*)(void*,PetscScalar*,PetscScalar*));
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
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()
@*/
int STShellSetName(ST st,char *name)
{
int ierr, (*f)(ST,char *);
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
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
 
Level: developer
 
.seealso: STShellSetName()
@*/
int STShellGetName(ST st,char **name)
{
int ierr, (*f)(ST,char **);
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
ierr = PetscObjectQueryFunction((PetscObject)st,"STShellGetName_C",(void (**)(void))&f);CHKERRQ(ierr);
if (f) {
ierr = (*f)(st,name);CHKERRQ(ierr);
} else {
SETERRQ(1,"Not shell spectral transformation, cannot get name");
}
PetscFunctionReturn(0);
}
 
/*
STCreate_Shell - 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.
 
Usage:
$ int (*apply)(void *,Vec,Vec);
$ int (*backtr)(void *,PetscScalar*,PetscScalar*);
$ STCreate(comm,&st);
$ STSetType(st,STSHELL);
$ STShellSetApply(st,apply,ctx);
$ STShellSetBackTransform(st,backtr); (optional)
 
*/
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STCreate_Shell"
int STCreate_Shell(ST st)
{
int ierr;
ST_Shell *shell;
 
PetscFunctionBegin;
st->ops->destroy = STDestroy_Shell;
ierr = PetscNew(ST_Shell,&shell); CHKERRQ(ierr);
PetscLogObjectMemory(st,sizeof(ST_Shell));
 
st->data = (void *) shell;
st->name = 0;
st->numberofshifts = 0;
 
st->ops->apply = STApply_Shell;
st->ops->backtr = STBackTransform_Shell;
st->ops->view = STView_Shell;
 
shell->apply = 0;
shell->name = 0;
shell->ctx = 0;
shell->backtr = 0;
 
ierr = PetscObjectComposeFunctionDynamic((PetscObject)st,"STShellSetApply_C","STShellSetApply_Shell",
STShellSetApply_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
 
/trunk/src/st/impls/shell/makefile
0,0 → 1,17
 
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
 
 
/trunk/src/st/impls/sinvert/sinvert.h
0,0 → 1,16
/*
Implements the shift-and-invert technique for eigenvalue problems.
*/
 
#if !defined(__SINVERT_H)
#define __SINVERT_H
 
typedef struct {
Mat A, B;
Vec w;
PetscScalar sigma;
} CTX_SINV;
 
extern int MatCreateMatSinvert(ST,Mat*);
 
#endif
/trunk/src/st/impls/sinvert/shellmat.c
0,0 → 1,101
/*
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.
*/
 
#include "src/st/stimpl.h"
#include "sinvert.h"
 
#undef __FUNCT__
#define __FUNCT__ "MatSinvert_Mult"
static int MatSinvert_Mult(Mat A,Vec x,Vec y)
{
int ierr;
CTX_SINV *ctx;
PetscScalar alpha;
 
ierr = MatShellGetContext(A,(void**)&ctx);CHKERRQ(ierr);
alpha = -ctx->sigma;
 
if (ctx->B) { /* y = (A - sB) x */
ierr = MatMult(ctx->B,x,ctx->w);CHKERRQ(ierr);
ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
ierr = VecAXPY(&alpha,ctx->w,y);CHKERRQ(ierr);
}
else { /* y = (A - sI) x */
ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
ierr = VecAXPY(&alpha,x,y);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "MatSinvert_GetDiagonal"
static int MatSinvert_GetDiagonal(Mat A,Vec diag)
{
int ierr;
CTX_SINV *ctx;
PetscScalar alpha;
Vec diagb;
 
ierr = MatShellGetContext(A,(void**)&ctx);CHKERRQ(ierr);
alpha = -ctx->sigma;
 
ierr = MatGetDiagonal(ctx->A,diag);CHKERRQ(ierr);
if (ctx->B) {
ierr = VecDuplicate(diag,&diagb);CHKERRQ(ierr);
ierr = MatGetDiagonal(ctx->B,diagb);CHKERRQ(ierr);
ierr = VecAXPY(&alpha,diagb,diag);CHKERRQ(ierr);
ierr = VecDestroy(diagb);CHKERRQ(ierr);
}
else {
ierr = VecShift(&alpha,diag);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "MatSinvert_Destroy"
static int MatSinvert_Destroy(Mat A)
{
CTX_SINV *ctx;
int ierr;
 
ierr = MatShellGetContext(A,(void**)&ctx);CHKERRQ(ierr);
if (ctx->B) { ierr = VecDestroy(ctx->w);CHKERRQ(ierr); }
ierr = PetscFree(ctx);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "MatCreateMatSinvert"
int MatCreateMatSinvert(ST st,Mat *mat)
{
int n, m, N, M, ierr;
PetscTruth hasA, hasB;
CTX_SINV *ctx;
 
PetscFunctionBegin;
ierr = PetscNew(CTX_SINV,&ctx);CHKERRQ(ierr);
PetscMemzero(ctx,sizeof(CTX_SINV));
PetscLogObjectMemory(st,sizeof(CTX_SINV));
ctx->A = st->A;
ctx->B = st->B;
ctx->sigma = st->sigma;
if (st->B) { ierr = VecDuplicate(st->vec,&ctx->w);CHKERRQ(ierr); }
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*)ctx,mat);CHKERRQ(ierr);
ierr = MatShellSetOperation(*mat,MATOP_MULT,(void(*)(void))MatSinvert_Mult);CHKERRQ(ierr);
ierr = MatShellSetOperation(*mat,MATOP_DESTROY,(void(*)(void))MatSinvert_Destroy);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))MatSinvert_GetDiagonal);CHKERRQ(ierr);
}
 
PetscFunctionReturn(0);
}
 
/trunk/src/st/impls/sinvert/sinvert.c
0,0 → 1,354
/*
Implements the shift-and-invert technique for eigenvalue problems.
*/
#include "src/st/stimpl.h" /*I "slepcst.h" I*/
#include "sinvert.h"
 
typedef struct {
PetscTruth shift_matrix; /* shift matrix rather than use shell mat */
MatStructure str; /* whether matrices have the same pattern or not */
Mat mat;
Vec w;
} ST_SINV;
 
#undef __FUNCT__
#define __FUNCT__ "STApply_Sinvert"
static int STApply_Sinvert(ST st,Vec x,Vec y)
{
int ierr;
ST_SINV *ctx = (ST_SINV *) st->data;
 
PetscFunctionBegin;
if (st->B) {
/* generalized eigenproblem: y = (A - sB)^-1 B x */
ierr = MatMult(st->B,x,ctx->w);CHKERRQ(ierr);
ierr = STAssociatedSLESSolve(st,ctx->w,y);CHKERRQ(ierr);
}
else {
/* standard eigenproblem: y = (A - sI)^-1 x */
ierr = STAssociatedSLESSolve(st,x,y);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STApplyNoB_Sinvert"
static int STApplyNoB_Sinvert(ST st,Vec x,Vec y)
{
int ierr;
 
PetscFunctionBegin;
ierr = STAssociatedSLESSolve(st,x,y);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STBackTransform_Sinvert"
int STBackTransform_Sinvert(ST st,PetscScalar *eigr,PetscScalar *eigi)
{
PetscFunctionBegin;
/* Note that this is not correct in the case of the RQI solver */
if (eigr) *eigr = 1.0 / *eigr + st->sigma;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STPost_Sinvert"
int STPost_Sinvert(ST st)
{
ST_SINV *ctx = (ST_SINV *) st->data;
PetscScalar alpha;
int ierr;
 
PetscFunctionBegin;
if( ctx->shift_matrix ) {
alpha = st->sigma;
if( st->B ) { ierr = MatAXPY(&alpha,st->B,st->A,ctx->str);CHKERRQ(ierr); }
else { ierr = MatShift( &alpha, st->A ); CHKERRQ(ierr); }
st->setupcalled = 0;
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetUp_Sinvert"
static int STSetUp_Sinvert(ST st)
{
int ierr;
ST_SINV *ctx = (ST_SINV *) st->data;
PetscScalar alpha;
 
PetscFunctionBegin;
 
if (ctx->shift_matrix) {
alpha = -st->sigma;
if (st->B) { ierr = MatAXPY(&alpha,st->B,st->A,ctx->str);CHKERRQ(ierr); }
else { ierr = MatShift(&alpha,st->A);CHKERRQ(ierr); }
ierr = SLESSetOperators(st->sles,st->A,st->A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
}
else {
ierr = MatCreateMatSinvert(st,&ctx->mat);CHKERRQ(ierr);
ierr = SLESSetOperators(st->sles,ctx->mat,ctx->mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
}
if (st->B && !ctx->w) { ierr = VecDuplicate(st->vec,&ctx->w);CHKERRQ(ierr); }
ierr = SLESSetUp(st->sles,st->vec,st->vec);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetShift_Sinvert"
static int STSetShift_Sinvert(ST st,PetscScalar newshift)
{
int ierr;
ST_SINV *stctx = (ST_SINV *) st->data;
PetscScalar alpha;
CTX_SINV *ctx;
 
PetscFunctionBegin;
 
/* Nothing to be done if STSetUp has not been called yet */
if (!st->setupcalled) PetscFunctionReturn(0);
 
if (stctx->shift_matrix) {
/* Undo previous operations */
alpha = st->sigma;
if (st->B) { ierr = MatAXPY(&alpha,st->B,st->A,stctx->str);CHKERRQ(ierr); }
else { ierr = MatShift(&alpha,st->A);CHKERRQ(ierr); }
/* Apply new shift */
alpha = -newshift;
if (st->B) { ierr = MatAXPY(&alpha,st->B,st->A,stctx->str);CHKERRQ(ierr); }
else { ierr = MatShift(&alpha,st->A);CHKERRQ(ierr); }
ierr = SLESSetOperators(st->sles,st->A,st->A,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
}
else {
ierr = MatShellGetContext(stctx->mat,(void**)&ctx);CHKERRQ(ierr);
ctx->sigma = newshift;
ierr = SLESSetOperators(st->sles,stctx->mat,stctx->mat,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
}
ierr = SLESSetUp(st->sles,st->vec,st->vec);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STDestroy_Sinvert"
static int STDestroy_Sinvert(ST st)
{
ST_SINV *ctx = (ST_SINV *) st->data;
int ierr;
 
PetscFunctionBegin;
if (!ctx->shift_matrix) { ierr = MatDestroy(ctx->mat);CHKERRQ(ierr); }
if (st->B) { ierr = VecDestroy(ctx->w);CHKERRQ(ierr); }
ierr = PetscFree(ctx);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STView_Sinvert"
static int STView_Sinvert(ST st,PetscViewer viewer)
{
ST_SINV *ctx = (ST_SINV *) st->data;
int ierr;
PetscTruth isascii;
char *str;
 
PetscFunctionBegin;
ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);CHKERRQ(ierr);
if (!isascii) {
SETERRQ1(1,"Viewer type %s not supported for STSINV",((PetscObject)viewer)->type_name);
}
if (ctx->shift_matrix) {
ierr = PetscViewerASCIIPrintf(viewer,"Shifting the matrix and unshifting at exit\n");CHKERRQ(ierr);
if (st->B) {
switch (ctx->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;
}
ierr = PetscViewerASCIIPrintf(viewer,"Matrices A and B have %s\n",str);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetFromOptions_Sinvert"
static int STSetFromOptions_Sinvert(ST st)
{
int ierr;
PetscTruth flg;
PC pc;
 
PetscFunctionBegin;
ierr = PetscOptionsHead("ST Shift-and-invert Options");CHKERRQ(ierr);
ierr = PetscOptionsName("-st_sinvert_shift_mat","Shift matrix explicitly","STSinvertSetShiftMat",&flg);CHKERRQ(ierr);
if (flg) {
ierr = STSinvertSetShiftMat(st);CHKERRQ(ierr);
}
else {
/* if shift_mat is set then the default preconditioner is ILU,
otherwise set Jacobi as the default */
ierr = SLESGetPC(st->sles,&pc); CHKERRQ(ierr);
ierr = PCSetType(pc,PCJACOBI);CHKERRQ(ierr);
}
ierr = PetscOptionsLogicalGroupBegin("-st_sinvert_same_pattern","same nonzero pattern","STSinvertSetMatStructure",&flg);CHKERRQ(ierr);
if (flg) {ierr = STSinvertSetMatStructure(st,SAME_NONZERO_PATTERN);CHKERRQ(ierr);}
ierr = PetscOptionsLogicalGroup("-st_sinvert_different_pattern","different nonzero pattern","STSinvertSetMatStructure",&flg);CHKERRQ(ierr);
if (flg) {ierr = STSinvertSetMatStructure(st,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);}
ierr = PetscOptionsLogicalGroupEnd("-st_sinvert_subset_pattern","subset nonzero pattern","STSinvertSetMatStructure",&flg);CHKERRQ(ierr);
if (flg) {ierr = STSinvertSetMatStructure(st,SUBSET_NONZERO_PATTERN);CHKERRQ(ierr);}
ierr = PetscOptionsTail();CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
/* -------------------------------------------------------------------------*/
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STSinvertSetShiftMat_Sinvert"
int STSinvertSetShiftMat_Sinvert(ST st)
{
ST_SINV *ctx = (ST_SINV *) st->data;
 
PetscFunctionBegin;
ctx->shift_matrix = PETSC_TRUE;
PetscFunctionReturn(0);
}
EXTERN_C_END
 
#undef __FUNCT__
#define __FUNCT__ "STSinvertSetShiftMat"
/*@
STSinvertSetShiftMat - Sets a flag to indicate that the matrix is
being shifted at STSetUp() and unshifted at the end of the computations.
 
Collective on ST
 
Input Parameters:
. st - the spectral transformation context
 
Options Database Key:
. -st_sinvert_shift_mat - Activates STSinvertSetShiftMat()
 
Note:
By default, the matrix is not shifted explicitly. Instead, the solver
works with an implicit shell matrix that represents the shifted matrix,
in which case only the Jacobi preconditioning is available for the linear
solves performed in each iteration of the eigensolver.
Level: intermediate
 
.seealso: STSetOperators()
@*/
int STSinvertSetShiftMat(ST st)
{
int ierr, (*f)(ST);
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
ierr = PetscObjectQueryFunction((PetscObject)st,"STSinvertSetShiftMat_C",(void (**)(void))&f);CHKERRQ(ierr);
if (f) {
ierr = (*f)(st);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STSinvertSetMatStructure_Sinvert"
int STSinvertSetMatStructure_Sinvert(ST st,MatStructure str)
{
ST_SINV *ctx = (ST_SINV *) st->data;
 
PetscFunctionBegin;
ctx->str = str;
PetscFunctionReturn(0);
}
EXTERN_C_END
 
#undef __FUNCT__
#define __FUNCT__ "STSinvertSetMatStructure"
/*@
STSinvertSetMatStructure - 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_sinvert_same_pattern - Indicates A and B have the same nonzero pattern
. -st_sinvert_different_pattern - Indicates A and B have different nonzero pattern
- -st_sinvert_subset_pattern - Indicates B's nonzero pattern is a subset of B'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()
@*/
int STSinvertSetMatStructure(ST st,MatStructure str)
{
int ierr, (*f)(ST,MatStructure);
 
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_COOKIE);
ierr = PetscObjectQueryFunction((PetscObject)st,"STSinvertSetMatStructure_C",(void (**)(void))&f);CHKERRQ(ierr);
if (f) {
ierr = (*f)(st,str);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
/* ---------------------------------------------------------------------------*/
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STCreate_Sinvert"
int STCreate_Sinvert(ST st)
{
int ierr;
char *prefix;
ST_SINV *ctx;
 
PetscFunctionBegin;
ierr = PetscNew(ST_SINV,&ctx); CHKERRQ(ierr);
PetscMemzero(ctx,sizeof(ST_SINV));
PetscLogObjectMemory(st,sizeof(ST_SINV));
st->numberofshifts = 1;
st->data = (void *) ctx;
 
st->ops->apply = STApply_Sinvert;
st->ops->applynoB = STApplyNoB_Sinvert;
st->ops->postsolve = STPost_Sinvert;
st->ops->backtr = STBackTransform_Sinvert;
st->ops->setup = STSetUp_Sinvert;
st->ops->setshift = STSetShift_Sinvert;
st->ops->destroy = STDestroy_Sinvert;
st->ops->setfromoptions = STSetFromOptions_Sinvert;
st->ops->view = STView_Sinvert;
 
ierr = SLESCreate(st->comm,&st->sles);CHKERRQ(ierr);
ierr = STGetOptionsPrefix(st,&prefix);CHKERRQ(ierr);
ierr = SLESSetOptionsPrefix(st->sles,prefix);CHKERRQ(ierr);
ierr = SLESAppendOptionsPrefix(st->sles,"st_");CHKERRQ(ierr);
ctx->shift_matrix = PETSC_FALSE;
ctx->str = DIFFERENT_NONZERO_PATTERN;
 
ierr = PetscObjectComposeFunctionDynamic((PetscObject)st,"STSinvertSetShiftMat_C","STSinvertSetShiftMat_Sinvert",
STSinvertSetShiftMat_Sinvert);CHKERRQ(ierr);
ierr = PetscObjectComposeFunctionDynamic((PetscObject)st,"STSinvertSetMatStructure_C","STSinvertSetMatStructure_Sinvert",
STSinvertSetMatStructure_Sinvert);CHKERRQ(ierr);
 
PetscFunctionReturn(0);
}
EXTERN_C_END
 
/trunk/src/st/impls/sinvert/makefile
0,0 → 1,17
 
ALL: lib
 
CFLAGS =
FFLAGS =
SOURCEC = sinvert.c shellmat.c
SOURCEF =
SOURCEH = sinvert.h
OBJSC = sinvert.o shellmat.o
LIBBASE = libslepc
DIRS =
MANSEC = ST
LOCDIR = src/st/impls/sinvert/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
/trunk/src/st/impls/makefile
0,0 → 1,11
 
ALL: lib
 
LIBBASE = libslepc
DIRS = none shell shift sinvert
LOCDIR = src/st/impls/
MANSEC = ST
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
/trunk/src/st/impls/shift/makefile
0,0 → 1,17
 
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
 
 
/trunk/src/st/impls/shift/shift.c
0,0 → 1,96
/*
Shift spectral transformation, applies (A + sigma I) as operator, or
inv(B)(A + sigma B) for generalized problems
*/
#include "src/st/stimpl.h" /*I "slepcst.h" I*/
 
#undef __FUNCT__
#define __FUNCT__ "STApply_Shift"
int STApply_Shift(ST st,Vec x,Vec y)
{
int ierr;
Vec w;
 
PetscFunctionBegin;
if (st->B) {
/* generalized eigenproblem: y = (B^-1 A + sI) x */
w = (Vec) st->data;
ierr = MatMult(st->A,x,w);CHKERRQ(ierr);
ierr = STAssociatedSLESSolve(st,w,y);CHKERRQ(ierr);
ierr = VecAXPY(&st->sigma,x,y);CHKERRQ(ierr);
}
else {
/* standard eigenproblem: y = (A + sI) x */
ierr = MatMult(st->A,x,y);CHKERRQ(ierr);
ierr = VecAXPY(&st->sigma,x,y);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STBackTransform_Shift"
int STBackTransform_Shift(ST st,PetscScalar *eigr,PetscScalar *eigi)
{
PetscFunctionBegin;
if (eigr) *eigr -= st->sigma;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STSetUp_Shift"
static int STSetUp_Shift(ST st)
{
int ierr;
Vec w;
 
PetscFunctionBegin;
if (st->sles) {
ierr = VecDuplicate(st->vec,&w);CHKERRQ(ierr);
st->data = (void *) w;
ierr = SLESSetUp(st->sles,st->vec,st->vec);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "STDestroy_Shift"
static int STDestroy_Shift(ST st)
{
int ierr;
Vec w;
 
PetscFunctionBegin;
if (st->data) {
w = (Vec) st->data;
ierr = VecDestroy(w);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "STCreate_Shift"
int STCreate_Shift(ST st)
{
int ierr;
char *prefix;
 
PetscFunctionBegin;
st->numberofshifts = 1;
st->ops->apply = STApply_Shift;
st->ops->backtr = STBackTransform_Shift;
st->ops->destroy = STDestroy_Shift;
st->ops->setup = STSetUp_Shift;
 
if (st->B) {
ierr = SLESCreate(st->comm,&st->sles);CHKERRQ(ierr);
ierr = STGetOptionsPrefix(st,&prefix);CHKERRQ(ierr);
ierr = SLESSetOptionsPrefix(st->sles,prefix);CHKERRQ(ierr);
ierr = SLESAppendOptionsPrefix(st->sles,"st_");CHKERRQ(ierr);
ierr = SLESSetOperators(st->sles,st->B,st->B,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
}
 
PetscFunctionReturn(0);
}
EXTERN_C_END
 
/trunk/src/st/makefile
0,0 → 1,11
 
ALL: lib
 
SOURCEH = stimpl.h ../../include/slepcst.h
DIRS = interface impls
LOCDIR = src/st/
MANSEC = ST
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
/trunk/src/st/stimpl.h
0,0 → 1,41
 
#ifndef _STIMPL
#define _STIMPL
 
#include "slepceps.h"
#include "slepcst.h"
 
typedef struct _STOps *STOps;
 
struct _STOps {
int (*setup)(ST);
int (*apply)(ST,Vec,Vec);
int (*applyB)(ST,Vec,Vec);
int (*applynoB)(ST,Vec,Vec);
int (*setshift)(ST,PetscScalar);
int (*setfromoptions)(ST);
int (*presolve)(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 */
 
/*------------------------- Misc data --------------------------*/
Vec vec;
SLES sles;
void *data;
int setupcalled;
int numberofshifts;
};
 
extern int STDefaultApplyB( ST, Vec, Vec );
 
#endif
 
/trunk/src/eps/epsimpl.h
0,0 → 1,96
 
#ifndef _EPSIMPL
#define _EPSIMPL
 
#include "slepceps.h"
 
typedef struct _EPSOps *EPSOps;
 
struct _EPSOps {
int (*solve)(EPS,int*); /* actual solver */
int (*setup)(EPS);
int (*setdefaults)(EPS);
int (*setfromoptions)(EPS);
int (*publishoptions)(EPS);
int (*destroy)(EPS);
int (*view)(EPS,PetscViewer);
};
 
/*
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 */
PetscReal tol; /* tolerance */
EPSWhich which; /* which part of the spectrum to be sought */
PetscTruth dropvectors; /* do not compute eigenvectors */
EPSProblemType problem_type; /* which kind of problem to be solved */
 
/*------------------------- Working data --------------------------*/
Vec vec_initial; /* initial vector for iterative methods */
Vec *V; /* set of basis vectors */
PetscScalar *eigr, *eigi; /* real and imaginary parts of eigenvalues */
PetscReal *errest; /* error estimates */
ST OP; /* spectral transformation object */
void *data; /* holder for misc stuff associated
with a particular solver */
int nconv, /* number of converged eigenvalues */
its; /* number of iterations so far computed */
 
/* ---------------- Default work-area and status vars -------------------- */
int nwork;
Vec *work;
 
int setupcalled;
PetscTruth isgeneralized,
ishermitian;
EPSConvergedReason reason;
 
int (*monitor[MAXEPSMONITORS])(EPS,int,int,PetscReal*,int,void*);
int (*monitordestroy[MAXEPSMONITORS])(void*);
void *monitorcontext[MAXEPSMONITORS];
int numbermonitors;
int (*vmonitor[MAXEPSMONITORS])(EPS,int,int,PetscScalar*,PetscScalar*,int,void*);
int (*vmonitordestroy[MAXEPSMONITORS])(void*);
void *vmonitorcontext[MAXEPSMONITORS];
int numbervmonitors;
 
/* --------------- Orthogonalization --------------------- */
int (*orthog)(EPS,int,PetscScalar*);
EPSOrthogonalizationType orth_type; /* which orthogonalization to use */
};
 
#define EPSMonitorEstimates(eps,it,nconv,errest,nest) \
{ int _ierr,_i,_im = eps->numbermonitors; \
for ( _i=0; _i<_im; _i++ ) {\
_ierr=(*eps->monitor[_i])(eps,it,nconv,errest,nest,eps->monitorcontext[_i]);\
CHKERRQ(_ierr); \
} \
}
 
#define EPSMonitorValues(eps,it,nconv,eigr,eigi,neig) \
{ int _ierr,_i,_im = eps->numbervmonitors; \
for ( _i=0; _i<_im; _i++ ) {\
_ierr=(*eps->vmonitor[_i])(eps,it,nconv,eigr,eigi,neig,eps->monitorcontext[_i]);\
CHKERRQ(_ierr); \
} \
}
 
extern int EPSDefaultDestroy(EPS);
extern int EPSDefaultGetWork(EPS,int);
extern int EPSDefaultFreeWork(EPS);
extern int EPSModifiedGramSchmidtOrthogonalization(EPS,int,PetscScalar*);
extern int EPSUnmodifiedGramSchmidtOrthogonalization(EPS,int,PetscScalar*);
extern int EPSIROrthogonalization(EPS,int,PetscScalar*);
 
#endif
/trunk/src/eps/interface/dense.c
0,0 → 1,257
 
/*
This file implements interfaces to direct solvers in LAPACK
*/
#include "slepceps.h" /*I "slepceps.h" I*/
#include "slepcblaslapack.h"
 
#undef __FUNCT__
#define __FUNCT__ "EPSSortEigenvalues"
/*@
EPSSortEigenvalues - Sorts a list of eigenvalues according to a certain
criterium.
 
Not Collective
 
Input Parameters:
+ n - dimension of the eigenproblem
. eig - pointer to the array containing the eigenvalues
. eigi - imaginary part of the eigenvalues (only when using real numbers)
. which - sorting criterium
- 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
criterium
 
Level: developer
 
.seealso: EPSDenseNHEPSorted()
@*/
int EPSSortEigenvalues(int n,PetscScalar *eig,PetscScalar *eigi,EPSWhich which,int nev,int *permout)
{
int ierr,i,*perm;
PetscReal *values;
 
ierr = PetscMalloc(n*sizeof(int),&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:
#if defined(PETSC_USE_COMPLEX)
for (i=0; i<n; i++) { values[i] = PetscAbsScalar(eig[i]); }
#else
for (i=0; i<n; i++) { values[i] = LAlapy2_(&eig[i],&eigi[i]); }
#endif
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] = 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");
}
 
ierr = PetscFree(values);CHKERRQ(ierr);
ierr = PetscFree(perm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDenseNHEP"
/*@
EPSDenseNHEP - Solves a dense non-Hermitian Eigenvalue Problem.
 
Not Collective
 
Input Parameter:
+ 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 the eigenvectors
 
Notes:
If w is PETSC_NULL then the eigenvectors are not computed.
 
Matrix A is overwritten.
This routine uses LAPACK routines xGEEV.
 
Level: developer
 
.seealso: EPSDenseNHEPSorted()
@*/
int EPSDenseNHEP(int n,PetscScalar *A,PetscScalar *w,PetscScalar *wi,PetscScalar *V)
{
int ierr;
#if defined(PETSC_HAVE_ESSL)
 
/* ESSL has a different calling sequence for dgeev() and zgeev() than
standard LAPACK */
PetscScalar *cwork;
PetscReal *work;
int i,clen,idummy,lwork,iopt;
 
PetscFunctionBegin;
#if !defined(PETSC_USE_COMPLEX)
clen = n;
#else
clen = 2*n;
#endif
ierr = PetscMalloc(clen*sizeof(PetscScalar),&cwork);CHKERRQ(ierr);
idummy = n;
lwork = 3*n;
ierr = PetscMalloc(lwork*sizeof(PetscReal),&work);CHKERRQ(ierr);
if (V) iopt = 1;
else iopt = 0;
LAgeev_(&iopt,A,&n,cwork,V,&n,&idummy,&n,work,&lwork);
ierr = PetscFree(work);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
for (i=0; i<n; i++) {
w[i] = cwork[2*i];
wi[i] = cwork[2*i+1];
}
#else
for (i=0; i<n; i++) w[i] = cwork[i];
#endif
ierr = PetscFree(cwork);CHKERRQ(ierr);
 
#elif !defined(PETSC_USE_COMPLEX)
 
PetscScalar *work,sdummy;
int lwork;
char *jobvr;
 
PetscFunctionBegin;
lwork = 5*n;
ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
if (V) jobvr = "V";
else jobvr = "N";
LAgeev_("N",jobvr,&n,A,&n,w,wi,&sdummy,&n,V,&n,work,&lwork,&ierr);
if (ierr) SETERRQ1(PETSC_ERR_LIB,"Error in LAPACK routine %d",ierr);
ierr = PetscFree(work);CHKERRQ(ierr);
 
#else
 
PetscScalar *work,sdummy;
PetscReal *rwork;
int lwork;
char *jobvr;
 
PetscFunctionBegin;
lwork = 5*n;
ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
ierr = PetscMalloc(2*n*sizeof(PetscReal),&rwork);CHKERRQ(ierr);
if (V) jobvr = "V";
else jobvr = "N";
LAgeev_("N",jobvr,&n,A,&n,w,&sdummy,&n,V,&n,work,&lwork,rwork,&ierr);
if (ierr) SETERRQ1(PETSC_ERR_LIB,"Error in LAPACK routine %d",ierr);
ierr = PetscFree(work);CHKERRQ(ierr);
ierr = PetscFree(rwork);CHKERRQ(ierr);
 
#endif
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDenseNHEPSorted"
/*@
EPSDenseNHEPSorted - Solves a dense non-Hermitian Eigenvalue Problem and
then sorts the computed eigenpairs.
 
Not Collective
 
Input Parameter:
+ 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 the eigenvectors
 
Notes:
If w is PETSC_NULL then the eigenvectors are not computed.
 
Matrix A is overwritten.
 
Level: developer
 
.seealso: EPSDenseNHEP(), EPSSortEigenvalues()
@*/
int EPSDenseNHEPSorted(int n,PetscScalar *A,PetscScalar *w,PetscScalar *wi,PetscScalar *V,int m,EPSWhich which)
{
int i,ierr,*perm,iwork[100];
PetscScalar *realpart,*imagpart,*vectors,work[200];
 
PetscFunctionBegin;
if (m<=100) perm = iwork;
else { ierr = PetscMalloc(m*sizeof(int),&perm);CHKERRQ(ierr); }
if (n<=100) { realpart = work; imagpart = work+100; }
else {
ierr = PetscMalloc(n*sizeof(PetscScalar),&realpart);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscScalar),&imagpart);CHKERRQ(ierr);
}
if (V) {
ierr = PetscMalloc(n*n*sizeof(PetscScalar),&vectors);CHKERRQ(ierr);
}
 
ierr = EPSDenseNHEP(n,A,realpart,imagpart,vectors);CHKERRQ(ierr);
 
ierr = EPSSortEigenvalues(n,realpart,imagpart,which,m,perm);CHKERRQ(ierr);
for (i=0; i<m; i++) {
w[i] = realpart[perm[i]];
#if !defined(PETSC_USE_COMPLEX)
wi[i] = imagpart[perm[i]];
#endif
if (V) {
ierr = PetscMemcpy(V+i*n,vectors+perm[i]*n,n*sizeof(PetscScalar));CHKERRQ(ierr);
}
}
 
if (m>100) { ierr = PetscFree(perm);CHKERRQ(ierr); }
if (n>100) {
ierr = PetscFree(realpart);CHKERRQ(ierr);
ierr = PetscFree(imagpart);CHKERRQ(ierr);
}
if (V) {
ierr = PetscFree(vectors);CHKERRQ(ierr);
}
 
PetscFunctionReturn(0);
}
 
/trunk/src/eps/interface/itcreate.c
0,0 → 1,523
/*
The basic EPS routines, Create, View, etc. are here.
*/
#include "src/eps/epsimpl.h" /*I "slepceps.h" I*/
#include "slepcblaslapack.h"
#include "petscsys.h"
 
PetscTruth EPSRegisterAllCalled = PETSC_FALSE;
PetscFList EPSList = 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()
@*/
int EPSView(EPS eps,PetscViewer viewer)
{
char *type, *which;
int ierr;
PetscTruth isascii;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
if (!viewer) viewer = PETSC_VIEWER_STDOUT_(eps->comm);
PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE);
PetscCheckSameComm(eps,viewer);
 
#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\n",type);CHKERRQ(ierr);
} 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_ALGEBRAIC: which = "largest (algebraic) eigenvalues"; break;
case EPS_SMALLEST_ALGEBRAIC: which = "smallest (algebraic) eigenvalues"; 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;
case EPS_BOTH_ENDS: which = "eigenvalues from both ends of the spectrum"; 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 basis 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);
if (eps->dropvectors) { ierr = PetscViewerASCIIPrintf(viewer," computing only eigenvalues\n");CHKERRQ(ierr);}
ierr = PetscViewerASCIIPushTab(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__ "EPSSetDropEigenvectors"
/*@C
EPSSetDropEigenvectors - Sets the EPS solver not to compute the
eigenvectors. In some methods, this can reduce the number of operations
necessary for obtaining the eigenvalues.
 
Collective on KSP
 
Input Parameter:
. eps - the eigensolver context
 
Options Database Keys:
. -eps_drop_eigenvectors - do not compute eigenvectors
 
Level: advanced
 
.seealso: EPSSetUp(), EPSSolve(), EPSDestroy()
@*/
int EPSSetDropEigenvectors(EPS eps)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
eps->dropvectors = PETSC_TRUE;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSPublish_Petsc"
static int EPSPublish_Petsc(PetscObject object)
{
#if defined(PETSC_HAVE_AMS)
EPS v = (EPS) object;
int ierr;
#endif
PetscFunctionBegin;
 
#if defined(PETSC_HAVE_AMS)
/* if it is already published then return */
if (v->amem >=0 ) PetscFunctionReturn(0);
 
ierr = PetscObjectPublishBaseBegin(object);CHKERRQ(ierr);
ierr = AMS_Memory_add_field((AMS_Memory)v->amem,"Iteration",&v->its,1,AMS_INT,AMS_READ,
AMS_COMMON,AMS_REDUCT_UNDEF);CHKERRQ(ierr);
ierr = PetscObjectPublishBaseEnd(object);CHKERRQ(ierr);
#endif
 
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 EPSPOWER
 
Level: beginner
 
.seealso: EPSSetUp(), EPSSolve(), EPSDestroy(), EPS
@*/
int EPSCreate(MPI_Comm comm,EPS *outeps)
{
EPS eps;
int ierr;
 
PetscFunctionBegin;
*outeps = 0;
PetscHeaderCreate(eps,_p_EPS,struct _EPSOps,EPS_COOKIE,-1,"EPS",comm,EPSDestroy,EPSView);
PetscLogObjectCreate(eps);
*outeps = eps;
 
eps->bops->publish = EPSPublish_Petsc;
eps->ops->setfromoptions = 0;
eps->ops->solve = 0;
eps->ops->setup = 0;
eps->ops->destroy = 0;
 
eps->type = -1;
eps->max_it = 0;
eps->nev = 1;
eps->ncv = 0;
eps->tol = 0.0;
eps->which = EPS_LARGEST_MAGNITUDE;
eps->dropvectors = PETSC_FALSE;
eps->problem_type = (EPSProblemType)0;
 
eps->vec_initial = 0;
eps->V = 0;
eps->eigr = 0;
eps->eigi = 0;
eps->errest = 0;
eps->OP = 0;
eps->data = 0;
eps->nconv = 0;
eps->its = 0;
 
eps->nwork = 0;
eps->work = 0;
eps->isgeneralized = PETSC_FALSE;
eps->ishermitian = PETSC_FALSE;
eps->setupcalled = 0;
eps->reason = EPS_CONVERGED_ITERATING;
 
eps->numbermonitors = 0;
eps->numbervmonitors = 0;
 
eps->orthog = EPSIROrthogonalization;
 
ierr = STCreate(comm,&eps->OP); CHKERRQ(ierr);
PetscLogObjectParent(eps,eps->OP);
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.
 
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
@*/
int EPSSetType(EPS eps,EPSType type)
{
int ierr,(*r)(EPS);
PetscTruth match;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
PetscValidCharPointer(type);
 
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;
}
/* Get the function pointers for the iterative method requested */
if (!EPSRegisterAllCalled) {ierr = EPSRegisterAll(PETSC_NULL); CHKERRQ(ierr);}
 
ierr = PetscFListFind(eps->comm,EPSList,type,(void (**)(void)) &r);CHKERRQ(ierr);
 
if (!r) SETERRQ1(1,"Unknown EPS type given: %s",type);
 
eps->setupcalled = 0;
ierr = (*r)(eps); CHKERRQ(ierr);
 
ierr = PetscObjectChangeTypeName((PetscObject)eps,type);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSRegisterDestroy"
/*@C
EPSRegisterDestroy - Frees the list of EPS methods that were
registered by EPSRegisterDynamic().
 
Not Collective
 
Level: advanced
 
.seealso: EPSRegisterDynamic(), EPSRegisterAll()
@*/
int EPSRegisterDestroy(void)
{
int ierr;
 
PetscFunctionBegin;
if (EPSList) {
ierr = PetscFListDestroy(&EPSList);CHKERRQ(ierr);
EPSList = 0;
}
EPSRegisterAllCalled = PETSC_FALSE;
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()
@*/
int EPSGetType(EPS eps,EPSType *type)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
*type = eps->type_name;
PetscFunctionReturn(0);
}
 
#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:
@*/
int EPSSetFromOptions(EPS eps)
{
int ierr;
char type[256];
PetscTruth flg;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
if (!EPSRegisterAllCalled) {ierr = EPSRegisterAll(PETSC_NULL);CHKERRQ(ierr);}
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:EPSPOWER),type,256,&flg);CHKERRQ(ierr);
if (flg) {
ierr = EPSSetType(eps,type);CHKERRQ(ierr);
}
/*
Set the type if it was never set.
*/
if (!eps->type_name) {
ierr = EPSSetType(eps,EPSPOWER);CHKERRQ(ierr);
}
 
ierr = PetscOptionsLogicalGroupBegin("-eps_hermitian","hermitian eigenvalue problem","EPSSetProblemType",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetProblemType(eps,EPS_HEP);CHKERRQ(ierr);}
ierr = PetscOptionsLogicalGroup("-eps_gen_hermitian","generalized hermitian eigenvalue problem","EPSSetProblemType",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetProblemType(eps,EPS_GHEP);CHKERRQ(ierr);}
ierr = PetscOptionsLogicalGroup("-eps_non_hermitian","non-hermitian eigenvalue problem","EPSSetProblemType",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetProblemType(eps,EPS_NHEP);CHKERRQ(ierr);}
ierr = PetscOptionsLogicalGroupEnd("-eps_gen_non_hermitian","generalized non-hermitian eigenvalue problem","EPSSetProblemType",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetProblemType(eps,EPS_GNHEP);CHKERRQ(ierr);}
 
ierr = PetscOptionsLogicalGroupBegin("-eps_mgs_orth","Modified Gram-Schmidt orthogonalization","EPSSetOrthogonalization",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetOrthogonalization(eps,EPS_MGS_ORTH);CHKERRQ(ierr);}
ierr = PetscOptionsLogicalGroup("-eps_cgs_orth","Classical Gram-Schmidt orthogonalization","EPSSetOrthogonalization",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetOrthogonalization(eps,EPS_CGS_ORTH);CHKERRQ(ierr);}
ierr = PetscOptionsLogicalGroupEnd("-eps_ir_orth","Iterative refinement orthogonalization","EPSSetOrthogonalization",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetOrthogonalization(eps,EPS_IR_ORTH);CHKERRQ(ierr);}
 
ierr = PetscOptionsInt("-eps_max_it","Maximum number of iterations","EPSSetTolerances",eps->max_it,&eps->max_it,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-eps_tol","Tolerance","KSPSetTolerances",eps->tol,&eps->tol,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsInt("-eps_nev","Number of eigenvalues to compute","EPSSetDimensions",eps->nev,&eps->nev,&flg);CHKERRQ(ierr);
if( eps->nev<1 ) SETERRQ(1,"Illegal value for option -eps_nev. Must be > 0");
ierr = PetscOptionsInt("-eps_ncv","Number of basis vectors","EPSSetDimensions",eps->ncv,&eps->ncv,&flg);CHKERRQ(ierr);
if( flg && eps->ncv<1 ) SETERRQ(1,"Illegal value for option -eps_ncv. Must be > 0");
 
ierr = PetscOptionsName("-eps_drop_eigenvectors","Do not compute eigenvectors","EPSSetDropEigenvectors",&flg);CHKERRQ(ierr);
if (flg) {
ierr = EPSSetDropEigenvectors(eps);CHKERRQ(ierr);
}
 
/* -----------------------------------------------------------------------*/
/*
Cancels all monitors hardwired into code before call to EPSSetFromOptions()
*/
ierr = PetscOptionsName("-eps_cancelmonitors","Remove any hardwired monitor routines","EPSClearMonitor",&flg);CHKERRQ(ierr);
if (flg) {
ierr = EPSClearMonitor(eps); CHKERRQ(ierr);
}
/*
Prints error estimates at each iteration
*/
ierr = PetscOptionsName("-eps_monitor","Monitor error estimates","EPSSetMonitor",&flg);CHKERRQ(ierr);
if (flg) {
ierr = EPSSetMonitor(eps,EPSDefaultEstimatesMonitor,PETSC_NULL);CHKERRQ(ierr);
}
/*
Prints approximate eigenvalues at each iteration
*/
ierr = PetscOptionsName("-eps_monitor_values","Monitor approximate eigenvalues","EPSSetValuesMonitor",&flg);CHKERRQ(ierr);
if (flg) {
ierr = EPSSetValuesMonitor(eps,EPSDefaultValuesMonitor,PETSC_NULL);CHKERRQ(ierr);
}
/* -----------------------------------------------------------------------*/
ierr = PetscOptionsLogicalGroupBegin("-eps_largest_magnitude","compute largest eigenvalues in magnitude","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_LARGEST_MAGNITUDE);CHKERRQ(ierr);}
ierr = PetscOptionsLogicalGroup("-eps_smallest_magnitude","compute smallest eigenvalues in magnitude","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_SMALLEST_MAGNITUDE);CHKERRQ(ierr);}
ierr = PetscOptionsLogicalGroup("-eps_largest_algebraic","compute largest (algebraic) eigenvalues","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_LARGEST_ALGEBRAIC);CHKERRQ(ierr);}
ierr = PetscOptionsLogicalGroup("-eps_smallest_algebraic","compute smallest (algebraic) eigenvalues","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_SMALLEST_ALGEBRAIC);CHKERRQ(ierr);}
ierr = PetscOptionsLogicalGroup("-eps_largest_real","compute largest real parts","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_LARGEST_REAL);CHKERRQ(ierr);}
ierr = PetscOptionsLogicalGroup("-eps_smallest_real","compute smallest real parts","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_SMALLEST_REAL);CHKERRQ(ierr);}
ierr = PetscOptionsLogicalGroup("-eps_largest_imaginary","compute largest imaginary parts","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_LARGEST_IMAGINARY);CHKERRQ(ierr);}
ierr = PetscOptionsLogicalGroup("-eps_smallest_imaginary","compute smallest imaginary parts","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_SMALLEST_IMAGINARY);CHKERRQ(ierr);}
ierr = PetscOptionsLogicalGroupEnd("-eps_both_ends","compute eigenvalues from both ends of the spectrum","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_BOTH_ENDS);CHKERRQ(ierr);}
 
ierr = PetscOptionsName("-eps_view","Print detailed information on solver used","EPSView",0);CHKERRQ(ierr);
ierr = PetscOptionsName("-eps_view_binary","Saves the matrices associated to the eigenproblem","EPSSetFromOptions",0);CHKERRQ(ierr);
ierr = PetscOptionsName("-eps_plot_eigs","Makes 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 = STSetFromOptions(eps->OP); CHKERRQ(ierr);
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}, ${SLEPC_DIR}, ${BOPT},
and others of the form ${any_environmental_variable} occuring in pathname will be
replaced with appropriate values.
 
.seealso: EPSRegisterAll(), EPSRegisterDestroy()
 
M*/
 
#undef __FUNCT__
#define __FUNCT__ "EPSRegister"
int EPSRegister(char *sname,char *path,char *name,int (*function)(EPS))
{
int ierr;
char fullname[256];
 
PetscFunctionBegin;
ierr = PetscFListConcat(path,name,fullname);CHKERRQ(ierr);
ierr = PetscFListAdd(&EPSList,sname,fullname,(void (*)(void))function);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
/trunk/src/eps/interface/borthog.c
0,0 → 1,119
/*
Routines used for the orthogonalization, taken from PETSc's
GMRES module.
 
Note that for the complex numbers version, the VecDot() and
VecMDot() arguments within the code MUST remain in the order
given for correct computation of inner products.
*/
#include "src/eps/epsimpl.h"
 
/*
This is the basic orthogonalization routine using modified Gram-Schmidt.
*/
#undef __FUNCT__
#define __FUNCT__ "EPSModifiedGramSchmidtOrthogonalization"
int EPSModifiedGramSchmidtOrthogonalization(EPS eps,int it,PetscScalar *H)
{
int ierr,j;
PetscScalar alpha;
 
PetscFunctionBegin;
for (j=0; j<=it; j++) {
/* alpha = ( v_{it+1}, v_j ) */
ierr = VecDot(eps->V[it+1],eps->V[j],&alpha);CHKERRQ(ierr);
/* store coefficients if requested */
if (H) *H++ = alpha;
/* v_{it+1} <- v_{it+1} - alpha v_j */
alpha = -alpha;
ierr = VecAXPY(&alpha,eps->V[j],eps->V[it+1]);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
/*
This version uses UNMODIFIED Gram-Schmidt. It is NOT always recommended,
but it can give MUCH better performance than the default modified form
when running in a parallel environment.
*/
#undef __FUNCT__
#define __FUNCT__ "EPSUnmodifiedGramSchmidtOrthogonalization"
int EPSUnmodifiedGramSchmidtOrthogonalization(EPS eps,int it,PetscScalar *H)
{
int ierr,j;
PetscScalar shh[100];
PetscTruth alloc = PETSC_FALSE;
 
PetscFunctionBegin;
 
if (!H) {
if (it<10) H = shh; /* Don't allocate small arrays */
else {
ierr = PetscMalloc((it+1)*(it+1)*sizeof(PetscScalar),&H);CHKERRQ(ierr);
alloc = PETSC_TRUE;
}
}
 
/* This is really a matrix-vector product, with the matrix stored
as pointer to rows */
ierr = VecMDot(it+1,eps->V[it+1],eps->V,H);CHKERRQ(ierr);
 
/* This is really a matrix-vector product:
[h_0,h_1,...]*[ v_0; v_1; ...] subtracted from v_{it+1}. */
for (j=0;j<=it;j++) H[j] = -H[j];
ierr = VecMAXPY(it+1,H,eps->V[it+1],eps->V);CHKERRQ(ierr);
for (j=0;j<=it;j++) H[j] = -H[j];
 
if (alloc) { ierr = PetscFree(H);CHKERRQ(ierr); }
PetscFunctionReturn(0);
}
 
/*
This version uses 1 iteration of iterative refinement of UNMODIFIED Gram-Schmidt.
It can give better performance when running in a parallel
environment and in some cases even in a sequential environment (because
MAXPY has more data reuse).
*/
#undef __FUNCT__
#define __FUNCT__ "EPSIROrthogonalization"
int EPSIROrthogonalization(EPS eps,int it,PetscScalar *H)
{
int ierr,j,ncnt;
PetscScalar shh[100],shh2[100],*lhh;
PetscTruth alloc = PETSC_FALSE;
 
PetscFunctionBegin;
if (!H) {
if (it<10) H = shh2; /* Don't allocate small arrays */
else {
ierr = PetscMalloc((it+1)*(it+1)*sizeof(PetscScalar),&H);CHKERRQ(ierr);
alloc = PETSC_TRUE;
}
}
/* Don't allocate small arrays */
if (it<100) lhh = shh;
else { ierr = PetscMalloc((it+1)*sizeof(PetscScalar),&lhh);CHKERRQ(ierr); }
/* Clear H since we will accumulate values into it */
for (j=0;j<=it;j++) H[j] = 0.0;
 
ncnt = 0;
do {
/* This is really a matrix-vector product, with the matrix stored
as pointer to rows */
ierr = VecMDot(it+1,eps->V[it+1],eps->V,lhh);CHKERRQ(ierr); /* <v,vnew> */
 
/* This is really a matrix vector product:
[h_0,h_1,...]*[ v_0; v_1; ...] subtracted from v_{it+1}. */
for (j=0;j<=it;j++) lhh[j] = -lhh[j];
ierr = VecMAXPY(it+1,lhh,eps->V[it+1],eps->V);CHKERRQ(ierr);
for (j=0;j<=it;j++) {
H[j] -= lhh[j]; /* H += -<v,vnew> */
}
} while (ncnt++ < 2);
 
if (it>=100) { ierr = PetscFree(lhh);CHKERRQ(ierr); }
if (alloc) { ierr = PetscFree(H);CHKERRQ(ierr); }
PetscFunctionReturn(0);
}
 
/trunk/src/eps/interface/itregis.c
0,0 → 1,78
 
#include "src/eps/epsimpl.h" /*I "slepceps.h" I*/
 
EXTERN_C_BEGIN
extern int EPSCreate_PREONLY(EPS);
extern int EPSCreate_POWER(EPS);
extern int EPSCreate_RQI(EPS);
extern int EPSCreate_SUBSPACE(EPS);
extern int EPSCreate_ARNOLDI(EPS);
#if defined(SLEPC_HAVE_ARPACK)
extern int EPSCreate_ARPACK(EPS);
#endif
extern int EPSCreate_LAPACK(EPS);
#if defined(SLEPC_HAVE_BLZPACK) && !defined(PETSC_USE_COMPLEX)
extern int EPSCreate_BLZPACK(EPS);
#endif
#if defined(SLEPC_HAVE_PLANSO) && !defined(PETSC_USE_COMPLEX)
extern int EPSCreate_PLANSO(EPS);
#endif
#if defined(SLEPC_HAVE_TRLAN) && !defined(PETSC_USE_COMPLEX)
extern int EPSCreate_TRLAN(EPS);
#endif
EXTERN_C_END
/*
This is used by EPSSetType() to make sure that at least one
EPSRegisterAll() is called. In general, if there is more than one
DLL, then EPSRegisterAll() may be called several times.
*/
extern PetscTruth EPSRegisterAllCalled;
 
#undef __FUNCT__
#define __FUNCT__ "EPSRegisterAll"
/*@C
EPSRegisterAll - Registers all the eigenvalue solvers in the EPS package.
 
Not Collective
 
Level: advanced
 
.seealso: EPSRegisterDestroy()
@*/
int EPSRegisterAll(char *path)
{
int ierr;
 
PetscFunctionBegin;
EPSRegisterAllCalled = PETSC_TRUE;
 
ierr = EPSRegisterDynamic(EPSPOWER, path,"EPSCreate_POWER",
EPSCreate_POWER);CHKERRQ(ierr);
ierr = EPSRegisterDynamic(EPSRQI, path,"EPSCreate_RQI",
EPSCreate_RQI);CHKERRQ(ierr);
ierr = EPSRegisterDynamic(EPSSUBSPACE, path,"EPSCreate_SUBSPACE",
EPSCreate_SUBSPACE);CHKERRQ(ierr);
ierr = EPSRegisterDynamic(EPSARNOLDI, path,"EPSCreate_ARNOLDI",
EPSCreate_ARNOLDI);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_PLANSO) && !defined(PETSC_USE_COMPLEX)
ierr = EPSRegisterDynamic(EPSPLANSO, path,"EPSCreate_PLANSO",
EPSCreate_PLANSO);CHKERRQ(ierr);
#endif
#if defined(SLEPC_HAVE_TRLAN) && !defined(PETSC_USE_COMPLEX)
ierr = EPSRegisterDynamic(EPSTRLAN, path,"EPSCreate_TRLAN",
EPSCreate_TRLAN);CHKERRQ(ierr);
#endif
PetscFunctionReturn(0);
}
 
/trunk/src/eps/interface/iterativ.c
0,0 → 1,211
 
/*
This file contains some simple default routines.
*/
#include "src/eps/epsimpl.h" /*I "slepceps.h" I*/
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetIterationNumber"
/*@
EPSGetIterationNumber - Gets the current iteration number. If the
EPSSolve() is complete, returns the number of iterations used.
Not Collective
 
Input Parameters:
. eps - the eigensolver context
 
Output Parameters:
. its - number of iterations
 
Level: intermediate
 
Note:
During the i-th iteration this call returns i-1
 
@*/
int EPSGetIterationNumber(EPS eps,int *its)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
*its = eps->its;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDefaultEstimatesMonitor"
/*@C
EPSDefaultEstimatesMonitor - Print the 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
. errest - error estimates
. nest - number of error estimates to display
- dummy - unused monitor context
 
Level: intermediate
 
.seealso: EPSSetMonitor()
@*/
int EPSDefaultEstimatesMonitor(EPS eps,int its,int nconv,PetscReal *errest,int nest,void *dummy)
{
int i,ierr;
PetscViewer viewer = (PetscViewer) dummy;
 
PetscFunctionBegin;
if (!viewer) viewer = PETSC_VIEWER_STDOUT_(eps->comm);
ierr = PetscViewerASCIIPrintf(viewer,"%3d EPS nconv=%d Error Estimates:",its,nconv);CHKERRQ(ierr);
for (i=0;i<nest;i++) {
ierr = PetscViewerASCIIPrintf(viewer," %10.8e",errest[i]);CHKERRQ(ierr);
}
ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDefaultValuesMonitor"
/*@C
EPSDefaultValuesMonitor - Print the current approximate values of the
eigenvalues.
 
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 (can be PETSC_NULL)
. neig - number of eigenvalues to display
- dummy - unused monitor context
 
Level: intermediate
 
.seealso: EPSSetEstimatesMonitor()
@*/
int EPSDefaultValuesMonitor(EPS eps,int its,int nconv,PetscScalar *eigr,PetscScalar *eigi,int neig,void *dummy)
{
int i,ierr;
PetscViewer viewer = (PetscViewer) dummy;
 
PetscFunctionBegin;
if (!viewer) viewer = PETSC_VIEWER_STDOUT_(eps->comm);
ierr = PetscViewerASCIIPrintf(viewer,"%3d EPS nconv=%d Values:",its,nconv);CHKERRQ(ierr);
for (i=0;i<neig;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 && eigi[i]!=0.0) { ierr = PetscViewerASCIIPrintf(viewer,"%+gi",eigi[i]);CHKERRQ(ierr); }
#endif
}
ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#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
 
*/
int EPSDefaultGetWork(EPS eps, int nw)
{
int ierr;
 
PetscFunctionBegin;
if (eps->work) {ierr = EPSDefaultFreeWork( eps );CHKERRQ(ierr);}
eps->nwork = nw;
ierr = VecDuplicateVecs(eps->vec_initial,nw,&eps->work); CHKERRQ(ierr);
PetscLogObjectParents(eps,nw,eps->work);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDefaultFreeWork"
/*
EPSDefaultFreeWork - Free work vectors.
 
Input Parameters:
. eps - eigensolver context
 
*/
int EPSDefaultFreeWork( EPS eps )
{
int ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
if (eps->work) {
ierr = VecDestroyVecs(eps->work,eps->nwork); CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDefaultDestroy"
/*
EPSDefaultDestroy - Destroys an eigensolver context variable for methods
with no separate context. Preferred calling sequence EPSDestroy().
 
Input Parameter:
. eps - the eigensolver context
 
*/
int EPSDefaultDestroy(EPS eps)
{
int ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
if (eps->data) {ierr = PetscFree(eps->data);CHKERRQ(ierr);}
 
/* free work vectors */
EPSDefaultFreeWork( eps );
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetConvergedReason"
/*@C
EPSGetConvergedReason - Gets the reason the EPS 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 the EPSSolve() is complete.
 
.seealso: EPSSetTolerances(), EPSConvergedReason
@*/
int EPSGetConvergedReason(EPS eps,EPSConvergedReason *reason)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
*reason = eps->reason;
PetscFunctionReturn(0);
}
 
/trunk/src/eps/interface/itfunc.c
0,0 → 1,1521
/*
Interface EPS routines that the user calls.
*/
 
#include "src/eps/epsimpl.h" /*I "slepceps.h" I*/
#include "slepcblaslapack.h"
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetDefaults"
/*@
EPSSetDefaults - Sets the default values of the internal parameters
of the eigensolver. Some of these parameters are set by a method-specific
routine.
 
Collective on EPS
 
Input Parameter:
. eps - eigenproblem solver context
 
Level: developer
 
.seealso: EPSSetType(), EPSSetUp()
@*/
int EPSSetDefaults(EPS eps)
{
int ierr;
Mat A,B;
PetscTruth Ah,Bh;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
 
/* Set default solver type */
if (!eps->type_name) {
ierr = EPSSetType(eps,EPSPOWER);CHKERRQ(ierr);
}
 
/* Set default problem type */
if (!eps->problem_type) {
ierr = STGetOperators(eps->OP,&A,&B);CHKERRQ(ierr);
ierr = SlepcIsHermitian(A,&Ah);CHKERRQ(ierr);
if (B==PETSC_NULL) {
if (Ah) { ierr = EPSSetProblemType(eps,EPS_HEP);CHKERRQ(ierr); }
else { ierr = EPSSetProblemType(eps,EPS_NHEP);CHKERRQ(ierr); }
}
else {
ierr = SlepcIsHermitian(B,&Bh);CHKERRQ(ierr);
if (Ah && Bh) { ierr = EPSSetProblemType(eps,EPS_GHEP);CHKERRQ(ierr); }
else { ierr = EPSSetProblemType(eps,EPS_GNHEP);CHKERRQ(ierr); }
}
}
 
if (eps->ops->setdefaults) {
ierr = (*eps->ops->setdefaults)(eps);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetUp"
/*@
EPSSetUp - Sets up all the internal data structures necessary for the
application of the eigensolver. The operations carried out depend on
the solver: factorization of a preconditioning matrix or simply the
allocation of necessary space.
 
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 want 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()
@*/
int EPSSetUp(EPS eps)
{
int n, m, i, ierr, nloc, nev, ncv;
PetscScalar *pV;
Vec v0;
Mat A;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
 
/* reset the convergence flag from the previous solves */
eps->reason = EPS_CONVERGED_ITERATING;
 
/* Check if the EPS initial vector has been set */
ierr = EPSGetInitialVector(eps,&v0);CHKERRQ(ierr);
if (!v0) {
ierr = STGetOperators(eps->OP,&A,PETSC_NULL);CHKERRQ(ierr);
ierr = MatGetLocalSize(A,&n,&m);CHKERRQ(ierr);
ierr = VecCreate(eps->comm,&v0);CHKERRQ(ierr);
ierr = VecSetSizes(v0,m,PETSC_DECIDE);CHKERRQ(ierr);
ierr = VecSetFromOptions(v0);CHKERRQ(ierr);
ierr = SlepcVecSetRandom(v0);CHKERRQ(ierr);
ierr = EPSSetInitialVector(eps,v0);CHKERRQ(ierr);
}
ierr = STSetVector(eps->OP,v0); CHKERRQ(ierr);
 
ierr = EPSSetDefaults(eps);CHKERRQ(ierr);
nev = eps->nev;
ncv = eps->ncv;
if (!eps->eigr){
ierr = PetscMalloc(ncv*sizeof(PetscScalar),&eps->eigr);CHKERRQ(ierr);
}
if (!eps->eigi){
ierr = PetscMalloc(ncv*sizeof(PetscScalar),&eps->eigi);CHKERRQ(ierr);
}
if (!eps->errest){
ierr = PetscMalloc(ncv*sizeof(PetscReal),&eps->errest);CHKERRQ(ierr);
}
if (!eps->V){
ierr = VecGetLocalSize(eps->vec_initial,&nloc);CHKERRQ(ierr);
ierr = PetscMalloc(ncv*sizeof(Vec),&eps->V);CHKERRQ(ierr);
ierr = PetscMalloc(ncv*nloc*sizeof(PetscScalar),&pV);CHKERRQ(ierr);
for (i=0;i<ncv;i++) {
ierr = VecCreateMPIWithArray(eps->comm,nloc,PETSC_DECIDE,pV+i*nloc,&eps->V[i]);CHKERRQ(ierr);
}
}
 
if (eps->setupcalled) PetscFunctionReturn(0);
ierr = PetscLogEventBegin(EPS_SetUp,eps,eps->V[0],eps->V[0],0);CHKERRQ(ierr);
eps->setupcalled = 1;
ierr = (*eps->ops->setup)(eps);CHKERRQ(ierr);
ierr = STSetUp(eps->OP); CHKERRQ(ierr);
ierr = PetscLogEventEnd(EPS_SetUp,eps,eps->V[0],eps->V[0],0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSolve"
/*@
EPSSolve - Solves the eigensystem.
 
Collective on EPS
 
Input Parameter:
. eps - eigensolver context obtained from EPSCreate()
 
Output Parameter:
. its - number of iterations performed by the solver
 
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
 
Notes:
On return, the 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.
 
Level: beginner
 
.seealso: EPSCreate(), EPSSetUp(), EPSDestroy(), EPSSetTolerances()
@*/
int EPSSolve(EPS eps,int *its)
{
int i,ierr,nits;
PetscReal re,im;
PetscTruth flg;
PetscViewer viewer;
PetscDraw draw;
PetscDrawSP drawsp;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
 
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);
}
 
if (!eps->setupcalled){ ierr = EPSSetUp(eps);CHKERRQ(ierr); }
ierr = PetscLogEventBegin(EPS_Solve,eps,eps->V[0],eps->V[0],0);CHKERRQ(ierr);
ierr = STPreSolve(eps->OP,eps);CHKERRQ(ierr);
ierr = (*eps->ops->solve)(eps,&nits);CHKERRQ(ierr);
ierr = STPostSolve(eps->OP,eps);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");
}
if (its) *its = nits;
 
/* Map eigenvalues back to the original problem, necessary in some
* spectral transformations */
ierr = EPSBackTransform(eps);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__ "EPSDestroy"
/*@C
EPSDestroy - Destroys the EPS context.
 
Collective on EPS
 
Input Parameter:
. eps - eigensolver context obtained from EPSCreate()
 
Level: beginner
 
.seealso: EPSCreate(), EPSSetUp(), EPSSolve()
@*/
int EPSDestroy(EPS eps)
{
int i,ierr;
PetscScalar *pV;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
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);
if (eps->ops->destroy) {
ierr = (*eps->ops->destroy)(eps); CHKERRQ(ierr);
}
 
if (eps->eigr){ ierr = PetscFree(eps->eigr);CHKERRQ(ierr); }
if (eps->eigi){ ierr = PetscFree(eps->eigi);CHKERRQ(ierr); }
if (eps->errest){ ierr = PetscFree(eps->errest);CHKERRQ(ierr); }
if (eps->V){
ierr = VecGetArray(eps->V[0],&pV);CHKERRQ(ierr);
for (i=0;i<eps->ncv;i++) {
ierr = VecDestroy(eps->V[i]);CHKERRQ(ierr);
}
ierr = PetscFree(pV);CHKERRQ(ierr);
ierr = PetscFree(eps->V);CHKERRQ(ierr);
}
ierr = VecDestroy(eps->vec_initial);CHKERRQ(ierr);
 
PetscLogObjectDestroy(eps);
PetscHeaderDestroy(eps);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetTolerances"
/*@C
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()
@*/
int EPSGetTolerances(EPS eps,PetscReal *tol,int *maxits)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
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_DEFAULT to retain the default value of any of the tolerances.
 
Level: intermediate
 
.seealso: EPSGetTolerances()
@*/
int EPSSetTolerances(EPS eps,PetscReal tol,int maxits)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
if (tol != PETSC_DEFAULT) eps->tol = tol;
if (maxits != PETSC_DEFAULT) 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()
@*/
int EPSGetDimensions(EPS eps,int *nev,int *ncv)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
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 nev
- -eps_ncv <ncv> - Sets ncv
 
Notes:
Use PETSC_DEFAULT to retain the previous value of any parameter.
 
Use PETSC_DECIDE for ncv to assign a reasonably good value, which is
dependent of the solution method.
 
Level: intermediate
 
.seealso: EPSGetDimensions()
@*/
int EPSSetDimensions(EPS eps,int nev,int ncv)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
 
if( nev != PETSC_DEFAULT ) {
if (nev<1) SETERRQ(1,"Illegal value of nev. Must be > 0");
eps->nev = nev;
}
if( ncv == PETSC_DECIDE ) eps->ncv = 0;
else if( ncv != PETSC_DEFAULT ) {
if (ncv<1) SETERRQ(1,"Illegal value of ncv. Must be > 0");
eps->ncv = ncv;
}
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 eigenvalues
 
Note:
This function should be called after EPSSolve() has finished.
 
Level: beginner
 
.seealso: EPSSetDimensions()
@*/
int EPSGetConverged(EPS eps,int *nconv)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
if (nconv) *nconv = eps->nconv;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetSolution"
/*@C
EPSGetSolution - Gets the location of the solution of the
eigenproblem which has already been solved. The solution consists
in both the eigenvalues and the eigenvectors (if available).
 
Not Collective
 
Input Parameter:
. eps - eigensolver context obtained from EPSCreate()
 
Output Parameters:
+ eigr - real part of eigenvalues
. eigi - imaginary part of eigenvalues
- V - eigenvectors
 
Notes:
In the complex case (PETSC_USE_COMPLEX) the eigenvalues are stored in eigr
and eigi is set to zero.
 
In the real case, complex eigenvectors are stored in two consecutive vectors
of V containing the real and imaginary parts, respectively.
 
Level: beginner
 
@*/
int EPSGetSolution(EPS eps, PetscScalar **eigr, PetscScalar **eigi, Vec **V)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
if (eigr) *eigr = eps->eigr;
if (eigi) *eigi = eps->eigi;
if (V) *V = eps->V;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetErrorEstimates"
/*@C
EPSGetErrorEstimates - Returns the error bounds associated to each of
the approximate eigenpairs.
 
Not Collective
 
Input Parameter:
. eps - eigensolver context obtained from EPSCreate()
 
Output Parameter:
. errest - the error estimates
 
Level: advanced
 
.seealso: EPSGetSolution(), EPSComputeError()
@*/
int EPSGetErrorEstimates(EPS eps, PetscReal **errest)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
*errest = eps->errest;
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()
@*/
int EPSSetST(EPS eps,ST st)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
PetscValidHeaderSpecific(st,ST_COOKIE);
PetscCheckSameComm(eps,st);
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()
@*/
int EPSGetST(EPS eps, ST *st)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
*st = eps->OP;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetMonitor"
/*@C
EPSSetMonitor - 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)
 
Calling Sequence of monitor:
$ monitor (EPS eps, int its, int nconv, PetscReal* errest, int nest, void *mctx)
 
+ eps - eigensolver context obtained from EPSCreate()
. its - iteration number
. nconv - number of converged eigenpairs
. errest - error estimates for each eigenpair
. nest - number of error estimates
- mctx - optional monitoring context, as set by EPSSetMonitor()
 
Options Database Keys:
+ -eps_monitor - print error estimates at each iteration
- -eps_cancelmonitors - cancels all monitors that have been hardwired into
a code by calls to EPSetMonitor(), but does not cancel those set via
the options database.
 
Notes:
Several different monitoring routines may be set by calling
EPSSetMonitor() multiple times; all will be called in the
order in which they were set.
 
Level: intermediate
 
.seealso: EPSDefaultEstimatesMonitor(), EPSClearMonitor()
@*/
int EPSSetMonitor(EPS eps, int (*monitor)(EPS,int,int,PetscReal*,int,void*), void *mctx)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
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;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetValuesMonitor"
/*@C
EPSSetValuesMonitor - Sets an ADDITIONAL function to be called at every
iteration to monitor the value of approximate eigenvalues.
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)
 
Calling Sequence of monitor:
$ monitor (EPS eps, int its, int nconv, PetscScalar* kr, PetscScalar* ki, int nest, void *mctx)
 
+ eps - eigensolver context obtained from EPSCreate()
. its - iteration number
. nconv - number of converged eigenpairs
. kr - real part of each eigenvalue
. ki - imaginary part of each eigenvalue
. nest - number of error estimates
- mctx - optional monitoring context, as set by EPSSetMonitor()
 
Options Database Keys:
+ -eps_monitor_values - print eigenvalue approximations at each iteration
- -eps_cancelmonitors - cancels all monitors that have been hardwired into
a code by calls to EPSetValuesMonitor(), but does not cancel those set
via the options database.
 
Notes:
Several different monitoring routines may be set by calling
EPSSetValuesMonitor() multiple times; all will be called in the
order in which they were set.
 
Level: intermediate
 
.seealso: EPSDefaultValuesMonitor(), EPSClearMonitor()
@*/
int EPSSetValuesMonitor(EPS eps, int (*monitor)(EPS,int,int,PetscScalar*,PetscScalar*,int,void*), void *mctx)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
if (eps->numbervmonitors >= MAXEPSMONITORS) {
SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Too many EPS values monitors set");
}
eps->vmonitor[eps->numbervmonitors] = monitor;
eps->vmonitorcontext[eps->numbervmonitors++] = (void*)mctx;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSClearMonitor"
/*@C
EPSClearMonitor - Clears all monitors for an EPS object.
 
Collective on EPS
 
Input Parameters:
. eps - eigensolver context obtained from EPSCreate()
 
Options Database Key:
. -eps_cancelmonitors - Cancels all monitors that have been hardwired
into a code by calls to EPSSetMonitor() or EPSSetValuesMonitor(),
but does not cancel those set via the options database.
 
Level: intermediate
 
.seealso: EPSSetMonitor(), EPSSetValuesMonitor()
@*/
int EPSClearMonitor(EPS eps)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
eps->numbermonitors = 0;
eps->numbervmonitors = 0;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetMonitorContext"
/*@C
EPSGetMonitorContext - Gets the estimates 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(), EPSDefaultEstimatesMonitor()
@*/
int EPSGetMonitorContext(EPS eps, void **ctx)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
*ctx = (eps->monitorcontext[0]);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetValuesMonitorContext"
/*@C
EPSGetValuesMonitorContext - Gets the values monitor context, as set by
EPSSetValuesMonitor() for the FIRST monitor only.
 
Not Collective
 
Input Parameter:
. eps - eigensolver context obtained from EPSCreate()
 
Output Parameter:
. ctx - monitor context
 
Level: intermediate
 
.seealso: EPSSetValuesMonitor(), EPSDefaultValuesMonitor()
@*/
int EPSGetValuesMonitorContext(EPS eps, void **ctx)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
*ctx = (eps->vmonitorcontext[0]);
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()
 
@*/
int EPSSetInitialVector(EPS eps,Vec vec)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
PetscValidHeaderSpecific(vec,VEC_COOKIE);
PetscCheckSameComm(eps,vec);
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 eigensolve context
 
Output Parameter:
. vec - the vector
 
Level: intermediate
 
.seealso: EPSSetInitialVector()
 
@*/
int EPSGetInitialVector(EPS eps,Vec *vec)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
*vec = eps->vec_initial;
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_ALGEBRAIC - largest (algebraic) eigenvalues
. EPS_SMALLEST_ALGEBRAIC - smallest (algebraic) eigenvalues
. EPS_LARGEST_REAL - largest real parts
. EPS_SMALLEST_REAL - smallest real parts
. EPS_LARGEST_IMAGINARY - largest imaginary parts
. EPS_SMALLEST_IMAGINARY - smallest imaginary parts
- EPS_BOTH_ENDS - eigenvalues from both ends of the spectrum (Hermitian case)
 
Options Database Keys:
+ -eps_largest_magnitude - Sets largest eigenvalues in magnitude
. -eps_smallest_magnitude - Sets smallest eigenvalues in magnitude
. -eps_largest_algebraic - Sets largest (algebraic) eigenvalues
. -eps_smallest_algebraic - Sets smallest (algebraic) eigenvalues
. -eps_largest_real - Sets largest real parts
. -eps_smallest_real - Sets smallest real parts
. -eps_largest_imaginary - Sets largest imaginary parts
. -eps_smallest_imaginary - Sets smallest imaginary parts
- -eps_both_ends - Sets both ends
 
Notes:
No all eigensolvers implemented in EPS account for all the possible values
stated above. Also, some values make sense only for certain types of
problems.
Level: intermediate
 
.seealso: EPSGetWhichEigenpairs()
@*/
int EPSSetWhichEigenpairs(EPS eps,EPSWhich which)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
eps->which = which;
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
 
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_ALGEBRAIC - largest (algebraic) eigenvalues
. EPS_SMALLEST_ALGEBRAIC - smallest (algebraic) eigenvalues
. EPS_LARGEST_REAL - largest real parts
. EPS_SMALLEST_REAL - smallest real parts
. EPS_LARGEST_IMAGINARY - largest imaginary parts
. EPS_SMALLEST_IMAGINARY - smallest imaginary parts
- EPS_BOTH_ENDS - eigenvalues from both ends of the spectrum (Hermitian case)
 
Level: intermediate
 
.seealso: EPSSetWhichEigenpairs()
@*/
int EPSGetWhichEigenpairs(EPS eps,EPSWhich *which)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
*which = eps->which;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSComputeExplicitOperator"
/*@
EPSComputeExplicitOperator - Computes the explicit operator associated
to the eigenvalue problem with the specified spectral transformation.
 
Collective on EPS
 
Input Parameter:
. eps - the eigenvalue solver context
 
Output Parameter:
. mat - the explict 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.
 
Currently, this routine uses a dense matrix format when 1 processor
is used and a sparse format otherwise. This routine is costly in general,
and is recommended for use only with relatively small systems.
 
Level: advanced
@*/
int EPSComputeExplicitOperator(EPS eps,Mat *mat)
{
Vec in,out;
int ierr,i,M,m,size,*rows,start,end;
MPI_Comm comm;
PetscScalar *array,zero = 0.0,one = 1.0;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
PetscValidPointer(mat);
comm = eps->comm;
 
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
 
ierr = VecDuplicate(eps->vec_initial,&in);CHKERRQ(ierr);
ierr = VecDuplicate(eps->vec_initial,&out);CHKERRQ(ierr);
ierr = VecGetSize(in,&M);CHKERRQ(ierr);
ierr = VecGetLocalSize(in,&m);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(in,&start,&end);CHKERRQ(ierr);
ierr = PetscMalloc((m+1)*sizeof(int),&rows);CHKERRQ(ierr);
for (i=0; i<m; i++) {rows[i] = start + i;}
 
if (size == 1) {
ierr = MatCreateSeqDense(comm,M,M,PETSC_NULL,mat);CHKERRQ(ierr);
} else {
ierr = MatCreateMPIAIJ(comm,m,m,M,M,0,0,0,0,mat);CHKERRQ(ierr);
}
for (i=0; i<M; i++) {
 
ierr = VecSet(&zero,in);CHKERRQ(ierr);
ierr = VecSetValues(in,1,&i,&one,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(in);CHKERRQ(ierr);
ierr = VecAssemblyEnd(in);CHKERRQ(ierr);
 
ierr = STApply(eps->OP,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__ "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()
@*/
int EPSSetOperators(EPS eps,Mat A,Mat B)
{
int ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
PetscValidHeaderSpecific(A,MAT_COOKIE);
if (B) PetscValidHeaderSpecific(B,MAT_COOKIE);
ierr = STSetOperators(eps->OP,A,B);CHKERRQ(ierr);
eps->setupcalled = 0; /* so that next solve call will call setup */
 
/* The following call is done in order to check the consistency of the
problem type with the specified matrices */
if (eps->problem_type) {
ierr = EPSSetProblemType(eps,eps->problem_type);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSComputeError"
/*@C
EPSComputeError - Computes the actual relative error associated with each of
the converged approximate eigenpairs.
 
Collective on EPS
 
Input Parameter:
. eps - the eigensolver context
 
Output Parameter:
. error - the relative error, computed as ||Ax-kBx||/|k| where k is the
eigenvalue and x is the eigenvector
 
Level: beginner
 
.seealso: EPSSolve()
@*/
int EPSComputeError(EPS eps,PetscReal *error)
{
Vec u, w;
Mat A, B;
int i, first=1, ierr;
PetscScalar alpha;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
ierr = STGetOperators(eps->OP,&A,&B);
 
ierr = VecDuplicate(eps->vec_initial,&u); CHKERRQ(ierr);
ierr = VecDuplicate(eps->vec_initial,&w); CHKERRQ(ierr);
for (i=0;i<eps->nconv;i++) {
#if !defined(PETSC_USE_COMPLEX)
if( eps->eigi[i] == 0.0 ) {
#endif
ierr = MatMult( A, eps->V[i], u ); CHKERRQ(ierr);
if(eps->isgeneralized) { ierr = MatMult( B, eps->V[i], w ); CHKERRQ(ierr); }
else { ierr = VecCopy( eps->V[i], w ); CHKERRQ(ierr); }
alpha = -eps->eigr[i];
ierr = VecAXPY( &alpha, w, u ); CHKERRQ(ierr);
ierr = VecNorm( u, NORM_2, &error[i] ); CHKERRQ(ierr);
error[i] /= PetscAbsScalar(eps->eigr[i]);
#if !defined(PETSC_USE_COMPLEX)
}
else if( first ) {
ierr = MatMult( A, eps->V[i], u ); CHKERRQ(ierr);
if(eps->isgeneralized) { ierr = MatMult( B, eps->V[i], w ); CHKERRQ(ierr); }
else { ierr = VecCopy( eps->V[i], w ); CHKERRQ(ierr); }
alpha = -eps->eigr[i];
ierr = VecAXPY( &alpha, w, u ); CHKERRQ(ierr);
if(eps->isgeneralized) { ierr = MatMult( B, eps->V[i+1], w ); CHKERRQ(ierr); }
else { ierr = VecCopy( eps->V[i+1], w ); CHKERRQ(ierr); }
alpha = eps->eigi[i];
ierr = VecAXPY( &alpha, w, u ); CHKERRQ(ierr);
ierr = VecNorm( u, NORM_2, &error[i] ); CHKERRQ(ierr);
ierr = MatMult( A, eps->V[i+1], u ); CHKERRQ(ierr);
alpha = -eps->eigr[i];
ierr = VecAXPY( &alpha, w, u ); CHKERRQ(ierr);
if(eps->isgeneralized) { ierr = MatMult( B, eps->V[i], w ); CHKERRQ(ierr); }
else { ierr = VecCopy( eps->V[i], w ); CHKERRQ(ierr); }
alpha = -eps->eigi[i];
ierr = VecAXPY( &alpha, w, u ); CHKERRQ(ierr);
ierr = VecNorm( u, NORM_2, &error[i+1] ); CHKERRQ(ierr);
error[i] = LAlapy2_( &error[i], &error[i+1] );
error[i] = error[i]/LAlapy2_( &eps->eigr[i], &eps->eigi[i] );
error[i+1] = error[i];
first = 0;
}
else first = 1;
#endif
}
ierr = VecDestroy(w); CHKERRQ(ierr);
ierr = VecDestroy(u); CHKERRQ(ierr);
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetProblemType"
/*@C
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 (default)
. -eps_gen_hermitian - generalized Hermitian eigenvalue problem
. -eps_non_hermitian - non-Hermitian eigenvalue problem
- -eps_gen_non_hermitian - generalized non-Hermitian eigenvalue problem
Note:
Normally, the user need not set the EPS type, since it can be set from
the information given in the EPSSetOperators call. This routine is reserved
for special cases such as when a nonsymmetric solver wants to be
used in a symmetric problem.
 
Level: advanced
 
.seealso: EPSSetOperators(), EPSSetType(), EPSType
@*/
int EPSSetProblemType(EPS eps,EPSProblemType type)
{
int n,m,ierr;
Mat A,B;
PetscTruth Ah,Bh,inconsistent=PETSC_FALSE;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
 
if (type!=EPS_HEP && type!=EPS_GHEP && type!=EPS_NHEP && type!=EPS_GNHEP ) { SETERRQ(PETSC_ERR_ARG_WRONG,"Unknown eigenvalue problem type"); }
 
ierr = STGetOperators(eps->OP,&A,&B);CHKERRQ(ierr);
if (!A) { SETERRQ(1,"Must call EPSSetOperators() first"); }
 
/* 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"); }
}
 
eps->problem_type = type;
 
ierr = SlepcIsHermitian(A,&Ah);CHKERRQ(ierr);
if (B) { ierr = SlepcIsHermitian(B,&Bh);CHKERRQ(ierr); }
 
if (!B) {
eps->isgeneralized = PETSC_FALSE;
if (Ah) eps->ishermitian = PETSC_TRUE;
else eps->ishermitian = PETSC_FALSE;
}
else {
eps->isgeneralized = PETSC_TRUE;
if (Ah && Bh) eps->ishermitian = PETSC_TRUE;
else eps->ishermitian = PETSC_FALSE;
}
switch (type) {
case EPS_HEP:
if (eps->isgeneralized || !eps->ishermitian) inconsistent=PETSC_TRUE;
eps->ishermitian = PETSC_TRUE;
break;
case EPS_GHEP:
/* Note that here we do not consider the case in which A and B are
non-hermitian but there exists a linear combination of them which is */
if (!eps->isgeneralized || !eps->ishermitian) inconsistent=PETSC_TRUE;
break;
case EPS_NHEP:
if (eps->isgeneralized) inconsistent=PETSC_TRUE;
eps->ishermitian = PETSC_FALSE;
break;
case EPS_GNHEP:
/* If matrix B is not given then an error is issued. An alternative
would be to generate an identity matrix. Also in EPS_GHEP above */
if (!eps->isgeneralized) inconsistent=PETSC_TRUE;
eps->ishermitian = PETSC_FALSE;
break;
}
if (inconsistent) { SETERRQ(0,"Warning: Inconsistent EPS state"); }
 
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()
@*/
int EPSGetProblemType(EPS eps,EPSProblemType *type)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
*type = eps->problem_type;
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
 
@*/
int EPSIsGeneralized(EPS eps,PetscTruth* is)
{
int ierr;
Mat B;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
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
 
@*/
int EPSIsHermitian(EPS eps,PetscTruth* is)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
if( eps->ishermitian ) *is = PETSC_TRUE;
else *is = PETSC_FALSE;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSQRDecomposition"
/*@
EPSQRDecomposition - Compute the QR factorization of the basis vectors.
 
Collective on EPS
 
Input Parameter:
+ eps - the eigenproblem solver context
. m - starting column
- n - ending column
 
Level: developer
 
@*/
int EPSQRDecomposition(EPS eps,int m,int n,PetscScalar *R,int ldr)
{
int ierr,k;
PetscScalar alpha;
PetscReal norm;
PetscFunctionBegin;
 
/* normalize v_m: r_{m,m} = ||v_m||_2; v_m = v_m/r_{m,m} */
ierr = VecNorm(eps->V[m],NORM_2,&norm);CHKERRQ(ierr);
if (R) { R[m+ldr*m] = norm; }
if (norm==0.0) SETERRQ( 1,"Zero vector in QR decomposition" );
alpha = 1.0/norm;
ierr = VecScale(&alpha,eps->V[m]);CHKERRQ(ierr);
 
for (k=m+1; k<n; k++) {
 
/* orthogonalize v_k with respect to v_0, ..., v_{k-1} */
ierr = PetscLogEventBegin(EPS_Orthogonalization,eps,0,0,0);CHKERRQ(ierr);
if (R) { ierr = (*eps->orthog)(eps,k-1,&R[0+ldr*k]);CHKERRQ(ierr); }
else { ierr = (*eps->orthog)(eps,k-1,PETSC_NULL);CHKERRQ(ierr); }
ierr = PetscLogEventEnd(EPS_Orthogonalization,eps,0,0,0);CHKERRQ(ierr);
 
/* normalize v_k: r_{k,k} = ||v_k||_2; v_k = v_k/r_{k,k} */
ierr = VecNorm(eps->V[k],NORM_2,&norm); CHKERRQ(ierr);
if (R) { R[k+ldr*k] = norm; }
if (norm==0.0) SETERRQ( 1,"Zero vector in QR decomposition" );
alpha = 1.0/norm;
ierr = VecScale(&alpha,eps->V[k]);CHKERRQ(ierr);
 
}
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSReverseProjection"
/*@
EPSReverseProjection - Compute the operation V=V*S, where the columns of
V are m of the basis vectors of the EPS object and S is an mxm dense
matrix.
 
Collective on EPS
 
Input Parameter:
+ eps - the eigenproblem solver context
. m - starting column
. k - dimension of matrix S
- S - pointer to the values of matrix S
 
Level: developer
 
Note:
Matrix S is overwritten.
 
@*/
int EPSReverseProjection(EPS eps,int k,int m,PetscScalar *S)
{
int i,j,n,ierr,lwork;
PetscScalar *tau,*work,*pV;
PetscFunctionBegin;
 
ierr = VecGetLocalSize(eps->vec_initial,&n);CHKERRQ(ierr);
lwork = n;
ierr = PetscMalloc(m*sizeof(PetscScalar),&tau);CHKERRQ(ierr);
ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
 
/* compute the LQ factorization L Q = S */
LAgelqf_(&m,&m,S,&m,tau,work,&lwork,&ierr);
 
/* triangular post-multiplication, V = V L */
for (i=k;i<k+m;i++) {
ierr = VecScale(S+(i-k)+m*(i-k),eps->V[i]);CHKERRQ(ierr);
for (j=i+1;j<k+m;j++) {
ierr = VecAXPY(S+(j-k)+m*(i-k),eps->V[j],eps->V[i]);CHKERRQ(ierr);
}
}
 
/* orthogonal post-multiplication, V = V Q */
ierr = VecGetArray(eps->V[k],&pV);CHKERRQ(ierr);
LAormlq_("R","N",&n,&m,&m,S,&m,tau,pV,&n,work,&lwork,&ierr,1,1);
ierr = VecRestoreArray(eps->V[k],&pV);CHKERRQ(ierr);
 
ierr = PetscFree(tau);CHKERRQ(ierr);
ierr = PetscFree(work);CHKERRQ(ierr);
 
PetscFunctionReturn(0);
}
 
 
#undef __FUNCT__
#define __FUNCT__ "EPSSwapEigenpairs"
/*@
EPSSwapEigenpairs - Swaps all the information internal to the EPS object
corresponding to eigenpairs which occupy the i-th and j-th positions.
 
Collective on EPS
 
Input Parameter:
+ eps - the eigenproblem solver context
. i - first index
- j - second index
 
Level: developer
 
@*/
int EPSSwapEigenpairs(EPS eps,int i,int j)
{
int ierr;
PetscScalar tscalar;
PetscReal treal;
PetscFunctionBegin;
if (i!=j) {
ierr = VecSwap(eps->V[i],eps->V[j]);CHKERRQ(ierr);
tscalar = eps->eigr[i];
eps->eigr[i] = eps->eigr[j];
eps->eigr[j] = tscalar;
tscalar = eps->eigi[i];
eps->eigi[i] = eps->eigi[j];
eps->eigi[j] = tscalar;
treal = eps->errest[i];
eps->errest[i] = eps->errest[j];
eps->errest[j] = treal;
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetOrthogonalization"
/*@C
EPSSetOrthogonalization - Specifies the type of orthogonalization technique
to be used inside the eigensolver.
 
Collective on EPS
 
Input Parameters:
+ eps - the eigensolver context obtained from EPSCreate
- type - a known type of orthogonalization
 
Options Database Keys:
+ -eps_ir_orth - Activates Iterative Refinement (IR) orthogonalization (default)
. -eps_mgs_orth - Activates Modified Gram-Schmidt (MGS) orthogonalization
- -eps_cgs_orth - Activates Classical Gram-Schmidt (CGS) orthogonalization
Notes:
The default orthogonalization technique (IR, an iterative variant of CGS)
works well for most problems. MGS is numerically more robust than CGS,
but CGS may give better scalability.
 
Level: intermediate
 
.seealso: EPSGetOrthogonalization()
@*/
int EPSSetOrthogonalization(EPS eps,EPSOrthogonalizationType type)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
 
if (type!=EPS_MGS_ORTH && type!=EPS_CGS_ORTH && type!=EPS_IR_ORTH ) { SETERRQ(PETSC_ERR_ARG_WRONG,"Unknown orthogonalization type"); }
 
switch (type) {
case EPS_CGS_ORTH:
eps->orthog = EPSUnmodifiedGramSchmidtOrthogonalization;
break;
case EPS_MGS_ORTH:
eps->orthog = EPSModifiedGramSchmidtOrthogonalization;
break;
case EPS_IR_ORTH:
eps->orthog = EPSIROrthogonalization;
break;
}
eps->orth_type = type;
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSGetOrthogonalization"
/*@C
EPSGetOrthogonalization - Gets the orthogonalization type from the
EPS object.
 
Not Collective
 
Input Parameter:
. eps - Eigensolver context
 
Output Parameter:
. type - type of orthogonalization technique
 
Level: intermediate
 
.seealso: EPSSetOrthogonalization()
@*/
int EPSGetOrthogonalization(EPS eps,EPSOrthogonalizationType *type)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
*type = eps->orth_type;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSBackTransform"
/*@C
EPSBackTransform - Transforms all the computed eigenvalues back to
the solution of the original problem.
 
Not Collective
 
Input Parameter:
. eps - the eigensolver context
 
Level: developer
 
.seealso: STBackTransform()
@*/
int EPSBackTransform(EPS eps)
{
ST st;
PetscScalar *eigr,*eigi;
int ierr,i,nconv;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
ierr = EPSGetSolution(eps,&eigr,&eigi,PETSC_NULL);CHKERRQ(ierr);
ierr = EPSGetConverged(eps,&nconv);CHKERRQ(ierr);
ierr = EPSGetST(eps,&st);CHKERRQ(ierr);
for (i=0;i<nconv;i++) {
ierr = STBackTransform(st,&eigr[i],&eigi[i]);CHKERRQ(ierr);
}
 
PetscFunctionReturn(0);
}
 
 
/trunk/src/eps/interface/dlregis.c
0,0 → 1,61
 
#include "slepceps.h"
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "PetscDLLibraryRegister"
/*
PetscDLLibraryRegister - This function is called when the dynamic library
it is in is opened.
 
This one registers all the EPS and ST methods in libpetsceps
library.
 
Input Parameter:
path - library path
*/
int PetscDLLibraryRegister(char *path)
{
int ierr;
 
ierr = PetscInitializeNoArguments(); if (ierr) return 1;
 
PetscFunctionBegin;
/*
If we got here then PETSc was properly loaded
*/
ierr = EPSRegisterAll(path); CHKERRQ(ierr);
ierr = STRegisterAll(path); CHKERRQ(ierr);
PetscFunctionReturn(0);
}
EXTERN_C_END
 
/* --------------------------------------------------------------------------*/
static char *contents = "Iterative methods for large sparse eigenvalue problems.\n";
 
static char *authors = SLEPC_AUTHOR_INFO;
static char *version = SLEPC_VERSION_NUMBER;
 
/* --------------------------------------------------------------------------*/
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "PetscDLLibraryInfo"
int PetscDLLibraryInfo(char *path,char *type,char **mess)
{
PetscTruth iscon,isaut,isver;
int ierr;
 
PetscFunctionBegin;
 
ierr = PetscStrcmp(type,"Contents",&iscon);CHKERRQ(ierr);
ierr = PetscStrcmp(type,"Authors",&isaut);CHKERRQ(ierr);
ierr = PetscStrcmp(type,"Version",&isver);CHKERRQ(ierr);
if (iscon) *mess = contents;
else if (isaut) *mess = authors;
else if (isver) *mess = version;
else *mess = 0;
 
PetscFunctionReturn(0);
}
EXTERN_C_END
 
/trunk/src/eps/interface/itcl.c
0,0 → 1,105
/*
Code for setting EPS options from the options database.
*/
 
#include "src/eps/epsimpl.h" /*I "slepceps.h" I*/
#include "petscsys.h"
 
#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()
@*/
int EPSSetOptionsPrefix(EPS eps,char *prefix)
{
int ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
ierr = PetscObjectSetOptionsPrefix((PetscObject)eps, prefix);CHKERRQ(ierr);
ierr = STSetOptionsPrefix(eps->OP,prefix);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()
@*/
int EPSAppendOptionsPrefix(EPS eps,char *prefix)
{
int ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
ierr = PetscObjectAppendOptionsPrefix((PetscObject)eps, prefix);CHKERRQ(ierr);
ierr = STAppendOptionsPrefix(eps->OP,prefix); 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()
@*/
int EPSGetOptionsPrefix(EPS eps,char **prefix)
{
int ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
ierr = PetscObjectGetOptionsPrefix((PetscObject)eps, prefix);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
/trunk/src/eps/interface/makefile
0,0 → 1,17
 
ALL: lib
 
CFLAGS =
FFLAGS =
SOURCEC = dlregis.c itcl.c itfunc.c itcreate.c iterativ.c itregis.c borthog.c dense.c
SOURCEF =
SOURCEH =
OBJSC = dlregis.o itcl.o itfunc.o itcreate.o iterativ.o itregis.o borthog.o dense.o
LIBBASE = libslepc
DIRS =
MANSEC = EPS
LOCDIR = src/eps/interface/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
/trunk/src/eps/impls/trlan/trlan.c
0,0 → 1,166
 
/*
This file implements a wrapper to the TRLAN package
*/
#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"
static int EPSSetUp_TRLAN(EPS eps)
{
int ierr, n;
EPS_TRLAN *tr = (EPS_TRLAN *)eps->data;
 
PetscFunctionBegin;
#if defined(PETSC_USE_COMPLEX)
SETERRQ(PETSC_ERR_SUP,"Requested method is not available for complex problems");
#endif
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);
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetDefaults_TRLAN"
static int EPSSetDefaults_TRLAN(EPS eps)
{
int ierr, 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 = eps->nev;
if (!eps->max_it) eps->max_it = PetscMax(100,N);
if (!eps->tol) eps->tol = 1.e-7;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "MatMult_TRLAN"
static int MatMult_TRLAN(int *n,int *m,PetscReal *xin,int *ldx,PetscReal *yout,int *ldy)
{
Vec x,y;
int i,ierr;
 
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);
}
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSolve_TRLAN"
static int EPSSolve_TRLAN(EPS eps,int *its)
{
int ipar[32], i, n, lohi, stat, ierr;
EPS_TRLAN *tr = (EPS_TRLAN *)eps->data;
PetscScalar *pV;
PetscFunctionBegin;
 
ierr = VecGetLocalSize(eps->vec_initial,&n); CHKERRQ(ierr);
lohi = 0;
if (eps->which==EPS_LARGEST_MAGNITUDE) lohi = 1;
else if (eps->which==EPS_SMALLEST_MAGNITUDE) lohi = -1;
 
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 = VecCopy(eps->vec_initial,eps->V[0]);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];
*its = eps->its;
eps->reason = EPS_CONVERGED_TOL;
for (i=0;i<eps->nconv;i++) eps->eigi[i]=0.0;
if (stat!=0) { SETERRQ1(PETSC_ERR_LIB,"Error in TRLAN (code=%d)",stat);}
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDestroy_TRLAN"
/*
EPSDestroy_TRLAN - Destroys the context variable for TRLAN.
 
Input Parameter:
. eps - the iterative context
*/
int EPSDestroy_TRLAN(EPS eps)
{
EPS_TRLAN *tr = (EPS_TRLAN *)eps->data;
int ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
if (tr->work) { ierr = PetscFree(tr->work);CHKERRQ(ierr); }
if (eps->data) { ierr = PetscFree(eps->data);CHKERRQ(ierr); }
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "EPSCreate_TRLAN"
int EPSCreate_TRLAN(EPS eps)
{
EPS_TRLAN *trlan;
int ierr;
 
PetscFunctionBegin;
ierr = PetscNew(EPS_TRLAN,&trlan);CHKERRQ(ierr);
PetscMemzero(trlan,sizeof(EPS_TRLAN));
PetscLogObjectMemory(eps,sizeof(EPS_TRLAN));
eps->data = (void *) trlan;
eps->ops->setup = EPSSetUp_TRLAN;
eps->ops->setdefaults = EPSSetDefaults_TRLAN;
eps->ops->solve = EPSSolve_TRLAN;
eps->ops->destroy = EPSDestroy_TRLAN;
eps->ops->view = 0;
PetscFunctionReturn(0);
}
EXTERN_C_END
/trunk/src/eps/impls/trlan/trlanp.h
0,0 → 1,55
/*
Private data structure used by the TRLAN interface
*/
 
#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
*/
#include "petsc.h"
 
/*
This include file on the Cray T3D/T3E defines the interface between
Fortran and C representations of charactor strings.
*/
#if defined(PETSC_USES_CPTOFCD)
#include <fortran.h>
#endif
 
#if !defined(PETSC_USE_COMPLEX)
 
/*
These are real case. TRLAN currently only has DOUBLE PRECISION version
*/
#if defined(PETSC_HAVE_FORTRAN_UNDERSCORE) || defined(PETSC_BLASLAPACK_F2C)
#define TRLan_ trlan77_
#elif defined(PETSC_HAVE_FORTRAN_CAPS)
#define TRLan_ TRLAN77
#else
#define TRLan_ trlan77
#endif
 
#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
 
/trunk/src/eps/impls/trlan/makefile
0,0 → 1,20
 
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
 
 
/trunk/src/eps/impls/arpack/arpack.c
0,0 → 1,279
 
/*
This file implements a wrapper to the ARPACK package
*/
#include "src/eps/impls/arpack/arpackp.h"
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetUp_ARPACK"
static int EPSSetUp_ARPACK(EPS eps)
{
int ierr, n, ncv;
EPS_ARPACK *ar = (EPS_ARPACK *)eps->data;
 
PetscFunctionBegin;
ncv = eps->ncv;
#if defined(PETSC_USE_COMPLEX)
ierr = PetscMalloc(ncv*sizeof(PetscReal),&ar->rwork);CHKERRQ(ierr);
ar->lworkl = 3*ncv*ncv+5*ncv;
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 = PetscMalloc(3*ncv*sizeof(PetscScalar),&ar->workev);CHKERRQ(ierr);
}
#endif
ierr = PetscMalloc(ar->lworkl*sizeof(PetscScalar),&ar->workl);CHKERRQ(ierr);
ierr = PetscMalloc(ncv*sizeof(PetscTruth),&ar->select);CHKERRQ(ierr);
ierr = VecGetLocalSize(eps->vec_initial,&n); CHKERRQ(ierr);
ierr = PetscMalloc(3*n*sizeof(PetscScalar),&ar->workd);CHKERRQ(ierr);
 
ierr = EPSDefaultGetWork(eps,1);CHKERRQ(ierr);
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetDefaults_ARPACK"
static int EPSSetDefaults_ARPACK(EPS eps)
{
int ierr, N;
 
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 eps->ncv = PetscMax(6,2*eps->nev+1);
if (eps->ncv>N) SETERRQ(1,"The value of ncv cannot be larger than N");
if (!eps->max_it) eps->max_it = PetscMax(100,N);
if (!eps->tol) eps->tol = 1.e-7;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSolve_ARPACK"
static int EPSSolve_ARPACK(EPS eps,int *its)
{
EPS_ARPACK *ar = (EPS_ARPACK *)eps->data;
char bmat[1], *which, howmny[] = "A";
int i, n, iparam[11], ipntr[14], ido, info, ierr;
PetscScalar sigmar, sigmai, *pV, *resid;
Vec x, y, w;
Mat A;
PetscTruth isSinv,rvec;
MPI_Fint fcomm;
PetscFunctionBegin;
 
fcomm = MPI_Comm_c2f(eps->comm);
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);
ierr = VecGetArray(eps->vec_initial,&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' ]
*/
bmat[0] = eps->isgeneralized? 'G': 'I';
ierr = PetscTypeCompare((PetscObject)eps->OP,STSINV,&isSinv);CHKERRQ(ierr);
if(isSinv) {
iparam[6] = 3;
ierr = STGetShift(eps->OP,&sigmar);CHKERRQ(ierr);
sigmai = 0.0;
}
else iparam[6] = eps->isgeneralized? 2: 1;
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;
#if !defined(PETSC_USE_COMPLEX)
case EPS_LARGEST_ALGEBRAIC: which = "LA"; break;
case EPS_SMALLEST_ALGEBRAIC: which = "SA"; break;
case EPS_BOTH_ENDS: which = "BE"; break;
#endif
default: SETERRQ(1,"Wrong value of eps->which");
}
 
for(;;) {
 
#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 );
EPSMonitorEstimates(eps,iparam[2],iparam[4],&ar->workl[ipntr[6]-1],eps->ncv);
EPSMonitorValues(eps,iparam[2],iparam[4],&ar->workl[ipntr[5]-1],PETSC_NULL,eps->ncv);
}
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 );
EPSMonitorEstimates(eps,iparam[2],iparam[4],&ar->workl[ipntr[7]-1],eps->ncv);
EPSMonitorValues(eps,iparam[2],iparam[4],&ar->workl[ipntr[5]-1],&ar->workl[ipntr[6]-1],eps->ncv);
}
#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 );
EPSMonitorEstimates(eps,iparam[2],iparam[4],(PetscReal*)&ar->workl[ipntr[7]-1],eps->ncv);
EPSMonitorValues(eps,iparam[2],iparam[4],&ar->workl[ipntr[5]-1],PETSC_NULL,eps->ncv);
#endif
 
if( ido == -1 ) {
ierr = VecPlaceArray( x, &ar->workd[ipntr[0]-1] );CHKERRQ(ierr);
ierr = VecPlaceArray( y, &ar->workd[ipntr[1]-1] );CHKERRQ(ierr);
ierr = STApply( eps->OP, x, y ); CHKERRQ(ierr);
if (iparam[6]==2) { /* regular inverse mode */
w = eps->work[0];
ierr = STGetOperators( eps->OP, &A, PETSC_NULL ); CHKERRQ(ierr);
ierr = MatMult(A,x,w);CHKERRQ(ierr);
ierr = VecCopy( w, x );CHKERRQ(ierr);
}
}
else if( ido == 1 ) {
ierr = VecPlaceArray( y, &ar->workd[ipntr[1]-1] );CHKERRQ(ierr);
if (isSinv && eps->isgeneralized) {
ierr = VecPlaceArray( x, &ar->workd[ipntr[2]-1] );CHKERRQ(ierr);
ierr = STApplyNoB( eps->OP, x, y ); CHKERRQ(ierr);
}
else {
ierr = VecPlaceArray( x, &ar->workd[ipntr[0]-1] );CHKERRQ(ierr);
ierr = STApply( eps->OP, x, y ); CHKERRQ(ierr);
}
if (iparam[6]==2) { /* regular inverse mode */
w = eps->work[0];
ierr = STGetOperators( eps->OP, &A, PETSC_NULL ); CHKERRQ(ierr);
ierr = MatMult(A,x,w);CHKERRQ(ierr);
ierr = VecCopy( w, x );CHKERRQ(ierr);
}
}
else if( ido == 2 ) {
ierr = VecPlaceArray( x, &ar->workd[ipntr[0]-1] );CHKERRQ(ierr);
ierr = VecPlaceArray( y, &ar->workd[ipntr[1]-1] );CHKERRQ(ierr);
ierr = STApplyB( eps->OP, x, y ); CHKERRQ(ierr);
}
else break;
}
 
eps->nconv = iparam[4];
eps->its = iparam[2];
*its = eps->its;
if (info==1) { SETERRQ(0,"Exceeded maximum number of iterations in xxAUPD"); }
else 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) { SETERRQ1(PETSC_ERR_LIB,"Error reported by ARPACK subroutine xxAUPD (%d)",info);}
 
if (eps->dropvectors) rvec = PETSC_FALSE;
else rvec = PETSC_TRUE;
 
#if !defined(PETSC_USE_COMPLEX)
if (eps->ishermitian) {
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 );
for (i=0;i<eps->nconv;i++) eps->eigi[i]=0.0;
}
else {
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
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); }
 
if(isSinv) {
for( i=0; i<eps->nconv; i++ )
eps->eigr[i] = 1.0 / (eps->eigr[i] - sigmar);
}
ierr = VecRestoreArray( eps->V[0], &pV ); CHKERRQ(ierr);
ierr = VecRestoreArray( eps->vec_initial, &resid ); CHKERRQ(ierr);
eps->reason = EPS_CONVERGED_TOL;
 
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__ "EPSDestroy_ARPACK"
int EPSDestroy_ARPACK(EPS eps)
{
EPS_ARPACK *ar = (EPS_ARPACK *)eps->data;
int ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
if (ar->workev) { ierr = PetscFree(ar->workev);CHKERRQ(ierr); }
if (ar->workl) { ierr = PetscFree(ar->workl);CHKERRQ(ierr); }
if (ar->select) { ierr = PetscFree(ar->select);CHKERRQ(ierr); }
if (ar->workd) { ierr = PetscFree(ar->workd);CHKERRQ(ierr); }
#if defined(PETSC_USE_COMPLEX)
if (ar->rwork) { ierr = PetscFree(ar->rwork);CHKERRQ(ierr); }
#endif
ierr = EPSDefaultDestroy(eps);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "EPSCreate_ARPACK"
int EPSCreate_ARPACK(EPS eps)
{
EPS_ARPACK *arpack;
int ierr;
 
PetscFunctionBegin;
ierr = PetscNew(EPS_ARPACK,&arpack);CHKERRQ(ierr);
PetscMemzero(arpack,sizeof(EPS_ARPACK));
PetscLogObjectMemory(eps,sizeof(EPS_ARPACK));
eps->data = (void *) arpack;
eps->ops->setup = EPSSetUp_ARPACK;
eps->ops->setdefaults = EPSSetDefaults_ARPACK;
eps->ops->solve = EPSSolve_ARPACK;
eps->ops->destroy = EPSDestroy_ARPACK;
eps->ops->view = 0;
PetscFunctionReturn(0);
}
EXTERN_C_END
/trunk/src/eps/impls/arpack/arpackp.h
0,0 → 1,220
/*
Private data structure used by the ARPACK interface
*/
 
#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
*/
#include "petsc.h"
 
/*
This include file on the Cray T3D/T3E defines the interface between
Fortran and C representations of character strings.
*/
#if defined(PETSC_USES_CPTOFCD)
#include <fortran.h>
#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 PDNAUPD PSNAUPD
#define PDNEUPD PSNEUPD
#define PDSAUPD PSSAUPD
#define PDSEUPD PSSEUPD
#endif
 
#if defined(PETSC_HAVE_FORTRAN_UNDERSCORE) || defined(PETSC_BLASLAPACK_F2C)
#define ARnaupd_ pdnaupd_
#define ARneupd_ pdneupd_
#define ARsaupd_ pdsaupd_
#define ARseupd_ pdseupd_
#elif defined(PETSC_HAVE_FORTRAN_CAPS)
#define ARnaupd_ PDNAUPD
#define ARneupd_ PDNEUPD
#define ARsaupd_ PDSAUPD
#define ARseupd_ PDSEUPD
#else
#define ARnaupd_ pdnaupd
#define ARneupd_ pdneupd
#define ARsaupd_ pdsaupd
#define ARseupd_ pdseupd
#endif
 
#else
/*
Complex
*/
#if defined(PETSC_USES_FORTRAN_SINGLE)
#define PZNAUPD PCNAUPD
#define PZNEUPD PCNEUPD
#endif
 
#if defined(PETSC_HAVE_FORTRAN_UNDERSCORE) || defined(PETSC_BLASLAPACK_F2C)
#define ARnaupd_ pznaupd_
#define ARneupd_ pzneupd_
#elif defined(PETSC_HAVE_FORTRAN_CAPS)
#define ARnaupd_ PZNAUPD
#define ARneupd_ PZNEUPD
#else
#define ARnaupd_ pznaupd
#define ARneupd_ pzneupd
#endif
 
#endif
 
#else
/* _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 DNAUPD SNAUPD
#define DNEUPD SNEUPD
#define DSAUPD SSAUPD
#define DSEUPD SSEUPD
#endif
 
#if defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
#define ARnaupd__ dnaupd
#define ARneupd__ dneupd
#define ARsaupd__ dsaupd
#define ARseupd__ dseupd
#elif defined(PETSC_HAVE_FORTRAN_CAPS)
#define ARnaupd__ DNAUPD
#define ARneupd__ DNEUPD
#define ARsaupd__ DSAUPD
#define ARseupd__ DSEUPD
#else
#define ARnaupd__ dnaupd
#define ARneupd__ dneupd
#define ARsaupd__ dsaupd
#define ARseupd__ dseupd
#endif
 
#else
/*
Complex
*/
#if defined(PETSC_USES_FORTRAN_SINGLE)
#define ZNAUPD CNAUPD
#define ZNEUPD CNEUPD
#endif
 
#if defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
#define ARnaupd__ znaupd
#define ARneupd__ zneupd
#elif defined(PETSC_HAVE_FORTRAN_CAPS)
#define ARnaupd__ ZNAUPD
#define ARneupd__ ZNEUPD
#else
#define ARnaupd__ pznaupd
#define ARneupd__ pzneupd
#endif
 
#endif
 
#endif
 
EXTERN_C_BEGIN
 
#if !defined(_petsc_mpi_uni)
 
extern void ARsaupd_(MPI_Comm*,int*,char*,int*,char*,int*,PetscReal*,PetscScalar*,
int*,PetscScalar*,int*,int*,int*,PetscScalar*,PetscScalar*,int*,int*,int,int);
extern void ARseupd_(MPI_Comm*,PetscTruth*,char*,PetscTruth*,PetscReal*,PetscReal*,
int*,PetscReal*,
char*,int*,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_Comm*,int*,char*,int*,char*,int*,PetscReal*,PetscScalar*,
int*,PetscScalar*,int*,int*,int*,PetscScalar*,PetscScalar*,int*,int*,int,int);
extern void ARneupd_(MPI_Comm*,PetscTruth*,char*,PetscTruth*,PetscReal*,PetscReal*,
PetscReal*,int*,PetscReal*,PetscReal*,PetscReal*,
char*,int*,char*,int*,PetscReal*,PetscScalar*,
int*,PetscScalar*,int*,int*,int*,PetscScalar*,PetscScalar*,int*,int*,int,int,int);
#else
extern void ARnaupd_(MPI_Comm*,int*,char*,int*,char*,int*,PetscReal*,PetscScalar*,
int*,PetscScalar*,int*,int*,int*,PetscScalar*,PetscScalar*,int*,PetscReal*,int*,
int,int);
extern void ARneupd_(MPI_Comm*,PetscTruth*,char*,PetscTruth*,PetscScalar*,PetscScalar*,
int*,PetscScalar*,PetscScalar*,
char*,int*,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*,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*,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*,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*,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*,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*,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
 
/trunk/src/eps/impls/arpack/makefile
0,0 → 1,19
 
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
 
 
/trunk/src/eps/impls/subspace/subspace.c
0,0 → 1,253
 
/*
This implements the subspace iteration method for finding the
eigenpairs associtated to the eigenvalues with largest magnitude.
*/
#include "src/eps/epsimpl.h"
 
typedef struct {
int inner;
} EPS_SUBSPACE;
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetUp_SUBSPACE"
static int EPSSetUp_SUBSPACE(EPS eps)
{
int ierr;
PetscFunctionBegin;
ierr = EPSDefaultGetWork(eps,1);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetDefaults_SUBSPACE"
static int EPSSetDefaults_SUBSPACE(EPS eps)
{
int ierr, N;
EPS_SUBSPACE *subspace = (EPS_SUBSPACE *)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 = PetscMax(2*eps->nev,eps->nev+8);
if (!eps->max_it) eps->max_it = PetscMax(100,N);
if (!subspace->inner) {
if (eps->ishermitian) subspace->inner = 10;
else subspace->inner = 4;
}
if (!eps->tol) eps->tol = 1.e-7;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSolve_SUBSPACE"
static int EPSSolve_SUBSPACE(EPS eps,int *its)
{
int ierr, i, j, k, maxit=eps->max_it, ncv = eps->ncv;
Vec w;
PetscReal relerr, tol=eps->tol;
PetscScalar alpha, *H, *S;
EPS_SUBSPACE *subspace = (EPS_SUBSPACE *)eps->data;
 
PetscFunctionBegin;
w = eps->work[0];
ierr = PetscMalloc(ncv*ncv*sizeof(PetscScalar),&H);CHKERRQ(ierr);
ierr = PetscMalloc(ncv*ncv*sizeof(PetscScalar),&S);CHKERRQ(ierr);
 
/* Build Z from initial vector */
ierr = VecCopy(eps->vec_initial,eps->V[0]);CHKERRQ(ierr);
for (k=1; k<ncv; k++) {
ierr = STApply(eps->OP,eps->V[k-1],eps->V[k]); CHKERRQ(ierr);
}
/* QR-Factorize V R = Z */
ierr = EPSQRDecomposition(eps,0,ncv,PETSC_NULL,ncv);CHKERRQ(ierr);
 
i = 0;
*its = 0;
 
while (*its<maxit) {
 
/* Y = OP^inner V */
for (k=i;k<ncv;k++) {
for (j=i;j<subspace->inner;j++) {
ierr = STApply(eps->OP,eps->V[k],w);CHKERRQ(ierr);
ierr = VecCopy(w,eps->V[k]);CHKERRQ(ierr);
}
}
 
/* QR-Factorize V R = Y */
ierr = EPSQRDecomposition(eps,i,ncv,PETSC_NULL,ncv);CHKERRQ(ierr);
/* compute the projected matrix, H = V^* A V */
for (j=i;j<ncv;j++) {
ierr = STApply(eps->OP,eps->V[j],w);CHKERRQ(ierr);
for (k=i;k<ncv;k++) {
ierr = VecDot(w,eps->V[k],H+(k-i)+(ncv-i)*(j-i));CHKERRQ(ierr);
}
}
 
/* solve the reduced problem, compute the
eigendecomposition H = S Theta S^* */
ierr = EPSDenseNHEP(ncv-i,H,eps->eigr+i,eps->eigi+i,S);CHKERRQ(ierr);
 
/* update V = V S */
ierr = EPSReverseProjection(eps,i,ncv-i,S);CHKERRQ(ierr);
 
/* check eigenvalue convergence */
for (j=i;j<ncv;j++) {
ierr = STApply(eps->OP,eps->V[j],w);CHKERRQ(ierr);
alpha = -eps->eigr[j];
ierr = VecAXPY(&alpha,eps->V[j],w);CHKERRQ(ierr);
ierr = VecNorm(w,NORM_2,&relerr);CHKERRQ(ierr);
eps->errest[j] = relerr;
}
 
/* lock converged Ritz pairs */
eps->nconv = i;
for (j=i;j<ncv;j++) {
if (eps->errest[j]<tol) {
if (j>eps->nconv) {
ierr = EPSSwapEigenpairs(eps,eps->nconv,j);CHKERRQ(ierr);
}
eps->nconv = eps->nconv + 1;
}
}
i = eps->nconv;
 
*its = *its + 1;
EPSMonitorEstimates(eps,*its,eps->nconv,eps->errest,ncv);
EPSMonitorValues(eps,*its,eps->nconv,eps->eigr,PETSC_NULL,ncv);
 
if (eps->nconv>=eps->nev) break;
 
}
 
ierr = PetscFree(H);CHKERRQ(ierr);
ierr = PetscFree(S);CHKERRQ(ierr);
 
if( *its==maxit ) *its = *its - 1;
eps->its = *its;
if( eps->nconv == eps->nev ) eps->reason = EPS_CONVERGED_TOL;
else eps->reason = EPS_DIVERGED_ITS;
#if defined(PETSC_USE_COMPLEX)
for (i=0;i<eps->nconv;i++) eps->eigi[i]=0.0;
#endif
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSView_SUBSPACE"
static int EPSView_SUBSPACE(EPS eps,PetscViewer viewer)
{
EPS_SUBSPACE *subspace = (EPS_SUBSPACE *) eps->data;
int ierr;
PetscTruth isascii;
 
PetscFunctionBegin;
ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);CHKERRQ(ierr);
if (!isascii) {
SETERRQ1(1,"Viewer type %s not supported for EPSSUBSPACE",((PetscObject)viewer)->type_name);
}
ierr = PetscViewerASCIIPrintf(viewer,"number of inner iterations: %d\n",subspace->inner);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetFromOptions_SUBSPACE"
static int EPSSetFromOptions_SUBSPACE(EPS eps)
{
EPS_SUBSPACE *subspace = (EPS_SUBSPACE *)eps->data;
int ierr,val;
PetscTruth flg;
 
PetscFunctionBegin;
ierr = PetscOptionsHead("SUBSPACE options");CHKERRQ(ierr);
val = subspace->inner;
ierr = PetscOptionsInt("-eps_subspace_inner","Number of inner iterations","EPSSubspaceSetInner",val,&val,&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSubspaceSetInner(eps,val);CHKERRQ(ierr);}
ierr = PetscOptionsTail();CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "EPSSubspaceSetInner_SUBSPACE"
int EPSSubspaceSetInner_SUBSPACE(EPS eps,int val)
{
EPS_SUBSPACE *subspace;
 
PetscFunctionBegin;
subspace = (EPS_SUBSPACE *) eps->data;
subspace->inner = val;
PetscFunctionReturn(0);
}
EXTERN_C_END
 
#undef __FUNCT__
#define __FUNCT__ "EPSSubspaceSetInner"
/*@
EPSSubspaceSetInner - Sets the number of inner iterations performed by
the Subspace Iteration method.
 
Collective on EPS
 
Input Parameters:
+ eps - the eigenproblem solver context
- val - number of iterations to perform
 
Options Database Key:
. -eps_subspace_inner - Sets the value of the inner iterations
 
Notes:
This value specifies how many matrix-vector products have to be carried
out in the Subspace Iteration method between the orthogonalization steps.
 
The default value is 10 for Hermitian problems and 4 for non-Hermitian ones.
Level: advanced
 
@*/
int EPSSubspaceSetInner(EPS eps,int val)
{
int ierr, (*f)(EPS,int);
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
ierr = PetscObjectQueryFunction((PetscObject)eps,"EPSSubspaceSetInner_C",(void (**)(void))&f);CHKERRQ(ierr);
if (f) {
ierr = (*f)(eps,val);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "EPSCreate_SUBSPACE"
int EPSCreate_SUBSPACE(EPS eps)
{
EPS_SUBSPACE *subspace;
int ierr;
 
PetscFunctionBegin;
ierr = PetscNew(EPS_SUBSPACE,&subspace);CHKERRQ(ierr);
PetscMemzero(subspace,sizeof(EPS_SUBSPACE));
PetscLogObjectMemory(eps,sizeof(EPS_SUBSPACE));
eps->data = (void *) subspace;
eps->ops->setup = EPSSetUp_SUBSPACE;
eps->ops->setdefaults = EPSSetDefaults_SUBSPACE;
eps->ops->solve = EPSSolve_SUBSPACE;
eps->ops->destroy = EPSDefaultDestroy;
eps->ops->setfromoptions = EPSSetFromOptions_SUBSPACE;
eps->ops->view = EPSView_SUBSPACE;
 
subspace->inner = 0;
ierr = PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSSubspaceSetInner_C","EPSSubspaceSetInner_SUBSPACE",EPSSubspaceSetInner_SUBSPACE);CHKERRQ(ierr);
 
PetscFunctionReturn(0);
}
EXTERN_C_END
 
/trunk/src/eps/impls/subspace/subspace.nou.c
0,0 → 1,279
 
/*
This implements the subspace iteration method for finding the
eigenvalues with highest modulus.
*/
#include "src/eps/epsimpl.h"
 
typedef struct {
int inner;
} EPS_SUBSPACE;
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetUp_SUBSPACE"
static int EPSSetUp_SUBSPACE(EPS eps)
{
int ierr;
PetscFunctionBegin;
ierr = EPSDefaultGetWork(eps,1);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetDefaults_SUBSPACE"
static int EPSSetDefaults_SUBSPACE(EPS eps)
{
int ierr, N;
EPS_SUBSPACE *subspace = (EPS_SUBSPACE *)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 = PetscMax(2*eps->nev,eps->nev+8);
if (!eps->max_it) eps->max_it = PetscMax(100,N);
if (!subspace->inner) {
if (eps->ishermitian) subspace->inner = 10;
else subspace->inner = 4;
}
if (!eps->tol) eps->tol = 1.e-7;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSolve_SUBSPACE"
static int EPSSolve_SUBSPACE(EPS eps,int *its)
{
int ierr, m, i, j, k, maxit=eps->max_it, ncv = eps->ncv;
Vec w;
PetscReal relerr, tol=eps->tol;
PetscScalar alpha, *H, *S;
EPS_SUBSPACE *subspace = (EPS_SUBSPACE *)eps->data;
 
PetscFunctionBegin;
w = eps->work[0];
ierr = PetscMalloc(ncv*ncv*sizeof(PetscScalar),&H);CHKERRQ(ierr);
ierr = PetscMalloc(ncv*ncv*sizeof(PetscScalar),&S);CHKERRQ(ierr);
 
/* Build Z from initial vector */
ierr = VecCopy(eps->vec_initial,eps->V[0]);CHKERRQ(ierr);
for (k=1; k<ncv; k++) {
ierr = STApply(eps->OP,eps->V[k-1],eps->V[k]); CHKERRQ(ierr);
/* ierr = SlepcVecSetRandom(eps->V[k]);CHKERRQ(ierr); */
}
/* QR-Factorize V R = Z */
ierr = EPSQRDecomposition(eps,0,ncv,PETSC_NULL,ncv);CHKERRQ(ierr);
 
i = 0;
*its = 0;
 
while (*its<maxit) {
 
/* Y = OP^iter V */
for (k=i;k<ncv;k++) {
for (j=i;j<subspace->inner;j++) {
ierr = STApply(eps->OP,eps->V[k],w);CHKERRQ(ierr);
ierr = VecCopy(w,eps->V[k]);CHKERRQ(ierr);
}
}
 
/* QR-Factorize V R = Y */
ierr = EPSQRDecomposition(eps,i,ncv,PETSC_NULL,ncv);CHKERRQ(ierr);
/* compute the projected matrix, H = V^* A V */
for (j=i;j<ncv;j++) {
ierr = STApply(eps->OP,eps->V[j],w);CHKERRQ(ierr);
for (k=i;k<ncv;k++) {
ierr = VecDot(w,eps->V[k],H+(k-i)+(ncv-i)*(j-i));CHKERRQ(ierr);
}
}
 
/* solve the reduced problem, compute the
eigendecomposition H = S Theta S^* */
// ierr = EPSDenseNHEP(ncv-i,H,eps->eigr+i,eps->eigi+i,S);CHKERRQ(ierr);
 
LAgehrd_(&m,&ilo,&m,H,&ncv,tau,work,&lwork,&ierr);
 
m = ncv;
ilo = 1;
lwork = m;
ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
ilo = k+1;
LAhseqr_("S","I",&m,&ilo,&m,H,&ncv,eps->eigr,eps->eigi,S,&ncv,work,&lwork,&ierr,1,1);
/* compute eigenvectors y_i */
/* ierr = PetscMemcpy(Y,S,ncv*ncv*sizeof(PetscScalar));CHKERRQ(ierr);
lwork = 3*m;
ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
LAtrevc_("R","B",select,&m,H,&ncv,Y,&ncv,Y,&ncv,&ncv,&mout,work,&ierr,1,1);
*/
/* update V = V S */
ierr = EPSReverseProjection(eps,i,ncv-i,S);CHKERRQ(ierr);
 
/* check eigenvalue convergence */
for (j=i;j<ncv;j++) {
ierr = STApply(eps->OP,eps->V[j],w);CHKERRQ(ierr);
alpha = -eps->eigr[j];
ierr = VecAXPY(&alpha,eps->V[j],w);CHKERRQ(ierr);
ierr = VecNorm(w,NORM_2,&relerr);CHKERRQ(ierr);
eps->errest[j] = relerr;
}
 
/* lock converged Ritz pairs */
eps->nconv = i;
for (j=i;j<ncv;j++) {
if (eps->errest[j]<tol) {
if (j>eps->nconv) {
ierr = EPSSwapEigenpairs(eps,eps->nconv,j);CHKERRQ(ierr);
}
eps->nconv = eps->nconv + 1;
}
}
i = eps->nconv;
 
*its = *its + 1;
EPSMonitorEstimates(eps,*its,eps->nconv,eps->errest,ncv);
EPSMonitorValues(eps,*its,eps->nconv,eps->eigr,PETSC_NULL,ncv);
 
if (eps->nconv>=eps->nev) break;
 
}
 
ierr = PetscFree(H);CHKERRQ(ierr);
ierr = PetscFree(S);CHKERRQ(ierr);
 
if( *its==maxit ) *its = *its - 1;
eps->its = *its;
if( eps->nconv == eps->nev ) eps->reason = EPS_CONVERGED_TOL;
else eps->reason = EPS_DIVERGED_ITS;
#if defined(PETSC_USE_COMPLEX)
for (i=0;i<eps->nconv;i++) eps->eigi[i]=0.0;
#endif
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDestroy_SUBSPACE"
/*
EPSDestroy_SUBSPACE - Destroys the context variable for SUBSPACE.
 
Input Parameter:
. eps - the iterative context
*/
int EPSDestroy_SUBSPACE(EPS eps)
{
int ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
if (eps->data) { ierr = PetscFree(eps->data);CHKERRQ(ierr); }
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSView_SUBSPACE"
static int EPSView_SUBSPACE(EPS eps,PetscViewer viewer)
{
EPS_SUBSPACE *subspace = (EPS_SUBSPACE *) eps->data;
int ierr;
PetscTruth isascii;
 
PetscFunctionBegin;
ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);CHKERRQ(ierr);
if (!isascii) {
SETERRQ1(1,"Viewer type %s not supported for EPSSUBSPACE",((PetscObject)viewer)->type_name);
}
ierr = PetscViewerASCIIPrintf(viewer,"inner iterations: %d\n",subspace->inner);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetFromOptions_SUBSPACE"
static int EPSSetFromOptions_SUBSPACE(EPS eps)
{
EPS_SUBSPACE *subspace = (EPS_SUBSPACE *)eps->data;
int ierr,val;
PetscTruth flg;
 
PetscFunctionBegin;
ierr = PetscOptionsHead("SUBSPACE options");CHKERRQ(ierr);
val = subspace->inner;
ierr = PetscOptionsInt("-eps_subspace_inner","Number of inner iterations","EPSSubspaceSetInner",val,&val,&flg);CHKERRQ(ierr);
if (flg) {ierr = EPSSubspaceSetInner(eps,val);CHKERRQ(ierr);}
ierr = PetscOptionsTail();CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "EPSSubspaceSetInner_SUBSPACE"
int EPSSubspaceSetInner_SUBSPACE(EPS eps,int val)
{
EPS_SUBSPACE *subspace;
 
PetscFunctionBegin;
subspace = (EPS_SUBSPACE *) eps->data;
subspace->inner = val;
PetscFunctionReturn(0);
}
EXTERN_C_END
 
#undef __FUNCT__
#define __FUNCT__ "EPSSubspaceSetInner"
/*@
EPSSubspaceSetInner - Sets the number of inner iterations performed by
the Subspace Iteration method.
 
Collective on EPS
 
Input Parameters:
. eps - the eigenproblem solver context
 
Options Database Key:
. -eps_subspace_inner - Sets the value of the inner iterations
 
Level: advanced
 
@*/
int EPSSubspaceSetInner(EPS eps,int val)
{
int ierr, (*f)(EPS,int);
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
ierr = PetscObjectQueryFunction((PetscObject)eps,"EPSSubspaceSetInner_C",(void (**)())&f);CHKERRQ(ierr);
if (f) {
ierr = (*f)(eps,val);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "EPSCreate_SUBSPACE"
int EPSCreate_SUBSPACE(EPS eps)
{
EPS_SUBSPACE *subspace;
int ierr;
 
PetscFunctionBegin;
ierr = PetscNew(EPS_SUBSPACE,&subspace);CHKERRQ(ierr);
PetscMemzero(subspace,sizeof(EPS_SUBSPACE));
PetscLogObjectMemory(eps,sizeof(EPS_SUBSPACE));
eps->data = (void *) subspace;
eps->ops->setup = EPSSetUp_SUBSPACE;
eps->ops->setdefaults = EPSSetDefaults_SUBSPACE;
eps->ops->solve = EPSSolve_SUBSPACE;
eps->ops->destroy = EPSDestroy_SUBSPACE;
eps->ops->setfromoptions = EPSSetFromOptions_SUBSPACE;
eps->ops->view = EPSView_SUBSPACE;
 
subspace->inner = 0;
ierr = PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSSubspaceSetInner_C","EPSSubspaceSetInner_SUBSPACE",EPSSubspaceSetInner_SUBSPACE);CHKERRQ(ierr);
 
PetscFunctionReturn(0);
}
EXTERN_C_END
/trunk/src/eps/impls/subspace/makefile
0,0 → 1,17
 
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
 
 
/trunk/src/eps/impls/blzpack/blzpack.c
0,0 → 1,374
 
/*
This file implements a wrapper to the BLZPACK package
*/
#include "src/eps/impls/blzpack/blzpackp.h"
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetUp_BLZPACK"
static int EPSSetUp_BLZPACK(EPS eps)
{
int ierr, listor, lrstor, ncuv, N, n, k1, k2, k3, k4;
EPS_BLZPACK *blz = (EPS_BLZPACK *)eps->data;
 
PetscFunctionBegin;
#if defined(PETSC_USE_COMPLEX)
SETERRQ(PETSC_ERR_SUP,"Requested method is not available for complex problems");
#endif
if (!eps->ishermitian)
SETERRQ(PETSC_ERR_SUP,"Requested method is only available for Hermitian problems");
 
if (eps->which!=EPS_LARGEST_MAGNITUDE)
SETERRQ(1,"Wrong value of eps->which");
 
ierr = VecGetSize(eps->vec_initial,&N);CHKERRQ(ierr);
ierr = VecGetLocalSize(eps->vec_initial,&n);CHKERRQ(ierr);
 
k1 = PetscMin(N,180);
k2 = blz->block_size? blz->block_size: 3;
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 = PetscMalloc((17+listor)*sizeof(int),&blz->istor);CHKERRQ(ierr);
blz->istor[14] = listor;
 
if( eps->isgeneralized ) lrstor = n*(k2*4+k1*2+k4)+k3;
else lrstor = n*(k2*4+k1)+k3;
ierr = PetscMalloc((4+lrstor)*sizeof(PetscReal),&blz->rstor);CHKERRQ(ierr);
blz->rstor[3] = lrstor;
 
ncuv = PetscMax(3,blz->block_size);
ierr = PetscMalloc(ncuv*n*sizeof(PetscScalar),&blz->u);CHKERRQ(ierr);
ierr = PetscMalloc(ncuv*n*sizeof(PetscScalar),&blz->v);CHKERRQ(ierr);
 
ierr = PetscMalloc(2*eps->ncv*sizeof(PetscReal),&blz->eig);CHKERRQ(ierr);
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetDefaults_BLZPACK"
static int EPSSetDefaults_BLZPACK(EPS eps)
{
int ierr, N;
 
PetscFunctionBegin;
ierr = VecGetSize(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(100,N);
if (!eps->tol) eps->tol = 1.e-7;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSolve_BLZPACK"
static int EPSSolve_BLZPACK(EPS eps,int *its)
{
EPS_BLZPACK *blz = (EPS_BLZPACK *)eps->data;
int i, n, nneig, lflag, nvopu, ierr;
Vec x, y;
PetscScalar sigma,*pV;
PetscTruth isSinv;
Mat A;
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);
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] = 0; /* 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] = eps->isgeneralized? 1: 0; /* problem type */
blz->istor[9] = 0; /* spectrum slicing */
blz->istor[10] = 0; /* solutions refinement */
blz->istor[11] = 3; /* level of printing */
blz->istor[12] = 6; /* file unit for output */
blz->istor[13] = MPI_Comm_c2f(eps->comm); /* communicator */
 
ierr = PetscTypeCompare((PetscObject)eps->OP,STSINV,&isSinv);CHKERRQ(ierr);
if(isSinv) { ierr = STGetShift(eps->OP,&sigma);CHKERRQ(ierr); }
else sigma = 0.0; /* shift from origin */
nneig = 0; /* no. of eigs less than sigma */
 
blz->rstor[0] = blz->initial; /* lower limit of eigenvalue interval */
blz->rstor[1] = blz->final; /* upper limit of eigenvalue interval */
blz->rstor[2] = eps->tol; /* threshold for convergence */
 
lflag = 0; /* reverse communication interface flag */
*its = 0;
 
for(;;) {
 
BLZpack_( blz->istor, blz->rstor, &sigma, &nneig, blz->u, blz->v,
&lflag, &nvopu, blz->eig, pV );
 
*its = *its + 1;
 
if( lflag == 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 (isSinv && eps->isgeneralized) {
ierr = STApplyNoB( eps->OP, x, y ); CHKERRQ(ierr);
} else {
ierr = STApply( eps->OP, x, y ); CHKERRQ(ierr);
}
}
}
else if( lflag == 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 = STApplyB( eps->OP, x, y ); CHKERRQ(ierr);
}
}
else if( lflag == 3 ) {
/* update shift */
ierr = STSetShift( eps->OP, sigma );CHKERRQ(ierr);
ierr = STGetOperators(eps->OP,&A,PETSC_NULL);CHKERRQ(ierr);
ierr = MatGetInertia(A,&nneig,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
}
else if( lflag == 4 ) {
/* copy the initial vector */
ierr = VecPlaceArray(x,blz->v);CHKERRQ(ierr);
ierr = VecCopy(eps->vec_initial,x);CHKERRQ(ierr);
}
else break;
}
 
ierr = VecRestoreArray( eps->V[0], &pV ); CHKERRQ(ierr);
 
eps->nconv = BLZistorr_(blz->istor,"NTEIG",5);
eps->its = *its;
eps->reason = EPS_CONVERGED_TOL;
 
for (i=0;i<eps->nconv;i++) {
eps->eigr[i]=blz->eig[i];
eps->eigi[i]=0.0;
}
 
if(isSinv) {
for( i=0; i<eps->nconv; i++ )
eps->eigr[i] = 1.0 / (eps->eigr[i] - sigma);
}
if (lflag!=0) { SETERRQ1(PETSC_ERR_LIB,"Error in BLZPACK (code=%d)",blz->istor[15]); }
ierr = VecDestroy(x);CHKERRQ(ierr);
ierr = VecDestroy(y);CHKERRQ(ierr);
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDestroy_BLZPACK"
/*
EPSDestroy_BLZPACK - Destroys the context variable for BLZPACK.
 
Input Parameter:
. eps - the iterative context
*/
int EPSDestroy_BLZPACK(EPS eps)
{
EPS_BLZPACK *blz = (EPS_BLZPACK *)eps->data;
int ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
if (blz->istor) { ierr = PetscFree(blz->istor);CHKERRQ(ierr); }
if (blz->rstor) { ierr = PetscFree(blz->rstor);CHKERRQ(ierr); }
if (blz->u) { ierr = PetscFree(blz->u);CHKERRQ(ierr); }
if (blz->v) { ierr = PetscFree(blz->v);CHKERRQ(ierr); }
if (blz->eig) { ierr = PetscFree(blz->eig);CHKERRQ(ierr); }
ierr = EPSDefaultDestroy(eps);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSView_BLZPACK"
static int EPSView_BLZPACK(EPS eps,PetscViewer viewer)
{
EPS_BLZPACK *blz = (EPS_BLZPACK *) eps->data;
int ierr;
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"
static int EPSSetFromOptions_BLZPACK(EPS eps)
{
EPS_BLZPACK *blz = (EPS_BLZPACK *)eps->data;
int ierr,bs,n;
PetscReal interval[2];
PetscTruth flg;
 
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 = 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);
}
 
ierr = PetscOptionsTail();CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "EPSBlzpackSetBlockSize_BLZPACK"
int EPSBlzpackSetBlockSize_BLZPACK(EPS eps,int bs)
{
EPS_BLZPACK *blz;
 
PetscFunctionBegin;
blz = (EPS_BLZPACK *) eps->data;
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
@*/
int EPSBlzpackSetBlockSize(EPS eps,int bs)
{
int ierr, (*f)(EPS,int);
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
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"
int EPSBlzpackSetInterval_BLZPACK(EPS eps,PetscReal initial,PetscReal final)
{
EPS_BLZPACK *blz;
 
PetscFunctionBegin;
blz = (EPS_BLZPACK *) eps->data;
blz->initial = initial;
blz->final = final;
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()
@*/
int EPSBlzpackSetInterval(EPS eps,PetscReal initial,PetscReal final)
{
int ierr, (*f)(EPS,PetscReal,PetscReal);
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
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__ "EPSCreate_BLZPACK"
int EPSCreate_BLZPACK(EPS eps)
{
EPS_BLZPACK *blzpack;
int ierr;
 
PetscFunctionBegin;
ierr = PetscNew(EPS_BLZPACK,&blzpack);CHKERRQ(ierr);
PetscMemzero(blzpack,sizeof(EPS_BLZPACK));
PetscLogObjectMemory(eps,sizeof(EPS_BLZPACK));
eps->data = (void *) blzpack;
eps->ops->setup = EPSSetUp_BLZPACK;
eps->ops->setdefaults = EPSSetDefaults_BLZPACK;
eps->ops->solve = EPSSolve_BLZPACK;
eps->ops->destroy = EPSDestroy_BLZPACK;
eps->ops->setfromoptions = EPSSetFromOptions_BLZPACK;
eps->ops->view = EPSView_BLZPACK;
 
blzpack->block_size = 0;
ierr = PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSBlzpackSetBlockSize_C","EPSBlzpackSetBlockSize_BLZPACK",EPSBlzpackSetBlockSize_BLZPACK);CHKERRQ(ierr);
blzpack->initial = 0.0;
blzpack->final = 0.0;
ierr = PetscObjectComposeFunctionDynamic((PetscObject)eps,"EPSBlzpackSetInterval_C","EPSBlzpackSetInterval_BLZPACK",EPSBlzpackSetInterval_BLZPACK);CHKERRQ(ierr);
 
PetscFunctionReturn(0);
}
EXTERN_C_END
/trunk/src/eps/impls/blzpack/blzpackp.h
0,0 → 1,76
/*
Private data structure used by the BLZPACK interface
*/
 
#if !defined(__BLZPACKP_H)
#define __BLZPACKP_H
 
#include "src/eps/epsimpl.h"
 
typedef struct {
int block_size; /* block size */
PetscReal initial,final; /* computational interval */
int *istor;
PetscReal *rstor;
PetscScalar *u;
PetscScalar *v;
PetscScalar *eig;
} EPS_BLZPACK;
 
 
/*
Definition of routines from the BLZPACK package
*/
 
#include "petsc.h"
 
/*
This include file on the Cray T3D/T3E defines the interface between
Fortran and C representations of character strings.
*/
#if defined(PETSC_USES_CPTOFCD)
#include <fortran.h>
#endif
 
#if !defined(PETSC_USE_COMPLEX)
 
/*
These are real case, current version of BLZPACK only supports real
matrices
*/
 
#if defined(PETSC_USES_FORTRAN_SINGLE)
/*
For these machines we must call the single precision Fortran version
*/
#define BLZDRD BLZDRS
#endif
 
#if defined(PETSC_HAVE_FORTRAN_UNDERSCORE) || defined(PETSC_BLASLAPACK_F2C)
#define BLZpack_ blzdrd_
#define BLZistorr_ istorr_
#define BLZrstorr_ rstorr_
#elif defined(PETSC_HAVE_FORTRAN_CAPS)
#define BLZpack_ BLZDRD
#define BLZistorr_ ISTORR
#define BLZrstorr_ RSTORR
#else
#define BLZpack_ blzdrd
#define BLZistorr_ istorr
#define BLZrstorr_ rstorr
#endif
 
#endif
 
EXTERN_C_BEGIN
 
extern void BLZpack_(int*,PetscReal*,PetscScalar*,int*,PetscScalar*,
PetscScalar*,int*,int*,PetscScalar*,PetscScalar*);
 
extern int BLZistorr_(int*,char*,int);
extern PetscReal BLZrstorr_(PetscReal*,char*,int);
 
EXTERN_C_END
 
#endif
 
/trunk/src/eps/impls/blzpack/makefile
0,0 → 1,20
 
ALL: lib
 
#requirespackage 'SLEPC_HAVE_BLZPACK'
#requiresscalar real
 
CFLAGS =
FFLAGS =
SOURCEC = blzpack.c
SOURCEF =
SOURCEH = blzpackp.h
OBJSC = blzpack.o
LIBBASE = libslepc
DIRS =
MANSEC = EPS
LOCDIR = src/eps/impls/blzpack/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
/trunk/src/eps/impls/arnoldi/arnoldi.c
0,0 → 1,201
 
/*
This implements the Arnoldi method with explicit restart and
deflation.
*/
#include "src/eps/epsimpl.h"
#include "slepcblaslapack.h"
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetUp_ARNOLDI"
static int EPSSetUp_ARNOLDI(EPS eps)
{
int ierr;
PetscFunctionBegin;
ierr = EPSDefaultGetWork(eps,1);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetDefaults_ARNOLDI"
static int EPSSetDefaults_ARNOLDI(EPS eps)
{
int ierr, 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 = PetscMax(2*eps->nev,eps->nev+8);
if (!eps->max_it) eps->max_it = PetscMax(100,N);
if (!eps->tol) eps->tol = 1.e-7;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSolve_ARNOLDI"
static int EPSSolve_ARNOLDI(EPS eps,int *its)
{
int ierr, i, j, k, m, maxit=eps->max_it, ncv = eps->ncv;
int lwork, ilo, mout;
Vec w;
PetscReal norm, tol=eps->tol;
PetscScalar alpha, *H, *Y, *S, *pV, *work;
 
PetscFunctionBegin;
w = eps->work[0];
ierr = PetscMalloc(ncv*ncv*sizeof(PetscScalar),&H);CHKERRQ(ierr);
ierr = PetscMemzero(H,ncv*ncv*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMalloc(ncv*ncv*sizeof(PetscScalar),&Y);CHKERRQ(ierr);
ierr = PetscMalloc(ncv*ncv*sizeof(PetscScalar),&S);CHKERRQ(ierr);
 
ierr = VecGetArray(eps->V[0],&pV);CHKERRQ(ierr);
ierr = VecRestoreArray(eps->V[0],&pV);CHKERRQ(ierr);
ierr = VecCopy(eps->vec_initial,eps->V[0]);CHKERRQ(ierr);
ierr = VecNorm(eps->V[0],NORM_2,&norm);CHKERRQ(ierr);
if (norm==0.0) SETERRQ( 1,"Null initial vector" );
alpha = 1.0/norm;
ierr = VecScale(&alpha,eps->V[0]);CHKERRQ(ierr);
 
*its = 0;
m = ncv-1; /* m is the number of Arnoldi vectors, one less than
the available vectors because one is needed for v_{m+1} */
k = 0; /* k is the number of locked vectors */
 
while (*its<maxit) {
 
/* compute the projected matrix, H, with the basic Arnoldi method */
for (j=k;j<m;j++) {
 
/* w = OP v_j */
ierr = STApply(eps->OP,eps->V[j],eps->V[j+1]);CHKERRQ(ierr);
 
/* orthogonalize wrt previous vectors */
ierr = (*eps->orthog)(eps,j,&H[0+ncv*j]);CHKERRQ(ierr);
 
/* h_{j+1,j} = ||w||_2 */
ierr = VecNorm(eps->V[j+1],NORM_2,&norm); CHKERRQ(ierr);
if (norm==0.0) SETERRQ( 1,"Breakdown in Arnoldi method" );
H[j+1+ncv*j] = norm;
alpha = 1.0/norm;
ierr = VecScale(&alpha,eps->V[j+1]);CHKERRQ(ierr);
 
}
 
/* At this point, H has the following structure
 
| * * | * * * * |
| * | * * * * |
| ------|-------------- |
H = | | * * * * |
| | * * * * |
| | * * * |
| | * * |
 
that is, a mxm upper Hessenberg matrix whose kxk principal submatrix
is (quasi-)triangular.
*/
 
/* reduce H to (real) Schur form, H = S \tilde{H} S' */
lwork = m;
ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
ilo = k+1;
#if !defined(PETSC_USE_COMPLEX)
LAhseqr_("S","I",&m,&ilo,&m,H,&ncv,eps->eigr,eps->eigi,S,&ncv,work,&lwork,&ierr,1,1);
#else
LAhseqr_("S","I",&m,&ilo,&m,H,&ncv,eps->eigr,S,&ncv,work,&lwork,&ierr,1,1);
#endif
ierr = PetscFree(work);CHKERRQ(ierr);
/* compute eigenvectors y_i */
ierr = PetscMemcpy(Y,S,ncv*ncv*sizeof(PetscScalar));CHKERRQ(ierr);
lwork = 3*m;
ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
LAtrevc_("R","B",PETSC_NULL,&m,H,&ncv,Y,&ncv,Y,&ncv,&ncv,&mout,work,&ierr,1,1);
ierr = PetscFree(work);CHKERRQ(ierr);
 
/* compute error estimates */
for (j=k;j<m;j++) {
/* errest_j = h_{m+1,m} |e_m' y_j| */
eps->errest[j] = PetscRealPart(H[m+ncv*(m-1)])
* PetscAbsScalar(Y[(m-1)+ncv*j]);
}
 
/* compute Ritz vectors */
ierr = EPSReverseProjection(eps,k,m-k,S);CHKERRQ(ierr);
 
/* lock converged Ritz pairs */
for (j=k;j<m;j++) {
if (eps->errest[j]<tol) {
if (j>k) {
ierr = EPSSwapEigenpairs(eps,k,j);CHKERRQ(ierr);
}
ierr = (*eps->orthog)(eps,k-1,PETSC_NULL);CHKERRQ(ierr);
ierr = VecNorm(eps->V[k],NORM_2,&norm); CHKERRQ(ierr);
if (norm==0.0) SETERRQ( 1,"Breakdown in Arnoldi method" );
alpha = 1.0/norm;
ierr = VecScale(&alpha,eps->V[k]);CHKERRQ(ierr);
/* h_{i,k} = v_i' OP v_k, i=1..k */
for (i=0;i<=k;i++) {
ierr = STApply(eps->OP,eps->V[k],w);CHKERRQ(ierr);
ierr = VecDot(w,eps->V[i],H+i+ncv*k);CHKERRQ(ierr);
}
H[k+1+ncv*k] = 0.0;
k = k + 1;
}
}
eps->nconv = k;
 
/* select next wanted eigenvector as restart vector */
ierr = EPSSortEigenvalues(m-k,eps->eigr+k,eps->eigi+k,eps->which,1,&i);CHKERRQ(ierr);
ierr = EPSSwapEigenpairs(eps,k,k+i);CHKERRQ(ierr);
 
/* orthogonalize u_k wrt previous vectors */
ierr = (*eps->orthog)(eps,k-1,PETSC_NULL);CHKERRQ(ierr);
 
/* normalize new initial vector */
ierr = VecNorm(eps->V[k],NORM_2,&norm); CHKERRQ(ierr);
if (norm==0.0) SETERRQ( 1,"Breakdown in Arnoldi method" );
alpha = 1.0/norm;
ierr = VecScale(&alpha,eps->V[k]);CHKERRQ(ierr);
 
*its = *its + 1;
EPSMonitorEstimates(eps,*its,eps->nconv,eps->errest,m);
EPSMonitorValues(eps,*its,eps->nconv,eps->eigr,eps->eigi,m);
 
if (eps->nconv>=eps->nev) break;
 
}
 
ierr = PetscFree(H);CHKERRQ(ierr);
ierr = PetscFree(Y);CHKERRQ(ierr);
ierr = PetscFree(S);CHKERRQ(ierr);
 
if( *its==maxit ) *its = *its - 1;
eps->its = *its;
if( eps->nconv == eps->nev ) eps->reason = EPS_CONVERGED_TOL;
else eps->reason = EPS_DIVERGED_ITS;
#if defined(PETSC_USE_COMPLEX)
for (i=0;i<eps->nconv;i++) eps->eigi[i]=0.0;
#endif
 
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "EPSCreate_ARNOLDI"
int EPSCreate_ARNOLDI(EPS eps)
{
PetscFunctionBegin;
eps->data = (void *) 0;
eps->ops->setup = EPSSetUp_ARNOLDI;
eps->ops->setdefaults = EPSSetDefaults_ARNOLDI;
eps->ops->solve = EPSSolve_ARNOLDI;
eps->ops->destroy = EPSDefaultDestroy;
PetscFunctionReturn(0);
}
EXTERN_C_END
 
/trunk/src/eps/impls/arnoldi/makefile
0,0 → 1,17
 
ALL: lib
 
CFLAGS =
FFLAGS =
SOURCEC = arnoldi.c
SOURCEF =
SOURCEH =
OBJSC = arnoldi.o
LIBBASE = libslepc
DIRS =
MANSEC = EPS
LOCDIR = src/eps/impls/arnoldi/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
/trunk/src/eps/impls/lapack/lapackp.h
0,0 → 1,13
/*
Private data structure used by the LAPACK interface.
*/
#if !defined(__LAPACKP_H)
#define __LAPACKP_H
 
#include "src/eps/epsimpl.h"
 
typedef struct {
Mat BA,A;
} EPS_LAPACK;
 
#endif
/trunk/src/eps/impls/lapack/lapack.c
0,0 → 1,155
 
/*
This file implements a wrapper to the LAPACK eigenvalue subroutines.
Currently, only LAPACK routines for standard problems are used.
Generalized problems are transformed to standard ones.
*/
#include "src/eps/impls/lapack/lapackp.h"
#include "slepcblaslapack.h"
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetUp_LAPACK"
static int EPSSetUp_LAPACK(EPS eps)
{
int ierr,i,size,rank,n,m,row,nz,*cols,dummy;
PetscScalar *vals;
EPS_LAPACK *la = (EPS_LAPACK *)eps->data;
MPI_Comm comm = eps->comm;
 
PetscFunctionBegin;
ierr = EPSComputeExplicitOperator(eps,&la->BA);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
 
ierr = MatGetSize(la->BA,&n,&n);CHKERRQ(ierr);
if (size > 1) { /* assemble matrix on first processor */
if (!rank) {
ierr = MatCreateMPIDense(comm,n,n,n,n,PETSC_NULL,&la->A);CHKERRQ(ierr);
}
else {
ierr = MatCreateMPIDense(comm,0,n,n,n,PETSC_NULL,&la->A);CHKERRQ(ierr);
}
PetscLogObjectParent(la->BA,la->A);
 
ierr = MatGetOwnershipRange(la->BA,&row,&dummy);CHKERRQ(ierr);
ierr = MatGetLocalSize(la->BA,&m,&dummy);CHKERRQ(ierr);
for (i=0; i<m; i++) {
ierr = MatGetRow(la->BA,row,&nz,&cols,&vals);CHKERRQ(ierr);
ierr = MatSetValues(la->A,1,&row,nz,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatRestoreRow(la->BA,row,&nz,&cols,&vals);CHKERRQ(ierr);
row++;
}
 
ierr = MatAssemblyBegin(la->A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(la->A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetDefaults_LAPACK"
static int EPSSetDefaults_LAPACK(EPS eps)
{
int ierr, N;
 
PetscFunctionBegin;
ierr = VecGetSize(eps->vec_initial,&N);CHKERRQ(ierr);
if (eps->ncv) {
if (eps->ncv<1 || eps->ncv>N) SETERRQ(1,"Wrong value of ncv");
}
else eps->ncv = eps->nev;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSolve_LAPACK"
static int EPSSolve_LAPACK(EPS eps,int *its)
{
int ierr,n,size,rank;
PetscScalar *array,*pV;
EPS_LAPACK *la = (EPS_LAPACK *)eps->data;
MPI_Comm comm = eps->comm;
PetscFunctionBegin;
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
if (size>1) {
ierr = MatGetArray(la->A,&array);CHKERRQ(ierr);
} else {
ierr = MatGetArray(la->BA,&array);CHKERRQ(ierr);
}
ierr = MatGetSize(la->BA,&n,&n);CHKERRQ(ierr);
 
if (eps->dropvectors) pV = PETSC_NULL;
else {
ierr = VecGetArray(eps->V[0],&pV);CHKERRQ(ierr);
}
 
ierr = EPSDenseNHEPSorted(n,array,eps->eigr,eps->eigi,pV,eps->ncv,eps->which);CHKERRQ(ierr);
 
if (!eps->dropvectors) {
ierr = VecRestoreArray(eps->V[0],&pV);CHKERRQ(ierr);
}
 
if (size > 1) {
ierr = MatRestoreArray(la->A,&array);CHKERRQ(ierr);
} else {
ierr = MatRestoreArray(la->BA,&array);CHKERRQ(ierr);
}
 
eps->nconv = eps->ncv;
eps->its = 1;
*its = eps->its;
eps->reason = EPS_CONVERGED_TOL;
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDestroy_LAPACK"
/*
EPSDestroy_LAPACK - Destroys the context variable for LAPACK.
 
Input Parameter:
. eps - the iterative context
*/
int EPSDestroy_LAPACK(EPS eps)
{
int ierr,size;
EPS_LAPACK *la = (EPS_LAPACK *)eps->data;
MPI_Comm comm = eps->comm;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
if (size > 1) {
ierr = MatDestroy(la->A);CHKERRQ(ierr);
}
ierr = MatDestroy(la->BA);CHKERRQ(ierr);
ierr = EPSDefaultDestroy(eps);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "EPSCreate_LAPACK"
int EPSCreate_LAPACK(EPS eps)
{
EPS_LAPACK *la;
int ierr;
 
PetscFunctionBegin;
ierr = PetscNew(EPS_LAPACK,&la);CHKERRQ(ierr);
PetscMemzero(la,sizeof(EPS_LAPACK));
PetscLogObjectMemory(eps,sizeof(EPS_LAPACK));
eps->data = (void *) la;
eps->ops->setup = EPSSetUp_LAPACK;
eps->ops->setdefaults = EPSSetDefaults_LAPACK;
eps->ops->solve = EPSSolve_LAPACK;
eps->ops->destroy = EPSDestroy_LAPACK;
eps->ops->view = 0;
PetscFunctionReturn(0);
}
EXTERN_C_END
/trunk/src/eps/impls/lapack/makefile
0,0 → 1,17
 
ALL: lib
 
CFLAGS =
FFLAGS =
SOURCEC = lapack.c
SOURCEF =
SOURCEH = lapackp.h
OBJSC = lapack.o
LIBBASE = libslepc
DIRS =
MANSEC = EPS
LOCDIR = src/eps/impls/lapack/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
/trunk/src/eps/impls/rqi/rqi.c
0,0 → 1,137
 
/*
This implements the Rayleigh Quotient Iteration method.
*/
#include "src/eps/epsimpl.h"
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetUp_RQI"
static int EPSSetUp_RQI(EPS eps)
{
int ierr;
PetscTruth isSinv;
 
PetscFunctionBegin;
ierr = PetscTypeCompare((PetscObject)eps->OP,STSINV,&isSinv);CHKERRQ(ierr);
if (!isSinv) SETERRQ(1,"A shift-and-invert ST must be specified in order to use RQI");
ierr = EPSDefaultGetWork(eps,3);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetDefaults_RQI"
static int EPSSetDefaults_RQI(EPS eps)
{
int ierr, 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 = eps->nev;
if (!eps->max_it) eps->max_it = PetscMax(100,N);
if (!eps->tol) eps->tol = 1.e-7;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSolve_RQI"
static int EPSSolve_RQI(EPS eps,int *its)
{
int ierr, i, maxit=eps->max_it;
Vec v, w, y, e;
PetscReal relerr, tol=1.0/PetscSqrtScalar(eps->tol);
PetscScalar theta, alpha, eta, rho;
 
PetscFunctionBegin;
v = eps->V[0];
y = eps->work[0];
w = eps->work[1];
e = eps->work[2];
eps->nconv = 0;
 
/* initial shift, rho_1 */
ierr = STGetShift(eps->OP,&rho);CHKERRQ(ierr);
 
/* w = B v, normalize v so that v^* w = 1 */
ierr = VecCopy(eps->vec_initial,v);CHKERRQ(ierr);
ierr = STApplyB(eps->OP,v,w);CHKERRQ(ierr);
ierr = VecDot(w,v,&eta);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
if (eta<0.0) SETERRQ(1,"Negative value of eta");
#endif
eta = PetscSqrtScalar(eta);
if (eta==0.0) SETERRQ(1,"Zero value of eta");
alpha = 1.0/eta;
ierr = VecScale(&alpha,v);CHKERRQ(ierr);
ierr = VecScale(&alpha,w);CHKERRQ(ierr);
 
for (i=0;i<maxit;i++) {
 
/* y = OP w */
ierr = STApplyNoB(eps->OP,w,y);CHKERRQ(ierr);
 
/* theta = w^* y */
ierr = VecDot(y,w,&theta);CHKERRQ(ierr);
 
/* w = B y */
ierr = STApplyB(eps->OP,y,w);CHKERRQ(ierr);
 
/* eta = ||y||_B */
ierr = VecDot(w,y,&eta);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
if (eta<0.0) SETERRQ(1,"Negative value of eta");
#endif
eta = PetscSqrtScalar(eta);
 
/* normalize y and w */
ierr = VecCopy(y,v);CHKERRQ(ierr);
alpha = 1.0/eta;
ierr = VecScale(&alpha,v);CHKERRQ(ierr);
ierr = VecScale(&alpha,w);CHKERRQ(ierr);
 
/* rho_{k+1} = rho_{k} + theta/eta^2 */
rho = rho + theta/(eta*eta);
ierr = STSetShift(eps->OP,rho);CHKERRQ(ierr);
 
/* if |theta| > tol^-1/2, stop */
relerr = PetscAbsScalar(theta);
eps->errest[eps->nconv] = 1/(relerr*relerr);
EPSMonitorEstimates(eps,i+1,eps->nconv,eps->errest,eps->nconv+1);
eps->eigr[eps->nconv] = rho;
EPSMonitorValues(eps,i+1,eps->nconv,eps->eigr,PETSC_NULL,eps->nconv+1);
if (relerr>tol) {
eps->nconv = eps->nconv + 1;
break;
}
 
}
 
if( i==maxit ) i--;
*its = i+1;
eps->its = *its;
if( eps->nconv == eps->nev ) eps->reason = EPS_CONVERGED_TOL;
else eps->reason = EPS_DIVERGED_ITS;
#if defined(PETSC_USE_COMPLEX)
for (i=0;i<eps->nconv;i++) eps->eigi[i]=0.0;
#endif
 
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "EPSCreate_RQI"
int EPSCreate_RQI(EPS eps)
{
PetscFunctionBegin;
eps->data = (void *) 0;
eps->ops->setup = EPSSetUp_RQI;
eps->ops->setdefaults = EPSSetDefaults_RQI;
eps->ops->solve = EPSSolve_RQI;
eps->ops->destroy = EPSDefaultDestroy;
eps->ops->view = 0;
PetscFunctionReturn(0);
}
EXTERN_C_END
/trunk/src/eps/impls/rqi/makefile
0,0 → 1,17
 
ALL: lib
 
CFLAGS =
FFLAGS =
SOURCEC = rqi.c
SOURCEF =
SOURCEH =
OBJSC = rqi.o
LIBBASE = libslepc
DIRS =
MANSEC = EPS
LOCDIR = src/eps/impls/rqi/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
/trunk/src/eps/impls/planso/plansop.h
0,0 → 1,68
/*
Private data structure used by the PLANSO interface
*/
 
#if !defined(__PLANSOP_H)
#define __PLANSOP_H
 
#include "src/eps/epsimpl.h"
 
typedef struct {
PetscReal *work;
int lwork;
} EPS_PLANSO;
 
 
/*
Definition of routines from the PLANSO package
*/
#include "petsc.h"
 
/*
This include file on the Cray T3D/T3E defines the interface between
Fortran and C representations of charactor strings.
*/
#if defined(PETSC_USES_CPTOFCD)
#include <fortran.h>
#endif
 
#if !defined(PETSC_USE_COMPLEX)
 
/*
These are real case. PLANSO currently only has DOUBLE PRECISION version
*/
#if defined(PETSC_HAVE_FORTRAN_UNDERSCORE) || defined(PETSC_BLASLAPACK_F2C)
#define PLANdr_ plandr_
#define PLANdr2_ plandr2_
#define PLANop_ op_
#define PLANopm_ opm_
#define PLANstore_ store_
#elif defined(PETSC_HAVE_FORTRAN_CAPS)
#define PLANdr_ PLANDR
#define PLANdr2_ PLANDR2
#define PLANop_ OP
#define PLANopm_ OPM
#define PLANstore_ STORE
#else
#define PLANdr_ plandr
#define PLANdr2_ plandr2
#define PLANop_ op
#define PLANopm_ opm
#define PLANstore_ store
#endif
 
#endif
 
EXTERN_C_BEGIN
 
extern void PLANdr_ (int*,int*,int*,PetscReal*,PetscReal*,PetscReal*,PetscTruth*,
PetscReal*,int*,int*,PetscScalar*,PetscScalar*,PetscReal*,
int*,int*,int*,MPI_Comm*);
extern void PLANdr2_(int*,int*,int*,int*,PetscReal*,
PetscReal*,int*,int*,PetscScalar*,PetscScalar*,PetscReal*,int*,
int*,int*,MPI_Comm*);
 
EXTERN_C_END
 
#endif
 
/trunk/src/eps/impls/planso/makefile
0,0 → 1,20
 
ALL: lib
 
#requirespackage 'SLEPC_HAVE_PLANSO'
#requiresscalar real
 
CFLAGS =
FFLAGS =
SOURCEC = planso.c
SOURCEF =
SOURCEH = plansop.h
OBJSC = planso.o
LIBBASE = libslepc
DIRS =
MANSEC = EPS
LOCDIR = src/eps/impls/planso/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
/trunk/src/eps/impls/planso/planso.c
0,0 → 1,149
 
/*
This file implements a wrapper to the PLANSO package
*/
#include "src/eps/impls/planso/plansop.h"
 
/* Nasty global variable to access EPS data from PLANop_ and PLANopm_ */
static EPS globaleps;
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetUp_PLANSO"
static int EPSSetUp_PLANSO(EPS eps)
{
int ierr, n;
EPS_PLANSO *pl = (EPS_PLANSO *)eps->data;
 
PetscFunctionBegin;
#if defined(PETSC_USE_COMPLEX)
SETERRQ(PETSC_ERR_SUP,"Requested method is not available for complex problems");
#endif
if (!eps->ishermitian)
SETERRQ(PETSC_ERR_SUP,"Requested method is only available for Hermitian problems");
 
ierr = VecGetLocalSize(eps->vec_initial,&n); CHKERRQ(ierr);
pl->lwork = 5*n+1+4*eps->ncv+PetscMax(n,eps->ncv+1);
ierr = PetscMalloc(pl->lwork*sizeof(PetscReal),&pl->work);CHKERRQ(ierr);
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetDefaults_PLANSO"
static int EPSSetDefaults_PLANSO(EPS eps)
{
int ierr, 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 = eps->nev;
if (!eps->max_it) eps->max_it = PetscMax(100,N);
if (!eps->tol) eps->tol = 1.e-7;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "PLANop_"
int PLANop_(int *n,PetscReal *s, PetscReal *q, PetscReal *p)
{
Vec x,y;
int ierr;
 
PetscFunctionBegin;
ierr = VecCreateMPIWithArray(globaleps->comm,*n,PETSC_DECIDE,(PetscScalar*)q,&x);CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(globaleps->comm,*n,PETSC_DECIDE,(PetscScalar*)p,&y);CHKERRQ(ierr);
ierr = STApply(globaleps->OP,x,y);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "PLANopm_"
int PLANopm_(int *n,PetscReal *q, PetscReal *s)
{
Vec x,y;
int ierr;
 
PetscFunctionBegin;
ierr = VecCreateMPIWithArray(globaleps->comm,*n,PETSC_DECIDE,(PetscScalar*)q,&x);CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(globaleps->comm,*n,PETSC_DECIDE,(PetscScalar*)s,&y);CHKERRQ(ierr);
ierr = STApplyB(globaleps->OP,x,y);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSolve_PLANSO"
static int EPSSolve_PLANSO(EPS eps,int *its)
{
int i, n, msglvl, lohi, ierr;
PetscReal condm;
EPS_PLANSO *pl = (EPS_PLANSO *)eps->data;
MPI_Fint fcomm;
PetscFunctionBegin;
 
ierr = VecGetLocalSize(eps->vec_initial,&n); CHKERRQ(ierr);
if (eps->which==EPS_LARGEST_MAGNITUDE) lohi = 1;
else if (eps->which==EPS_SMALLEST_MAGNITUDE) lohi = -1;
 
condm = 1.0; /* estimated condition number: we have no information */
msglvl = 0;
globaleps = eps;
fcomm = MPI_Comm_c2f(eps->comm);
 
PLANdr2_( &n, &eps->ncv, &eps->nev, &lohi, &condm, &eps->tol, &eps->its, &eps->nconv,
eps->eigr, eps->eigi, pl->work, &pl->lwork, &ierr, &msglvl, &fcomm );
 
for (i=0;i<eps->nconv;i++) eps->eigi[i]=0.0;
*its = eps->its;
eps->reason = EPS_CONVERGED_TOL;
if (ierr!=0) { SETERRQ1(PETSC_ERR_LIB,"Error in PLANSO (code=%d)",ierr);}
 
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSDestroy_PLANSO"
/*
EPSDestroy_PLANSO - Destroys the context variable for PLANSO.
 
Input Parameter:
. eps - the iterative context
*/
int EPSDestroy_PLANSO(EPS eps)
{
EPS_PLANSO *pl = (EPS_PLANSO *)eps->data;
int ierr;
 
PetscFunctionBegin;
PetscValidHeaderSpecific(eps,EPS_COOKIE);
if (pl->work) { ierr = PetscFree(pl->work);CHKERRQ(ierr); }
if (eps->data) { ierr = PetscFree(eps->data);CHKERRQ(ierr); }
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "EPSCreate_PLANSO"
int EPSCreate_PLANSO(EPS eps)
{
EPS_PLANSO *planso;
int ierr;
 
PetscFunctionBegin;
ierr = PetscNew(EPS_PLANSO,&planso);CHKERRQ(ierr);
PetscMemzero(planso,sizeof(EPS_PLANSO));
PetscLogObjectMemory(eps,sizeof(EPS_PLANSO));
eps->data = (void *) planso;
eps->ops->setup = EPSSetUp_PLANSO;
eps->ops->setdefaults = EPSSetDefaults_PLANSO;
eps->ops->solve = EPSSolve_PLANSO;
eps->ops->destroy = EPSDestroy_PLANSO;
eps->ops->view = 0;
PetscFunctionReturn(0);
}
EXTERN_C_END
/trunk/src/eps/impls/power/makefile
0,0 → 1,17
 
ALL: lib
 
CFLAGS =
FFLAGS =
SOURCEC = power.c
SOURCEF =
SOURCEH =
OBJSC = power.o
LIBBASE = libslepc
DIRS =
MANSEC = EPS
LOCDIR = src/eps/impls/power/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
/trunk/src/eps/impls/power/power.c
0,0 → 1,158
 
/*
This implements the power iteration for finding the eigenpair
corresponding to the eigenvalue with largest magnitude.
*/
#include "src/eps/epsimpl.h"
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetUp_POWER"
static int EPSSetUp_POWER(EPS eps)
{
int ierr;
PetscFunctionBegin;
ierr = EPSDefaultGetWork(eps,3);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSetDefaults_POWER"
static int EPSSetDefaults_POWER(EPS eps)
{
int ierr, 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 = eps->nev;
if (!eps->max_it) eps->max_it = PetscMax(2000,100*N);
if (!eps->tol) eps->tol = 1.e-7;
PetscFunctionReturn(0);
}
 
#undef __FUNCT__
#define __FUNCT__ "EPSSolve_POWER"
static int EPSSolve_POWER(EPS eps,int *its)
{
int ierr, i, k, maxit=eps->max_it;
Vec v, w, y, e;
PetscReal relerr, norm, tol=eps->tol;
PetscScalar theta, alpha, eta;
PetscTruth isSinv;
 
PetscFunctionBegin;
v = eps->V[0];
y = eps->work[0];
w = eps->work[1];
e = eps->work[2];
eps->nconv = 0;
 
ierr = PetscTypeCompare((PetscObject)eps->OP,STSINV,&isSinv);CHKERRQ(ierr);
 
ierr = VecCopy(eps->vec_initial,y);CHKERRQ(ierr);
 
for (i=0;i<maxit;i++) {
 
if (isSinv) {
/* w = B y */
ierr = STApplyB(eps->OP,y,w);CHKERRQ(ierr);
 
/* eta = ||y||_B */
ierr = VecDot(w,y,&eta);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
if (eta<0.0) SETERRQ(1,"Negative value of eta");
#endif
eta = PetscSqrtScalar(eta);
 
/* normalize y and w */
ierr = VecCopy(y,v);CHKERRQ(ierr);
if (eta==0.0) SETERRQ(1,"Zero value of eta");
alpha = 1.0/eta;
ierr = VecScale(&alpha,v);CHKERRQ(ierr);
ierr = VecScale(&alpha,w);CHKERRQ(ierr);
 
/* y = OP w */
ierr = STApplyNoB(eps->OP,w,y);CHKERRQ(ierr);
 
/* Wielandt deflation, y = y - lambda_k v_k v_k^* v, for k=1..nconv */
for (k=0;k<eps->nconv;k++) {
ierr = VecDot(v,eps->V[k],&alpha);CHKERRQ(ierr);
alpha = -alpha*eps->eigr[k];
ierr = VecAXPY(&alpha,eps->V[k],y);CHKERRQ(ierr);
}
 
/* theta = w^* y */
ierr = VecDot(y,w,&theta);CHKERRQ(ierr);
}
else {
/* v = y/||y||_2 */
ierr = VecCopy(y,v);CHKERRQ(ierr);
ierr = VecNorm(y,NORM_2,&norm);CHKERRQ(ierr);
alpha = 1.0/norm;
ierr = VecScale(&alpha,v);CHKERRQ(ierr);
 
/* y = OP v */
ierr = STApply(eps->OP,v,y);CHKERRQ(ierr);
 
/* Wielandt deflation, y = y - lambda_k v_k v_k^* v, for k=1..nconv */
for (k=0;k<eps->nconv;k++) {
ierr = VecDot(v,eps->V[k],&alpha);CHKERRQ(ierr);
alpha = -alpha*eps->eigr[k];
ierr = VecAXPY(&alpha,eps->V[k],y);CHKERRQ(ierr);
}
 
/* theta = v^* y */
ierr = VecDot(y,v,&theta);CHKERRQ(ierr);
}
 
/* if ||y-theta v||_2 / |theta| < tol, stop */
ierr = VecCopy(y,e);CHKERRQ(ierr);
alpha = -theta;
ierr = VecAXPY(&alpha,v,e);CHKERRQ(ierr);
ierr = VecNorm(e,NORM_2,&relerr);CHKERRQ(ierr);
relerr = relerr / PetscAbsScalar(theta);
eps->errest[eps->nconv] = relerr;
EPSMonitorEstimates(eps,i+1,eps->nconv,eps->errest,eps->nconv+1);
eps->eigr[eps->nconv] = theta;
EPSMonitorValues(eps,i+1,eps->nconv,eps->eigr,PETSC_NULL,eps->nconv+1);
if (relerr<tol) {
if(isSinv) {
ierr = VecNorm(y,NORM_2,&norm);CHKERRQ(ierr);
alpha = 1.0/norm;
ierr = VecScale(&alpha,v);CHKERRQ(ierr);
}
eps->nconv = eps->nconv + 1;
if (eps->nconv==eps->nev) break;
v = eps->V[eps->nconv];
}
 
}
 
if( i==maxit ) i--;
*its = i+1;
eps->its = *its;
if( eps->nconv == eps->nev ) eps->reason = EPS_CONVERGED_TOL;
else eps->reason = EPS_DIVERGED_ITS;
for (i=0;i<eps->nconv;i++) eps->eigi[i]=0.0;
 
PetscFunctionReturn(0);
}
 
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "EPSCreate_POWER"
int EPSCreate_POWER(EPS eps)
{
PetscFunctionBegin;
eps->data = (void *) 0;
eps->ops->setup = EPSSetUp_POWER;
eps->ops->setdefaults = EPSSetDefaults_POWER;
eps->ops->solve = EPSSolve_POWER;
eps->ops->destroy = EPSDefaultDestroy;
eps->ops->view = 0;
PetscFunctionReturn(0);
}
EXTERN_C_END
/trunk/src/eps/impls/makefile
0,0 → 1,11
 
ALL: lib
 
LIBBASE = libslepc
DIRS = power rqi subspace arnoldi lapack arpack blzpack planso trlan
LOCDIR = src/eps/impls/
MANSEC = EPS
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
/trunk/src/eps/makefile
0,0 → 1,11
 
ALL: lib
 
SOURCEH = epsimpl.h ../../include/slepceps.h
DIRS = interface impls
LOCDIR = src/eps/
MANSEC = EPS
 
include ${SLEPC_DIR}/bmake/slepc_common
 
 
/trunk/src/fortran/custom/zst.c
0,0 → 1,121
 
#include "src/fortran/custom/zpetsc.h"
#include "slepcst.h"
 
#ifdef PETSC_HAVE_FORTRAN_CAPS
#define stsettype_ STSETTYPE
#define stregisterdestroy_ STREGISTERDESTROY
#define stgettype_ STGETTYPE
#define stdestroy_ STDESTROY
#define stcreate_ STCREATE
#define stgetoperators_ STGETOPERATORS
#define stsetoptionsprefix_ STSETOPTIONSPREFIX
#define stappendoptionsprefix_ STAPPENDOPTIONSPREFIX
#define stgetoptionsprefix_ STGETOPTIONSPREFIX
#define stview_ STVIEW
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
#define stsettype_ stsettype
#define stregisterdestroy_ stregisterdestroy
#define stgettype_ stgettype
#define stdestroy_ stdestroy
#define stcreate_ stcreate
#define stgetoperators_ stgetoperators
#define stsetoptionsprefix_ stsetoptionsprefix
#define stappendoptionsprefix_ stappendoptionsprefix
#define stgetoptionsprefix_ stgetoptionsprefix
#define stview_ stview
#endif
 
EXTERN_C_BEGIN
 
void PETSC_STDCALL stsettype_(ST *st,CHAR type PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
{
char *t;
 
FIXCHAR(type,len,t);
*ierr = STSetType(*st,t);
FREECHAR(type,t);
}
 
void PETSC_STDCALL stregisterdestroy_(int *ierr)
{
*ierr = STRegisterDestroy();
}
 
void PETSC_STDCALL stgettype_(ST *st,CHAR name PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
{
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
}
 
void PETSC_STDCALL stdestroy_(ST *st,int *ierr)
{
*ierr = STDestroy(*st);
}
 
void PETSC_STDCALL stcreate_(MPI_Comm *comm,ST *newst,int *ierr)
{
*ierr = STCreate((MPI_Comm)PetscToPointerComm(*comm),newst);
}
 
void PETSC_STDCALL stgetoperators_(ST *st,Mat *mat,Mat *pmat,int *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),
int *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),
int *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),
int *ierr PETSC_END_LEN(len))
{
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
}
 
void PETSC_STDCALL stview_(ST *st,PetscViewer *viewer, int *ierr)
{
PetscViewer v;
PetscPatchDefaultViewers_Fortran(viewer,v);
*ierr = STView(*st,v);
}
 
EXTERN_C_END
 
/trunk/src/fortran/custom/zeps.c
0,0 → 1,230
 
#include "src/fortran/custom/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 epsregisterdestroy_ EPSREGISTERDESTROY
#define epsdefaultestimatesmonitor_ EPSDEFAULTESTIMATESMONITOR
#define epsdefaultvaluesmonitor_ EPSDEFAULTVALUESMONITOR
#define epsgetconvergedreason_ EPSGETCONVERGEDREASON
#define epsdestroy_ EPSDESTROY
#define epsgetsolution_ EPSGETSOLUTION
#define epsgetst_ EPSGETST
#define epsgettolerances_ EPSGETTOLERANCES
#define epssetmonitor_ EPSSETMONITOR
#define epssetvaluesmonitor_ EPSSETVALUESMONITOR
#define epscomputeerror_ EPSCOMPUTEERROR
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
#define epsview_ epsview
#define epssetoptionsprefix_ ekepsview
#define epssetoptionsprefix_ epssetoptionsprefix
#define epsappendoptionsprefix_ epsappendoptionsprefix
#define epsgetoptionsprefix_ epsgetoptionsprefix
#define epscreate_ epscreate
#define epssettype_ epssettype
#define epsgettype_ epsgettype
#define epsregisterdestroy_ epsregisterdestroy
#define epsdefaultestimatesmonitor_ epsdefaultestimatesmonitor
#define epsdefaultvaluesmonitor_ epsdefaultvaluesmonitor
#define epsgetconvergedreason_ epsgetconvergedreason
#define epsdestroy_ epsdestroy
#define epsgetsolution_ epsgetsolution
#define epsgetst_ epsgetst
#define epsgettolerances_ epsgettolerances
#define epssetmonitor_ epssetmonitor
#define epssetvaluesmonitor_ epssetvaluesmonitor
#define epscomputeerror_ epscomputeerror
#endif
 
EXTERN_C_BEGIN
 
void PETSC_STDCALL epsgetconvergedreason_(EPS *eps,EPSConvergedReason *reason,int *ierr)
{
*ierr = EPSGetConvergedReason(*eps,reason);
}
 
void PETSC_STDCALL epsview_(EPS *eps,PetscViewer *viewer, int *ierr)
{
PetscViewer v;
PetscPatchDefaultViewers_Fortran(viewer,v);
*ierr = EPSView(*eps,v);
}
 
void PETSC_STDCALL epssettype_(EPS *eps,CHAR type PETSC_MIXED_LEN(len),int *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),int *ierr PETSC_END_LEN(len))
{
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
}
 
void PETSC_STDCALL epssetoptionsprefix_(EPS *eps,CHAR prefix PETSC_MIXED_LEN(len),
int *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),
int *ierr PETSC_END_LEN(len))
{
char *t;
 
FIXCHAR(prefix,len,t);
*ierr = EPSAppendOptionsPrefix(*eps,t);
FREECHAR(prefix,t);
}
 
void PETSC_STDCALL epscreate_(MPI_Comm *comm,EPS *eps,int *ierr){
*ierr = EPSCreate((MPI_Comm)PetscToPointerComm(*comm),eps);
}
 
/*
These are not usually called from Fortran but allow Fortran users
to transparently set these monitors from .F code
functions, hence no STDCALL
*/
void epsdefaultestimatesmonitor_(EPS *eps,int *it,int *nconv,PetscReal *errest,int *nest,void *ctx,int *ierr)
{
*ierr = EPSDefaultEstimatesMonitor(*eps,*it,*nconv,errest,*nest,ctx);
}
void epsdefaultvaluesmonitor_(EPS *eps,int *it,int *nconv,PetscScalar *eigr,PetscScalar *eigi,int *neig,void *ctx,int *ierr)
{
*ierr = EPSDefaultValuesMonitor(*eps,*it,*nconv,eigr,eigi,*neig,ctx);
}
static void (PETSC_STDCALL *f1)(EPS*,int*,int*,PetscReal*,int*,void*,int*);
static int ourmonitor(EPS eps,int i,int nc,PetscReal *d,int l,void* ctx)
{
int ierr = 0;
(*f1)(&eps,&i,&nc,d,&l,ctx,&ierr);CHKERRQ(ierr);
return 0;
}
 
void PETSC_STDCALL epssetmonitor_(EPS *eps,void (PETSC_STDCALL *monitor)(EPS*,int*,int*,PetscReal*,int*,void*,int*),
void *mctx,void (PETSC_STDCALL *monitordestroy)(void *,int *),int *ierr)
{
if ((void(*)())monitor == (void(*)())epsdefaultestimatesmonitor_) {
*ierr = EPSSetMonitor(*eps,EPSDefaultEstimatesMonitor,0);
} else {
f1 = monitor;
if (FORTRANNULLFUNCTION(monitordestroy)) {
*ierr = EPSSetMonitor(*eps,ourmonitor,mctx);
} else {
*ierr = EPSSetMonitor(*eps,ourmonitor,mctx);
}
}
}
 
static void (PETSC_STDCALL *f3)(EPS*,int*,int*,PetscScalar*,PetscScalar*,int*,void*,int*);
static int ourmonitor2(EPS eps,int i,int nc,PetscScalar *d1,PetscScalar *d2,int l,void* ctx)
{
int ierr = 0;
(*f3)(&eps,&i,&nc,d1,d2,&l,ctx,&ierr);CHKERRQ(ierr);
return 0;
}
 
void PETSC_STDCALL epssetvaluesmonitor_(EPS *eps,void (PETSC_STDCALL *monitor)(EPS*,int*,int*,PetscScalar*,PetscScalar*,int*,void*,int*),
void *mctx,void (PETSC_STDCALL *monitordestroy)(void *,int *),int *ierr)
{
if ((void(*)())monitor == (void(*)())epsdefaultvaluesmonitor_) {
*ierr = EPSSetValuesMonitor(*eps,EPSDefaultValuesMonitor,0);
} else {
f3 = monitor;
if (FORTRANNULLFUNCTION(monitordestroy)) {
*ierr = EPSSetValuesMonitor(*eps,ourmonitor2,mctx);
} else {
*ierr = EPSSetValuesMonitor(*eps,ourmonitor2,mctx);
}
}
}
 
void PETSC_STDCALL epsgetst_(EPS *eps,ST *B,int *ierr)
{
*ierr = EPSGetST(*eps,B);
}
 
void PETSC_STDCALL epsgettolerances_(EPS *eps,PetscReal *tol,int *maxits,int *ierr)
{
*ierr = EPSGetTolerances(*eps,tol,maxits);
}
 
/*
epsgetsolution() is slightly different from C since in the Fortran
version the user has to provide the array to hold the vector objects,
while in C that array is allocated by the EPSGetSolution()
*/
void PETSC_STDCALL epsgetsolution_(EPS *eps,PetscScalar* eigr,PetscScalar* eigi,Vec *v,int *ierr)
{
Vec *lV;
PetscScalar *leigr, *leigi;
int i;
*ierr = EPSGetSolution(*eps,&leigr,&leigi,&lV);
for (i=0; i<(*eps)->nconv; i++) {
v[i] = lV[i];
eigr[i] = leigr[i];
eigi[i] = leigi[i];
}
}
 
void PETSC_STDCALL epsdestroy_(EPS *eps,int *ierr)
{
*ierr = EPSDestroy(*eps);
}
 
void PETSC_STDCALL epsregisterdestroy_(int* ierr)
{
*ierr = EPSRegisterDestroy();
}
 
void PETSC_STDCALL epsgetoptionsprefix_(EPS *eps,CHAR prefix PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
{
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
}
 
void PETSC_STDCALL epscomputeerror_(EPS *eps,PetscReal *error,int *ierr)
{
*ierr = EPSComputeError(*eps,error);
}
 
EXTERN_C_END
 
/trunk/src/fortran/custom/zslepc_startf.c
0,0 → 1,66
 
#include "src/fortran/custom/zpetsc.h"
/* #include "sys.h" */
#include "petscsys.h"
 
#ifdef PETSC_HAVE_FORTRAN_CAPS
#define slepcinitializefortran_ SLEPCINITIALIZEFORTRAN
#define slepcsetcommonblock_ SLEPCSETCOMMONBLOCK
#define slepc_null_function_ SLEPC_NULL_FUNCTION
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
#define slepcinitializefortran_ slepcinitializefortran
#define slepcsetcommonblock_ slepcsetcommonblock
#define slepc_null_function_ slepc_null_function
#endif
 
#if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE)
#define slepc_null_function_ slepc_null_function__
#endif
 
EXTERN_C_BEGIN
extern void PETSC_STDCALL slepcsetcommonblock_(void);
EXTERN_C_END
 
/*@C
SlepcInitializeFortran - Routine that should be called from C after
the call to SlepcInitialize() if one is using a C main program
that calls Fortran routines that in turn call SLEPc routines.
 
Collective on MPI_COMM_WORLD
 
Level: beginner
 
Notes:
SlepcInitializeFortran() initializes some of the default SLEPc variables
for use in Fortran if a user's main program is written in C.
SlepcInitializeFortran() is NOT needed if a user's main
program is written in Fortran; in this case, just calling
SlepcInitialize() in the main (Fortran) program is sufficient.
 
.seealso: SlepcInitialize()
 
@*/
 
int SlepcInitializeFortran(void)
{
slepcsetcommonblock_();
return 0;
}
EXTERN_C_BEGIN
 
void PETSC_STDCALL slepcinitializefortran_(int *info)
{
*info = SlepcInitializeFortran();
}
 
/*
A valid address for the Fortran variable SLEPC_NULL_FUNCTION
*/
void slepc_null_function_(void)
{
return;
}
 
EXTERN_C_END
 
/trunk/src/fortran/custom/slepcfort.F
0,0 → 1,17
!
! Utility routine used to set some values into a Fortran common block
 
subroutine SlepcSetCommonBlock()
implicit none
 
#include "include/finclude/petsc.h"
#include "include/finclude/slepc.h"
 
SLEPC_NULL_CHARACTER = PETSC_NULL_CHARACTER
SLEPC_NULL_INTEGER = PETSC_NULL_INTEGER
SLEPC_NULL_SCALAR = PETSC_NULL_SCALAR
SLEPC_NULL_DOUBLE = PETSC_NULL_DOUBLE
 
return
end
 
/trunk/src/fortran/custom/makefile
0,0 → 1,16
 
ALL: lib
 
CFLAGS =
FFLAGS =
SOURCEC = zslepc_start.c zslepc_startf.c zeps.c zst.c
SOURCEF = slepcfort.F
SOURCEH =
OBJSC = zslepc_start.o zslepc_startf.o zeps.o zst.o
OBJSF = slepcfort.o
LIBBASE = libslepcfortran
MANSEC =
LOCDIR = src/fortran/custom/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
/trunk/src/fortran/custom/zslepc_start.c
0,0 → 1,121
/*
This file contains the Fortran version of SlepcInitialize().
*/
 
/*
This is to prevent the Cray T3D version of MPI (University of Edinburgh)
from redefining MPI_INIT(). They put this in to detect errors in C code,
but here we do want to be calling the Fortran version from a C subroutine.
*/
#define T3DMPI_FORTRAN
#define T3EMPI_FORTRAN
 
#include "src/fortran/custom/zpetsc.h"
#include "slepc.h"
 
extern PetscTruth SlepcBeganPetsc;
extern PetscRandom rctx;
extern int ST_COOKIE;
extern int EPS_COOKIE;
 
static PetscTruth SlepcInitializeCalled=PETSC_FALSE;
 
#if defined(PETSC_HAVE_NAGF90)
#define iargc_ f90_unix_MP_iargc
#define getarg_ f90_unix_MP_getarg
#endif
 
#ifdef PETSC_HAVE_FORTRAN_CAPS
#define petscinitialize_ PETSCINITIALIZE
#define slepcinitialize_ SLEPCINITIALIZE
#define iargc_ IARGC
#define getarg_ GETARG
#if defined(PARCH_win32)
#define IARGC NARGS
#endif
 
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
#define petscinitialize_ petscinitialize
#define slepcinitialize_ slepcinitialize
/*
HP-UX does not have Fortran underscore but iargc and getarg
do have underscores????
*/
#if !defined(PETSC_HAVE_FORTRAN_IARGC_UNDERSCORE)
#define iargc_ iargc
#define getarg_ getarg
#endif
 
#endif
 
EXTERN_C_BEGIN
extern void PETSC_STDCALL mpi_init_(int*);
 
#if defined(PETSC_USE_FORTRAN_MIXED_STR_ARG)
extern void petscinitialize_(CHAR,int,int*);
#else
extern void petscinitialize_(CHAR,int*,int);
#endif
 
/*
Different Fortran compilers handle command lines in different ways
*/
#if defined(PARCH_win32)
/*
extern short __declspec(dllimport) __stdcall iargc_();
extern void __declspec(dllimport) __stdcall getarg_(short*,char*,int,short *);
*/
extern short __stdcall iargc_();
extern void __stdcall getarg_(short*,char*,int,short *);
 
#else
extern int iargc_();
extern void getarg_(int*,char*,int);
/*
The Cray T3D/T3E use the PXFGETARG() function
*/
#if defined(PETSC_HAVE_PXFGETARG)
extern void PXFGETARG(int *,_fcd,int*,int*);
#endif
#endif
EXTERN_C_END
 
extern int SlepcRegisterEvents();
 
EXTERN_C_BEGIN
/*
SlepcInitialize - Version called from Fortran.
 
Notes:
Since this routine is called from Fortran it does not return error codes.
*/
void PETSC_STDCALL slepcinitialize_(CHAR filename PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
{
*ierr = 1;
if (SlepcInitializeCalled) {*ierr = 0; return;}
 
if (!PetscInitializeCalled) {
#if defined(PETSC_USE_FORTRAN_MIXED_STR_ARG)
petscinitialize_(filename,len,ierr);
#else
petscinitialize_(filename,ierr,len);
#endif
if (*ierr) return;
SlepcBeganPetsc = PETSC_TRUE;
}
 
PetscRandomCreate(PETSC_COMM_WORLD,RANDOM_DEFAULT,&rctx);
 
EPS_COOKIE = 0;
PetscLogClassRegister(&EPS_COOKIE,"Eigenproblem Solver");
ST_COOKIE = 0;
PetscLogClassRegister(&ST_COOKIE,"Spectral Transform");
 
*ierr = SlepcRegisterEvents();
 
SlepcInitializeCalled = PETSC_TRUE;
PetscLogInfo(0,"SlepcInitialize: SLEPc successfully started from Fortran\n");
 
}
 
EXTERN_C_END
/trunk/src/fortran/makefile
0,0 → 1,9
 
ALL: lib
 
DIRS = auto custom
XDIRS = auto
LOCDIR = src/fortran/
 
include ${SLEPC_DIR}/bmake/slepc_common
 
/trunk/src/makefile
0,0 → 1,6
 
DIRS = eps st sys fortran examples
 
LOCDIR = src/
 
include ${SLEPC_DIR}/bmake/slepc_common
/trunk/src/examples/ex2.c
0,0 → 1,136
 
static char help[] = "Simple example that solves an eigensystem with the "
"EPS object. The standard symmetric eigenvalue problem to be solved "
"corresponds to the Laplacian operator in 2 dimensions.\n\n"
"The command line options are:\n\n"
" -n <n>, where <n> = number of grid subdivisions in x dimension.\n\n"
" -m <m>, where <m> = number of grid subdivisions in y dimension.\n\n";
 
#include "slepceps.h"
 
#undef __FUNCT__
#define __FUNCT__ "main"
int main( int argc, char **argv )
{
Vec *x; /* basis vectors */
Mat A; /* operator matrix */
EPS eps; /* eigenproblem solver context */
EPSType type;
PetscReal *error, tol;
PetscScalar *kr, *ki;
int N, n=10, m, nev, ierr, maxit, i, j, I, J, its, nconv, Istart, Iend;
PetscScalar v;
PetscTruth flag;
 
SlepcInitialize(&argc,&argv,(char*)0,help);
 
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-m",&m,&flag);CHKERRQ(ierr);
if( flag==PETSC_FALSE ) m=n;
N = n*m;
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n2-D Laplacian Eigenproblem, N=%d (%dx%d grid)\n\n",N,n,m);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the operator matrix that defines the eigensystem, Ax=kx
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
ierr = MatCreate(PETSC_COMM_WORLD,PETSC_DECIDE,PETSC_DECIDE,N,N,&A);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
for( I=Istart; I<Iend; I++ ) {
v = -1.0; i = I/n; j = I-i*n;
if(i>0) { J=I-n; MatSetValues(A,1,&I,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); }
if(i<m-1) { J=I+n; MatSetValues(A,1,&I,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); }
if(j>0) { J=I-1; MatSetValues(A,1,&I,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); }
if(j<n-1) { J=I+1; MatSetValues(A,1,&I,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr); }
v=4.0; MatSetValues(A,1,&I,1,&I,&v,INSERT_VALUES);CHKERRQ(ierr);
}
 
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
/*
Create eigensolver context
*/
ierr = EPSCreate(PETSC_COMM_WORLD,&eps);CHKERRQ(ierr);
 
/*
Set operators. In this case, it is a standard eigenvalue problem
*/
ierr = EPSSetOperators(eps,A,PETSC_NULL);CHKERRQ(ierr);
 
/*
Set solver parameters at runtime
*/
ierr = EPSSetFromOptions(eps);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the eigensystem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
ierr = EPSSolve(eps,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of iterations of the method: %d\n",its);CHKERRQ(ierr);
 
/*
Optional: Get some information from the solver and display it
*/
ierr = EPSGetType(eps,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Solution method: %s\n\n",type);CHKERRQ(ierr);
ierr = EPSGetDimensions(eps,&nev,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of requested eigenvalues: %d\n",nev);CHKERRQ(ierr);
ierr = EPSGetTolerances(eps,&tol,&maxit);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Stopping condition: tol=%.4g, maxit=%d\n",tol,maxit);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
/*
Get number of converged eigenpairs
*/
ierr = EPSGetConverged(eps,&nconv);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of converged approximate eigenpairs: %d\n\n",nconv);CHKERRQ(ierr);
 
if (nconv>0) {
/*
Get converged eigenpairs: i-th eigenvalue is stored in kr[i] (real part) and
ki[i] (imaginary part), and the corresponding eigenvector is stored in x[i]
*/
ierr = EPSGetSolution(eps,&kr,&ki,&x);CHKERRQ(ierr);
 
/*
Compute the relative error associated to each eigenpair
*/
ierr = PetscMalloc(nconv*sizeof(PetscReal),&error);CHKERRQ(ierr);
ierr = EPSComputeError(eps,error);CHKERRQ(ierr);
 
/*
Display eigenvalues and relative errors
*/
ierr = PetscPrintf(PETSC_COMM_WORLD,
" k ||Ax-kx||/|k|\n"
" ----------------- -----------------\n" );CHKERRQ(ierr);
for( i=0; i<nconv; i++ ) {
if (ki[i]!=0.0) {
ierr = PetscPrintf(PETSC_COMM_WORLD," %9f%+9f j %12f\n",kr[i],ki[i],error[i]);CHKERRQ(ierr); }
else {
ierr = PetscPrintf(PETSC_COMM_WORLD," %12f %12f\n",kr[i],error[i]);CHKERRQ(ierr); }
}
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n" );CHKERRQ(ierr);
ierr = PetscFree(error);CHKERRQ(ierr);
}
/*
Free work space
*/
ierr = EPSDestroy(eps);CHKERRQ(ierr);
ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = SlepcFinalize();CHKERRQ(ierr);
return 0;
}
 
/trunk/src/examples/ex3.c
0,0 → 1,196
 
static char help[] = "This example solves the same eigenproblem as in "
"example ex2.c, but using a shell matrix. The problem is a standard "
"symmetric eigenproblem corresponding to the 2-D Laplacian operator.\n\n"
"The command line options are:\n\n"
" -n <n>, where <n> = number of grid subdivisions in both x and y dimensions.\n\n";
 
#include "slepceps.h"
#include "petscblaslapack.h"
 
/*
User-defined routines
*/
extern int MatLaplacian2D_Mult( Mat A, Vec x, Vec y );
 
#undef __FUNCT__
#define __FUNCT__ "main"
int main( int argc, char **argv )
{
Vec *x; /* basis vectors */
Mat A; /* operator matrix */
EPS eps; /* eigenproblem solver context */
EPSType type;
PetscReal *error, tol;
PetscScalar *kr, *ki;
int size, N, n=10, nev, ierr, maxit, i, its, nconv;
 
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size != 1) SETERRQ(1,"This is a uniprocessor example only!");
 
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr);
N = n*n;
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n2-D Laplacian Eigenproblem (matrix-free version), N=%d (%dx%d grid)\n\n",N,n,n);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the operator matrix that defines the eigensystem, Ax=kx
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
ierr = MatCreateShell(PETSC_COMM_WORLD,N,N,N,N,&n,&A);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatShellSetOperation(A,MATOP_MULT,(void(*)())MatLaplacian2D_Mult);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
/*
Create eigensolver context
*/
ierr = EPSCreate(PETSC_COMM_WORLD,&eps);CHKERRQ(ierr);
 
/*
Set operators. In this case, it is a standard eigenvalue problem
*/
ierr = EPSSetOperators(eps,A,PETSC_NULL);CHKERRQ(ierr);
 
/*
Set solver parameters at runtime
*/
ierr = EPSSetFromOptions(eps);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the eigensystem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
ierr = EPSSolve(eps,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of iterations of the method: %d\n",its);CHKERRQ(ierr);
 
/*
Optional: Get some information from the solver and display it
*/
ierr = EPSGetType(eps,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Solution method: %s\n\n",type);CHKERRQ(ierr);
ierr = EPSGetDimensions(eps,&nev,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of requested eigenvalues: %d\n",nev);CHKERRQ(ierr);
ierr = EPSGetTolerances(eps,&tol,&maxit);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Stopping condition: tol=%.4g, maxit=%d\n",tol,maxit);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
/*
Get number of converged eigenpairs
*/
ierr = EPSGetConverged(eps,&nconv);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of converged approximate eigenpairs: %d\n\n",nconv);CHKERRQ(ierr);
 
if (nconv>0) {
/*
Get converged eigenpairs: i-th eigenvalue is stored in kr[i] (real part) and
ki[i] (imaginary part), and the corresponding eigenvector is stored in x[i]
*/
ierr = EPSGetSolution(eps,&kr,&ki,&x);CHKERRQ(ierr);
 
/*
Compute the relative error associated to each eigenpair
*/
ierr = PetscMalloc(nconv*sizeof(PetscReal),&error);CHKERRQ(ierr);
ierr = EPSComputeError(eps,error);CHKERRQ(ierr);
 
/*
Display eigenvalues and relative errors
*/
ierr = PetscPrintf(PETSC_COMM_WORLD,
" k ||Ax-kx||/|k|\n"
" ----------------- -----------------\n" );CHKERRQ(ierr);
for( i=0; i<nconv; i++ ) {
if (ki[i]!=0.0) {
ierr = PetscPrintf(PETSC_COMM_WORLD," %9f%+9f j %12f\n",kr[i],ki[i],error[i]);CHKERRQ(ierr); }
else {
ierr = PetscPrintf(PETSC_COMM_WORLD," %12f %12f\n",kr[i],error[i]);CHKERRQ(ierr); }
}
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n" );CHKERRQ(ierr);
ierr = PetscFree(error);CHKERRQ(ierr);
}
/*
Free work space
*/
ierr = EPSDestroy(eps);CHKERRQ(ierr);
ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = SlepcFinalize();CHKERRQ(ierr);
return 0;
}
 
/*
Compute the matrix vector multiplication y<---T*x where T is a nx by nx
tridiagonal matrix with DD on the diagonal, DL on the subdiagonal, and
DU on the superdiagonal.
*/
static void tv( int nx, PetscScalar *x, PetscScalar *y )
{
PetscScalar dd, dl, du;
int j;
 
dd = 4.0;
dl = -1.0;
du = -1.0;
 
y[0] = dd*x[0] + du*x[1];
for( j=1; j<nx-1; j++ )
y[j] = dl*x[j-1] + dd*x[j] + du*x[j+1];
y[nx-1] = dl*x[nx-2] + dd*x[nx-1];
}
 
#undef __FUNCT__
#define __FUNCT__ "MatLaplacian2D_Mult"
/*
Matrix-vector product subroutine for the 2D Laplacian.
 
The matrix used is the 2 dimensional discrete Laplacian on unit square with
zero Dirichlet boundary condition.
Computes y <-- A*x, where A is the block tridiagonal matrix
| T -I |
|-I T -I |
A = | -I T |
| ... -I|
| -I T|
The subroutine TV is called to compute y<--T*x.
*/
int MatLaplacian2D_Mult( Mat A, Vec x, Vec y )
{
void *ctx;
int ierr, nx, lo, j, one=1;
PetscScalar *px, *py, dmone=-1.0;
ierr = MatShellGetContext( A, &ctx ); CHKERRQ(ierr);
nx = *(int *)ctx;
ierr = VecGetArray( x, &px ); CHKERRQ(ierr);
ierr = VecGetArray( y, &py ); CHKERRQ(ierr);
 
tv( nx, &px[0], &py[0] );
BLaxpy_( &nx, &dmone, &px[nx], &one, &py[0], &one );
 
for( j=2; j<nx; j++ ) {
lo = (j-1)*nx;
tv( nx, &px[lo], &py[lo]);
BLaxpy_( &nx, &dmone, &px[lo-nx], &one, &py[lo], &one );
BLaxpy_( &nx, &dmone, &px[lo+nx], &one, &py[lo], &one );
}
 
lo = (nx-1)*nx;
tv( nx, &px[lo], &py[lo]);
BLaxpy_( &nx, &dmone, &px[lo-nx], &one, &py[lo], &one );
 
ierr = VecRestoreArray( x, &px ); CHKERRQ(ierr);
ierr = VecRestoreArray( y, &py ); CHKERRQ(ierr);
 
return 0;
}
 
/trunk/src/examples/ex4.c
0,0 → 1,137
 
static char help[] = "Solves an eigensystem loaded from a file.\n\n"
"This example works for both real and complex numbers.\n\n"
"The command line options are:\n\n"
" -file <filename>, where <filename> = matrix file in PETSc binary form.\n\n";
 
#include "slepceps.h"
 
#undef __FUNCT__
#define __FUNCT__ "main"
int main( int argc, char **argv )
{
Vec *x; /* basis vectors */
Mat A; /* operator matrix */
EPS eps; /* eigenproblem solver context */
EPSType type;
PetscReal *error, tol, re, im;
PetscScalar *kr, *ki;
int nev, ierr, maxit, i, its, nconv;
char filename[256];
PetscViewer viewer;
PetscTruth flg;
 
 
SlepcInitialize(&argc,&argv,(char*)0,help);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Load the operator matrix that defines the eigensystem, Ax=kx
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nEigenproblem stored in file.\n\n");CHKERRQ(ierr);
ierr = PetscOptionsGetString(PETSC_NULL,"-file",filename,256,&flg);CHKERRQ(ierr);
if (!flg) {
SETERRQ(1,"Must indicate a file name with the -file option.");
}
 
#if defined(PETSC_USE_COMPLEX)
ierr = PetscPrintf(PETSC_COMM_WORLD," Reading COMPLEX matrix from a binary file...\n");CHKERRQ(ierr);
#else
ierr = PetscPrintf(PETSC_COMM_WORLD," Reading REAL matrix from a binary file...\n");CHKERRQ(ierr);
#endif
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,filename,PETSC_BINARY_RDONLY,&viewer);CHKERRQ(ierr);
ierr = MatLoad(viewer,MATMPIAIJ,&A);CHKERRQ(ierr);
ierr = PetscViewerDestroy(viewer);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
/*
Create eigensolver context
*/
ierr = EPSCreate(PETSC_COMM_WORLD,&eps);CHKERRQ(ierr);
 
/*
Set operators. In this case, it is a standard eigenvalue problem
*/
ierr = EPSSetOperators(eps,A,PETSC_NULL);CHKERRQ(ierr);
 
/*
Set solver parameters at runtime
*/
ierr = EPSSetFromOptions(eps);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the eigensystem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
ierr = EPSSolve(eps,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of iterations of the method: %d\n",its);CHKERRQ(ierr);
 
/*
Optional: Get some information from the solver and display it
*/
ierr = EPSGetType(eps,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Solution method: %s\n\n",type);CHKERRQ(ierr);
ierr = EPSGetDimensions(eps,&nev,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of requested eigenvalues: %d\n",nev);CHKERRQ(ierr);
ierr = EPSGetTolerances(eps,&tol,&maxit);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Stopping condition: tol=%.4g, maxit=%d\n",tol,maxit);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
/*
Get number of converged eigenpairs
*/
ierr = EPSGetConverged(eps,&nconv);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of converged approximate eigenpairs: %d\n\n",nconv);CHKERRQ(ierr);
 
if (nconv>0) {
/*
Get converged eigenpairs: i-th eigenvalue is stored in kr[i] (real part) and
ki[i] (imaginary part), and the corresponding eigenvector is stored in x[i]
*/
ierr = EPSGetSolution(eps,&kr,&ki,&x);CHKERRQ(ierr);
 
/*
Compute the relative error associated to each eigenpair
*/
ierr = PetscMalloc(nconv*sizeof(PetscReal),&error);CHKERRQ(ierr);
ierr = EPSComputeError(eps,error);CHKERRQ(ierr);
 
/*
Display eigenvalues and relative errors
*/
ierr = PetscPrintf(PETSC_COMM_WORLD,
" k ||Ax-kx||/|k|\n"
" --------------------- -----------------\n" );CHKERRQ(ierr);
for( i=0; i<nconv; i++ ) {
#if defined(PETSC_USE_COMPLEX)
re = PetscRealPart(kr[i]);
im = PetscImaginaryPart(kr[i]);
#else
re = kr[i];
im = ki[i];
#endif
if( im>0.0 ) ierr = PetscPrintf(PETSC_COMM_WORLD," % 6f + %6f i",re,im);
else if( im<0.0 ) ierr = PetscPrintf(PETSC_COMM_WORLD," % 6f - %6f i",re,-im);
else ierr = PetscPrintf(PETSC_COMM_WORLD," % 6f ",re);
CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," % 12f\n",error[i]);CHKERRQ(ierr);
}
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n" );CHKERRQ(ierr);
ierr = PetscFree(error);CHKERRQ(ierr);
}
/*
Free work space
*/
ierr = EPSDestroy(eps);CHKERRQ(ierr);
ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = SlepcFinalize();CHKERRQ(ierr);
return 0;
}
 
/trunk/src/examples/ex5.c
0,0 → 1,211
 
static char help[] = "Eigenvalue problem associated with a Markov model "
"of a random walk on a triangular grid. It is a standard symmetric "
"eigenproblem and the rightmost eigenvalue is known to be 1.\n\n"
"This example illustrates how the user can set the initial vector.\n\n"
"The command line options are:\n\n"
" -m <m>, where <m> = number of grid subdivisions in each dimension.\n\n";
 
#include "slepceps.h"
 
/*
User-defined routines
*/
extern int MatMarkovModel( int m, Mat A );
 
#undef __FUNCT__
#define __FUNCT__ "main"
int main( int argc, char **argv )
{
Vec *x; /* basis vectors */
Vec v0; /* initial vector */
Mat A; /* operator matrix */
EPS eps; /* eigenproblem solver context */
EPSType type;
PetscReal *error, tol;
PetscScalar *kr, *ki;
int N, M, m=15, nev, ierr, maxit, i, its, nconv;
PetscScalar alpha;
 
SlepcInitialize(&argc,&argv,(char*)0,help);
 
ierr = PetscOptionsGetInt(PETSC_NULL,"-m",&m,PETSC_NULL);CHKERRQ(ierr);
N = m*(m+1)/2;
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nMarkov Model, N=%d (m=%d)\n\n",N,m);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the operator matrix that defines the eigensystem, Ax=kx
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
ierr = MatCreate(PETSC_COMM_WORLD,PETSC_DECIDE,PETSC_DECIDE,N,N,&A);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatMarkovModel( m, A );CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
/*
Create eigensolver context
*/
ierr = EPSCreate(PETSC_COMM_WORLD,&eps);CHKERRQ(ierr);
 
/*
Set operators. In this case, it is a standard eigenvalue problem
*/
ierr = EPSSetOperators(eps,A,PETSC_NULL);CHKERRQ(ierr);
 
/*
Set solver parameters at runtime
*/
ierr = EPSSetFromOptions(eps);CHKERRQ(ierr);
 
/*
Set the initial vector. This is optional, if not done the initial
vector is set to random values
*/
ierr = MatGetLocalSize(A,PETSC_NULL,&M);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_WORLD,&v0);CHKERRQ(ierr);
ierr = VecSetSizes(v0,M,PETSC_DECIDE);CHKERRQ(ierr);
ierr = VecSetFromOptions(v0);CHKERRQ(ierr);
alpha = 1.0;
ierr = VecSet(&alpha,v0);CHKERRQ(ierr);
ierr = EPSSetInitialVector(eps,v0);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the eigensystem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
ierr = EPSSolve(eps,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of iterations of the method: %d\n",its);CHKERRQ(ierr);
 
/*
Optional: Get some information from the solver and display it
*/
ierr = EPSGetType(eps,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Solution method: %s\n\n",type);CHKERRQ(ierr);
ierr = EPSGetDimensions(eps,&nev,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of requested eigenvalues: %d\n",nev);CHKERRQ(ierr);
ierr = EPSGetTolerances(eps,&tol,&maxit);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Stopping condition: tol=%.4g, maxit=%d\n",tol,maxit);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
/*
Get number of converged eigenpairs
*/
ierr = EPSGetConverged(eps,&nconv);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of converged approximate eigenpairs: %d\n\n",nconv);CHKERRQ(ierr);
 
if (nconv>0) {
/*
Get converged eigenpairs: i-th eigenvalue is stored in kr[i] (real part) and
ki[i] (imaginary part), and the corresponding eigenvector is stored in x[i]
*/
ierr = EPSGetSolution(eps,&kr,&ki,&x);CHKERRQ(ierr);
 
/*
Compute the relative error associated to each eigenpair
*/
ierr = PetscMalloc(nconv*sizeof(PetscReal),&error);CHKERRQ(ierr);
ierr = EPSComputeError(eps,error);CHKERRQ(ierr);
 
/*
Display eigenvalues and relative errors
*/
ierr = PetscPrintf(PETSC_COMM_WORLD,
" k ||Ax-kx||/|k|\n"
" ----------------- -----------------\n" );CHKERRQ(ierr);
for( i=0; i<nconv; i++ ) {
if (ki[i]!=0.0) {
ierr = PetscPrintf(PETSC_COMM_WORLD," %9f%+9f j %12f\n",kr[i],ki[i],error[i]);CHKERRQ(ierr); }
else {
ierr = PetscPrintf(PETSC_COMM_WORLD," %12f %12f\n",kr[i],error[i]);CHKERRQ(ierr); }
}
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n" );CHKERRQ(ierr);
ierr = PetscFree(error);CHKERRQ(ierr);
}
/*
Free work space
*/
ierr = EPSDestroy(eps);CHKERRQ(ierr);
ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = SlepcFinalize();CHKERRQ(ierr);
return 0;
}
 
#undef __FUNCT__
#define __FUNCT__ "MatMarkovModel"
/*
Matrix generator for a Markov model of a random walk on a triangular grid.
 
This subroutine generates a test matrix that models a random walk on a
triangular grid. This test example was used by G. W. Stewart ["{SRRIT} - a
FORTRAN subroutine to calculate the dominant invariant subspaces of a real
matrix", Tech. report. TR-514, University of Maryland (1978).] and in a few
papers on eigenvalue problems by Y. Saad [see e.g. LAA, vol. 34, pp. 269-295
(1980) ]. These matrices provide reasonably easy test problems for eigenvalue
algorithms. The transpose of the matrix is stochastic and so it is known
that one is an exact eigenvalue. One seeks the eigenvector of the transpose
associated with the eigenvalue unity. The problem is to calculate the steady
state probability distribution of the system, which is the eigevector
associated with the eigenvalue one and scaled in such a way that the sum all
the components is equal to one.
 
Note: the code will actually compute the transpose of the stochastic matrix
that contains the transition probabilities.
*/
int MatMarkovModel( int m, Mat A )
{
const PetscReal cst = 0.5/(PetscReal)(m-1);
PetscReal pd, pu;
int ierr, i, j, jmax, ix=0, Istart, Iend;
 
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
for( i=1; i<=m; i++ ) {
jmax = m-i+1;
for( j=1; j<=jmax; j++ ) {
ix = ix + 1;
if( ix-1<Istart || ix>Iend ) continue; /* compute only owned rows */
if( j!=jmax ) {
pd = cst*(PetscReal)(i+j-1);
/* north */
if( i==1 ) {
ierr = MatSetValue( A, ix-1, ix, 2*pd, INSERT_VALUES );
CHKERRQ(ierr);
}
else {
ierr = MatSetValue( A, ix-1, ix, pd, INSERT_VALUES );
CHKERRQ(ierr);
}
/* east */
if( j==1 ) {
ierr = MatSetValue( A, ix-1, ix+jmax-1, 2*pd, INSERT_VALUES );
CHKERRQ(ierr);
}
else {
ierr = MatSetValue( A, ix-1, ix+jmax-1, pd, INSERT_VALUES );
CHKERRQ(ierr);
}
}
/* south */
pu = 0.5 - cst*(PetscReal)(i+j-3);
if( j>1 ) {
ierr = MatSetValue( A, ix-1, ix-2, pu, INSERT_VALUES );
CHKERRQ(ierr);
}
/* west */
if( i>1 ) {
ierr = MatSetValue( A, ix-1, ix-jmax-2, pu, INSERT_VALUES );
CHKERRQ(ierr);
}
}
}
ierr = MatAssemblyBegin( A, MAT_FINAL_ASSEMBLY ); CHKERRQ(ierr);
ierr = MatAssemblyEnd( A, MAT_FINAL_ASSEMBLY ); CHKERRQ(ierr);
return 0;
}
 
/trunk/src/examples/ex7.c
0,0 → 1,149
 
static char help[] = "Solves a generalized eigenvalue problem Ax=kBx by loading"
" the matrices from a file.\n\n"
"This example works for both real and complex numbers.\n\n"
"The command line options are:\n\n"
" -f1 <filename>, where <filename> = matrix (A) file in PETSc binary form.\n"
" -f2 <filename>, where <filename> = matrix (B) file in PETSc binary form.\n\n";
 
#include "slepceps.h"
 
#undef __FUNCT__
#define __FUNCT__ "main"
int main( int argc, char **argv )
{
Vec *x; /* basis vectors */
Mat A,B; /* matrices */
EPS eps; /* eigenproblem solver context */
EPSType type;
PetscReal *error, tol, re, im;
PetscScalar *kr, *ki;
int nev, ierr, maxit, i, its, nconv;
char filename[256];
PetscViewer viewer;
PetscTruth flg;
 
 
SlepcInitialize(&argc,&argv,(char*)0,help);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Load the matrices that define the eigensystem, Ax=kBx
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nGeneralized eigenproblem stored in file.\n\n");CHKERRQ(ierr);
ierr = PetscOptionsGetString(PETSC_NULL,"-f1",filename,256,&flg);CHKERRQ(ierr);
if (!flg) {
SETERRQ(1,"Must indicate a file name for matrix A with the -f1 option.");
}
 
#if defined(PETSC_USE_COMPLEX)
ierr = PetscPrintf(PETSC_COMM_WORLD," Reading COMPLEX matrices from binary files...\n");CHKERRQ(ierr);
#else
ierr = PetscPrintf(PETSC_COMM_WORLD," Reading REAL matrices from binary files...\n");CHKERRQ(ierr);
#endif
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,filename,PETSC_BINARY_RDONLY,&viewer);CHKERRQ(ierr);
ierr = MatLoad(viewer,MATMPIAIJ,&A);CHKERRQ(ierr);
ierr = PetscViewerDestroy(viewer);CHKERRQ(ierr);
 
ierr = PetscOptionsGetString(PETSC_NULL,"-f2",filename,256,&flg);CHKERRQ(ierr);
if (!flg) {
SETERRQ(1,"Must indicate a file name for matrix B with the -f2 option.");
}
 
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,filename,PETSC_BINARY_RDONLY,&viewer);CHKERRQ(ierr);
ierr = MatLoad(viewer,MATMPIAIJ,&B);CHKERRQ(ierr);
ierr = PetscViewerDestroy(viewer);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
/*
Create eigensolver context
*/
ierr = EPSCreate(PETSC_COMM_WORLD,&eps);CHKERRQ(ierr);
 
/*
Set operators. In this case, it is a generalized eigenvalue problem
*/
ierr = EPSSetOperators(eps,A,B);CHKERRQ(ierr);
 
/*
Set solver parameters at runtime
*/
ierr = EPSSetFromOptions(eps);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the eigensystem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
ierr = EPSSolve(eps,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of iterations of the method: %d\n",its);CHKERRQ(ierr);
 
/*
Optional: Get some information from the solver and display it
*/
ierr = EPSGetType(eps,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Solution method: %s\n\n",type);CHKERRQ(ierr);
ierr = EPSGetDimensions(eps,&nev,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of requested eigenvalues: %d\n",nev);CHKERRQ(ierr);
ierr = EPSGetTolerances(eps,&tol,&maxit);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Stopping condition: tol=%.4g, maxit=%d\n",tol,maxit);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
/*
Get number of converged eigenpairs
*/
ierr = EPSGetConverged(eps,&nconv);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of converged approximate eigenpairs: %d\n\n",nconv);CHKERRQ(ierr);
 
if (nconv>0) {
/*
Get converged eigenpairs: i-th eigenvalue is stored in kr[i] (real part) and
ki[i] (imaginary part), and the corresponding eigenvector is stored in x[i]
*/
ierr = EPSGetSolution(eps,&kr,&ki,&x);CHKERRQ(ierr);
 
/*
Compute the relative error associated to each eigenpair
*/
ierr = PetscMalloc(nconv*sizeof(PetscReal),&error);CHKERRQ(ierr);
ierr = EPSComputeError(eps,error);CHKERRQ(ierr);
 
/*
Display eigenvalues and relative errors
*/
ierr = PetscPrintf(PETSC_COMM_WORLD,
" k ||Ax-kx||/|k|\n"
" --------------------- -----------------\n" );CHKERRQ(ierr);
for( i=0; i<nconv; i++ ) {
#if defined(PETSC_USE_COMPLEX)
re = PetscRealPart(kr[i]);
im = PetscImaginaryPart(kr[i]);
#else
re = kr[i];
im = ki[i];
#endif
if( im>0.0 ) ierr = PetscPrintf(PETSC_COMM_WORLD," % 6f + %6f i",re,im);
else if( im<0.0 ) ierr = PetscPrintf(PETSC_COMM_WORLD," % 6f - %6f i",re,-im);
else ierr = PetscPrintf(PETSC_COMM_WORLD," %g ",re);
CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," % 12f\n",error[i]);CHKERRQ(ierr);
}
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n" );CHKERRQ(ierr);
ierr = PetscFree(error);CHKERRQ(ierr);
}
/*
Free work space
*/
ierr = EPSDestroy(eps);CHKERRQ(ierr);
ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = MatDestroy(B);CHKERRQ(ierr);
ierr = SlepcFinalize();CHKERRQ(ierr);
return 0;
}
 
/trunk/src/examples/ex8.c
0,0 → 1,180
 
static char help[] = "This example estimates the 2-norm condition number of a"
"matrix A, that is, the ratio of the largest singular value of A to the "
"smallest. The matrix is a Grcar matrix.\n\n"
"The command line options are:\n\n"
" -n <n>, where <n> = matrix dimension.\n\n";
 
#include "slepceps.h"
 
/*
This example computes the singular values of A by computing the eigenvalues
of A^T*A, where A^T denotes the transpose of A.
 
An nxn Grcar matrix is a nonsymmetric Toeplitz matrix:
 
| 1 1 1 1 |
| -1 1 1 1 1 |
| -1 1 1 1 1 |
| . . . . . |
A = | . . . . . |
| -1 1 1 1 1 |
| -1 1 1 1 |
| -1 1 1 |
| -1 1 |
 
*/
 
 
/*
Matrix multiply routine
*/
#undef __FUNCT__
#define __FUNCT__ "MatSVD_Mult"
int MatSVD_Mult(Mat H,Vec x,Vec y)
{
Mat A;
Vec w;
int n, m, N, M, ierr;
MPI_Comm comm;
 
ierr = MatShellGetContext(H,(void**)&A);CHKERRQ(ierr);
ierr = PetscObjectGetComm((PetscObject)A,&comm);CHKERRQ(ierr);
ierr = MatGetLocalSize(A,&n,&m);CHKERRQ(ierr);
ierr = MatGetSize(A,&N,&M);CHKERRQ(ierr);
ierr = VecCreate(comm,&w);CHKERRQ(ierr);
ierr = VecSetSizes(w,n,N);CHKERRQ(ierr);
ierr = VecSetFromOptions(w);CHKERRQ(ierr);
ierr = MatMult(A,x,w);CHKERRQ(ierr);
ierr = MatMultTranspose(A,w,y);CHKERRQ(ierr);
ierr = VecDestroy(w);CHKERRQ(ierr);
 
return 0;
}
 
#undef __FUNCT__
#define __FUNCT__ "main"
int main( int argc, char **argv )
{
Mat A; /* Grcar matrix */
Mat H; /* eigenvalue problem matrix, H=A^T*A */
EPS eps; /* eigenproblem solver context */
int N=30, n, ierr, i, its, nconv, col[5], Istart, Iend;
PetscScalar *kr, sigma_1, sigma_n, value[] = { -1, 1, 1, 1, 1 };
 
SlepcInitialize(&argc,&argv,(char*)0,help);
 
#if defined(PETSC_USE_COMPLEX)
SETERRQ(1,"This example does not work with complex numbers!");
#endif
#if !defined(SLEPC_HAVE_ARPACK)
SETERRQ(1,"This example requires that ARPACK is installed!");
#endif
 
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&N,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nEstimate de condition number of a Grcar matrix, n=%d\n\n",N);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Generate the matrix
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
ierr = MatCreate(PETSC_COMM_WORLD,PETSC_DECIDE,PETSC_DECIDE,N,N,&A);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
 
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
for( i=Istart; i<Iend; i++ ) {
col[0]=i-1; col[1]=i; col[2]=i+1; col[3]=i+2; col[4]=i+3;
if (i==0) {
ierr = MatSetValues(A,1,&i,4,col+1,value+1,INSERT_VALUES);CHKERRQ(ierr);
}
else {
ierr = MatSetValues(A,1,&i,PetscMin(5,N-i+1),col,value,INSERT_VALUES);CHKERRQ(ierr);
}
}
 
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
 
/*
Now create a symmetric shell matrix H=A^T*A
*/
ierr = MatGetLocalSize(A,PETSC_NULL,&n);CHKERRQ(ierr);
ierr = MatCreateShell(PETSC_COMM_WORLD,n,n,PETSC_DETERMINE,PETSC_DETERMINE,(void*)A,&H);CHKERRQ(ierr);
ierr = MatShellSetOperation(H,MATOP_MULT,(void(*)())MatSVD_Mult);CHKERRQ(ierr);
ierr = MatShellSetOperation(H,MATOP_MULT_TRANSPOSE,(void(*)())MatSVD_Mult);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver and set the solution method
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
/*
Create eigensolver context
*/
ierr = EPSCreate(PETSC_COMM_WORLD,&eps);CHKERRQ(ierr);
 
/*
Set operators. In this case, it is a standard symmetric eigenvalue problem
*/
ierr = EPSSetOperators(eps,H,PETSC_NULL);CHKERRQ(ierr);
 
/*
Set solver parameters at runtime
*/
ierr = EPSSetFromOptions(eps);CHKERRQ(ierr);
 
/*
Set the solution method. Two eigenvalues are requested, one from each end
of the spectrum
*/
ierr = EPSSetType(eps,EPSARPACK);CHKERRQ(ierr);
ierr = EPSSetDimensions(eps,2,PETSC_DEFAULT);CHKERRQ(ierr);
ierr = EPSSetWhichEigenpairs(eps,EPS_BOTH_ENDS);CHKERRQ(ierr);
ierr = EPSSetTolerances(eps,PETSC_DEFAULT,1000);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the eigensystem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
ierr = EPSSolve(eps,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of iterations of the method: %d\n",its);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
/*
Get number of converged eigenpairs
*/
ierr = EPSGetConverged(eps,&nconv);CHKERRQ(ierr);
 
if (nconv==2) {
/*
Get converged eigenpairs: i-th eigenvalue is stored in kr[i]. In this
example, we are not interested in the eigenvectors
*/
ierr = EPSGetSolution(eps,&kr,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
 
/*
The singular values of A are the square roots of the eigenvalues of H
*/
sigma_1 = PetscSqrtScalar(PetscMax(kr[0],kr[1]));
sigma_n = PetscSqrtScalar(PetscMin(kr[0],kr[1]));
 
ierr = PetscPrintf(PETSC_COMM_WORLD," Computed singular values: sigma_1=%6f, sigma_n=%6f\n",sigma_1,sigma_n);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Estimated condition number: sigma_1/sigma_n=%6f\n\n",sigma_1/sigma_n);CHKERRQ(ierr);
 
}
else {
ierr = PetscPrintf(PETSC_COMM_WORLD," Process did not converge!\n\n");CHKERRQ(ierr);
}
/*
Free work space
*/
ierr = EPSDestroy(eps);CHKERRQ(ierr);
ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = MatDestroy(H);CHKERRQ(ierr);
ierr = SlepcFinalize();CHKERRQ(ierr);
return 0;
}
 
/trunk/src/examples/ex9.c
0,0 → 1,318
 
static char help[] = "This example solves the eigenvalue problem associated to"
"the Brusselator wave model in chemical reactions.\n\n"
"The command line options are:\n\n"
" -n <n>, where <n> = block dimension of the 2x2 block matrix.\n"
" -L <L>, where <L> = bifurcation parameter.\n"
" -alpha <alpha>, -beta <beta>, -delta1 <delta1>, -delta2 <delta2>,\n"
" where <alpha> <beta> <delta1> <delta2> = model parameters.\n\n";
 
#include "slepceps.h"
 
/*
This example computes the eigenvalues with largest real part of the
following matrix
 
A = [ tau1*T+(beta-1)*I alpha^2*I
-beta*I tau2*T-alpha^2*I ],
 
where
 
T = tridiag{1,-2,1}
h = 1/(n+1)
tau1 = delta1/(h*L)^2
tau2 = delta2/(h*L)^2
*/
 
 
/*
Matrix operations
*/
extern int MatBrussel_Mult(Mat,Vec,Vec);
extern int MatBrussel_Shift(PetscScalar*,Mat);
extern int MatBrussel_GetDiagonal(Mat,Vec);
 
typedef struct {
Mat T;
Vec x1, x2, y1, y2;
PetscScalar alpha, beta, tau1, tau2, sigma;
} CTX_BRUSSEL;
 
#undef __FUNCT__
#define __FUNCT__ "main"
int main( int argc, char **argv )
{
Vec *x; /* basis vectors */
Mat A; /* eigenvalue problem matrix */
EPS eps; /* eigenproblem solver context */
EPSType type;
PetscReal *error, tol, re, im;
PetscScalar delta1, delta2, L, h, *kr, *ki, value[3];
int N=30, n, nev, ierr, maxit, i, its, nconv,
col[3], Istart, Iend, FirstBlock=0, LastBlock=0;
CTX_BRUSSEL *ctx;
 
SlepcInitialize(&argc,&argv,(char*)0,help);
 
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&N,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nBrusselator wave model, n=%d\n\n",N);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Generate the matrix
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
/*
Create shell matrix context and set default parameters
*/
ierr = PetscNew(CTX_BRUSSEL,&ctx);CHKERRQ(ierr);
ctx->alpha = 2.0;
ctx->beta = 5.45;
delta1 = 0.008;
delta2 = 0.004;
L = 0.51302;
 
/*
Look the command line for user-provided parameters
*/
ierr = PetscOptionsGetScalar(PETSC_NULL,"-L",&L,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetScalar(PETSC_NULL,"-alpha",&ctx->alpha,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetScalar(PETSC_NULL,"-beta",&ctx->beta,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetScalar(PETSC_NULL,"-delta1",&delta1,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetScalar(PETSC_NULL,"-delta2",&delta2,PETSC_NULL);CHKERRQ(ierr);
 
/*
Create matrix T
*/
ierr = MatCreate(PETSC_COMM_WORLD,PETSC_DECIDE,PETSC_DECIDE,N,N,&ctx->T);CHKERRQ(ierr);
ierr = MatSetFromOptions(ctx->T);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(ctx->T,&Istart,&Iend);CHKERRQ(ierr);
if (Istart==0) FirstBlock=PETSC_TRUE;
if (Iend==N) LastBlock=PETSC_TRUE;
value[0]=1.0; value[1]=-2.0; value[2]=1.0;
for( i=(FirstBlock? Istart+1: Istart); i<(LastBlock? Iend-1: Iend); i++ ) {
col[0]=i-1; col[1]=i; col[2]=i+1;
ierr = MatSetValues(ctx->T,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr);
}
if (LastBlock) {
i=N-1; col[0]=N-2; col[1]=N-1;
ierr = MatSetValues(ctx->T,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
}
if (FirstBlock) {
i=0; col[0]=0; col[1]=1; value[0]=-2.0; value[1]=1.0;
ierr = MatSetValues(ctx->T,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
}
 
ierr = MatAssemblyBegin(ctx->T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(ctx->T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatGetLocalSize(ctx->T,&n,PETSC_NULL);CHKERRQ(ierr);
 
/*
Fill the remaining information in the shell matrix context
and create auxiliary vectors
*/
h = 1.0 / (double)(N+1);
ctx->tau1 = delta1 / ((h*L)*(h*L));
ctx->tau2 = delta2 / ((h*L)*(h*L));
ctx->sigma = 0.0;
ierr = VecCreateMPIWithArray(PETSC_COMM_WORLD,n,PETSC_DECIDE,PETSC_NULL,&ctx->x1);CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(PETSC_COMM_WORLD,n,PETSC_DECIDE,PETSC_NULL,&ctx->x2);CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(PETSC_COMM_WORLD,n,PETSC_DECIDE,PETSC_NULL,&ctx->y1);CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(PETSC_COMM_WORLD,n,PETSC_DECIDE,PETSC_NULL,&ctx->y2);CHKERRQ(ierr);
 
/*
Create the shell matrix
*/
ierr = MatCreateShell(PETSC_COMM_WORLD,2*n,2*n,2*N,2*N,(void*)ctx,&A);CHKERRQ(ierr);
ierr = MatShellSetOperation(A,MATOP_MULT,(void(*)())MatBrussel_Mult);CHKERRQ(ierr);
ierr = MatShellSetOperation(A,MATOP_SHIFT,(void(*)())MatBrussel_Shift);CHKERRQ(ierr);
ierr = MatShellSetOperation(A,MATOP_GET_DIAGONAL,(void(*)())MatBrussel_GetDiagonal);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
/*
Create eigensolver context
*/
ierr = EPSCreate(PETSC_COMM_WORLD,&eps);CHKERRQ(ierr);
 
/*
Set operators. In this case, it is a standard eigenvalue problem
*/
ierr = EPSSetOperators(eps,A,PETSC_NULL);CHKERRQ(ierr);
 
/*
Force to use ARPACK if it is installed and ask for the rightmost eigenvalues
*/
#if defined(SLEPC_HAVE_ARPACK)
ierr = EPSSetType(eps,EPSARPACK);CHKERRQ(ierr);
ierr = EPSSetWhichEigenpairs(eps,EPS_LARGEST_REAL);CHKERRQ(ierr);
ierr = EPSSetDimensions(eps,PETSC_DEFAULT,12);CHKERRQ(ierr);
#endif
 
/*
Set other solver options at runtime
*/
ierr = EPSSetFromOptions(eps);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the eigensystem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
ierr = EPSSolve(eps,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of iterations of the method: %d\n",its);CHKERRQ(ierr);
/*
Optional: Get some information from the solver and display it
*/
ierr = EPSGetType(eps,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Solution method: %s\n\n",type);CHKERRQ(ierr);
ierr = EPSGetDimensions(eps,&nev,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of requested eigenvalues: %d\n",nev);CHKERRQ(ierr);
ierr = EPSGetTolerances(eps,&tol,&maxit);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Stopping condition: tol=%.4g, maxit=%d\n",tol,maxit);CHKERRQ(ierr);
 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 
/*
Get number of converged eigenpairs
*/
ierr = EPSGetConverged(eps,&nconv);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of converged approximate eigenpairs: %d\n\n",nconv);CHKERRQ(ierr);
 
if (nconv>0) {
/*
Get converged eigenpairs: i-th eigenvalue is stored in kr[i] (real part) and
ki[i] (imaginary part), and the corresponding eigenvector is stored in x[i]
*/
ierr = EPSGetSolution(eps,&kr,&ki,&x);CHKERRQ(ierr);
 
/*
Compute the relative error associated to each eigenpair
*/
ierr = PetscMalloc(nconv*sizeof(PetscReal),&error);CHKERRQ(ierr);
ierr = EPSComputeError(eps,error);CHKERRQ(ierr);
 
/*
Display eigenvalues and relative errors
*/
ierr = PetscPrintf(PETSC_COMM_WORLD,
" k ||Ax-kx||/|k|\n"
" --------------------- -----------------\n" );CHKERRQ(ierr);
for( i=0; i<nconv; i++ ) {
#if defined(PETSC_USE_COMPLEX)
re = PetscRealPart(kr[i]);
im = PetscImaginaryPart(kr[i]);
#else
re = kr[i];
im = ki[i];
#endif
if( im>0.0 ) ierr = PetscPrintf(PETSC_COMM_WORLD," % 6f + %6f i",re,im);
else if( im<0.0 ) ierr = PetscPrintf(PETSC_COMM_WORLD," % 6f - %6f i",re,-im);
else ierr = PetscPrintf(PETSC_COMM_WORLD," % 6f ",re);
CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," % 12f\n",error[i]);CHKERRQ(ierr);
}
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n" );CHKERRQ(ierr);
ierr = PetscFree(error);CHKERRQ(ierr);
}
/*
Free work space
*/
ierr = EPSDestroy(eps);CHKERRQ(ierr);
ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = MatDestroy(ctx->T);CHKERRQ(ierr);
ierr = VecDestroy(ctx->x1);CHKERRQ(ierr);
ierr = VecDestroy(ctx->x2);CHKERRQ(ierr);
ierr = VecDestroy(ctx->y1);CHKERRQ(ierr);
ierr = VecDestroy(ctx->y2);CHKERRQ(ierr);
ierr = PetscFree(ctx);CHKERRQ(ierr);
ierr = SlepcFinalize();CHKERRQ(ierr);
return 0;
}
 
#undef __FUNC__
#define __FUNC__ "MatBrussel_Mult"
int MatBrussel_Mult(Mat A,Vec x,Vec y)
{
int n, ierr;
PetscScalar alpha, *px, *py;
MPI_Comm comm;
CTX_BRUSSEL *ctx;
 
ierr = MatShellGetContext(A,(void**)&ctx);CHKERRQ(ierr);
ierr = PetscObjectGetComm((PetscObject)A,&comm);CHKERRQ(ierr);
ierr = MatGetLocalSize(ctx->T,&n,PETSC_NULL);CHKERRQ(ierr);
ierr = VecGetArray(x,&px);CHKERRQ(ierr);
ierr = VecGetArray(y,&py);CHKERRQ(ierr);
ierr = VecPlaceArray(ctx->x1,px);CHKERRQ(ierr);
ierr = VecPlaceArray(ctx->x2,px+n);CHKERRQ(ierr);
ierr = VecPlaceArray(ctx->y1,py);CHKERRQ(ierr);
ierr = VecPlaceArray(ctx->y2,py+n);CHKERRQ(ierr);
 
ierr = MatMult(ctx->T,ctx->x1,ctx->y1);CHKERRQ(ierr);
ierr = VecScale(&ctx->tau1,ctx->y1);CHKERRQ(ierr);
alpha = ctx->beta - 1.0 - ctx->sigma;
ierr = VecAXPY(&alpha,ctx->x1,ctx->y1);CHKERRQ(ierr);
alpha = ctx->alpha * ctx->alpha;
ierr = VecAXPY(&alpha,ctx->x2,ctx->y1);CHKERRQ(ierr);
 
ierr = MatMult(ctx->T,ctx->x2,ctx->y2);CHKERRQ(ierr);
ierr = VecScale(&ctx->tau2,ctx->y2);CHKERRQ(ierr);
alpha = -ctx->beta;
ierr = VecAXPY(&alpha,ctx->x1,ctx->y2);CHKERRQ(ierr);
alpha = -ctx->alpha * ctx->alpha - ctx->sigma;
ierr = VecAXPY(&alpha,ctx->x2,ctx->y2);CHKERRQ(ierr);
 
ierr = VecRestoreArray(x,&px);CHKERRQ(ierr);
ierr = VecRestoreArray(y,&py);CHKERRQ(ierr);
 
return 0;
}
 
#undef __FUNCT__
#define __FUNCT__ "MatBrussel_Shift"
int MatBrussel_Shift( PetscScalar* a, Mat Y )
{
CTX_BRUSSEL *ctx;
int ierr;
 
ierr = MatShellGetContext( Y, (void**)&ctx ); CHKERRQ(ierr);
ctx->sigma += *a;
PetscFunctionReturn(0);
}
 
#undef __FUNC__
#define __FUNC__ "MatBrussel_GetDiagonal"
int MatBrussel_GetDiagonal(Mat A,Vec diag)
{
Vec d1, d2;
int n, ierr;
PetscScalar alpha, *pd;
MPI_Comm comm;
CTX_BRUSSEL *ctx;
 
ierr = MatShellGetContext(A,(void**)&ctx);CHKERRQ(ierr);
ierr = PetscObjectGetComm((PetscObject)A,&comm);CHKERRQ(ierr);
ierr = MatGetLocalSize(ctx->T,&n,PETSC_NULL);CHKERRQ(ierr);
ierr = VecGetArray(diag,&pd);CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(comm,n,PETSC_DECIDE,pd,&d1);CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(comm,n,PETSC_DECIDE,pd+n,&d2);CHKERRQ(ierr);
 
alpha = -2.0*ctx->tau1 + ctx->beta - 1.0 - ctx->sigma;
ierr = VecSet(&alpha,d1);CHKERRQ(ierr);
alpha = -2.0*ctx->tau2 - ctx->alpha*ctx->alpha - ctx->sigma;
ierr = VecSet(&alpha,d2);CHKERRQ(ierr);
 
ierr = VecDestroy(d1);CHKERRQ(ierr);
ierr = VecDestroy(d2);CHKERRQ(ierr);
ierr = VecRestoreArray(diag,&pd);CHKERRQ(ierr);
 
return 0;
}
 
 
/trunk/src/examples/mvmisg.f
0,0 → 1,113
SUBROUTINE MVMISG( TRANS, N, M, X, LDX, Y, LDY )
* ..
* .. Scalar Arguments ..
INTEGER LDY, LDX, M, N, TRANS
* ..
* .. Array Arguments ..
DOUBLE PRECISION Y( LDY, * ), X( LDX, * )
* ..
*
* Purpose
* =======
*
* Compute
*
* Y(:,1:M) = op(A)*X(:,1:M)
*
* where op(A) is A or A' (the transpose of A). The A is the Ising
* matrix.
*
* Arguments
* =========
*
* TRANS (input) INTEGER
* If TRANS = 0, compute Y(:,1:M) = A*X(:,1:M)
* If TRANS = 1, compute Y(:,1:M) = A'*X(:,1:M)
*
* N (input) INTEGER
* The order of the matrix A. N has to be an even number.
*
* M (input) INTEGERS
* The number of columns of X to multiply.
*
* X (input) DOUBLE PRECISION array, dimension ( LDX, M )
* X contains the matrix (vectors) X.
*
* LDX (input) INTEGER
* The leading dimension of array X, LDX >= max( 1, N )
*
* Y (output) DOUBLE PRECISION array, dimension (LDX, M )
* contains the product of the matrix op(A) with X.
*
* LDY (input) INTEGER
* The leading dimension of array Y, LDY >= max( 1, N )
*
* ===================================================================
*
*
* .. PARAMETERS ..
DOUBLE PRECISION PI
PARAMETER ( PI = 3.141592653589793D+00 )
DOUBLE PRECISION ALPHA, BETA
PARAMETER ( ALPHA = PI/4, BETA = PI/4 )
*
* .. Local Variables ..
INTEGER I, K
DOUBLE PRECISION COSA, COSB, SINA, SINB, TEMP, TEMP1
*
* .. Intrinsic functions ..
INTRINSIC COS, SIN
*
COSA = COS( ALPHA )
SINA = SIN( ALPHA )
COSB = COS( BETA )
SINB = SIN( BETA )
*
IF ( TRANS.EQ.0 ) THEN
*
* Compute Y(:,1:M) = A*X(:,1:M)
 
DO 30 K = 1, M
*
Y( 1, K ) = COSB*X( 1, K ) - SINB*X( N, K )
DO 10 I = 2, N-1, 2
Y( I, K ) = COSB*X( I, K ) + SINB*X( I+1, K )
Y( I+1, K ) = -SINB*X( I, K ) + COSB*X( I+1, K )
10 CONTINUE
Y( N, K ) = SINB*X( 1, K ) + COSB*X( N, K )
*
DO 20 I = 1, N, 2
TEMP = COSA*Y( I, K ) + SINA*Y( I+1, K )
Y( I+1, K ) = -SINA*Y( I, K ) + COSA*Y( I+1, K )
Y( I, K ) = TEMP
20 CONTINUE
*
30 CONTINUE
*
ELSE IF ( TRANS.EQ.1 ) THEN
*
* Compute Y(:1:M) = A'*X(:,1:M)
*
DO 60 K = 1, M
*
DO 40 I = 1, N, 2
Y( I, K ) = COSA*X( I, K ) - SINA*X( I+1, K )
Y( I+1, K ) = SINA*X( I, K ) + COSA*X( I+1, K )
40 CONTINUE
TEMP = COSB*Y(1,K) + SINB*Y(N,K)
DO 50 I = 2, N-1, 2
TEMP1 = COSB*Y( I, K ) - SINB*Y( I+1, K )
Y( I+1, K ) = SINB*Y( I, K ) + COSB*Y( I+1, K )
Y( I, K ) = TEMP1
50 CONTINUE
Y( N, K ) = -SINB*Y( 1, K ) + COSB*Y( N, K )
Y( 1, K ) = TEMP
*
60 CONTINUE
*
END IF
*
RETURN
*
* END OF MVMISG
END
/trunk/src/examples/ex1f.F
0,0 → 1,190
!
! Program usage: mpirun -np n ex1f [-help] [-n <n>] [all SLEPc options]
!
! Description: Simple example that solves an eigensystem with the EPS object.
! The standard symmetric eigenvalue problem to be solved corresponds to the
! Laplacian operator in 1 dimension.
!
! The command line options are:
! -n <n>, where <n> = number of grid points = matrix size
!
!/*T
! Concepts: SLEPc - Basic functionality
! Routines: SlepcInitialize(); SlepcFinalize();
! Routines: EPSCreate(); EPSSetFromOptions();
! Routines: EPSSolve(); EPSDestroy();
!T*/
!
! ----------------------------------------------------------------------
!
program main
implicit none
 
#include "finclude/petsc.h"
#include "finclude/petscvec.h"
#include "finclude/petscmat.h"
#include "finclude/slepc.h"
#include "finclude/slepceps.h"
 
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Declarations
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
! Variables:
! A operator matrix
! x basis vectors
! eps eigenproblem solver context
 
#define MAXNEV 30
Mat A
Vec x(MAXNEV)
EPS eps
EPSType type
PetscReal tol, error(MAXNEV)
PetscScalar kr(MAXNEV), ki(MAXNEV)
integer rank, n, nev, ierr, maxit, i, its, nconv
integer col(3), Istart, Iend
PetscTruth flg
PetscScalar value(3)
 
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Beginning of program
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
call SlepcInitialize(PETSC_NULL_CHARACTER,ierr)
call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
n = 30
call PetscOptionsGetInt(PETSC_NULL_CHARACTER,'-n',n,flg,ierr)
 
if (rank .eq. 0) then
write(6,*)
write(6,100) n
write(6,*)
endif
100 format ('1-D Laplacian Eigenproblem, n =',i6)
 
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Compute the operator matrix that defines the eigensystem, Ax=kx
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
call MatCreate(PETSC_COMM_WORLD,PETSC_DECIDE,PETSC_DECIDE,n,n,A,
& ierr)
call MatSetFromOptions(A,ierr)
 
call MatGetOwnershipRange(A,Istart,Iend,ierr)
if (Istart .eq. 0) then
i = 0
col(1) = 0
col(2) = 1
value(1) = 2.0
value(2) = -1.0
call MatSetValues(A,1,i,2,col,value,INSERT_VALUES,ierr)
Istart = Istart+1
endif
if (Iend .eq. n) then
i = n-1
col(1) = n-2
col(2) = n-1
value(1) = -1.0
value(2) = 2.0
call MatSetValues(A,1,i,2,col,value,INSERT_VALUES,ierr)
Iend = Iend-1
endif
value(1) = -1.0
value(2) = 2.0
value(3) = -1.0
do i=Istart,Iend-1
col(1) = i-1
col(2) = i
col(3) = i+1
call MatSetValues(A,1,i,3,col,value,INSERT_VALUES,ierr)
enddo
 
call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr)
call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr)
 
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Create the eigensolver and display info
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
! ** Create eigensolver context
call EPSCreate(PETSC_COMM_WORLD,eps,ierr)
 
! ** Set operators. In this case, it is a standard eigenvalue problem
call EPSSetOperators(eps,A,PETSC_NULL_OBJECT,ierr)
 
! ** Set solver parameters at runtime
call EPSSetFromOptions(eps,ierr)
 
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Solve the eigensystem
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
call EPSSolve(eps,its,ierr)
if (rank .eq. 0) then
write(6,*)
write(6,140) its
endif
140 format (' Number of iterations of the method: ',i4)
! ** Optional: Get some information from the solver and display it
call EPSGetType(eps,type,ierr)
if (rank .eq. 0) then
write(6,110) type
endif
110 format (' Solution method: ',a)
call EPSGetDimensions(eps,nev,PETSC_NULL_INTEGER,ierr)
if (rank .eq. 0) then
write(6,120) nev
endif
120 format (' Number of requested eigenvalues:',i2)
call EPSGetTolerances(eps,tol,maxit,ierr)
if (rank .eq. 0) then
write(6,130) tol, maxit
endif
130 format (' Stopping condition: tol=',1pe10.4,', maxit=',i6)
 
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Display solution and clean up
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
! ** Get number of converged eigenpairs (supposed to be < MAXNEV)
call EPSGetConverged(eps,nconv,ierr)
if (rank .eq. 0) then
write(6,150) nconv
endif
150 format (' Number of converged approximate eigenpairs:',i2)
 
! ** Get converged eigenpairs: i-th eigenvalue is stored in kr(i) (real part) and
! ** ki(i) (imaginary part), and the corresponding eigenvector is stored in x(i)
call EPSGetSolution(eps,kr,ki,x,ierr)
 
! ** Compute the relative error associated to each eigenpair
call EPSComputeError(eps,error,ierr)
 
! ** Display eigenvalues and relative errors
if (nconv.gt.0 .and. rank.eq.0) then
write(6,*)
write(6,160)
write(6,170)
do i=1,nconv
if (ki(i).ne.0.D0) then
write(6,180) kr(i), ki(i), error(i)
else
write(6,190) kr(i), error(i)
endif
enddo
write(6,*)
endif
160 format (' k ||Ax-kx||/|k|')
170 format (' ----------------- -----------------')
180 format (1pe11.4,1pe11.4,' j ',1pe12.4)
190 format (' ',1pe12.4,' ',1pe12.4)
 
! ** Free work space
call EPSDestroy(eps,ierr)
call MatDestroy(A,ierr)
 
call SlepcFinalize(ierr)
end
 
/trunk/src/examples/ex6f.F
0,0 → 1,214
!
! Program usage: mpirun -np n ex6f [-help] [-m <m>] [all SLEPc options]
!
! Description: This example solves the eigensystem arising in the Ising
! model for ferromagnetic materials. The file mvmisg.f must be linked
! together. Information about the model can be found at the following
! site http://math.nist.gov/MatrixMarket/data/NEP
!
! The command line options are:
! -m <m>, where <m> is the number of 2x2 blocks, i.e. matrix size N=2*m
!
!/*T
! Concepts: SLEPc - Basic functionality
! Routines: SlepcInitialize(); SlepcFinalize();
! Routines: EPSCreate(); EPSSetFromOptions();
! Routines: EPSSolve(); EPSDestroy();
!T*/
!
! ----------------------------------------------------------------------
!
program main
implicit none
 
#include "finclude/petsc.h"
#include "finclude/petscvec.h"
#include "finclude/petscmat.h"
#include "finclude/slepc.h"
#include "finclude/slepceps.h"
 
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Declarations
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
! Variables:
! A operator matrix
! x basis vectors
! eps eigenproblem solver context
 
#define MAXNEV 30
Mat A
Vec x(MAXNEV)
EPS eps
EPSType type
PetscReal tol, error(MAXNEV)
PetscScalar kr(MAXNEV), ki(MAXNEV)
integer size, rank, N, m, nev, ierr, maxit, i, its, nconv
PetscTruth flg
 
! This is the routine to use for matrix-free approach
!
external MatIsing_Mult
 
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Beginning of program
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
call SlepcInitialize(PETSC_NULL_CHARACTER,ierr)
#if defined(PETSC_USE_COMPLEX)
write(6,*) "This example requires real numbers."
goto 999
#endif
call MPI_Comm_size(PETSC_COMM_WORLD,size,ierr)
call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
if (size .ne. 1) then
if (rank .eq. 0) then
write(6,*) 'This is a uniprocessor example only!'
endif
SETERRQ(1,' ',ierr)
endif
m = 30
call PetscOptionsGetInt(PETSC_NULL_CHARACTER,'-m',m,flg,ierr)
N = 2*m
 
if (rank .eq. 0) then
write(6,*)
write(6,100) m
write(6,*)
endif
100 format ('Ising Model Eigenproblem, m =',i6,', (N=2*m)' )
 
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Register the matrix-vector subroutine for the operator that defines
! the eigensystem, Ax=kx
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
call MatCreateShell(PETSC_COMM_WORLD,N,N,N,N,PETSC_NULL_OBJECT,A,
& ierr)
call MatShellSetOperation(A,MATOP_MULT,MatIsing_Mult,ierr)
 
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Create the eigensolver and display info
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
! ** Create eigensolver context
call EPSCreate(PETSC_COMM_WORLD,eps,ierr)
 
! ** Set operators. In this case, it is a standard eigenvalue problem
call EPSSetOperators(eps,A,PETSC_NULL_OBJECT,ierr)
 
! ** Set solver parameters at runtime
call EPSSetFromOptions(eps,ierr)
 
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Solve the eigensystem
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
call EPSSolve(eps,its,ierr)
if (rank .eq. 0) then
write(6,*)
write(6,140) its
endif
140 format (' Number of iterations of the method: ',i4)
 
! ** Optional: Get some information from the solver and display it
call EPSGetType(eps,type,ierr)
if (rank .eq. 0) then
write(6,110) type
endif
110 format (' Solution method: ',a)
call EPSGetDimensions(eps,nev,PETSC_NULL_INTEGER,ierr)
if (rank .eq. 0) then
write(6,120) nev
endif
120 format (' Number of requested eigenvalues:',i2)
call EPSGetTolerances(eps,tol,maxit,ierr)
if (rank .eq. 0) then
write(6,130) tol, maxit
endif
130 format (' Stopping condition: tol=',1pe10.4,', maxit=',i6)
 
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Display solution and clean up
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
! ** Get number of converged eigenpairs (supposed to be < MAXNEV)
call EPSGetConverged(eps,nconv,ierr)
if (rank .eq. 0) then
write(6,150) nconv
endif
150 format (' Number of converged approximate eigenpairs:',i2)
 
! ** Get converged eigenpairs: i-th eigenvalue is stored in kr(i) (real part) and
! ** ki(i) (imaginary part), and the corresponding eigenvector is stored in x(i)
call EPSGetSolution(eps,kr,ki,x,ierr)
 
! ** Compute the relative error associated to each eigenpair
call EPSComputeError(eps,error,ierr)
 
! ** Display eigenvalues and relative errors
if (nconv.gt.0 .and. rank.eq.0) then
write(6,*)
write(6,160)
write(6,170)
do i=1,nconv
if (ki(i).ne.0.D0) then
write(6,180) kr(i), ki(i), error(i)
else
write(6,190) kr(i), error(i)
endif
enddo
write(6,*)
endif
160 format (' k ||Ax-kx||/|k|')
170 format (' ----------------- -----------------')
180 format (1pe11.4,1pe11.4,' j ',1pe12.4)
190 format (' ',1pe12.4,' ',1pe12.4)
 
! ** Free work space
call EPSDestroy(eps,ierr)
call MatDestroy(A,ierr)
 
999 continue
call SlepcFinalize(ierr)
end
 
! -------------------------------------------------------------------
!
! MatIsing_Mult - user provided matrix-vector multiply
!
! Input Parameters:
! A - matrix
! x - input vector
!
! Output Parameter:
! y - output vector
!
subroutine MatIsing_Mult(A,x,y,ierr)
implicit none
 
#include "finclude/petsc.h"
 
Mat A
Vec x,y
integer trans,one,ierr,i,N
PetscScalar x_array(1),y_array(1)
PetscOffset i_x,i_y
 
! The actual routine for the matrix-vector product
external mvmisg
 
call MatGetSize(A,N,PETSC_NULL_INTEGER,ierr)
call VecGetArray(x,x_array,i_x,ierr)
call VecGetArray(y,y_array,i_y,ierr)
 
trans = 0
one = 1
call mvmisg(trans,N,one,x_array(i_x+1),N,y_array(i_y+1),N)
 
call VecRestoreArray(x,x_array,i_x,ierr)
call VecRestoreArray(y,y_array,i_y,ierr)
 
return
end
 
/trunk/src/examples/ex1
0,0 → 1,354
ELF€œ4%4 (# 44€4€ÀÀôô€ô€€€ØÂØÂÐPP %œ.òrrhh /lib/ld-linux.so.2GNUayu
e:8)h<Gqtkbp [Ps5ainSM'`rfT7Z;Ivx_RO^30&C2B#o]gm(%>dEwV
"$ .,1?6+*FD4ANXLJ-H@Qc!\=jlYUK9/W—@—(:P— B`—(Op—Á€—Ô 
—È —*°—©À—@à'#Зàà—'«ð—@4˜úº`3˜² ˜?0˜ï@˜V,P˜4IrñÿR`˜%<ñÿ£p˜@€˜È˜8m ˜÷<à}$°˜ªaÀ˜ÜÛИºe Pr u”à˜ýƒ$u“ð˜'ß`¶õ  ™-‘™Î÷ ™£—
©0™6»(‡ž @™Û ^P™1GXÌÍ ²`™r"Êp™ú〙aِ™Ä¤è§° N ™n_°™Öü¯d Ë8|À™6ëЙ(~à™(-˜¨ Ì43 uñÿÏð™JäšÀšØï šl G0š¿ °@ši‚N†" „p† Pš0‰†˜ ›`š(Œpšõÿ 
¹LW €šÌõš˜ šsì>°š'þÀšrК 1"(uïàšº.ðš„›f, uñÿ?”sñÿ?œ~ñÿV›{† U ›:0›c@›¸eP›z›`›[Œ,†" up›%€›P›š ›‘²T©§ Dº°›4ÁÀ›&÷ЛäÔà›Eäð›`sœò÷œ>Î œé}0œ<"X@œEÁPœö“`œ`pœ4èȇ$ £ libslepc.soEPSDestroyPetscErrorEPSGetDimensionsMatGetOwnershipRange_DYNAMICMatAssemblyEndEPSGetTolerancesPETSC_COMM_WORLDPetscTrMallocEPSSetFromOptions_initEPSSolve__deregister_frame_infoEPSGetSolutionEPSGetTypeMatDestroyEPSComputeError_finiEPSGetConvergedMatSetValuesPetscTrFreeMatAssemblyBegin_GLOBAL_OFFSET_TABLE_SlepcFinalizeEPSSetOperatorsEPSCreate__register_frame_infoSlepcInitialize__gmon_start__pdnaupd_s_cmps_wsfee_wsfedo_fiopdsaupd_pdneupd_s_copydlapy2_dcopy_dlaset_dlahqr_dlacpy_dscal_dtrevc_dnrm2_dgemv_dtrmm_dger_dswap_pdseupd_dlamch_lsame_ddot_dlabad_dlascl_daxpy_dlanhs_dlartg_dlarfg_dlarf_dlanv2_drot_xerbla_libpetscsles.sodlasr_PetscOptionsGetIntdgeqr2_dlasrt_powdorm2r_PetscPrintflibpetscdm.soMatCreateMatSetFromOptionslibpetscmat.sompipriv_libpetscvec.solibpetsc.solibX11.so.6libstdc++.so.5d_lg10pow_dds_catdlassq_logcopysignbi_f77_get_constants_mpi_null_copy_fn_mpi_null_delete_fn_mpi_dup_fn_mpi_comm_null_copy_fn_mpi_comm_null_delete_fn_mpi_comm_dup_fn_bi_f77_init_dlange_sqrtdlaln2_dasum_idamax_dlarfx_libpthread.so.0libfmpi.sompi_comm_dup_fn__mpi_dup_fn__mpi_comm_rank__mpi_init_mpi_comm_null_delete_fn__mpi_allreduce__mpi_null_copy_fn__mpi_comm_null_copy_fn__mpi_null_delete_fn__libmpi.solibCEPCF90.so.3libPEPCF90.so.3etime_libintrins.so.3__dso_handlelibF90.so.3log10f_powrrf_powddlibdl.so.2libg2c.so.0do_lioe_wslesecond_G77_second_0s_wslelibm.so.6libcxa.so.3libc.so.6__cxa_finalize_IO_stdin_used__libc_start_main_etext_edata__bss_start_end/home/jroman/soft/slepc/slepc-dev/lib/libO/linux_intel:/usr/local/soft/petsc/2.1.6/lib/libO/linux_intel:/opt/intel/compiler70/ia32/lib___get_intrinsicsGLIBC_2.1.3GLIBC_2.0ësi Ýii
éüt!u0urux u"$u$(uU s¤s¨s¬s°s´s¸s¼sÀs Äs Ès Ìs
ÐsÔsØsÜsàsäsèsìsðsôsøsüstt t# t%t't(t)t+ t-$t.(t0,t10t24t38t5<t6@t9Dt:Ht;Lt?Pt@TtAXtB\tC`tDdtGhtIltJptMttNxtO|tQ€tS„tTˆtVŒtWtX”t\˜t^œt_ t`¤ta¨tb¬td°te´tf¸tg¼tjÀtkÄtlÈtmÌtnÐtoÔtpØtqÜtràtsättètuìtvU‰åƒì聐èŸèƄÉÃÿ5˜sÿ%œsÿ% shéàÿÿÿÿ%¤shéÐÿÿÿÿ%¨shéÀÿÿÿÿ%¬shé°ÿÿÿÿ%°sh é ÿÿÿÿ%´sh(éÿÿÿÿ%¸sh0é€ÿÿÿÿ%¼sh8épÿÿÿÿ%Àsh@é`ÿÿÿÿ%ÄshHéPÿÿÿÿ%ÈshPé@ÿÿÿÿ%ÌshXé0ÿÿÿÿ%Ðsh`é ÿÿÿÿ%Ôshhéÿÿÿÿ%Øshpéÿÿÿÿ%Üshxéðþÿÿÿ%àsh€éàþÿÿÿ%äshˆéÐþÿÿÿ%èshéÀþÿÿÿ%ìsh˜é°þÿÿÿ%ðsh é þÿÿÿ%ôsh¨éþÿÿÿ%øsh°é€þÿÿÿ%üsh¸épþÿÿÿ%thÀé`þÿÿÿ%thÈéPþÿÿÿ%thÐé@þÿÿÿ% thØé0þÿÿÿ%thàé þÿÿÿ%thèéþÿÿÿ%thðéþÿÿÿ%thøéðýÿÿÿ% théàýÿÿÿ%$théÐýÿÿÿ%(théÀýÿÿÿ%,thé°ýÿÿÿ%0th é ýÿÿÿ%4th(éýÿÿÿ%8th0é€ýÿÿÿ%<th8épýÿÿÿ%@th@é`ýÿÿÿ%DthHéPýÿÿÿ%HthPé@ýÿÿÿ%LthXé0ýÿÿÿ%Pth`é ýÿÿÿ%Tthhéýÿÿÿ%Xthpéýÿÿÿ%\thxéðüÿÿÿ%`th€éàüÿÿÿ%dthˆéÐüÿÿÿ%hthéÀüÿÿÿ%lth˜é°üÿÿÿ%pth é üÿÿÿ%tth¨éüÿÿÿ%xth°é€üÿÿÿ%|th¸épüÿÿÿ%€thÀé`üÿÿÿ%„thÈéPüÿÿÿ%ˆthÐé@üÿÿÿ%ŒthØé0üÿÿÿ%thàé üÿÿÿ%”thèéüÿÿÿ%˜thðéüÿÿÿ%œthøéðûÿÿÿ% théàûÿÿÿ%¤théÐûÿÿÿ%¨théÀûÿÿÿ%¬thé°ûÿÿÿ%°th é ûÿÿÿ%´th(éûÿÿÿ%¸th0é€ûÿÿÿ%¼th8épûÿÿÿ%Àth@é`ûÿÿÿ%ÄthHéPûÿÿÿ%ÈthPé@ûÿÿÿ%ÌthXé0ûÿÿÿ%Ðth`é ûÿÿÿ%Ôthhéûÿÿÿ%Øthpéûÿÿÿ%Üthxéðúÿÿÿ%àth€éàúÿÿÿ%äthˆéÐúÿÿÿ%èthéÀúÿÿÿ%ìth˜é°úÿÿ1í^‰áƒäðPTRh h—QVhȝèoýÿÿôU‰åSPè[ÃæÖ‹ƒt…ÀtÿЋ]üÉАU‰åV‰]üè[ÃÀ֍ƒp‹…Àt ƒÄøƒ\‹‰$ƒ˜‰D$è,ÿÿÿƒÄ‹]üÉÃU‰åV‰]üè[Ã|֍ƒl‹…ÀtWƒ\‹‰$è$üÿÿY‹]üÉÉöU‰å‹E‰ÂƒÂ‰U‹@ƒøÿuë%‹E‰ÂƒÂ‰U‹@ƒøÿt‹E‹…Àtä‹E‹ÿÐëÛÉÐU‰åV‰]üè[ÃÖWƒh‹‹‰$èæüÿÿYWƒ`‹‰$èˆÿÿÿYèJÿÿÿ‹]üÉÐS‹ÜƒäøWVUìŒPP®$X
€P®$XXÇD$ Ch€PS jRPèZþÿÿT$03ÀPRhäRPè‡ùÿÿƒÄ …À… ÿt$ hœRÿ5 uè˜ýÿÿƒÄ …À…¹
‹T$ L$$Q¸ÿÿÿÿRRPPÿ5 uèPúÿÿƒÄ…À…f
ÿt$$èÜûÿÿY…À…)
D$,T$(RPÿt$,èpùÿÿƒÄ …À…à ‹L$,ò¨Qò5 QòT$0òt$8òT$@¾º…ɽ¸yt‹ò‹T$(;T$ t‹èƒþ‹ÁEÇEÏë
‹D$H‹T$(ƒÀ‹ÈzÿƒýE×;Â}D‰L$H‰D$P|$HL$LPÿ‰T$LƒÀº‰D$TD$0RPQjWRÿt$<èhûÿÿƒÄ…À…ò뢅íu‰L$HëB‹D$ T$HL$Ll$0xÿƒÀþ‰|$H‰D$L‰|$P¸PUQjRPÿt$<èûÿÿƒÄ…À…¯…ötVò= Qò5¨Qò|$0òt$8T$H3ö¸‰t$H‰t$L‰D$PL$Ll$0PUQjRPÿt$<èÀúÿÿƒÄ…À…ujÿt$(èêúÿÿƒÄ…À…jÿt$(èDøÿÿƒÄ…À…ӍD$XPÿ5 uèÉûÿÿƒÄ…À…jÿt$(ÿt$`èïúÿÿƒÄ …À…Hÿt$Xè«øÿÿY…À… D$\Pÿt$\è´øÿÿƒÄ…À…Çÿt$\hpRÿ5 uè5ûÿÿƒÄ …À…}D$`Pÿt$\èÜøÿÿƒÄ…À…9ÿt$`hXRÿ5 uèýúÿÿƒÄ …À…ïD$djPÿt$`èâöÿÿƒÄ …À…©ÿt$dh0Rÿ5 uèÃúÿÿƒÄ …À…_D$lT$hRPÿt$`è•÷ÿÿƒÄ …À…‹ uòt$l‹D$hòt$‰$ÇD$R‰D$èpúÿÿ…À…¹D$tPÿt$\è
ùÿÿƒÄ…À…uÿt$thÜQÿ5 uè;úÿÿƒÄ …À…+‹D$t…ÀŽ]„$€T$|L$xQRPÿt$dè©÷ÿÿƒÄ…À…΋D$t”$„RÀÀhÐRÀhÈRhÀRjuPÿ$uƒÄ…À…nÿ´$„ÿt$\è øÿÿƒÄ…À…(h Pÿ5 uèžùÿÿƒÄ…À…â‹D$tÇD$H3҅À~s‹L$|òÑf/˜Q„F‹- u‹Œ$€‹”$„ò4òt$òD$ò‚òD$‰,$ÇD$´Qè'ùÿÿ…À…ЋT$HƒÂ;T$t‰T$H|h°Qÿ5 uèþøÿÿƒÄ…À…vhÐRhÈRhÀRh‡ÿ´$”ÿ(uƒÄ…À…ÿt$Xè~ôÿÿY…À…Üÿt$$èÜöÿÿY…À…œèî÷ÿÿ…Àue3ÀÄŒ]^_‹ã[ÃhàRjPhÐRhÈRhÀRj+èMôÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRj3è"ôÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRhèôóÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRhŽèÆóÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRhè˜óÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRh‡èjóÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRh†è<óÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRhèóÿÿÄ¨]^_‹ã[Ë- u‹Œ$€‹”$„ò4ò‚òt$òD$‰,$ÇD$ÈQèçöÿÿ…À„ÀýÿÿhàRjPhÐRhÈRhÀRh„èžòÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRj}èsòÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRjvèHòÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRjuèòÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRjpèòñÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRjièÇñÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRjgèœñÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRj]èqñÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRj[èFñÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRjZèñÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRjXèððÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRjWèÅðÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRjVèšðÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRjRèoðÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRjPèDðÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRjJèðÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRjEèîïÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRj@èÃïÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRj7è˜ïÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRj6èmïÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRj/èBïÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRj%èïÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRj#èìîÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRj"èÁîÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRjè–îÿÿÄ¨]^_‹ã[ÃhàRjPhÐRhÈRhÀRjèkîÿÿÄ¨]^_‹ã[АU‰åWVSƒì ‹](‹}4‹u8‹E ƒ8…Îèqփì hDuèÈ­¡¨}£„uÇEð‹£hu‹G£ˆuÇŒuÇlu‹G£€uƒÄ‹Uƒ: ÇEðÿÿÿÿéP‹Eƒ8 ÇEðþÿÿÿé<‹U‹@9 ÇEðýÿÿÿé&ƒ=ˆu ÇEðüÿÿÿéjjh`ÿuè݃Ä…À„jjhbÿuèå܃Ä…ÀtijjhdÿuèÍ܃Ä…ÀtQjjhfÿuèµÜƒÄ…Àt9jjhhÿuèÜƒÄ…Àt!jjhjÿuè…܃Ä…Àt ÇEðûÿÿÿët‹E€8It€8Gt ÇEðúÿÿÿë^‹‰Â¯ÐR@B‹UD9} ÇEðùÿÿÿë>¡€uHƒøv ÇEðöÿÿÿë*ƒ=€uu‹U€:Gu ÇEðõÿÿÿëƒ=huvÇEðôÿÿÿƒ}ðt‹Eð‹UH‰‹E Çcé°ƒ=Œu
ÇŒu‹U ÝÙîÚéßàöÄuƒìjhlÿuè°0‹U ݃ċ‹U+£˜u‹£u‹‰Â¯ÐR@¹TBÿ…Òx‹E@ÇDÈøÇDÈüAJyì‹£tu‹‰xuÇ`u¯@£ u£œu£\u£du¯‰pu‹ƒÀ¯У”u‰F ¡`u‰F¡ u‰F¡œu‰F¡\u‰F¡pu‰F4jjÿuHÿu<V‹U@¡puDÂøPhxu¡duDÂøP¡\uDÂøP¡œuDÂøP¡ uDÂøPhtu¡`uDÂøPÿu0ÿu,hˆuhhuhluh€uÿu$ÿu h˜uhuÿuÿuÿuÿu ÿuèÞJƒÄp‹E ƒ8u¡˜u‰G‹U ƒ:c…¡ˆu‰G¡˜u‰G¡ ~‰G ¡$~‰G$¡(~‰G(‹EHƒ8ˆÎƒ8uǃ=„uŽÙƒìj)h€h„}hˆuh¤h€}ÿuèq0ƒÄj0hÀh„}h˜uh¤h€}ÿuèK0ƒÄj*hh„}¡ u‹U@DÂøPh˜uh€}ÿuèi7ƒÄj/h@h„}¡œu‹U@DÂøPh˜uh€}ÿuè;7ƒÄj!h€h„}¡\u‹U@DÂøPh˜uh€}ÿuè
7ƒÄ ƒì hHuè)©ÙHuØ%DuÙP~ƒÄƒ=„uŽ®ƒìEðPEìPÿuè¨êÿÿƒÄƒ}ì…Žƒì h8SèÞíÿÿèêÿÿÇ$LSèÍíÿÿƒÄ jhˆuh¤èYëÿÿƒÄ jh ~h¤èEëÿÿƒÄ jh$~h¤è1ëÿÿƒÄ jh(~h¤èëÿÿƒÄ jh,~h¤è ëÿÿƒÄ jh0~h¤èõêÿÿƒÄ jhˆ~h¤èáêÿÿƒÄ jhŒ~h¤èÍêÿÿƒÄ jhP~h¤è¹êÿÿƒÄ jhT~h¤è¥êÿÿƒÄ jhX~h¤è‘êÿÿƒÄ jh”~h¤è}êÿÿƒÄ jh~h¤èiêÿÿƒÄ jh\~h¤èUêÿÿƒÄ jh`~h¤èAêÿÿƒÄ jhd~h¤è-êÿÿƒÄ jhh~h¤èêÿÿƒÄ jh˜~h¤èêÿÿè èÿÿƒÄeô[^_ÉÐU‰åWVSƒì ‹}‹](‹u4‹E ƒ8…ÑèyЃì h¤uè §¡Œ}£àuÇÀu‹£Ìu‹F£äuÇìuÇÐu‹F£èuƒÄ‹Uƒ: ÇÀuÿÿÿÿë!ƒ? ÇÀuþÿÿÿë‹;
ÇÀuýÿÿÿ‹+£øuƒ=äu
ÇÀuüÿÿÿjjhÀÿuèXփÄ…ÀtjjjhÂÿuè@փÄ…ÀtRjjhÄÿuè(փÄ…Àt:jjhÆÿuèփÄ…Àt"jjhÈÿuèøՃÄ…Àt
ÇÀuûÿÿÿ‹E€8It€8Gt
ÇÀuúÿÿÿ‹‰Â¯Ð‹UD9}
ÇÀuùÿÿÿ¡èuHƒøv ÇÀuöÿÿÿëYƒ=èuu‹U€:Gu ÇÀuõÿÿÿë<ƒ=Ìuv ÇÀuôÿÿÿë'ƒ?u"jjhÈÿuèVՃÄ…Àu
ÇÀuóÿÿÿƒ=Àut¡Àu‹UH‰‹E ÇcéTƒ=ìu
Çìu‹U ÝÙîÚéßàöÄuƒìjhÊÿuèï)‹U ݃ċ+£øu‹£ðu‹‰Â¯Ð¹TÂÿ…Òx‹E@ÇDÈøÇDÈüAJyì‹£Øu‹‰ÜuÇÄuD£üu£¼u£Èu‹¯Ò‰Ôu‹@Уôu‹U8‰B ¡Äu‰B¡üu‰B¡¼u‰B¡Ôu‰B(ƒìjjÿuHÿu<ÿu8‹U@¡ÔuDÂøPhÜu¡ÈuDÂøP¡¼uDÂøP¡üuDÂøPhØu¡ÄuDÂøPÿu0ÿu,häuhÌuhÐuhèuÿu$ÿu høuhðuÿuÿuÿuÿu ÿuè¸ZƒÄp‹E ƒ8u¡øu‰F‹U ƒ:c…Á¡äu‰F¡øu‰F¡ ~‰F ¡$~‰F$¡(~‰F(‹EHƒ8ˆƒ8uǃ=àuŽ«ƒìj)hàh„}häuh¤h€}ÿuèË)ƒÄj)h h„}høuh¤h€}ÿuè¥)ƒÄjhIh„}¡üu‹U@DÂøPhøuh€}ÿuèÃ0ƒÄj"h€h„}¡¼u‹U@DÂøPhøuh€}ÿuè•0ƒÄ ƒì h¨uè±¢Ù¨uØ%¤uÙ4~ƒÄƒ=àuŽ›ƒìhÀuEðPÿuè/äÿÿƒÄƒ}ð…zƒì hYèeçÿÿè ãÿÿÇ$,YèTçÿÿƒÄ jhäuh¤èàäÿÿƒÄ jh ~h¤èÌäÿÿƒÄ jh$~h¤è¸äÿÿƒÄ jh(~h¤è¤äÿÿƒÄ jh,~h¤èäÿÿƒÄ jh0~h¤è|äÿÿƒÄ jhˆ~h¤èhäÿÿƒÄ jhŒ~h¤èTäÿÿƒÄ jh4~h¤è@äÿÿƒÄ jh8~h¤è,äÿÿƒÄ jh<~h¤èäÿÿƒÄ jh”~h¤èäÿÿƒÄ jh~h¤èðãÿÿƒÄ jh@~h¤èÜãÿÿƒÄ jhD~h¤èÈãÿÿƒÄ jhH~h¤è´ãÿÿƒÄ jhL~h¤è ãÿÿè;âÿÿƒÄeô[^_ÉÃU‰åWVSì0‹u4‹EX‹}\‹À}‰•4ÿÿÿ‹X‹@‰E˜‹MlÇjhÀÿuè†%hUUå?h`d$øÝ$èãÿÿݝÿÿÿÇEƒÄ ƒ}˜ ÇEòÿÿÿéF‹E8ƒ8 ÇEÿÿÿÿé2‹U@ƒ: ÇEþÿÿÿé‹M@‹@‹UL9 ÇEýÿÿÿéjjhÏÿu<èüσÄ…À„jjhÑÿu<èàσÄ…ÀtijjhÓÿu<èÈσÄ…ÀtQjjhÕÿu<è°ÏƒÄ…Àt9jjh×ÿu<è˜ÏƒÄ…Àt!jjhÙÿu<è€ÏƒÄ…Àt ÇEûÿÿÿëh€>It€>Gt ÇEúÿÿÿëU‹ML‹‰Â¯ÐR@B‹Uh9} ÇEùÿÿÿë2‹E€8At€8Pt€8St‹U ƒ:t ÇEóÿÿÿë‹M€9SuÇEôÿÿÿCÿƒøw jjhÛëCƒûu0‹E,ÝÙîÙÉÚéßà€äE€ô@u jjháëƒûu jjhçëƒûujjhíEØPèIσÄëÇEöÿÿÿƒûu €>GuÇEõÿÿÿƒ}t
‹E‹Ul‰éž‹O‰Pÿÿÿ‹_‹w‹G‰…Tÿÿÿ‹UL‹‰EŒ‹‰E”‹TÿÿÿMŒ‰HÿÿÿMŒ‰DÿÿÿMŒ‰LÿÿÿMŒ‰<ÿÿÿ‹EŒ¯ȉ…@ÿÿÿ‹…Hÿÿÿ‰G ‹•Dÿÿÿ‰W$‹Lÿÿÿ‰O(‹…<ÿÿÿ‰G,‹•@ÿÿÿ‰W0‹ML‹‰Â¯W4‰•0ÿÿÿ‰•,ÿÿÿЉ…(ÿÿÿ‹Md‹½Pÿÿÿ‹Dù‹Tù ‰…`ÿÿÿ‰•dÿÿÿÇDùÇDù ƒ½4ÿÿÿŽ„ƒìj7hh„}‹•0ÿÿÿDÑøPÿuLh€}ÿuè`+ƒÄj7h@h„}‹,ÿÿÿ‹}dDÏøPÿuLh€}ÿuè3+ƒÄj-h€h„}‹•(ÿÿÿD×øPÿuLh€}ÿuè +ƒÄ ‹M ƒ9„Ò Dž$ÿÿÿ¿‹EL‹Jx&‹Md‹…TÿÿÿøWÛ$d$Ý\Áð‹EÇD¸üGJy݋UL‹‹M@+‰E¤ÇE ƒìj‹UdÂPR‹½TÿÿÿÁçD:øP‹µ,ÿÿÿÁæD2øP‹0ÿÿÿÁãDøPE¤PQÿu<E PÿuèVPƒÄ0ƒ½4ÿÿÿ~xƒìj6hÀh„}‹UdDøPÿuLh€}ÿuè+*ƒÄj6h h„}‹MdD1øPÿuLh€}ÿuè*ƒÄj0h@ h„}‹UdD:øPÿuLh€}ÿuèÝ)ƒÄ ÇEœ¿‹ML‹Kˆá‹udƒì‹…,ÿÿÿ‹UL)øDÆøP‹…0ÿÿÿ)øDÆøPè¶Üÿÿ݅ÿÿÿƒÄÝáßàöÄtÝØëÝًMd‹…Tÿÿÿ‹UL)øÝDÁøÙ½^ÿÿÿf‹…^ÿÿÿ´ f‰…\ÿÿÿÙ­\ÿÿÿ۝XÿÿÿÙ­^ÿÿÿ‹•Xÿÿÿ‹E˜9Eœ}I‹…(ÿÿÿЉ…Üþÿÿ‹EDÜ‹…ÜþÿÿÝDÁðÙÉÚéßàöÄu#‹MÇD‘üÿEœ‹E@;~Dž$ÿÿÿëÝØGK‰"ÿÿÿƒ½4ÿÿÿ~Mƒìj'h€ h„}EœPh¤h€}ÿuèg!ƒÄj)hÀ h„}E˜Ph¤h€}ÿuèB!ƒÄ ‹Eœ;E˜t‹UlÇñÿÿÿ颃ì h¤‹µ<ÿÿÿÁæ‹UdD2øPh¤‹PÿÿÿDÊøP‹EŒ‹}L¯‰EԍEÔPè7ÜÿÿƒÄ jE”P‹@ÿÿÿÁã‹UdDøPhÐ$hÈ$WWhé è§ÝÿÿƒÄEPE”P‹Ud\øSWh¤‹DÿÿÿDÊøP‹½HÿÿÿDúøPEŒPt2øVÿuLh¤ÿuLh¤h¤èÕÛÿÿƒÄ4h¤‹Ud‹LÿÿÿDÊøPE”P‹…@ÿÿÿ‹}LDÂðPWè…ÛÿÿƒÄ ƒ}t‹ElÇøÿÿÿ雃½4ÿÿÿŽÇƒìj)h!h„}‹•Hÿÿÿ‹MdDÑøPÿuLh€}ÿuè4'ƒÄj.h@!h„}‹½Dÿÿÿ‹UdDúøPÿuLh€}ÿuè'ƒÄj+h€!h„}‹Lÿÿÿ‹}dDÏøPÿuLh€}ÿuèÚ&ƒÄ ƒ½4ÿÿÿ~4ƒì j*hÀ!h„}EŒP‹•<ÿÿÿD×øPÿuLÿuLh€}ÿuèÅ-ƒÄ0ƒ½$ÿÿÿ„;jjEPh¤EˆPÿuL‹Ud‹LÿÿÿDÊøPE€P…xÿÿÿPE˜P‹½DÿÿÿDúøP‹HÿÿÿDÊøPE”P‹½@ÿÿÿDúøPEŒP‹<ÿÿÿDÊøPÿuLÿuhê!hë!è£éƒÄPƒ}u‹}lÇé)
ƒ½4ÿÿÿŽƒìj4h"h„}‹•Hÿÿÿ‹MdDÑøPÿuLh€}ÿuèÂ%ƒÄj4h@"h„}‹½Dÿÿÿ‹UdDúøPÿuLh€}ÿuè•%ƒÄ ƒ½4ÿÿÿ~7ƒì j1h€"h„}E”P‹<ÿÿÿ‹}dDÏøPÿuLÿuLh€}ÿuè},ƒÄ0ƒì h¤‹Ud‹LÿÿÿDÊøPE”P‹…@ÿÿÿ‹}LDÂðPWè"ÙÿÿƒÄ jjhۍEØPèǃÄ…ÀuQƒì h¤ÿuh¤‹•Hÿÿÿ‹MdDÑøPE˜PèßØÿÿƒÄh¤ÿuh¤‹½Dÿÿÿ‹UdDúøPE˜Pè¸ØÿÿƒÄ ƒìEP‹ML‹‹U0ÂPRE”P‹@ÿÿÿÁã‹}dDøPE˜PQè2ØÿÿƒÄj jEP‹U8‹‹M`ÁPÿuTÿuPÿu0E”P\øSE˜PÿuLRh±"h¼"èÚÿÿƒÄ@jÿu$ÿu ÿuTÿuPE˜Pÿu8hé è Ùÿÿ¿ƒÄ ‹]˜Kx|‹Ed‰…ÿÿÿwÿ‰ð¯E”…@ÿÿÿø‹•ÿÿÿÝDÂðÙîÚéßàöÄEuIE”P‹…<ÿÿÿøDÂðPhØ$U˜RèÔÖÿÿh¤‰ð¯E”…<ÿÿÿ‹MdDÁøPhØ$E˜Pè­ÖÿÿƒÄ GKy‹U€:A…'¿‹ML‹Hx!;}˜
‹UÇDºüë ‹MÇD¹üGHyßjjEPÿu0…tÿÿÿPÿuLE”P‹Ud‹½@ÿÿÿDúøPh¤…hÿÿÿPE”P‹<ÿÿÿDÊøPÿuLÿuhÁ"h¼"èµØÿÿƒÄ@ƒ}t‹}lÇ÷ÿÿÿé
¾¿‹E˜H‰…ÿÿÿˆx‹Ud‰• ÿÿÿ‹…Dÿÿÿø‹ ÿÿÿÝDÁðÙîÙÉÚéßà€äE€ô@uVƒìh¤_ÿ‰Ø¯E”…@ÿÿÿDÁøPÿuLèåØÿÿh¤¯]”@ÿÿÿ‹Ed\ØøSÙèÞñÝ]ȍUÈRÿuLèkÕÿÿƒÄ éê…ö…݃ìh¤‰ø¯E”…@ÿÿÿ‹MdDÁøPÿuLè‡ØÿÿƒÄÝ]ÀEÀPƒìh¤_ÿ‰Ø¯E”…@ÿÿÿ‹UdDÂøPÿuLèVØÿÿƒÄÝ]¸M¸QèÕÿÿh¤¯]”@ÿÿÿ‹Ed\ØøSÜ=Ð$ݝàþÿÿ‹àþÿÿ‹µäþÿÿ‰]°‰u´U°RÿuLè¶ÔÿÿƒÄ h¤‰ø¯E”…@ÿÿÿ‹MdDÁøP‰]¨‰u¬E¨PÿuLèˆÔÿÿ¾ƒÄë¾Gÿÿÿÿ‰‘þÿÿjh¤ÿu0hÈ$h¤‹Ud‹LÿÿÿDÊøPE”P‹½@ÿÿÿDúøPhÐ$E˜PÿuLhÇ"èEÔÿÿ¾¿ƒÄ0‹]˜Kxz‹E0‰…ÿÿÿ‰…ÿÿÿ‹…Dÿÿÿø‹UdÝDÂðÙîÙÉÚéßà€äE€ü@tH…öu?ƒì‹•ÿÿÿúPƒèPèÚÓÿÿ‹ÿÿÿÝ\ùø‹ÿÿÿ‹Dùø‹Tùü‰ù‰Tù¾ƒÄë¾GKy•ƒ½4ÿÿÿ~pƒìj0hà"h„}‹½Lÿÿÿ‹UdDúøPÿuLh€}ÿuèR ƒÄ ƒ½4ÿÿÿ~7ƒì j$h #h„}E”P‹@ÿÿÿ‹}dDÏøPÿuLÿuLh€}ÿuè:'ƒÄ0ƒì h¤‹•Lÿÿÿ‹MdDÑøPh¤ÿu0E˜PèèÓÿÿƒÄEP‹}L‹‹U0ÂPRE”P‹@ÿÿÿÁã‹UdDøPE˜PWèeÓÿÿƒÄj jEP‹M8‹‹}`ÇPÿu$ÿu ÿu0E”P‹UdDøPE˜PÿuLQh±"h¼"è2ÕÿÿƒÄ<jj jjÿu$ÿu E”P‹Md\øShÐ$E˜Pÿu8hD#hL#hX#h¼"è ÒÿÿƒÄ@éŃì h¤ÿuh¤Áã‹}dDøPE˜PèÓÿÿƒÄh¤ÿuh¤ÁæD7øPE˜PèãÒÿÿƒÄh¤‹HÿÿÿDÏøPh¤\øSE˜Pè½ÒÿÿƒÄh¤‰ú‹½DÿÿÿDúøPh¤t2øVE˜Pè•ÒÿÿƒÄh¤‹Ud‹LÿÿÿDÊøPh¤‹½TÿÿÿDúøPE˜PèfÒÿÿƒÄ jjhۍEØPèYÀƒÄ…Àu6‹E ƒ8„kh¤‹•Lÿÿÿ‹MdDÑøP…`ÿÿÿPÿuLè,ÑÿÿƒÄéMjjháEØPè
ÀƒÄ…À…š‹} ƒ?t%h¤‹•Lÿÿÿ‹MdDÑøP…`ÿÿÿPÿuLèÝÐÿÿƒÄDž8ÿÿÿ‹}L‹Kˆ¡‹}d‰þƒì‹…Dÿÿÿ…8ÿÿÿDÇðP‹…Hÿÿÿ…8ÿÿÿDÇðPè¥Ðÿÿ‹…Lÿÿÿ…8ÿÿÿÝDÆðÙáØñÞñÝ\ÆðƒÄÿ…8ÿÿÿKxLë®jjhçEØPèS¿ƒÄ…Àu
‹UL‹Hx)Hx&ëûjjhíEØPè-¿ƒÄ…Àu ‹ML‹HxHyýjjháEØPè ¿ƒÄ…À…ŒÇ…8ÿÿÿ‹}L‹H‰…ÿÿÿˆŸ‹Ud‰•üþÿÿ‰×ƒì‹µDÿÿÿµ8ÿÿÿ‹üþÿÿDñðP‹Hÿÿÿ8ÿÿÿDÙðPè¿ÏÿÿÝDßðØñØñ‹E(ÜÝ\ßðÝD÷ðØñÞñ‹U,Ü*Ý\÷ðƒÄÿ…8ÿÿÿÿÿÿÿyë/jjhç]ØSè`¾ƒÄ…ÀtjjhíSèJ¾ƒÄ…ÀuNƒì h¤ÿuh¤‹Hÿÿÿ‹}dDÏøPE˜PèÐÿÿƒÄh¤ÿuh¤‹•DÿÿÿD×øPE˜PèðÏÿÿƒÄ jjháEØPè㽃Ä…Àupƒ½4ÿÿÿ~gƒìj4h`#h„}ÿuE˜Ph€}ÿu訃Äj4h #h„}ÿuE˜Ph€}ÿuè…ƒÄj4hà#h„}‹Lÿÿÿ‹}dDÏøéˆjjhۍEØPèZ½ƒÄ…À…€ƒ½4ÿÿÿ~wƒìj,h $h„}ÿuE˜Ph€}ÿuèƒÄj,h`$h„}ÿuE˜Ph€}ÿuèøƒÄj"h $h„}‹•Lÿÿÿ‹MdDÑøPE˜Ph€}ÿuèÊƒÄ ‹} ƒ?„è‹E€8A…ÜjjháEØP襼ƒÄ…À…¿¾¿‹U˜J‰•øþÿÿˆx‹Md‰ôþÿÿ‰ðþÿÿ‹E0‰…ìþÿÿ‰èþÿÿ‹…Dÿÿÿø‹•ôþÿÿÝDÂðÙîÙÉÚéßà€äE€ô@u4Gÿ¯E”…@ÿÿÿ‹UL‹•Hÿÿÿú‹ôþÿÿÝDÁðÜtÑð‹E0Ý\øøé÷…ö…êƒì‹µDÿÿÿþ‹•ðþÿÿDòðP‹HÿÿÿûDÚðPèôÌÿÿOÿ‰Ôþÿÿ‰È¯E”…@ÿÿÿ‰…Üþÿÿ‹EL‹‹•Üþÿÿʋ…èþÿÿÝDÐðÜLØð‰ø¯E”…@ÿÿÿȋ•èþÿÿÝDÂðÜLòðÞÁØñØñ‹ìþÿÿÝ\ùø‰ø¯E”…@ÿÿÿ‰…Üþÿÿ‹EL‹‹•Üþÿÿʋ…èþÿÿÝDÐðÜLØð‹•Ôþÿÿ¯U”•@ÿÿÿÊÝDÐðÜLððÞéØñÞñ‹•ìþÿÿÝú¾ƒÄë¾Gÿøþÿÿ‰¦þÿÿƒì ÿu$ÿu h¤ÿu0h¤ÿuHhÐ$E˜Pÿu8èæÎÿÿƒÄ0eô[^_ÉАU‰åWVSì¼‹}(‹EL‹uP‹¤}‰•xÿÿÿ‹X‹@‰E¸‹M`ǃ}¸„ˆÇE´ƒ}¸ÇE´òÿÿÿ‹E,ƒ8ÇE´ÿÿÿÿ‹U4ƒ:ÇE´þÿÿÿ‹M@‹‹U4;ÇE´ýÿÿÿjjh%ÿu0è=ºƒÄ…Àtgjjh%ÿu0è%ºƒÄ…ÀtOjjh%ÿu0è
ºƒÄ…Àt7jjh%ÿu0èõ¹ƒÄ…Àtjjh%ÿu0èݹƒÄ…ÀtÇE´ûÿÿÿ€?It €?GtÇE´úÿÿÿ‹M€9At€9Pt€9St‹E ƒ8tAÇE´ñÿÿÿ‹U ƒ:t2‹M€9SuÇE´ðÿÿÿ‹E ƒ8t‹U@‹‰Â¯Ð‹U\9}ÇE´ùÿÿÿCÿƒøw jjh
%ë.ƒûu jjh%ëƒûu jjh%ëƒûujjh%EØPè¹¹ƒÄëÇE´öÿÿÿƒûu €?GuÇE´õÿÿÿ‹M4ƒ9ujjh%ÿu0è㸃Ä…ÀuÇE´ôÿÿÿƒ}´t
‹E´‹]`‰é·
‹F‰E‹^‹V‰U”‹M@‹ ‰|ÿÿÿ‰M°ʉUˆʉUŒʉU„‰È‹U@¯E„‰E€‹‹M€A‰F ‹Eˆ‰F‹UŒ‰V ‹M„‰N$‹U@‹‹v(Ɖµtÿÿÿð‰…pÿÿÿƒìjh"%ÿuèA
hUUå?h`d$øÝ$èÓÊÿÿݝXÿÿÿ‹M‹EXÝDÈøݕ`ÿÿÿƒÄ €?IuÝ] ë Ý؀?Guh¤ÿuTÿu,ÿuèÚ
Ý] ƒÄƒ½xÿÿÿ~]ƒìj*h@%h„}‹•tÿÿÿ‹MXDÑøPÿu@h€}ÿu誃Äj-h€%h„}‹½pÿÿÿ‹UXDúøPÿu@h€}ÿuè}ƒÄ ‹M ƒ9„÷DžTÿÿÿ¹‹]@‹Jx#‹]X‹E”ÈQÛ$d$Ý\Ãð‹}ÇDüAJyà‹U@‹‹M4+‰EÄÇEÀƒìj‹UXÂPR‹u”ÁæD2øP‹tÿÿÿÁãDøPEÄPQÿu0EÀPÿuè¦LƒÄ0ƒ½xÿÿÿ~Nƒìj)hÀ%h„}‹}XDøPÿu@h€}ÿu賃Äj0h&h„}D7øPÿu@h€}ÿuèƒÄ ÇE¼¹‹E@‹0NˆÆ‹}XÙ}žf‹Ež´ f‰Eœ‹…tÿÿÿ‹U@)ȋTÇü‹DÇø‰…@ÿÿÿ‰•Dÿÿÿ݅@ÿÿÿÙá݅XÿÿÿÝáßàöÄtÝØëÝً]X‹E”‹U@)ÈÝDÃøÙmœÛ]˜Ùmž‹U˜‹E¸9E¼}I‹…pÿÿÿЉ…<ÿÿÿ‹E8Ü‹…<ÿÿÿÝDÃðÙÉÚéßàöÄu#‹]ÇD“üÿE¼‹E4;~DžTÿÿÿëÝØAN‰Jÿÿÿƒ½xÿÿÿ~Mƒìj'h@&h„}E¼Ph¤h€}ÿuè4 ƒÄj)h€&h„}E¸Ph¤h€}ÿuè ƒÄ ‹E¼;E¸t‹U`Çïÿÿÿé?
ƒì h¤‹uŒÁæ‹UXD2øPh¤‹MÊP‹]@‹H‰EԍEÔPèÇÿÿƒÄh¤‹]ˆÁã‹UXDøPh¤‹E…|ÿÿÿDÂøPÿu@èÝÆÿÿƒÄjE´P‹UX‹}€DúøPE°P‹M„DÊøPt2øV\øSÿu@h©&èÒÀƒÄ0ƒ}´t‹]`ÇøÿÿÿéŒ ƒ½xÿÿÿ~ƒì h¤‹]€Áã‹UXDøPE°P‹E„‹}@DÂðPWèYÆÿÿƒÄj-hÀ&h„}‹Uˆ‹MXDÑøPWh€}ÿuè1ƒÄj0h'h„}‹}X\øSÿu@h€}ÿuè
ƒÄ ƒ½Tÿÿÿ„,Džlÿÿÿ‹E@‹8ƒÿ„‹•lÿÿÿ‹Mƒ|‘üt B‰•lÿÿÿéì‹]ƒ|»üuOé܋MX‹uˆµlÿÿÿ‹Dñð‹Tñô‰E¨‰U¬‹]ˆû‹DÙð‹TÙô‰Dñð‰Tñô‹E¨‹U¬‰DÙð‰TÙôƒì h¤‹u€ÁæD1øPh¤‹lÿÿÿK‰Ø‹U@¯E„DÁøPRèDÅÿÿƒÄh¤‹M@¯]„‹UX\ÚøSh¤_ÿ‰Ø¯E„DÂøPQèÅÿÿƒÄh¤‰Ø‹}@¯E„‹UXDÂøPh¤t2øVWèåÄÿÿÿ…lÿÿÿ‰ßƒÄ 9½lÿÿÿŒìþÿÿƒ½xÿÿÿ~-ƒìj'h@'h„}‹Uˆ‹MXDÑøPÿu@h€}ÿuè›ƒÄ ƒì h¤ÿuh¤‹]ˆ‹}XDßøPE¸PëDƒì h¤ÿuh¤Áã‹UXDøPE¸PèSÄÿÿƒÄh¤‹UX‹MˆDÊøPh¤\øSÿu@è.ÄÿÿƒÄ jjh
%EØPè!²ƒÄ…ÀuJ‹] ƒ;tjE°P‹}„‹UXDúø驃ì h¤‹EX‹MŒTÈøRh¤‹]”DØøPÿu@èÍÃÿÿéƒì h¤‹UX‹}€DúøPh¤‹MˆDÊøPÿu@è ÃÿÿƒÄ jjh%EØP蓱ƒÄ…Àu4¾‹]@‹JˆÃ‹MXÙè‹EˆðÙÀÜtÁð‹}$ÜÝ\ÁðFJˆœëâjjh%EØPèF±ƒÄ…Àu2¾‹E@‹Ixz‹UXÙè‹Eˆð‹]$ÝÜLÂðÝDÂðØâÞùÝ\ÂðFIxUëàjjh%EØPèû°ƒÄ…Àu<¾‹}@‹Jx/‹MXÙè‹EˆðÝDÁðÙÀØ‹]$Ü ÙÉØâÞùÝ\ÁðFJyàÝØëÝØëÝ؃ì h¤ÿuh¤‹]ˆÁã‹}XDøPE¸Pè‰ÂÿÿƒÄj‹M€DÏøP\øSE¸Ph¤h%èئƒÄ ‹] ƒ;t%jE°P‹U„D×øPÿu@ÿuE¸PSh%è¬ësƒì h¤‹]ŒÁã‹UXDøPh¤‹M”DÊøPÿu@è ÂÿÿƒÄ h¤‹}XDøP݅`ÿÿÿÜ} Ý]ȍEÈPÿu@èñÀÿÿƒÄj\øSÿuE¸Ph¤h%è5¦ƒÄ ‹E ƒ8„D‹U€:A…8ƒìE´P‹UX‹MŒDÊøP‹E€‹]@DÂøPE°P‹]„ÁãDøPE¸Pÿu@èÁÿÿƒÄj jE´P‹},‹‹UTÂPÿuHÿuD‹E€‹M@‹UXDÂøPE°P\øSE¸PQWhg'hr'èáÂÿÿƒÄ@jÿu ÿuÿuHÿuDE¸PWhw'èÂÿÿ¹ƒÄ ‹]@‹ƒêx‹]X‹EŒÈÇDÃðÇDÃôAJyç‹UX‹EŒ‹}@ÇDÂðÇDÂôð?ƒìj jE´PE¨PW‹MŒDÊøP‹E€DÂøPE°P‹]„DÚøPE¸Ph¤Whz'hƒ'è1ÂÿÿƒÄ@jjh
%EØPèd®ƒÄ…Àu;‹} ƒ?t3¹‹E@‹Jˆc‹]X‹EŒÈÝDÃðÙá܍`ÿÿÿÝ\ÃðAJˆCëájjh
%]ØS讃ąÀ„$‹U ƒ:„h¤‹MŒ‹}XDÏøPE Pÿu@èå¾ÿÿjjh%SèέƒÄ …Àu9¾‹E@‹KˆÕ‰ù‹UŒòÝDÑðÙá‹E€ðÝDÁðØÈÞùÝ\ÑðFKˆ¯ëÚjjh%EØPè|­ƒÄ…Àu?¾‹U@‹Kˆƒ‹MXÙè‹UŒòÝDÑðÙá‹}$Ü‹E€ðÝDÁðØâØÈÞùÝ\ÑðFKxUë×jjh%EØPè$­ƒÄ…Àu<¾‹E@‹Kx/‹MXÙè‹UŒò‹E€ðÝDÑðÜtÁðÝDÁðØâÞÉÙáÝ\ÑðFKyÜÝØëÝØjjh
%EØPèϬƒÄ…ÀtKƒ½xÿÿÿŽ˜ƒìj+h 'h„}ÿuE¸Ph€}ÿuè
ƒÄj7hà'h„}‹UŒ‹MXDÑøëEƒ½xÿÿÿ~Qƒìjh(h„}ÿuE¸Ph€}ÿuèI
ƒÄj!h@(h„}‹]Œ‹}XDßøPE¸Ph€}ÿuè
ƒÄ ‹E ƒ8„¾jjh%]ØS謃ąÀtjjh%Sè遲Ä…Àu7¾‹]¸Kˆ€‹MX‹U€ò‰ð¯E°E„‹}@ÝDÁðÜtÑøÝ\ÑøFKxZëۋE ƒ8tPjjh%EØP藫ƒÄ…Àu7¾‹]¸Kx,‹MXÙè‹U€ò‰ð¯E°E„‹}@ÝDÑøØáÜ|ÁðÝ\ÑøFKyÛÝØjjh
%EØPèG«ƒÄ…Àt5ƒì ÿu ÿuh¤‹U€‹MXDÑøPh¤ÿu<hÐ$E¸Pÿu,è¿ÿÿƒÄ0eô[^_ÉАU‰åVSƒì(‹u‹] jSèR¿ÿÿÝ]àjjhp(Sèð¿ÿÿƒÄ …ÀuBjjhq(SèÚ¿ÿÿƒÄ…Àu,jjhr(SèÄ¿ÿÿƒÄ…Àujjhs(S访ÿÿƒÄ…ÀtƒìEôPVhx(ë9jjht(S艿ÿÿƒÄ…Àujjhu(Sès¿ÿÿƒÄ…Àt)ƒìEôPVh€(h|(h¤EèPEàPèè¾ÿÿƒÄ ë ‹Eà‹Uä‰Eè‰UìÝEèeø[^ÉÐU‰åSƒì(‹]ÿuÿuÿu èT¾ÿÿÝ]؋E؋U܉Eà‰UäƒÄ EôPShx(h|(h¤EèPEàP聾ÿÿƒÄ ÙîÝEèÝéßà€äE€ô@uÝ]ØëRÝØÝEØÜuèh@jd$øÝ$è=¼ÿÿƒÄ Ý]àEôPSh„(h|(h¤EØPEàPè&¾ÿÿÝEØÙáÙúÜMèÝ]ØƒÄ ÝE؋]üÉАU‰åWVSƒÄ€E”PEPÿuè»ÿÿƒÄƒ}…‹E ‰E„ƒøP~ÇE„P¾‹]„Kx}˜jjhˆ(D>ÿP蛩ƒÄFKyæ‹E„@‰Ã÷ӉƃÃQx}˜jjh‰(D>ÿPèo©ƒÄFKyæ‹U ‹£Ü^ƒì hØ^èÙ½ÿÿƒÄ ÿu ÿuh¤èf»ÿÿƒÄ ÿu„E˜Ph¤èR»ÿÿèí¹ÿÿƒÄ‹Mƒ9Žd‹U‹…Àu¸‹Mƒ9‰‹÷؃ø¿‹E‹8ƒÇ ¸gfff÷ïÁú‰øÁø‰×)ÇÇEŒOˆõ‹UŒƒÂ ‹M‹‰Eˆ9Ð~‰Uˆ‹U ‹£_ƒì hü^è"½ÿÿƒÄ jMŒQh¤诺ÿÿƒÄ jEˆPh¤蜺ÿÿ‹EŒ‹Uˆ‰ÆƒÄ‰Ó)Ãxƒìj‹UD²üPh¤ètºÿÿƒÄFKyâè¹ÿÿƒEŒ
OˆdéjÿÿÿƒøÁ‹M‹9ƒÇ¸“$I’÷ï:‰ÁÁù‰ø™‰Ï)×ÇEŒOˆ*‹UŒƒÂ‹M‹9Ð~‰Ð‰Eˆ‹U ‹£_ƒì h_èX¼ÿÿƒÄ jMŒQh¤èå¹ÿÿƒÄ jEˆPh¤èÒ¹ÿÿ‹EŒ‹Uˆ‰ÆƒÄ‰Ó)Ãxƒìj‹UD²üPh¤誹ÿÿƒÄFKyâè>¸ÿÿƒEŒOˆšékÿÿÿƒø
½‹M‹9ƒÇ¸gfff÷ïÑú‰øÁø‰×)ÇÇEŒOˆd‹UŒƒÂ‹M‹9Ð~‰Ð‰Eˆ‹U ‹£(_ƒì h$_蒻ÿÿƒÄ jMŒQh¤è¹ÿÿƒÄ jEˆPh¤è ¹ÿÿ‹EŒ‹Uˆ‰ÆƒÄ‰Ó)Ãxƒìj‹UD²üPh¤èä¸ÿÿƒÄFKyâèx·ÿÿƒEŒOˆÔékÿÿÿ‹M‹9ƒÇ¸VUUU÷ï‰ùÁù‰×)ÏÇEŒOˆ©‹UŒƒÂ‹M‹9Ð~‰Ð‰Eˆ‹U ‹£<_ƒì h8_è׺ÿÿƒÄ jMŒQh¤èd¸ÿÿƒÄ jEˆPh¤èQ¸ÿÿ‹EŒ‹Uˆ‰ÆƒÄ‰Ó)Ãxƒìj‹UD²üPh¤è)¸ÿÿƒÄFKyâ轶ÿÿƒEŒOˆékÿÿÿƒø¾‹M‹9ƒÇ¸gfff÷ïÁú‰øÁø‰×)ÇÇEŒOˆâ‹UŒƒÂ‹M‹9Ð~‰Ð‰Eˆ‹U ‹£P_ƒì hL_èºÿÿƒÄ jMŒQh¤蝷ÿÿƒÄ jEˆPh¤芷ÿÿ‹EŒ‹Uˆ‰ÆƒÄ‰Ó)Ãxƒìj‹UD²üPh¤èb·ÿÿƒÄFKyâèöµÿÿƒEŒOˆRékÿÿÿƒøÁ‹M‹9ƒÇ¸‰ˆˆˆ÷ï:‰ÁÁù‰ø™‰Ï)×ÇEŒOˆ‹UŒƒÂ‹M‹9Ð~‰Ð‰Eˆ‹U ‹£d_ƒì h`_èF¹ÿÿƒÄ jMŒQh¤èÓ¶ÿÿƒÄ jEˆPh¤èÀ¶ÿÿ‹EŒ‹Uˆ‰ÆƒÄ‰Ó)Ãxƒìj‹UD²üPh¤蘶ÿÿƒÄFKyâè,µÿÿƒEŒOˆˆékÿÿÿƒø
¾‹M‹9ƒÇ ¸gfff÷ïÁú‰øÁø‰×)ÇÇEŒOˆQ‹UŒƒÂ ‹M‹9Ð~‰Ð‰Eˆ‹U ‹£x_ƒì ht_è¸ÿÿƒÄ jMŒQh¤è ¶ÿÿƒÄ jEˆPh¤èùµÿÿ‹EŒ‹Uˆ‰ÆƒÄ‰Ó)Ãxƒìj‹UD²üPh¤èѵÿÿƒÄFKyâèe´ÿÿƒEŒ
OˆÁékÿÿÿ‹M‹9ƒÇ¸“$I’÷ï:‰ÁÁù‰ø™‰Ï)×ÇEŒOˆ‹UŒƒÂ‹M‹9Ð~‰Ð‰Eˆ‹U ‹£Œ_ƒì hˆ_è¾·ÿÿƒÄ jMŒQh¤èKµÿÿƒÄ jEˆPh¤è8µÿÿ‹EŒ‹Uˆ‰ÆƒÄ‰Ó)Ãxƒìj‹UD²üPh¤èµÿÿƒÄFKyâ褳ÿÿƒEŒO‰pÿÿÿ‹M ‹£ _ƒì hœ_èB·ÿÿè}³ÿÿƒÄeô[^_ÉАU‰åWVSƒÄ€E”PEPÿuèdzÿÿƒÄƒ}…ú‹E ‰E„ƒøP~ÇE„P¾‹]„Kx}˜jjh(D>ÿPèO¢ƒÄFKyæ‹E„@‰Ã÷ӉƃÃQx}˜jjh‘(D>ÿPè#¢ƒÄFKyæ‹U ‹£|`ƒì hx`荶ÿÿƒÄ ÿu ÿuh¤è´ÿÿƒÄ ÿu„E˜Ph¤è´ÿÿ衲ÿÿƒÄ‹Mƒ9ŽB‹U‹…Àu¸‹Mƒ9‰‹÷؃ø¾