| /* |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #if !defined(__SLEPCVERSION_H) |
| #define __SLEPCVERSION_H |
| /* ========================================================================== */ |
| /* |
| Current SLEPC version number and release date |
| */ |
| #define SLEPC_VERSION_RELEASE 1 |
| #define SLEPC_VERSION_MAJOR 3 |
| #define SLEPC_VERSION_MINOR 0 |
| #define SLEPC_VERSION_SUBMINOR 0 |
| #define SLEPC_VERSION_PATCH 6 |
| #define SLEPC_VERSION_DATE "February 3, 2009" |
| #define SLEPC_VERSION_PATCH_DATE "September 21, 2009" |
| #define SLEPC_AUTHOR_INFO " The SLEPc Team\n\ |
| slepc-maint@grycap.upv.es\n\ |
| http://www.grycap.upv.es/slepc\n" |
| #define SLEPC_VERSION_(MAJOR,MINOR,SUBMINOR) \ |
| ((SLEPC_VERSION_MAJOR == (MAJOR)) && \ |
| (SLEPC_VERSION_MINOR == (MINOR)) && \ |
| (SLEPC_VERSION_SUBMINOR == (SUBMINOR)) && \ |
| (SLEPC_VERSION_RELEASE == 1)) |
| #endif |
| /* |
| Spectral transformation module for eigenvalue problems. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #if !defined(__SLEPCST_H) |
| #define __SLEPCST_H |
| #include "petscksp.h" |
| PETSC_EXTERN_CXX_BEGIN |
| extern PetscCookie ST_COOKIE; |
| /*S |
| ST - Abstract SLEPc object that manages spectral transformations. |
| This object is accessed only in advanced applications. |
| Level: beginner |
| .seealso: STCreate(), EPS |
| S*/ |
| typedef struct _p_ST* ST; |
| /*E |
| STType - String with the name of a SLEPc spectral transformation |
| Level: beginner |
| .seealso: STSetType(), ST |
| E*/ |
| #define STType char* |
| #define STSHELL "shell" |
| #define STSHIFT "shift" |
| #define STSINV "sinvert" |
| #define STCAYLEY "cayley" |
| #define STFOLD "fold" |
| EXTERN PetscErrorCode STCreate(MPI_Comm,ST*); |
| EXTERN PetscErrorCode STDestroy(ST); |
| EXTERN PetscErrorCode STSetType(ST,const STType); |
| EXTERN PetscErrorCode STGetType(ST,const STType*); |
| EXTERN PetscErrorCode STSetOperators(ST,Mat,Mat); |
| EXTERN PetscErrorCode STGetOperators(ST,Mat*,Mat*); |
| EXTERN PetscErrorCode STSetUp(ST); |
| EXTERN PetscErrorCode STSetFromOptions(ST); |
| EXTERN PetscErrorCode STView(ST,PetscViewer); |
| EXTERN PetscErrorCode STApply(ST,Vec,Vec); |
| EXTERN PetscErrorCode STGetBilinearForm(ST,Mat*); |
| EXTERN PetscErrorCode STApplyTranspose(ST,Vec,Vec); |
| EXTERN PetscErrorCode STComputeExplicitOperator(ST,Mat*); |
| EXTERN PetscErrorCode STPostSolve(ST); |
| EXTERN PetscErrorCode STInitializePackage(char*); |
| EXTERN PetscErrorCode STSetKSP(ST,KSP); |
| EXTERN PetscErrorCode STGetKSP(ST,KSP*); |
| EXTERN PetscErrorCode STAssociatedKSPSolve(ST,Vec,Vec); |
| EXTERN PetscErrorCode STSetShift(ST,PetscScalar); |
| EXTERN PetscErrorCode STGetShift(ST,PetscScalar*); |
| EXTERN PetscErrorCode STSetOptionsPrefix(ST,const char*); |
| EXTERN PetscErrorCode STAppendOptionsPrefix(ST,const char*); |
| EXTERN PetscErrorCode STGetOptionsPrefix(ST,const char*[]); |
| EXTERN PetscErrorCode STBackTransform(ST,PetscScalar*,PetscScalar*); |
| EXTERN PetscErrorCode STCheckNullSpace(ST,PetscInt,const Vec[]); |
| EXTERN PetscErrorCode STGetOperationCounters(ST,PetscInt*,PetscInt*); |
| EXTERN PetscErrorCode STResetOperationCounters(ST); |
| /*E |
| STMatMode - determines how to handle the coefficient matrix associated |
| to the spectral transformation |
| Level: intermediate |
| .seealso: STSetMatMode(), STGetMatMode() |
| E*/ |
| typedef enum { STMATMODE_COPY, STMATMODE_INPLACE, |
| STMATMODE_SHELL } STMatMode; |
| EXTERN PetscErrorCode STSetMatMode(ST,STMatMode); |
| EXTERN PetscErrorCode STGetMatMode(ST,STMatMode*); |
| EXTERN PetscErrorCode STSetMatStructure(ST,MatStructure); |
| EXTERN PetscErrorCode STRegister(const char*,const char*,const char*,PetscErrorCode(*)(ST)); |
| #if defined(PETSC_USE_DYNAMIC_LIBRARIES) |
| #define STRegisterDynamic(a,b,c,d) STRegister(a,b,c,0) |
| #else |
| #define STRegisterDynamic(a,b,c,d) STRegister(a,b,c,d) |
| #endif |
| EXTERN PetscErrorCode STRegisterDestroy(void); |
| /* --------- options specific to particular spectral transformations-------- */ |
| EXTERN PetscErrorCode STShellGetContext(ST st,void **ctx); |
| EXTERN PetscErrorCode STShellSetContext(ST st,void *ctx); |
| EXTERN PetscErrorCode STShellSetApply(ST st,PetscErrorCode (*apply)(void*,Vec,Vec)); |
| EXTERN PetscErrorCode STShellSetApplyTranspose(ST st,PetscErrorCode (*applytrans)(void*,Vec,Vec)); |
| EXTERN PetscErrorCode STShellSetBackTransform(ST st,PetscErrorCode (*backtr)(void*,PetscScalar*,PetscScalar*)); |
| EXTERN PetscErrorCode STShellSetName(ST,const char[]); |
| EXTERN PetscErrorCode STShellGetName(ST,char*[]); |
| EXTERN PetscErrorCode STCayleySetAntishift(ST,PetscScalar); |
| EXTERN PetscErrorCode STFoldSetLeftSide(ST st,PetscTruth left); |
| PETSC_EXTERN_CXX_END |
| #endif |
| /* |
| User interface for the SLEPC eigenproblem solvers. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #if !defined(__SLEPCEPS_H) |
| #define __SLEPCEPS_H |
| #include "slepc.h" |
| #include "slepcst.h" |
| #include "slepcip.h" |
| PETSC_EXTERN_CXX_BEGIN |
| extern PetscCookie EPS_COOKIE; |
| /*S |
| EPS - Abstract SLEPc object that manages all the eigenvalue |
| problem solvers. |
| Level: beginner |
| .seealso: EPSCreate(), ST |
| S*/ |
| typedef struct _p_EPS* EPS; |
| /*E |
| EPSType - String with the name of a SLEPc eigensolver |
| Level: beginner |
| .seealso: EPSSetType(), EPS |
| E*/ |
| #define EPSType char* |
| #define EPSPOWER "power" |
| #define EPSSUBSPACE "subspace" |
| #define EPSARNOLDI "arnoldi" |
| #define EPSLANCZOS "lanczos" |
| #define EPSKRYLOVSCHUR "krylovschur" |
| #define EPSLAPACK "lapack" |
| /* the next ones are interfaces to external libraries */ |
| #define EPSARPACK "arpack" |
| #define EPSBLZPACK "blzpack" |
| #define EPSTRLAN "trlan" |
| #define EPSBLOPEX "blopex" |
| #define EPSPRIMME "primme" |
| /*E |
| EPSProblemType - determines the type of eigenvalue problem |
| Level: beginner |
| .seealso: EPSSetProblemType(), EPSGetProblemType() |
| E*/ |
| typedef enum { EPS_HEP=1, EPS_GHEP, |
| EPS_NHEP, EPS_GNHEP, EPS_PGNHEP } EPSProblemType; |
| /*E |
| EPSExtraction - determines the type of extraction technique employed |
| by the eigensolver |
| Level: beginner |
| .seealso: EPSSetExtraction(), EPSGetExtraction() |
| E*/ |
| typedef enum { EPS_RITZ=1, EPS_HARMONIC, |
| EPS_REFINED, EPS_REFINED_HARMONIC } EPSExtraction; |
| /*E |
| EPSClass - determines if the eigensolver is one- or two-sided |
| Level: intermediate |
| .seealso: EPSSetClass(), EPSGetClass() |
| E*/ |
| typedef enum { EPS_ONE_SIDE, EPS_TWO_SIDE } EPSClass; |
| /*E |
| EPSWhich - determines which part of the spectrum is requested |
| Level: intermediate |
| .seealso: EPSSetWhichEigenpairs(), EPSGetWhichEigenpairs() |
| E*/ |
| typedef enum { EPS_LARGEST_MAGNITUDE, EPS_SMALLEST_MAGNITUDE, |
| EPS_LARGEST_REAL, EPS_SMALLEST_REAL, |
| EPS_LARGEST_IMAGINARY, EPS_SMALLEST_IMAGINARY } EPSWhich; |
| EXTERN PetscErrorCode EPSCreate(MPI_Comm,EPS *); |
| EXTERN PetscErrorCode EPSDestroy(EPS); |
| EXTERN PetscErrorCode EPSSetType(EPS,const EPSType); |
| EXTERN PetscErrorCode EPSGetType(EPS,const EPSType*); |
| EXTERN PetscErrorCode EPSSetProblemType(EPS,EPSProblemType); |
| EXTERN PetscErrorCode EPSGetProblemType(EPS,EPSProblemType*); |
| EXTERN PetscErrorCode EPSSetExtraction(EPS,EPSExtraction); |
| EXTERN PetscErrorCode EPSGetExtraction(EPS,EPSExtraction*); |
| EXTERN PetscErrorCode EPSSetClass(EPS,EPSClass); |
| EXTERN PetscErrorCode EPSGetClass(EPS,EPSClass*); |
| EXTERN PetscErrorCode EPSSetOperators(EPS,Mat,Mat); |
| EXTERN PetscErrorCode EPSGetOperators(EPS,Mat*,Mat*); |
| EXTERN PetscErrorCode EPSSetFromOptions(EPS); |
| EXTERN PetscErrorCode EPSSetUp(EPS); |
| EXTERN PetscErrorCode EPSSolve(EPS); |
| EXTERN PetscErrorCode EPSView(EPS,PetscViewer); |
| EXTERN PetscErrorCode EPSInitializePackage(char *); |
| EXTERN PetscErrorCode EPSSetTarget(EPS,PetscScalar); |
| EXTERN PetscErrorCode EPSGetTarget(EPS,PetscScalar*); |
| EXTERN PetscErrorCode EPSSetST(EPS,ST); |
| EXTERN PetscErrorCode EPSGetST(EPS,ST*); |
| EXTERN PetscErrorCode EPSSetIP(EPS,IP); |
| EXTERN PetscErrorCode EPSGetIP(EPS,IP*); |
| EXTERN PetscErrorCode EPSSetTolerances(EPS,PetscReal,PetscInt); |
| EXTERN PetscErrorCode EPSGetTolerances(EPS,PetscReal*,PetscInt*); |
| EXTERN PetscErrorCode EPSSetDimensions(EPS,PetscInt,PetscInt,PetscInt); |
| EXTERN PetscErrorCode EPSGetDimensions(EPS,PetscInt*,PetscInt*,PetscInt*); |
| EXTERN PetscErrorCode EPSGetConverged(EPS,PetscInt*); |
| EXTERN PetscErrorCode EPSGetEigenpair(EPS,PetscInt,PetscScalar*,PetscScalar*,Vec,Vec); |
| EXTERN PetscErrorCode EPSGetValue(EPS,PetscInt,PetscScalar*,PetscScalar*); |
| EXTERN PetscErrorCode EPSGetRightVector(EPS,PetscInt,Vec,Vec); |
| EXTERN PetscErrorCode EPSGetLeftVector(EPS,PetscInt,Vec,Vec); |
| EXTERN PetscErrorCode EPSComputeRelativeError(EPS,PetscInt,PetscReal*); |
| EXTERN PetscErrorCode EPSComputeRelativeErrorLeft(EPS,PetscInt,PetscReal*); |
| EXTERN PetscErrorCode EPSComputeResidualNorm(EPS,PetscInt,PetscReal*); |
| EXTERN PetscErrorCode EPSComputeResidualNormLeft(EPS,PetscInt,PetscReal*); |
| EXTERN PetscErrorCode EPSGetInvariantSubspace(EPS,Vec*); |
| EXTERN PetscErrorCode EPSGetLeftInvariantSubspace(EPS,Vec*); |
| EXTERN PetscErrorCode EPSGetErrorEstimate(EPS,PetscInt,PetscReal*); |
| EXTERN PetscErrorCode EPSGetErrorEstimateLeft(EPS,PetscInt,PetscReal*); |
| EXTERN PetscErrorCode EPSMonitorSet(EPS,PetscErrorCode (*)(EPS,PetscInt,PetscInt,PetscScalar*,PetscScalar*,PetscReal*,PetscInt,void*), |
| void*,PetscErrorCode (*monitordestroy)(void*)); |
| EXTERN PetscErrorCode EPSMonitorCancel(EPS); |
| EXTERN PetscErrorCode EPSGetMonitorContext(EPS,void **); |
| EXTERN PetscErrorCode EPSGetIterationNumber(EPS,PetscInt*); |
| EXTERN PetscErrorCode EPSGetOperationCounters(EPS,PetscInt*,PetscInt*,PetscInt*); |
| EXTERN PetscErrorCode EPSSetInitialVector(EPS,Vec); |
| EXTERN PetscErrorCode EPSGetInitialVector(EPS,Vec*); |
| EXTERN PetscErrorCode EPSSetLeftInitialVector(EPS,Vec); |
| EXTERN PetscErrorCode EPSGetLeftInitialVector(EPS,Vec*); |
| EXTERN PetscErrorCode EPSSetWhichEigenpairs(EPS,EPSWhich); |
| EXTERN PetscErrorCode EPSGetWhichEigenpairs(EPS,EPSWhich*); |
| EXTERN PetscErrorCode EPSIsGeneralized(EPS,PetscTruth*); |
| EXTERN PetscErrorCode EPSIsHermitian(EPS,PetscTruth*); |
| EXTERN PetscErrorCode EPSMonitorDefault(EPS,PetscInt,PetscInt,PetscScalar*,PetscScalar*,PetscReal*,PetscInt,void*); |
| EXTERN PetscErrorCode EPSMonitorLG(EPS,PetscInt,PetscInt,PetscScalar*,PetscScalar*,PetscReal*,PetscInt,void*); |
| EXTERN PetscErrorCode EPSAttachDeflationSpace(EPS,PetscInt,Vec*,PetscTruth); |
| EXTERN PetscErrorCode EPSRemoveDeflationSpace(EPS); |
| EXTERN PetscErrorCode EPSSetOptionsPrefix(EPS,const char*); |
| EXTERN PetscErrorCode EPSAppendOptionsPrefix(EPS,const char*); |
| EXTERN PetscErrorCode EPSGetOptionsPrefix(EPS,const char*[]); |
| /*E |
| EPSConvergedReason - reason an eigensolver was said to |
| have converged or diverged |
| Level: beginner |
| .seealso: EPSSolve(), EPSGetConvergedReason(), EPSSetTolerances() |
| E*/ |
| typedef enum {/* converged */ |
| EPS_CONVERGED_TOL = 2, |
| /* diverged */ |
| EPS_DIVERGED_ITS = -3, |
| EPS_DIVERGED_BREAKDOWN = -4, |
| EPS_DIVERGED_NONSYMMETRIC = -5, |
| EPS_CONVERGED_ITERATING = 0} EPSConvergedReason; |
| EXTERN PetscErrorCode EPSGetConvergedReason(EPS,EPSConvergedReason *); |
| EXTERN PetscErrorCode EPSSortEigenvalues(PetscInt,PetscScalar*,PetscScalar*,EPSWhich,PetscInt,PetscInt*); |
| EXTERN PetscErrorCode EPSSortEigenvaluesReal(PetscInt,PetscReal*,EPSWhich,PetscInt,PetscInt*,PetscReal*); |
| EXTERN PetscErrorCode EPSDenseNHEP(PetscInt,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*); |
| EXTERN PetscErrorCode EPSDenseGNHEP(PetscInt,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*); |
| EXTERN PetscErrorCode EPSDenseHEP(PetscInt,PetscScalar*,PetscInt,PetscReal*,PetscScalar*); |
| EXTERN PetscErrorCode EPSDenseGHEP(PetscInt,PetscScalar*,PetscScalar*,PetscReal*,PetscScalar*); |
| EXTERN PetscErrorCode EPSDenseHessenberg(PetscInt,PetscInt,PetscScalar*,PetscInt,PetscScalar*); |
| EXTERN PetscErrorCode EPSDenseSchur(PetscInt,PetscInt,PetscScalar*,PetscInt,PetscScalar*,PetscScalar*,PetscScalar*); |
| EXTERN PetscErrorCode EPSSortDenseSchur(PetscInt,PetscInt,PetscScalar*,PetscInt,PetscScalar*,PetscScalar*,PetscScalar*,EPSWhich); |
| EXTERN PetscErrorCode EPSSortDenseSchurTarget(PetscInt,PetscInt,PetscScalar*,PetscInt,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar,EPSWhich); |
| EXTERN PetscErrorCode EPSDenseTridiagonal(PetscInt,PetscReal*,PetscReal*,PetscReal*,PetscScalar*); |
| EXTERN PetscErrorCode EPSGetStartVector(EPS,PetscInt,Vec,PetscTruth*); |
| EXTERN PetscErrorCode EPSGetLeftStartVector(EPS,PetscInt,Vec); |
| EXTERN PetscErrorCode EPSRegister(const char*,const char*,const char*,PetscErrorCode(*)(EPS)); |
| #if defined(PETSC_USE_DYNAMIC_LIBRARIES) |
| #define EPSRegisterDynamic(a,b,c,d) EPSRegister(a,b,c,0) |
| #else |
| #define EPSRegisterDynamic(a,b,c,d) EPSRegister(a,b,c,d) |
| #endif |
| EXTERN PetscErrorCode EPSRegisterDestroy(void); |
| /* --------- options specific to particular eigensolvers -------- */ |
| /*E |
| EPSPowerShiftType - determines the type of shift used in the Power iteration |
| Level: advanced |
| .seealso: EPSPowerSetShiftType(), EPSPowerGetShiftType() |
| E*/ |
| typedef enum { EPSPOWER_SHIFT_CONSTANT, EPSPOWER_SHIFT_RAYLEIGH, |
| EPSPOWER_SHIFT_WILKINSON } EPSPowerShiftType; |
| EXTERN PetscErrorCode EPSPowerSetShiftType(EPS,EPSPowerShiftType); |
| EXTERN PetscErrorCode EPSPowerGetShiftType(EPS,EPSPowerShiftType*); |
| EXTERN PetscErrorCode EPSArnoldiSetDelayed(EPS,PetscTruth); |
| EXTERN PetscErrorCode EPSArnoldiGetDelayed(EPS,PetscTruth*); |
| /*E |
| EPSLanczosReorthogType - determines the type of reorthogonalization |
| used in the Lanczos method |
| Level: advanced |
| .seealso: EPSLanczosSetReorthog(), EPSLanczosGetReorthog() |
| E*/ |
| typedef enum { EPSLANCZOS_REORTHOG_LOCAL, |
| EPSLANCZOS_REORTHOG_FULL, |
| EPSLANCZOS_REORTHOG_SELECTIVE, |
| EPSLANCZOS_REORTHOG_PERIODIC, |
| EPSLANCZOS_REORTHOG_PARTIAL, |
| EPSLANCZOS_REORTHOG_DELAYED } EPSLanczosReorthogType; |
| EXTERN PetscErrorCode EPSLanczosSetReorthog(EPS,EPSLanczosReorthogType); |
| EXTERN PetscErrorCode EPSLanczosGetReorthog(EPS,EPSLanczosReorthogType*); |
| EXTERN PetscErrorCode EPSBlzpackSetBlockSize(EPS,PetscInt); |
| EXTERN PetscErrorCode EPSBlzpackSetInterval(EPS,PetscReal,PetscReal); |
| EXTERN PetscErrorCode EPSBlzpackSetNSteps(EPS,PetscInt); |
| /*E |
| EPSPRIMMEMethod - determines the method selected in the PRIMME library |
| Level: advanced |
| .seealso: EPSPRIMMESetMethod(), EPSPRIMMEGetMethod() |
| E*/ |
| typedef enum { |
| EPSPRIMME_DYNAMIC, |
| EPSPRIMME_DEFAULT_MIN_TIME, |
| EPSPRIMME_DEFAULT_MIN_MATVECS, |
| EPSPRIMME_ARNOLDI, |
| EPSPRIMME_GD, |
| EPSPRIMME_GD_PLUSK, |
| EPSPRIMME_GD_OLSEN_PLUSK, |
| EPSPRIMME_JD_OLSEN_PLUSK, |
| EPSPRIMME_RQI, |
| EPSPRIMME_JDQR, |
| EPSPRIMME_JDQMR, |
| EPSPRIMME_JDQMR_ETOL, |
| EPSPRIMME_SUBSPACE_ITERATION, |
| EPSPRIMME_LOBPCG_ORTHOBASIS, |
| EPSPRIMME_LOBPCG_ORTHOBASISW |
| } EPSPRIMMEMethod; |
| /*E |
| EPSPRIMMEPrecond - determines the type of preconditioning |
| used in the PRIMME library |
| Level: advanced |
| .seealso: EPSPRIMMESetPrecond(), EPSPRIMMEGetPrecond() |
| E*/ |
| typedef enum { |
| EPSPRIMME_NONE, |
| EPSPRIMME_DIAGONAL |
| } EPSPRIMMEPrecond; |
| EXTERN PetscErrorCode EPSPRIMMESetBlockSize(EPS eps,PetscInt bs); |
| EXTERN PetscErrorCode EPSPRIMMESetMethod(EPS eps, EPSPRIMMEMethod method); |
| EXTERN PetscErrorCode EPSPRIMMESetPrecond(EPS eps, EPSPRIMMEPrecond precond); |
| EXTERN PetscErrorCode EPSPRIMMEGetBlockSize(EPS eps,PetscInt *bs); |
| EXTERN PetscErrorCode EPSPRIMMEGetMethod(EPS eps, EPSPRIMMEMethod *method); |
| EXTERN PetscErrorCode EPSPRIMMEGetPrecond(EPS eps, EPSPRIMMEPrecond *precond); |
| PETSC_EXTERN_CXX_END |
| #endif |
| /* |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #if !defined(__SLEPCIP_H) |
| #define __SLEPCIP_H |
| #include "slepc.h" |
| PETSC_EXTERN_CXX_BEGIN |
| extern PetscCookie IP_COOKIE; |
| /*E |
| IPOrthogonalizationType - determines what type of orthogonalization to use |
| Level: advanced |
| .seealso: IPSetOrthogonalization(), IPGetOrthogonalization(), IPOrthogonalize() |
| E*/ |
| typedef enum { IP_MGS_ORTH, IP_CGS_ORTH } IPOrthogonalizationType; |
| /*E |
| IPOrthogonalizationRefinementType - determines what type of refinement |
| to use during orthogonalization |
| Level: advanced |
| .seealso: IPSetOrthogonalization(), IPGetOrthogonalization(), IPOrthogonalize() |
| E*/ |
| typedef enum { IP_ORTH_REFINE_NEVER, IP_ORTH_REFINE_IFNEEDED, |
| IP_ORTH_REFINE_ALWAYS } IPOrthogonalizationRefinementType; |
| /*S |
| IP - Abstraction of a vector inner product, that can be defined |
| in different ways. Using this object is not required for application |
| programmers. |
| Level: beginner |
| .seealso: IPCreate() |
| S*/ |
| typedef struct _p_IP* IP; |
| EXTERN PetscErrorCode IPInitializePackage(char *path); |
| EXTERN PetscErrorCode IPCreate(MPI_Comm,IP*); |
| EXTERN PetscErrorCode IPSetOptionsPrefix(IP,const char *); |
| EXTERN PetscErrorCode IPAppendOptionsPrefix(IP,const char *); |
| EXTERN PetscErrorCode IPGetOptionsPrefix(IP,const char *[]); |
| EXTERN PetscErrorCode IPSetFromOptions(IP); |
| EXTERN PetscErrorCode IPSetOrthogonalization(IP,IPOrthogonalizationType,IPOrthogonalizationRefinementType,PetscReal); |
| EXTERN PetscErrorCode IPGetOrthogonalization(IP,IPOrthogonalizationType*,IPOrthogonalizationRefinementType*,PetscReal*); |
| EXTERN PetscErrorCode IPView(IP,PetscViewer); |
| EXTERN PetscErrorCode IPDestroy(IP); |
| EXTERN PetscErrorCode IPOrthogonalize(IP,PetscInt,PetscTruth*,Vec*,Vec,PetscScalar*,PetscReal*,PetscTruth*,Vec,PetscScalar*); |
| EXTERN PetscErrorCode IPOrthogonalizeCGS(IP,PetscInt,PetscTruth*,Vec*,Vec,PetscScalar*,PetscReal*,PetscReal*,Vec); |
| EXTERN PetscErrorCode IPBiOrthogonalize(IP,PetscInt,Vec*,Vec*,Vec,PetscScalar*,PetscReal*); |
| EXTERN PetscErrorCode IPQRDecomposition(IP,Vec*,PetscInt,PetscInt,PetscScalar*,PetscInt,Vec); |
| /*E |
| IPBilinearForm - determines the type of bilinear/sesquilinear form |
| Level: developer |
| .seealso: IPSetBilinearForm(), IPGetBilinearForm() |
| E*/ |
| typedef enum { IPINNER_HERMITIAN, IPINNER_SYMMETRIC } IPBilinearForm; |
| EXTERN PetscErrorCode IPSetBilinearForm(IP,Mat,IPBilinearForm); |
| EXTERN PetscErrorCode IPGetBilinearForm(IP,Mat*,IPBilinearForm*); |
| EXTERN PetscErrorCode IPApplyMatrix(IP,Vec,Vec); |
| EXTERN PetscErrorCode IPInnerProduct(IP ip,Vec,Vec,PetscScalar*); |
| EXTERN PetscErrorCode IPInnerProductBegin(IP ip,Vec,Vec,PetscScalar*); |
| EXTERN PetscErrorCode IPInnerProductEnd(IP ip,Vec,Vec,PetscScalar*); |
| EXTERN PetscErrorCode IPMInnerProduct(IP ip,Vec,PetscInt,const Vec[],PetscScalar*); |
| EXTERN PetscErrorCode IPMInnerProductBegin(IP ip,Vec,PetscInt,const Vec[],PetscScalar*); |
| EXTERN PetscErrorCode IPMInnerProductEnd(IP ip,Vec,PetscInt,const Vec[],PetscScalar*); |
| EXTERN PetscErrorCode IPNorm(IP ip,Vec,PetscReal*); |
| EXTERN PetscErrorCode IPNormBegin(IP ip,Vec,PetscReal*); |
| EXTERN PetscErrorCode IPNormEnd(IP ip,Vec,PetscReal*); |
| EXTERN PetscErrorCode IPGetOperationCounters(IP,PetscInt*); |
| EXTERN PetscErrorCode IPResetOperationCounters(IP); |
| PETSC_EXTERN_CXX_END |
| #endif |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| ! |
| ! |
| ! Additional SVD include file for use of SLEPc with Fortran 90/HPF |
| ! |
| #include "finclude/ftn-custom/slepcsvd.h90" |
| #if defined(PETSC_USE_FORTRAN_INTERFACES) |
| interface |
| #include "finclude/ftn-auto/slepcsvd.h90" |
| end interface |
| #endif |
| ! |
| ! Include file for Fortran use of the ST object in SLEPc |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| #if !defined(__SLEPCST_H) |
| #define __SLEPCST_H |
| #include "finclude/petsckspdef.h" |
| #if !defined(PETSC_USE_FORTRAN_DATATYPES) |
| #define ST PetscFortranAddr |
| #endif |
| #define STType character*(80) |
| #define STMatMode PetscEnum |
| #define STSHELL 'shell' |
| #define STSHIFT 'shift' |
| #define STSINV 'sinvert' |
| #define STCAYLEY 'cayley' |
| #define STFOLD 'fold' |
| #endif |
| ! |
| ! Include file for Fortran use of the EPS object in SLEPc |
| ! |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| #if !defined(__SLEPCEPS_H) |
| #define __SLEPCEPS_H |
| #include "finclude/slepcstdef.h" |
| #include "finclude/slepcipdef.h" |
| #if !defined(PETSC_USE_FORTRAN_DATATYPES) |
| #define EPS PetscFortranAddr |
| #endif |
| #define EPSType character*(80) |
| #define EPSConvergedReason PetscEnum |
| #define EPSProblemType PetscEnum |
| #define EPSWhich PetscEnum |
| #define EPSClass PetscEnum |
| #define EPSExtraction PetscEnum |
| #define EPSPowerShiftType PetscEnum |
| #define EPSLanczosReorthogType PetscEnum |
| #define EPSPRIMMEMethod PetscEnum |
| #define EPSPRIMMEPrecond PetscEnum |
| #define EPSPOWER 'power' |
| #define EPSSUBSPACE 'subspace' |
| #define EPSARNOLDI 'arnoldi' |
| #define EPSLANCZOS 'lanczos' |
| #define EPSKRYLOVSCHUR 'krylovschur' |
| #define EPSLAPACK 'lapack' |
| #define EPSARPACK 'arpack' |
| #define EPSBLZPACK 'blzpack' |
| #define EPSTRLAN 'trlan' |
| #define EPSBLOPEX 'blopex' |
| #define EPSPRIMME 'primme' |
| #endif |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| ! Single Fortran include file for all of SLEPc |
| ! |
| #include "finclude/slepc.h" |
| #include "finclude/slepceps.h" |
| #include "finclude/slepcip.h" |
| #include "finclude/slepcst.h" |
| #include "finclude/slepcsvd.h" |
| ! |
| ! Include file for Fortran use of the IP object in SLEPc |
| ! |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| #include "finclude/slepcipdef.h" |
| PetscEnum IP_MGS_ORTH |
| PetscEnum IP_CGS_ORTH |
| parameter (IP_MGS_ORTH = 0) |
| parameter (IP_CGS_ORTH = 1) |
| PetscEnum IP_ORTH_REFINE_NEVER |
| PetscEnum IP_ORTH_REFINE_IFNEEDED |
| PetscEnum IP_ORTH_REFINE_ALWAYS |
| parameter (IP_ORTH_REFINE_NEVER = 0) |
| parameter (IP_ORTH_REFINE_IFNEEDED = 1) |
| parameter (IP_ORTH_REFINE_ALWAYS = 2) |
| PetscEnum IPINNER_HERMITIAN |
| PetscEnum IPINNER_SYMMETRIC |
| parameter (IPINNER_HERMITIAN = 0) |
| parameter (IPINNER_SYMMETRIC = 1) |
| ! |
| ! Include file for Fortran use of the SVD object in SLEPc |
| ! |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| #if !defined(__SLEPCSVD_H) |
| #define __SLEPCSVD_H |
| #include "finclude/slepcipdef.h" |
| #include "finclude/slepcepsdef.h" |
| #if !defined(PETSC_USE_FORTRAN_DATATYPES) |
| #define SVD PetscFortranAddr |
| #endif |
| #define SVDType character*(80) |
| #define SVDTransposeMode PetscEnum |
| #define SVDWhich PetscEnum |
| #define SVDConvergedReason PetscEnum |
| #define SVDCROSS 'cross' |
| #define SVDCYCLIC 'cyclic' |
| #define SVDLAPACK 'lapack' |
| #define SVDLANCZOS 'lanczos' |
| #define SVDTRLANCZOS 'trlanczos' |
| #endif |
| ! |
| ! Include file for Fortran use of the SLEPc package |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| #include "petscconf.h" |
| #include "finclude/petscdef.h" |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| ! Single Fortran 90 include file |
| ! |
| #include "finclude/slepcall.h" |
| #include "finclude/slepceps.h90" |
| #include "finclude/slepcip.h90" |
| #include "finclude/slepcst.h90" |
| #include "finclude/slepcsvd.h90" |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| ! |
| ! |
| ! Additional IP include file for use of SLEPc with Fortran 90/HPF |
| ! |
| #include "finclude/ftn-custom/slepcip.h90" |
| #if defined(PETSC_USE_FORTRAN_INTERFACES) |
| interface |
| #include "finclude/ftn-auto/slepcip.h90" |
| end interface |
| #endif |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| #if !defined(__SLEPCSVDDEF_H90) |
| #define __SLEPCSVDDEF_H90 |
| #if defined(PETSC_USE_FORTRAN_DATATYPES) |
| type SVD |
| PetscFortranAddr:: v |
| end type SVD |
| #endif |
| #endif |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| #if !defined(PETSC_USE_FORTRAN_MODULES) |
| #include "finclude/ftn-custom/slepcsvddef.h90" |
| #endif |
| #if defined(PETSC_USE_FORTRAN_DATATYPES) && !defined(SVD_HIDE) |
| #define SVD_HIDE type(SVD) |
| #elif !defined(SVD_HIDE) |
| #define SVD_HIDE SVD |
| #endif |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| #if !defined(__SLEPCSTDEF_H90) |
| #define __SLEPCSTDEF_H90 |
| #if defined(PETSC_USE_FORTRAN_DATATYPES) |
| type ST |
| PetscFortranAddr:: v |
| end type ST |
| #endif |
| #endif |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| #if !defined(__SLEPCEPSDEF_H90) |
| #define __SLEPCEPSDEF_H90 |
| #if defined(PETSC_USE_FORTRAN_DATATYPES) |
| type EPS |
| PetscFortranAddr:: v |
| end type EPS |
| #endif |
| #endif |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| #if !defined(PETSC_USE_FORTRAN_MODULES) |
| #include "finclude/ftn-custom/slepcstdef.h90" |
| #endif |
| #if defined(PETSC_USE_FORTRAN_DATATYPES) && !defined(ST_HIDE) |
| #define ST_HIDE type(ST) |
| #elif !defined(ST_HIDE) |
| #define ST_HIDE ST |
| #endif |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| include ${SLEPC_DIR}/conf/slepc_common |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| #if !defined(PETSC_USE_FORTRAN_MODULES) |
| #include "finclude/ftn-custom/slepcepsdef.h90" |
| #endif |
| #if defined(PETSC_USE_FORTRAN_DATATYPES) && !defined(EPS_HIDE) |
| #define EPS_HIDE type(EPS) |
| #elif !defined(EPS_HIDE) |
| #define EPS_HIDE EPS |
| #endif |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| #if !defined(__SLEPCIPDEF_H90) |
| #define __SLEPCIPDEF_H90 |
| #if defined(PETSC_USE_FORTRAN_DATATYPES) |
| type IP |
| PetscFortranAddr:: v |
| end type IP |
| #endif |
| #endif |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| #if !defined(PETSC_USE_FORTRAN_MODULES) |
| #include "finclude/ftn-custom/slepcipdef.h90" |
| #endif |
| #if defined(PETSC_USE_FORTRAN_DATATYPES) && !defined(IP_HIDE) |
| #define IP_HIDE type(IP) |
| #elif !defined(IP_HIDE) |
| #define IP_HIDE IP |
| #endif |
| ! |
| ! Include file for Fortran use of the ST object in SLEPc |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| #include "finclude/slepcstdef.h" |
| PetscEnum STMATMODE_COPY |
| PetscEnum STMATMODE_INPLACE |
| PetscEnum STMATMODE_SHELL |
| parameter (STMATMODE_COPY = 0) |
| parameter (STMATMODE_INPLACE = 1) |
| parameter (STMATMODE_SHELL = 2) |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| ! Single Fortran include file for all of SLEPc |
| ! |
| #include "finclude/slepcepsdef.h" |
| #include "finclude/slepcipdef.h" |
| #include "finclude/slepcstdef.h" |
| #include "finclude/slepcsvddef.h" |
| ! |
| ! Include file for Fortran use of the EPS object in SLEPc |
| ! |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| #include "finclude/slepcepsdef.h" |
| ! Convergence flags. |
| ! They sould match the flags in $SLEPC_DIR/include/slepceps.h |
| PetscEnum EPS_CONVERGED_TOL |
| PetscEnum EPS_DIVERGED_ITS |
| PetscEnum EPS_DIVERGED_BREAKDOWN |
| PetscEnum EPS_DIVERGED_NONSYMMETRIC |
| PetscEnum 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) |
| PetscEnum EPS_HEP |
| PetscEnum EPS_GHEP |
| PetscEnum EPS_NHEP |
| PetscEnum EPS_GNHEP |
| PetscEnum EPS_PGNHEP |
| parameter (EPS_HEP = 1) |
| parameter (EPS_GHEP = 2) |
| parameter (EPS_NHEP = 3) |
| parameter (EPS_GNHEP = 4) |
| parameter (EPS_PGNHEP = 5) |
| PetscEnum EPS_LARGEST_MAGNITUDE |
| PetscEnum EPS_SMALLEST_MAGNITUDE |
| PetscEnum EPS_LARGEST_REAL |
| PetscEnum EPS_SMALLEST_REAL |
| PetscEnum EPS_LARGEST_IMAGINARY |
| PetscEnum EPS_SMALLEST_IMAGINARY |
| parameter (EPS_LARGEST_MAGNITUDE = 0) |
| parameter (EPS_SMALLEST_MAGNITUDE = 1) |
| parameter (EPS_LARGEST_REAL = 2) |
| parameter (EPS_SMALLEST_REAL = 3) |
| parameter (EPS_LARGEST_IMAGINARY = 4) |
| parameter (EPS_SMALLEST_IMAGINARY = 5) |
| PetscEnum EPSPOWER_SHIFT_CONSTANT |
| PetscEnum EPSPOWER_SHIFT_RAYLEIGH |
| PetscEnum EPSPOWER_SHIFT_WILKINSON |
| parameter (EPSPOWER_SHIFT_CONSTANT = 0) |
| parameter (EPSPOWER_SHIFT_RAYLEIGH = 1) |
| parameter (EPSPOWER_SHIFT_WILKINSON = 2) |
| PetscEnum EPS_ONE_SIDE |
| PetscEnum EPS_TWO_SIDE |
| parameter (EPS_ONE_SIDE = 0) |
| parameter (EPS_TWO_SIDE = 1) |
| PetscEnum EPS_RITZ |
| PetscEnum EPS_HARMONIC |
| PetscEnum EPS_REFINED |
| PetscEnum EPS_REFINED_HARMONIC |
| parameter (EPS_RITZ = 1) |
| parameter (EPS_HARMONIC = 2) |
| parameter (EPS_REFINED = 3) |
| parameter (EPS_REFINED_HARMONIC = 4) |
| PetscEnum EPSLANCZOS_REORTHOG_LOCAL |
| PetscEnum EPSLANCZOS_REORTHOG_FULL |
| PetscEnum EPSLANCZOS_REORTHOG_SELECTIVE |
| PetscEnum EPSLANCZOS_REORTHOG_PERIODIC |
| PetscEnum EPSLANCZOS_REORTHOG_PARTIAL |
| parameter (EPSLANCZOS_REORTHOG_LOCAL = 0) |
| parameter (EPSLANCZOS_REORTHOG_FULL = 1) |
| parameter (EPSLANCZOS_REORTHOG_SELECTIVE = 2) |
| parameter (EPSLANCZOS_REORTHOG_PERIODIC = 3) |
| parameter (EPSLANCZOS_REORTHOG_PARTIAL = 4) |
| PetscEnum EPSPRIMME_DYNAMIC |
| PetscEnum EPSPRIMME_DEFAULT_MIN_TIME |
| PetscEnum EPSPRIMME_DEFAULT_MIN_MATVECS |
| PetscEnum EPSPRIMME_ARNOLDI |
| PetscEnum EPSPRIMME_GD |
| PetscEnum EPSPRIMME_GD_PLUSK |
| PetscEnum EPSPRIMME_GD_OLSEN_PLUSK |
| PetscEnum EPSPRIMME_JD_OLSEN_PLUSK |
| PetscEnum EPSPRIMME_RQI |
| PetscEnum EPSPRIMME_JDQR |
| PetscEnum EPSPRIMME_JDQMR |
| PetscEnum EPSPRIMME_JDQMR_ETOL |
| PetscEnum EPSPRIMME_SUBSPACE_ITERATION |
| PetscEnum EPSPRIMME_LOBPCG_ORTHOBASIS |
| PetscEnum EPSPRIMME_LOBPCG_ORTHOBASISW |
| parameter (EPSPRIMME_DYNAMIC = 0) |
| parameter (EPSPRIMME_DEFAULT_MIN_TIME = 1) |
| parameter (EPSPRIMME_DEFAULT_MIN_MATVECS = 2) |
| parameter (EPSPRIMME_ARNOLDI = 3) |
| parameter (EPSPRIMME_GD = 4) |
| parameter (EPSPRIMME_GD_PLUSK = 5) |
| parameter (EPSPRIMME_GD_OLSEN_PLUSK = 7) |
| parameter (EPSPRIMME_JD_OLSEN_PLUSK = 8) |
| parameter (EPSPRIMME_RQI = 9) |
| parameter (EPSPRIMME_JDQR = 10) |
| parameter (EPSPRIMME_JDQMR = 11) |
| parameter (EPSPRIMME_JDQMR_ETOL = 12) |
| parameter (EPSPRIMME_SUBSPACE_ITERATION = 13) |
| parameter (EPSPRIMME_LOBPCG_ORTHOBASIS = 14) |
| parameter (EPSPRIMME_LOBPCG_ORTHOBASISW = 15) |
| PetscEnum EPSPRIMME_NONE |
| PetscEnum EPSPRIMME_DIAGONAL |
| parameter (EPSPRIMME_NONE = 0) |
| parameter (EPSPRIMME_DIAGONAL = 1) |
| ! |
| ! Include file for Fortran use of the IP object in SLEPc |
| ! |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| #if !defined(__SLEPCIP_H) |
| #define __SLEPCIP_H |
| #if !defined(PETSC_USE_FORTRAN_DATATYPES) |
| #define IP PetscFortranAddr |
| #endif |
| #define IPOrthogonalizationType PetscEnum |
| #define IPOrthogonalizationRefinementType PetscEnum |
| #define IPBilinearForm PetscEnum |
| #endif |
| ! |
| ! Include file for Fortran use of the SVD object in SLEPc |
| ! |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| #include "finclude/slepcsvddef.h" |
| ! Convergence flags. |
| ! They sould match the flags in $SLEPC_DIR/include/slepcsvd.h |
| PetscEnum SVD_CONVERGED_TOL |
| PetscEnum SVD_DIVERGED_ITS |
| PetscEnum SVD_DIVERGED_BREAKDOWN |
| PetscEnum SVD_CONVERGED_ITERATING |
| parameter (SVD_CONVERGED_TOL = 2) |
| parameter (SVD_DIVERGED_ITS = -3) |
| parameter (SVD_DIVERGED_BREAKDOWN = -4) |
| parameter (SVD_CONVERGED_ITERATING = 0) |
| PetscEnum SVD_TRANSPOSE_EXPLICIT |
| PetscEnum SVD_TRANSPOSE_IMPLICIT |
| parameter (SVD_TRANSPOSE_EXPLICIT = 0) |
| parameter (SVD_TRANSPOSE_IMPLICIT = 1) |
| integer SVD_LARGEST |
| integer SVD_SMALLEST |
| parameter (SVD_LARGEST = 0) |
| parameter (SVD_SMALLEST = 1) |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| ! |
| ! |
| ! Additional ST include file for use of SLEPc with Fortran 90/HPF |
| ! |
| #include "finclude/ftn-custom/slepcst.h90" |
| #if defined(PETSC_USE_FORTRAN_INTERFACES) |
| interface |
| #include "finclude/ftn-auto/slepcst.h90" |
| end interface |
| #endif |
| ! |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! SLEPc - Scalable Library for Eigenvalue Problem Computations |
| ! Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| ! |
| ! This file is part of SLEPc. |
| ! |
| ! SLEPc is free software: you can redistribute it and/or modify it under the |
| ! terms of version 3 of the GNU Lesser General Public License as published by |
| ! the Free Software Foundation. |
| ! |
| ! SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| ! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| ! more details. |
| ! |
| ! You should have received a copy of the GNU Lesser General Public License |
| ! along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| ! |
| ! |
| ! |
| ! Additional EPS include file for use of SLEPc with Fortran 90/HPF |
| ! |
| #include "finclude/ftn-custom/slepceps.h90" |
| #if defined(PETSC_USE_FORTRAN_INTERFACES) |
| interface |
| #include "finclude/ftn-auto/slepceps.h90" |
| end interface |
| #endif |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| CFLAGS = |
| FFLAGS = |
| SOURCEC = |
| SOURCEF = |
| SOURCEH = slepc.h slepceps.h slepcst.h slepcsvd.h slepcip.h |
| OBJSC = |
| OBJSF = |
| LIBBASE = libslepc |
| DIRS = |
| MANSEC = |
| LOCDIR = include/finclude/ |
| include ${SLEPC_DIR}/conf/slepc_common |
| runexamples: |
| /* |
| User interface for the SLEPC singular value solvers. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #if !defined(__SLEPCSVD_H) |
| #define __SLEPCSVD_H |
| #include "slepc.h" |
| #include "slepceps.h" |
| PETSC_EXTERN_CXX_BEGIN |
| extern PetscCookie SVD_COOKIE; |
| /*S |
| SVD - Abstract SLEPc object that manages all the singular value |
| problem solvers. |
| Level: beginner |
| .seealso: SVDCreate() |
| S*/ |
| typedef struct _p_SVD* SVD; |
| /*E |
| SVDType - String with the name of a SLEPc singular value solver |
| Level: beginner |
| .seealso: SVDSetType(), SVD |
| E*/ |
| #define SVDType char* |
| #define SVDCROSS "cross" |
| #define SVDCYCLIC "cyclic" |
| #define SVDLAPACK "lapack" |
| #define SVDLANCZOS "lanczos" |
| #define SVDTRLANCZOS "trlanczos" |
| /*E |
| SVDTransposeMode - determines how to handle the transpose of the matrix |
| Level: advanced |
| .seealso: SVDSetTransposeMode(), SVDGetTransposeMode() |
| E*/ |
| typedef enum { SVD_TRANSPOSE_EXPLICIT, SVD_TRANSPOSE_IMPLICIT } SVDTransposeMode; |
| /*E |
| SVDWhich - determines whether largest or smallest singular triplets |
| are to be computed |
| Level: intermediate |
| .seealso: SVDSetWhichSingularTriplets(), SVDGetWhichSingularTriplets() |
| E*/ |
| typedef enum { SVD_LARGEST, SVD_SMALLEST } SVDWhich; |
| /*E |
| SVDConvergedReason - reason a singular value solver was said to |
| have converged or diverged |
| Level: beginner |
| .seealso: SVDSolve(), SVDGetConvergedReason(), SVDSetTolerances() |
| E*/ |
| typedef enum {/* converged */ |
| SVD_CONVERGED_TOL = 2, |
| /* diverged */ |
| SVD_DIVERGED_ITS = -3, |
| SVD_DIVERGED_BREAKDOWN = -4, |
| SVD_CONVERGED_ITERATING = 0 } SVDConvergedReason; |
| EXTERN PetscErrorCode SVDCreate(MPI_Comm,SVD*); |
| EXTERN PetscErrorCode SVDSetIP(SVD,IP); |
| EXTERN PetscErrorCode SVDGetIP(SVD,IP*); |
| EXTERN PetscErrorCode SVDSetType(SVD,const SVDType); |
| EXTERN PetscErrorCode SVDGetType(SVD,const SVDType*); |
| EXTERN PetscErrorCode SVDSetOperator(SVD,Mat); |
| EXTERN PetscErrorCode SVDGetOperator(SVD,Mat*); |
| EXTERN PetscErrorCode SVDSetInitialVector(SVD,Vec); |
| EXTERN PetscErrorCode SVDGetInitialVector(SVD,Vec*); |
| EXTERN PetscErrorCode SVDSetTransposeMode(SVD,SVDTransposeMode); |
| EXTERN PetscErrorCode SVDGetTransposeMode(SVD,SVDTransposeMode*); |
| EXTERN PetscErrorCode SVDSetDimensions(SVD,PetscInt,PetscInt,PetscInt); |
| EXTERN PetscErrorCode SVDGetDimensions(SVD,PetscInt*,PetscInt*,PetscInt*); |
| EXTERN PetscErrorCode SVDSetTolerances(SVD,PetscReal,PetscInt); |
| EXTERN PetscErrorCode SVDGetTolerances(SVD,PetscReal*,PetscInt*); |
| EXTERN PetscErrorCode SVDSetWhichSingularTriplets(SVD,SVDWhich); |
| EXTERN PetscErrorCode SVDGetWhichSingularTriplets(SVD,SVDWhich*); |
| EXTERN PetscErrorCode SVDSetFromOptions(SVD); |
| EXTERN PetscErrorCode SVDSetOptionsPrefix(SVD,const char*); |
| EXTERN PetscErrorCode SVDAppendOptionsPrefix(SVD,const char*); |
| EXTERN PetscErrorCode SVDGetOptionsPrefix(SVD,const char*[]); |
| EXTERN PetscErrorCode SVDSetUp(SVD); |
| EXTERN PetscErrorCode SVDSolve(SVD); |
| EXTERN PetscErrorCode SVDGetIterationNumber(SVD,PetscInt*); |
| EXTERN PetscErrorCode SVDGetConvergedReason(SVD,SVDConvergedReason*); |
| EXTERN PetscErrorCode SVDGetConverged(SVD,PetscInt*); |
| EXTERN PetscErrorCode SVDGetSingularTriplet(SVD,PetscInt,PetscReal*,Vec,Vec); |
| EXTERN PetscErrorCode SVDComputeResidualNorms(SVD,PetscInt,PetscReal*,PetscReal*); |
| EXTERN PetscErrorCode SVDComputeRelativeError(SVD,PetscInt,PetscReal*); |
| EXTERN PetscErrorCode SVDGetOperationCounters(SVD,PetscInt*,PetscInt*); |
| EXTERN PetscErrorCode SVDView(SVD,PetscViewer); |
| EXTERN PetscErrorCode SVDDestroy(SVD); |
| EXTERN PetscErrorCode SVDInitializePackage(char*); |
| EXTERN PetscErrorCode SVDMonitorSet(SVD,PetscErrorCode (*)(SVD,PetscInt,PetscInt,PetscReal*,PetscReal*,PetscInt,void*), |
| void*,PetscErrorCode (*monitordestroy)(void*)); |
| EXTERN PetscErrorCode SVDMonitorCancel(SVD); |
| EXTERN PetscErrorCode SVDGetMonitorContext(SVD,void **); |
| EXTERN PetscErrorCode SVDMonitorDefault(SVD,PetscInt,PetscInt,PetscReal*,PetscReal*,PetscInt,void*); |
| EXTERN PetscErrorCode SVDMonitorLG(SVD,PetscInt,PetscInt,PetscReal*,PetscReal*,PetscInt,void*); |
| EXTERN PetscErrorCode SVDDense(PetscInt,PetscInt,PetscScalar*,PetscReal*,PetscScalar*,PetscScalar*); |
| EXTERN PetscErrorCode SVDCrossSetEPS(SVD,EPS); |
| EXTERN PetscErrorCode SVDCrossGetEPS(SVD,EPS*); |
| EXTERN PetscErrorCode SVDCyclicSetExplicitMatrix(SVD,PetscTruth); |
| EXTERN PetscErrorCode SVDCyclicGetExplicitMatrix(SVD,PetscTruth*); |
| EXTERN PetscErrorCode SVDCyclicSetEPS(SVD,EPS); |
| EXTERN PetscErrorCode SVDCyclicGetEPS(SVD,EPS*); |
| EXTERN PetscErrorCode SVDLanczosSetOneSide(SVD,PetscTruth); |
| EXTERN PetscErrorCode SVDTRLanczosSetOneSide(SVD,PetscTruth); |
| EXTERN PetscErrorCode SVDRegister(const char*,const char*,const char*,PetscErrorCode(*)(SVD)); |
| #if defined(PETSC_USE_DYNAMIC_LIBRARIES) |
| #define SVDRegisterDynamic(a,b,c,d) SVDRegister(a,b,c,0) |
| #else |
| #define SVDRegisterDynamic(a,b,c,d) SVDRegister(a,b,c,d) |
| #endif |
| EXTERN PetscErrorCode SVDRegisterDestroy(void); |
| PETSC_EXTERN_CXX_END |
| #endif |
| /* |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #ifndef _EPSIMPL |
| #define _EPSIMPL |
| #include "slepceps.h" |
| extern PetscFList EPSList; |
| extern PetscLogEvent EPS_SetUp, EPS_Solve, EPS_Dense; |
| typedef struct _EPSOps *EPSOps; |
| struct _EPSOps { |
| PetscErrorCode (*solve)(EPS); /* one-sided solver */ |
| PetscErrorCode (*solvets)(EPS); /* two-sided solver */ |
| PetscErrorCode (*setup)(EPS); |
| PetscErrorCode (*setfromoptions)(EPS); |
| PetscErrorCode (*publishoptions)(EPS); |
| PetscErrorCode (*destroy)(EPS); |
| PetscErrorCode (*view)(EPS,PetscViewer); |
| PetscErrorCode (*backtransform)(EPS); |
| PetscErrorCode (*computevectors)(EPS); |
| }; |
| /* |
| Maximum number of monitors you can run with a single EPS |
| */ |
| #define MAXEPSMONITORS 5 |
| /* |
| Defines the EPS data structure. |
| */ |
| struct _p_EPS { |
| PETSCHEADER(struct _EPSOps); |
| /*------------------------- User parameters --------------------------*/ |
| PetscInt max_it, /* maximum number of iterations */ |
| nev, /* number of eigenvalues to compute */ |
| ncv, /* number of basis vectors */ |
| mpd, /* maximum dimension of projected problem */ |
| allocated_ncv, /* number of basis vectors allocated */ |
| nds; /* number of basis vectors of deflation space */ |
| PetscScalar target; /* target value */ |
| PetscTruth target_set; /* flag indicating if target was specified */ |
| PetscReal tol; /* tolerance */ |
| EPSWhich which; /* which part of the spectrum to be sought */ |
| PetscTruth evecsavailable; /* computed eigenvectors */ |
| EPSProblemType problem_type; /* which kind of problem to be solved */ |
| EPSExtraction extraction; /* which kind of extraction to be applied */ |
| EPSClass solverclass; /* whether the selected solver is one- or two-sided */ |
| /*------------------------- Working data --------------------------*/ |
| Vec vec_initial, /* initial vector */ |
| vec_initial_left, /* left initial vector for two-sided solvers */ |
| *V, /* set of basis vectors and computed eigenvectors */ |
| *AV, /* auxiliar set of basis vectors */ |
| *W, /* set of left basis vectors and computed left eigenvectors */ |
| *DS, /* deflation space */ |
| *DSV; /* deflation space and basis vectors*/ |
| PetscScalar *eigr, *eigi, /* real and imaginary parts of eigenvalues */ |
| *T, *Tl; /* projected matrices */ |
| PetscReal *errest, /* error estimates */ |
| *errest_left; /* left error estimates */ |
| ST OP; /* spectral transformation object */ |
| IP ip; /* innerproduct object */ |
| void *data; /* placeholder for misc stuff associated |
| with a particular solver */ |
| PetscInt nconv, /* number of converged eigenvalues */ |
| its, /* number of iterations so far computed */ |
| *perm; /* permutation for eigenvalue ordering */ |
| /* ---------------- Default work-area and status vars -------------------- */ |
| PetscInt nwork; |
| Vec *work; |
| PetscInt setupcalled; |
| PetscTruth isgeneralized, |
| ispositive, |
| ishermitian; |
| EPSConvergedReason reason; |
| PetscErrorCode (*monitor[MAXEPSMONITORS])(EPS,PetscInt,PetscInt,PetscScalar*,PetscScalar*,PetscReal*,PetscInt,void*); |
| PetscErrorCode (*monitordestroy[MAXEPSMONITORS])(void*); |
| void *monitorcontext[MAXEPSMONITORS]; |
| PetscInt numbermonitors; |
| PetscTruth ds_ortho; /* if vectors in DS have to be orthonormalized */ |
| }; |
| #define EPSMonitor(eps,it,nconv,eigr,eigi,errest,nest) \ |
| { PetscErrorCode _ierr; PetscInt _i,_im = eps->numbermonitors; \ |
| for ( _i=0; _i<_im; _i++ ) {\ |
| _ierr=(*eps->monitor[_i])(eps,it,nconv,eigr,eigi,errest,nest,eps->monitorcontext[_i]);\ |
| CHKERRQ(_ierr); \ |
| } \ |
| } |
| EXTERN PetscErrorCode EPSRegisterAll(char *); |
| EXTERN PetscErrorCode EPSDestroy_Default(EPS); |
| EXTERN PetscErrorCode EPSDefaultGetWork(EPS,PetscInt); |
| EXTERN PetscErrorCode EPSDefaultFreeWork(EPS); |
| EXTERN PetscErrorCode EPSAllocateSolution(EPS); |
| EXTERN PetscErrorCode EPSFreeSolution(EPS); |
| EXTERN PetscErrorCode EPSBackTransform_Default(EPS); |
| EXTERN PetscErrorCode EPSComputeVectors_Default(EPS); |
| EXTERN PetscErrorCode EPSComputeVectors_Hermitian(EPS); |
| EXTERN PetscErrorCode EPSComputeVectors_Schur(EPS); |
| /* Private functions of the solver implementations */ |
| EXTERN PetscErrorCode EPSBasicArnoldi(EPS,PetscTruth,PetscScalar*,PetscInt,Vec*,PetscInt,PetscInt*,Vec,PetscReal*,PetscTruth*); |
| EXTERN PetscErrorCode EPSDelayedArnoldi(EPS,PetscScalar*,PetscInt,Vec*,PetscInt,PetscInt*,Vec,PetscReal*,PetscTruth*); |
| EXTERN PetscErrorCode EPSDelayedArnoldi1(EPS,PetscScalar*,PetscInt,Vec*,PetscInt,PetscInt*,Vec,PetscReal*,PetscTruth*); |
| EXTERN PetscErrorCode ArnoldiResiduals(PetscScalar*,PetscInt,PetscScalar*,PetscReal,PetscInt,PetscInt,PetscScalar*,PetscScalar*,PetscReal*,PetscScalar*); |
| EXTERN PetscErrorCode EPSFullLanczos(EPS,PetscReal*,PetscReal*,Vec*,PetscInt,PetscInt*,Vec,PetscTruth*); |
| EXTERN PetscErrorCode EPSTranslateHarmonic(PetscInt,PetscScalar*,PetscInt,PetscScalar,PetscScalar,PetscScalar*,PetscScalar*); |
| #endif |
| /* |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #ifndef _IPIMPL |
| #define _IPIMPL |
| #include "slepcip.h" |
| extern PetscCookie IP_COOKIE; |
| extern PetscLogEvent IP_InnerProduct,IP_Orthogonalize,IP_ApplyMatrix; |
| struct _p_IP { |
| PETSCHEADER(int); |
| IPOrthogonalizationType orthog_type; /* which orthogonalization to use */ |
| IPOrthogonalizationRefinementType orthog_ref; /* refinement method */ |
| PetscReal orthog_eta; |
| IPBilinearForm bilinear_form; |
| Mat matrix; |
| PetscInt innerproducts; |
| /*------------------------- Cache Bx product -------------------*/ |
| PetscInt xid; |
| PetscInt xstate; |
| Vec Bx; |
| }; |
| EXTERN PetscErrorCode IPApplyMatrix_Private(IP,Vec); |
| #endif |
| /* |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #ifndef _SVDIMPL |
| #define _SVDIMPL |
| #include "slepcsvd.h" |
| #include "slepcip.h" |
| extern PetscFList SVDList; |
| extern PetscLogEvent SVD_SetUp, SVD_Solve, SVD_Dense; |
| typedef struct _SVDOps *SVDOps; |
| struct _SVDOps { |
| PetscErrorCode (*solve)(SVD); |
| PetscErrorCode (*setup)(SVD); |
| PetscErrorCode (*setfromoptions)(SVD); |
| PetscErrorCode (*publishoptions)(SVD); |
| PetscErrorCode (*destroy)(SVD); |
| PetscErrorCode (*view)(SVD,PetscViewer); |
| }; |
| /* |
| Maximum number of monitors you can run with a single SVD |
| */ |
| #define MAXSVDMONITORS 5 |
| /* |
| Defines the SVD data structure. |
| */ |
| struct _p_SVD { |
| PETSCHEADER(struct _SVDOps); |
| Mat OP; /* problem matrix */ |
| Mat A; /* problem matrix (m>n) */ |
| Mat AT; /* transposed matrix */ |
| SVDTransposeMode transmode; /* transpose mode */ |
| PetscReal *sigma; /* singular values */ |
| PetscInt *perm; /* permutation for singular value ordering */ |
| Vec *U,*V; /* left and right singular vectors */ |
| Vec vec_initial; /* initial vector */ |
| PetscInt n; /* maximun size of descomposition */ |
| SVDWhich which; /* which singular values are computed */ |
| PetscInt nconv; /* number of converged values */ |
| PetscInt nsv; /* number of requested values */ |
| PetscInt ncv; /* basis size */ |
| PetscInt mpd; /* maximum dimension of projected problem */ |
| PetscInt its; /* iteration counter */ |
| PetscInt max_it; /* max iterations */ |
| PetscReal tol; /* tolerance */ |
| PetscReal *errest; /* error estimates */ |
| void *data; /* placeholder for misc stuff associated |
| with a particular solver */ |
| PetscInt setupcalled; |
| SVDConvergedReason reason; |
| IP ip; |
| PetscErrorCode (*monitor[MAXSVDMONITORS])(SVD,PetscInt,PetscInt,PetscReal*,PetscReal*,PetscInt,void*); |
| PetscErrorCode (*monitordestroy[MAXSVDMONITORS])(void*); |
| void *monitorcontext[MAXSVDMONITORS]; |
| PetscInt numbermonitors; |
| PetscInt matvecs; |
| }; |
| EXTERN PetscErrorCode SVDRegisterAll(char *); |
| #define SVDMonitor(svd,it,nconv,sigma,errest,nest) \ |
| { PetscErrorCode _ierr; PetscInt _i,_im = svd->numbermonitors; \ |
| for ( _i=0; _i<_im; _i++ ) {\ |
| _ierr=(*svd->monitor[_i])(svd,it,nconv,sigma,errest,nest,svd->monitorcontext[_i]);\ |
| CHKERRQ(_ierr); \ |
| } \ |
| } |
| #endif |
| EXTERN PetscErrorCode SVDDestroy_Default(SVD); |
| EXTERN PetscErrorCode SVDMatMult(SVD,PetscTruth,Vec,Vec); |
| EXTERN PetscErrorCode SVDMatGetVecs(SVD,Vec*,Vec*); |
| EXTERN PetscErrorCode SVDMatGetSize(SVD,PetscInt*,PetscInt*); |
| EXTERN PetscErrorCode SVDMatGetLocalSize(SVD,PetscInt*,PetscInt*); |
| EXTERN PetscErrorCode SVDTwoSideLanczos(SVD,PetscReal*,PetscReal*,Vec*,Vec,Vec*,PetscInt,PetscInt,PetscScalar*,Vec,Vec); |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| CFLAGS = |
| FFLAGS = |
| SOURCEC = |
| SOURCEF = |
| SOURCEH = epsimpl.h stimpl.h svdimpl.h ipimpl.h |
| OBJSC = |
| OBJSF = |
| LIBBASE = libslepc |
| DIRS = |
| LOCDIR = include/ |
| MANSEC = |
| include ${SLEPC_DIR}/conf/slepc_common |
| /* |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #ifndef _STIMPL |
| #define _STIMPL |
| #include "slepceps.h" |
| extern PetscLogEvent ST_SetUp, ST_Apply, ST_ApplyB, ST_ApplyTranspose; |
| extern PetscFList STList; |
| typedef struct _STOps *STOps; |
| struct _STOps { |
| PetscErrorCode (*setup)(ST); |
| PetscErrorCode (*apply)(ST,Vec,Vec); |
| PetscErrorCode (*getbilinearform)(ST,Mat*); |
| PetscErrorCode (*applytrans)(ST,Vec,Vec); |
| PetscErrorCode (*setshift)(ST,PetscScalar); |
| PetscErrorCode (*setfromoptions)(ST); |
| PetscErrorCode (*postsolve)(ST); |
| PetscErrorCode (*backtr)(ST,PetscScalar*,PetscScalar*); |
| PetscErrorCode (*destroy)(ST); |
| PetscErrorCode (*view)(ST,PetscViewer); |
| }; |
| struct _p_ST { |
| PETSCHEADER(struct _STOps); |
| /*------------------------- User parameters --------------------------*/ |
| Mat A,B; /* Matrices which define the eigensystem */ |
| PetscScalar sigma; /* Value of the shift */ |
| STMatMode shift_matrix; |
| MatStructure str; /* whether matrices have the same pattern or not */ |
| Mat mat; |
| /*------------------------- Misc data --------------------------*/ |
| KSP ksp; |
| Vec w; |
| void *data; |
| PetscInt setupcalled; |
| PetscInt lineariterations; |
| PetscInt applys; |
| PetscErrorCode (*checknullspace)(ST,PetscInt,const Vec[]); |
| }; |
| EXTERN PetscErrorCode STRegisterAll(char*); |
| EXTERN PetscErrorCode STGetBilinearForm_Default(ST,Mat*); |
| EXTERN PetscErrorCode STView_Default(ST,PetscViewer); |
| EXTERN PetscErrorCode STAssociatedKSPSolve(ST,Vec,Vec); |
| EXTERN PetscErrorCode STAssociatedKSPSolveTranspose(ST,Vec,Vec); |
| EXTERN PetscErrorCode STCheckNullSpace_Default(ST,PetscInt,const Vec[]); |
| EXTERN PetscErrorCode STMatShellCreate(ST st,Mat *mat); |
| #endif |
| /* |
| Necessary routines in BLAS and LAPACK not included in petscblaslapack.f |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #if !defined(__SLEPCBLASLAPACK_H) |
| #define __SLEPCBLASLAPACK_H |
| #include "petscblaslapack.h" |
| /* Macros for building LAPACK names */ |
| #if defined(PETSC_BLASLAPACK_UNDERSCORE) |
| #if defined(PETSC_USE_SINGLE) |
| #define SLEPC_BLASLAPACKREAL(lcase,ucase) s##lcase##_ |
| #if defined(PETSC_USE_COMPLEX) |
| #define SLEPC_BLASLAPACK(lcase,ucase) c##lcase##_ |
| #else |
| #define SLEPC_BLASLAPACK(lcase,ucase) s##lcase##_ |
| #endif |
| #else |
| #define SLEPC_BLASLAPACKREAL(lcase,ucase) d##lcase##_ |
| #if defined(PETSC_USE_COMPLEX) |
| #define SLEPC_BLASLAPACK(lcase,ucase) z##lcase##_ |
| #else |
| #define SLEPC_BLASLAPACK(lcase,ucase) d##lcase##_ |
| #endif |
| #endif |
| #elif defined(PETSC_BLASLAPACK_CAPS) || defined(PETSC_BLASLAPACK_STDCALL) |
| #if defined(PETSC_USE_SINGLE) |
| #define SLEPC_BLASLAPACKREAL(lcase,ucase) S##ucase |
| #if defined(PETSC_USE_COMPLEX) |
| #define SLEPC_BLASLAPACK(lcase,ucase) C##ucase |
| #else |
| #define SLEPC_BLASLAPACK(lcase,ucase) S##ucase |
| #endif |
| #else |
| #define SLEPC_BLASLAPACKREAL(lcase,ucase) D##ucase |
| #if defined(PETSC_USE_COMPLEX) |
| #define SLEPC_BLASLAPACK(lcase,ucase) Z##ucase |
| #else |
| #define SLEPC_BLASLAPACK(lcase,ucase) D##ucase |
| #endif |
| #endif |
| #else |
| #if defined(PETSC_USE_SINGLE) |
| #define SLEPC_BLASLAPACKREAL(lcase,ucase) s##lcase |
| #if defined(PETSC_USE_COMPLEX) |
| #define SLEPC_BLASLAPACK(lcase,ucase) c##lcase |
| #else |
| #define SLEPC_BLASLAPACK(lcase,ucase) s##lcase |
| #endif |
| #else |
| #define SLEPC_BLASLAPACKREAL(lcase,ucase) d##lcase |
| #if defined(PETSC_USE_COMPLEX) |
| #define SLEPC_BLASLAPACK(lcase,ucase) z##lcase |
| #else |
| #define SLEPC_BLASLAPACK(lcase,ucase) d##lcase |
| #endif |
| #endif |
| #endif |
| /* LAPACK functions without string parameters */ |
| #define LAPACKlaev2_ SLEPC_BLASLAPACK(laev2,LAEV2) |
| #define LAPACKgehrd_ SLEPC_BLASLAPACK(gehrd,GEHRD) |
| #define LAPACKgetri_ SLEPC_BLASLAPACK(getri,GETRI) |
| #define LAPACKgelqf_ SLEPC_BLASLAPACK(gelqf,GELQF) |
| #if !defined(PETSC_USE_COMPLEX) |
| #define LAPACKorghr_ SLEPC_BLASLAPACK(orghr,ORGHR) |
| #else |
| #define LAPACKorghr_ SLEPC_BLASLAPACK(unghr,UNGHR) |
| #endif |
| /* LAPACK functions with string parameters */ |
| #if !defined(PETSC_BLASLAPACK_STDCALL) |
| #define BLAStrsm_(a,b,c,d,e,f,g,h,i,j,k) SLEPC_BLASLAPACK(trsm,TRSM) ((a),(b),(c),(d),(e),(f),(g),(h),(i),(j),(k),1,1,1,1) |
| #define LAPACKlanhs_(a,b,c,d,e) SLEPC_BLASLAPACK(lanhs,LANHS) ((a),(b),(c),(d),(e),1) |
| #define LAPACKlange_(a,b,c,d,e,f) SLEPC_BLASLAPACK(lange,LANGE) ((a),(b),(c),(d),(e),(f),1) |
| #define LAPACKstevr_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) SLEPC_BLASLAPACKREAL(stevr,STEVR) ((a),(b),(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),(o),(p),(q),(r),(s),(t),1,1) |
| #define LAPACKbdsdc_(a,b,c,d,e,f,g,h,i,j,k,l,m,n) SLEPC_BLASLAPACKREAL(bdsdc,BDSDC) ((a),(b),(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),1,1) |
| #define LAPACKggevx_(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,aa,ab,ac) SLEPC_BLASLAPACK(ggevx,GGEVX) ((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),(aa),(ab),(ac),1,1,1,1) |
| #define LAPACKsteqr_(a,b,c,d,e,f,g,h) SLEPC_BLASLAPACKREAL(steqr,STEQR) ((a),(b),(c),(d),(e),(f),(g),(h),1) |
| #define LAPACKorgtr_(a,b,c,d,e,f,g,h) SLEPC_BLASLAPACKREAL(orgtr,ORGTR) ((a),(b),(c),(d),(e),(f),(g),(h),1) |
| #define LAPACKsytrd_(a,b,c,d,e,f,g,h,i,j) SLEPC_BLASLAPACKREAL(sytrd,SYTRD) ((a),(b),(c),(d),(e),(f),(g),(h),(i),(j),1) |
| #if !defined(PETSC_USE_COMPLEX) |
| #define LAPACKsyevr_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u) SLEPC_BLASLAPACK(syevr,SYEVR) ((a),(b),(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),(o),(p),(q),(r),(s),(t),(u),1,1,1) |
| #define LAPACKsygvd_(a,b,c,d,e,f,g,h,i,j,k,l,m,n) SLEPC_BLASLAPACK(sygvd,SYGVD) ((a),(b),(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),1,1) |
| #define LAPACKormlq_(a,b,c,d,e,f,g,h,i,j,k,l,m) SLEPC_BLASLAPACK(ormlq,ORMLQ) ((a),(b),(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),1,1) |
| #define LAPACKtrevc_(a,b,c,d,e,f,g,h,i,j,k,l,m,n) SLEPC_BLASLAPACK(trevc,TREVC) ((a),(b),(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),1,1) |
| #define LAPACKgeevx_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w) SLEPC_BLASLAPACK(geevx,GEEVX) ((a),(b),(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),(o),(p),(q),(r),(s),(t),(u),(v),(w),1,1,1,1) |
| #define LAPACKhseqr_(a,b,c,d,e,f,g,h,i,j,k,l,m,n) SLEPC_BLASLAPACK(hseqr,HSEQR) ((a),(b),(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),1,1) |
| #define LAPACKtrexc_(a,b,c,d,e,f,g,h,i,j) SLEPC_BLASLAPACK(trexc,TREXC) ((a),(b),(c),(d),(e),(f),(g),(h),(i),(j),1) |
| #define LAPACKgesdd_(a,b,c,d,e,f,g,h,i,j,k,l,m,n) SLEPC_BLASLAPACK(gesdd,GESDD) ((a),(b),(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),1) |
| #else |
| #define LAPACKsyevr_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w) SLEPC_BLASLAPACK(heevr,HEEVR) ((a),(b),(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),(o),(p),(q),(r),(s),(t),(u),(v),(w),1,1,1) |
| #define LAPACKsygvd_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) SLEPC_BLASLAPACK(hegvd,HEGVD) ((a),(b),(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),(o),(p),1,1) |
| #define LAPACKormlq_(a,b,c,d,e,f,g,h,i,j,k,l,m) SLEPC_BLASLAPACK(unmlq,UNMLQ) ((a),(b),(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),1,1) |
| #define LAPACKtrevc_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) SLEPC_BLASLAPACK(trevc,TREVC) ((a),(b),(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),(o),1,1) |
| #define LAPACKgeevx_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v) SLEPC_BLASLAPACK(geevx,GEEVX) ((a),(b),(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),(o),(p),(q),(r),(s),(t),(u),(v),1,1,1,1) |
| #define LAPACKhseqr_(a,b,c,d,e,f,g,h,i,j,k,l,m) SLEPC_BLASLAPACK(hseqr,HSEQR) ((a),(b),(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),1,1) |
| #define LAPACKtrexc_(a,b,c,d,e,f,g,h,i) SLEPC_BLASLAPACK(trexc,TREXC) ((a),(b),(c),(d),(e),(f),(g),(h),(i),1) |
| #define LAPACKgesdd_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) SLEPC_BLASLAPACK(gesdd,GESDD) ((a),(b),(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),(o),1) |
| #endif |
| #else /* PETSC_BLASLAPACK_STDCALL */ |
| #define BLAStrsm_(a,b,c,d,e,f,g,h,i,j,k) SLEPC_BLASLAPACK(trsm,TRSM) ((a),1,(b),1,(c),1,(d),1,(e),(f),(g),(h),(i),(j),(k)) |
| #define LAPACKlanhs_(a,b,c,d,e) SLEPC_BLASLAPACK(lanhs,LANHS) ((a),1,(b),(c),(d),(e)) |
| #define LAPACKlange_(a,b,c,d,e,f) SLEPC_BLASLAPACK(lange,LANGE) ((a),1,(b),(c),(d),(e),(f)) |
| #define LAPACKstevr_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) SLEPC_BLASLAPACKREAL(stevr,STEVR) ((a),1,(b),1,(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),(o),(p),(q),(r),(s),(t)) |
| #define LAPACKbdsdc_(a,b,c,d,e,f,g,h,i,j,k,l,m,n) SLEPC_BLASLAPACKREAL(bdsdc,BDSDC) ((a),1,(b),1,(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n)) |
| #define LAPACKggevx_(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,aa,ab,ac) SLEPC_BLASLAPACK(ggevx,GGEVX) ((a),1,(b),1,(c),1,(d),1,(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),(o),(p),(q),(r),(s),(t),(u),(v),(w),(x),(y),(z),(aa),(ab),(ac)) |
| #define LAPACKsteqr_(a,b,c,d,e,f,g,h) SLEPC_BLASLAPACKREAL(steqr,STEQR) ((a),1,(b),(c),(d),(e),(f),(g),(h)) |
| #define LAPACKorgtr_(a,b,c,d,e,f,g,h) SLEPC_BLASLAPACKREAL(orgtr,ORGTR) ((a),1,(b),(c),(d),(e),(f),(g),(h)) |
| #define LAPACKsytrd_(a,b,c,d,e,f,g,h,i,j) SLEPC_BLASLAPACKREAL(sytrd,SYTRD) ((a),1,(b),(c),(d),(e),(f),(g),(h),(i),(j)) |
| #if !defined(PETSC_USE_COMPLEX) |
| #define LAPACKsyevr_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u) SLEPC_BLASLAPACK(syevr,SYEVR) ((a),1,(b),1,(c),1,(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),(o),(p),(q),(r),(s),(t),(u)) |
| #define LAPACKsygvd_(a,b,c,d,e,f,g,h,i,j,k,l,m,n) SLEPC_BLASLAPACK(sygvd,SYGVD) ((a),(b),1,(c),1,(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n)) |
| #define LAPACKormlq_(a,b,c,d,e,f,g,h,i,j,k,l,m) SLEPC_BLASLAPACK(ormlq,ORMLQ) ((a),1,(b),1,(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m)) |
| #define LAPACKtrevc_(a,b,c,d,e,f,g,h,i,j,k,l,m,n) SLEPC_BLASLAPACK(trevc,TREVC) ((a),1,(b),1,(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n)) |
| #define LAPACKgeevx_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w) SLEPC_BLASLAPACK(geevx,GEEVX) ((a),1,(b),1,(c),1,(d),1,(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),(o),(p),(q),(r),(s),(t),(u),(v),(w)) |
| #define LAPACKhseqr_(a,b,c,d,e,f,g,h,i,j,k,l,m,n) SLEPC_BLASLAPACK(hseqr,HSEQR) ((a),1,(b),1,(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n)) |
| #define LAPACKtrexc_(a,b,c,d,e,f,g,h,i,j) SLEPC_BLASLAPACK(trexc,TREXC) ((a),1,(b),(c),(d),(e),(f),(g),(h),(i),(j)) |
| #define LAPACKgesdd_(a,b,c,d,e,f,g,h,i,j,k,l,m,n) SLEPC_BLASLAPACK(gesdd,GESDD) ((a),1,(b),(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n)) |
| #else |
| #define LAPACKsyevr_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w) SLEPC_BLASLAPACK(heevr,HEEVR) ((a),1,(b),1,(c),1,(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),(o),(p),(q),(r),(s),(t),(u),(v),(w)) |
| #define LAPACKsygvd_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) SLEPC_BLASLAPACK(hegvd,HEGVD) ((a),(b),1,(c),1,(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),(o),(p)) |
| #define LAPACKormlq_(a,b,c,d,e,f,g,h,i,j,k,l,m) SLEPC_BLASLAPACK(unmlq,UNMLQ) ((a),1,(b),1,(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m)) |
| #define LAPACKtrevc_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) SLEPC_BLASLAPACK(trevc,TREVC) ((a),1,(b),1,(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),(o)) |
| #define LAPACKgeevx_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v) SLEPC_BLASLAPACK(geevx,GEEVX) ((a),1,(b),1,(c),1,(d),1,(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),(o),(p),(q),(r),(s),(t),(u),(v)) |
| #define LAPACKhseqr_(a,b,c,d,e,f,g,h,i,j,k,l,m) SLEPC_BLASLAPACK(hseqr,HSEQR) ((a),1,(b),1,(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m)) |
| #define LAPACKtrexc_(a,b,c,d,e,f,g,h,i) SLEPC_BLASLAPACK(trexc,TREXC) ((a),1,(b),(c),(d),(e),(f),(g),(h),(i)) |
| #define LAPACKgesdd_(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) SLEPC_BLASLAPACK(gesdd,GESDD) ((a),1,(b),(c),(d),(e),(f),(g),(h),(i),(j),(k),(l),(m),(n),(o)) |
| #endif |
| #endif |
| PETSC_EXTERN_CXX_BEGIN |
| EXTERN_C_BEGIN |
| #if !defined(PETSC_BLASLAPACK_STDCALL) |
| /* LAPACK functions without string parameters */ |
| EXTERN void SLEPC_BLASLAPACK(laev2,LAEV2) (PetscScalar*,PetscScalar*,PetscScalar*,PetscReal*,PetscReal*,PetscReal*,PetscScalar*); |
| EXTERN void SLEPC_BLASLAPACK(gehrd,GEHRD) (PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void SLEPC_BLASLAPACK(getri,GETRI) (PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void SLEPC_BLASLAPACK(gelqf,GELQF) (PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*); |
| #if !defined(PETSC_USE_COMPLEX) |
| EXTERN void SLEPC_BLASLAPACK(orghr,ORGHR) (PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*); |
| #else |
| EXTERN void SLEPC_BLASLAPACK(unghr,UNGHR) (PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*); |
| #endif |
| /* LAPACK functions with string parameters */ |
| EXTERN void SLEPC_BLASLAPACK(trsm,TRSM) (const char*,const char*,const char*,const char*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt,PetscBLASInt,PetscBLASInt,PetscBLASInt); |
| EXTERN PetscReal SLEPC_BLASLAPACK(lanhs,LANHS) (const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscBLASInt); |
| EXTERN PetscReal SLEPC_BLASLAPACK(lange,LANGE) (const char*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACKREAL(stevr,STEVR) (const char*,const char*,PetscBLASInt*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscReal*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACKREAL(bdsdc,BDSDC) (const char*,const char*,PetscBLASInt*,PetscReal*,PetscReal*,PetscReal*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACKREAL(steqr,STEQR) (const char*,PetscBLASInt*,PetscReal*,PetscReal*,PetscReal*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACKREAL(orgtr,ORGTR) (const char*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscReal*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACKREAL(sytrd,SYTRD) (const char*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt); |
| #if !defined(PETSC_USE_COMPLEX) |
| EXTERN void SLEPC_BLASLAPACK(hseqr,HSEQR) (const char*,const char*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACK(trexc,TREXC) (const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACK(trevc,TREVC) (const char*,const char*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACK(geevx,GEEVX) (const char*,const char*,const char*,const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt,PetscBLASInt,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACK(ggevx,GGEVX) (const char*,const char*,const char*,const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt,PetscBLASInt,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACK(syevr,SYEVR) (const char*,const char*,const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACK(sygvd,SYGVD) (PetscBLASInt*,const char*,const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACK(gesdd,GESDD) (const char*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACK(ormlq,ORMLQ) (const char*,const char*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt); |
| #else |
| EXTERN void SLEPC_BLASLAPACK(hseqr,HSEQR) (const char*,const char*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACK(trexc,TREXC) (const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACK(trevc,TREVC) (const char*,const char*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscReal*,PetscBLASInt*,PetscBLASInt,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACK(geevx,GEEVX) (const char*,const char*,const char*,const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt,PetscBLASInt,PetscBLASInt,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACK(ggevx,GGEVX) (const char*,const char*,const char*,const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*, PetscBLASInt*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscScalar*, PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt,PetscBLASInt,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACK(heevr,HEEVR) (const char *,const char*,const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscReal*,PetscScalar*,PetscBLASInt*,PetscBLASInt*, PetscScalar*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACK(hegvd,HEGVD) (PetscBLASInt*,const char*,const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACK(gesdd,GESDD) (const char*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACK(unmlq,UNMLQ) (const char*,const char*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACK(ungtr,UNGTR) (const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt); |
| EXTERN void SLEPC_BLASLAPACK(hetrd,HETRD) (const char*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscReal*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt); |
| #endif |
| #else /* PETSC_BLASLAPACK_STDCALL */ |
| /* LAPACK functions without string parameters */ |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(laev2,LAEV2) (PetscScalar*,PetscScalar*,PetscScalar*,PetscReal*,PetscReal*,PetscReal*,PetscScalar*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(gehrd,GEHRD) (PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(getri,GETRI) (PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(gelqf,GELQF) (PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*); |
| #if !defined(PETSC_USE_COMPLEX) |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(orghr,ORGHR) (PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*); |
| #else |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(unghr,UNGHR) (PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*); |
| #endif |
| /* LAPACK functions with string parameters */ |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(trsm,TRSM) (const char*,PetscBLASInt,const char*,PetscBLASInt,const char*,PetscBLASInt,const char*,PetscBLASInt,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*); |
| EXTERN PetscReal PETSC_STDCALL SLEPC_BLASLAPACK(lanhs,LANHS) (const char*,PetscBLASInt,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*); |
| EXTERN PetscReal PETSC_STDCALL SLEPC_BLASLAPACK(lange,LANGE) (const char*,PetscBLASInt,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACKREAL(stevr,STEVR) (const char*,PetscBLASInt,const char*,PetscBLASInt,PetscBLASInt*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscReal*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACKREAL(bdsdc,BDSDC) (const char*,PetscBLASInt,const char*,PetscBLASInt,PetscBLASInt*,PetscReal*,PetscReal*,PetscReal*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACKREAL(steqr,STEQR) (const char*,PetscBLASInt,PetscBLASInt*,PetscReal*,PetscReal*,PetscReal*,PetscBLASInt*,PetscReal*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACKREAL(orgtr,ORGTR) (const char*,PetscBLASInt,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscReal*,PetscReal*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACKREAL(sytrd,SYTRD) (const char*,PetscBLASInt,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscBLASInt*,PetscBLASInt*); |
| #if !defined(PETSC_USE_COMPLEX) |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(hseqr,HSEQR) (const char*,PetscBLASInt,const char*,PetscBLASInt,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(trexc,TREXC) (const char*,PetscBLASInt,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(trevc,TREVC) (const char*,PetscBLASInt,const char*,PetscBLASInt,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(geevx,GEEVX) (const char*,PetscBLASInt,const char*,PetscBLASInt,const char*,PetscBLASInt,const char*,PetscBLASInt,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(ggevx,GGEVX) (const char*,PetscBLASInt,const char*,PetscBLASInt,const char*,PetscBLASInt,const char*,PetscBLASInt,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(syevr,SYEVR) (const char*,PetscBLASInt,const char*,PetscBLASInt,const char*,PetscBLASInt,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(sygvd,SYGVD) (PetscBLASInt*,const char*,PetscBLASInt,const char*,PetscBLASInt,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(gesdd,GESDD) (const char*,PetscBLASInt,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(ormlq,ORMLQ) (const char*,PetscBLASInt,const char*,PetscBLASInt,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*); |
| #else |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(hseqr,HSEQR) (const char*,PetscBLASInt,const char*,PetscBLASInt,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(trexc,TREXC) (const char*,PetscBLASInt,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(trevc,TREVC) (const char*,PetscBLASInt,const char*,PetscBLASInt,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscReal*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(geevx,GEEVX) (const char*,PetscBLASInt,const char*,PetscBLASInt,const char*,PetscBLASInt,const char*,PetscBLASInt,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(ggevx,GGEVX) (const char*,PetscBLASInt,const char*,PetscBLASInt,const char*,PetscBLASInt,const char*,PetscBLASInt,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*, PetscBLASInt*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscScalar*, PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(heevr,HEEVR) (const char*,PetscBLASInt,const char*,PetscBLASInt,const char*,PetscBLASInt,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscReal*,PetscScalar*,PetscBLASInt*,PetscBLASInt*, PetscScalar*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(hegvd,HEGVD) (PetscBLASInt*,const char*,PetscBLASInt,const char*,PetscBLASInt,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(gesdd,GESDD) (const char*,PetscBLASInt,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(unmlq,UNMLQ) (const char*,PetscBLASInt,const char*,PetscBLASInt,PetscBLASInt*,PetscBLASInt*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(ungtr,UNGTR) (const char*,PetscBLASInt,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*); |
| EXTERN void PETSC_STDCALL SLEPC_BLASLAPACK(hetrd,HETRD) (const char*,PetscBLASInt,PetscBLASInt*,PetscScalar*,PetscBLASInt*,PetscReal*,PetscReal*,PetscScalar*,PetscScalar*,PetscBLASInt*,PetscBLASInt*); |
| #endif |
| #endif |
| EXTERN_C_END |
| PETSC_EXTERN_CXX_END |
| #endif |
| /* |
| This is the main SLEPc include file (for C and C++). It is included |
| by all other SLEPc include files, so it almost never has to be |
| specifically included. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #if !defined(__SLEPC_H) |
| #define __SLEPC_H |
| /* ========================================================================== */ |
| /* |
| Current SLEPc version number and release date |
| */ |
| #include "slepcversion.h" |
| /* ========================================================================== */ |
| /* |
| The PETSc include files. |
| */ |
| #include "petsc.h" |
| #include "petscvec.h" |
| #include "petscmat.h" |
| PETSC_EXTERN_CXX_BEGIN |
| /* |
| Initialization of SLEPc and other system routines |
| */ |
| EXTERN PetscErrorCode SlepcInitialize(int*,char***,char[],const char[]); |
| EXTERN PetscErrorCode SlepcFinalize(void); |
| EXTERN PetscErrorCode SlepcInitializeFortran(void); |
| EXTERN PetscErrorCode SlepcVecSetRandom(Vec); |
| EXTERN PetscErrorCode SlepcIsHermitian(Mat,PetscTruth*); |
| #if !defined(PETSC_USE_COMPLEX) |
| EXTERN PetscReal SlepcAbsEigenvalue(PetscScalar,PetscScalar); |
| #else |
| #define SlepcAbsEigenvalue(x,y) PetscAbsScalar(x) |
| #endif |
| EXTERN PetscErrorCode SlepcMatConvertSeqDense(Mat,Mat*); |
| EXTERN PetscErrorCode SlepcCheckOrthogonality(Vec*,PetscInt,Vec *,PetscInt,Mat,PetscScalar*); |
| EXTERN PetscErrorCode SlepcUpdateVectors(PetscInt,Vec*,PetscInt,PetscInt,const PetscScalar*,PetscInt,PetscTruth); |
| extern PetscTruth SlepcInitializeCalled; |
| PETSC_EXTERN_CXX_END |
| #endif |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| CFLAGS = |
| FFLAGS = |
| SOURCEC = |
| SOURCEF = |
| SOURCEH = slepc.h slepceps.h slepcst.h slepcsvd.h slepcip.h slepcversion.h slepcblaslapack.h |
| OBJSC = |
| OBJSF = |
| LIBBASE = libslepc |
| DIRS = finclude private |
| LOCDIR = include/ |
| MANSEC = |
| include ${SLEPC_DIR}/conf/slepc_common |
| GNU LESSER GENERAL PUBLIC LICENSE |
| Version 3, 29 June 2007 |
| Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/> |
| Everyone is permitted to copy and distribute verbatim copies |
| of this license document, but changing it is not allowed. |
| This version of the GNU Lesser General Public License incorporates |
| the terms and conditions of version 3 of the GNU General Public |
| License, supplemented by the additional permissions listed below. |
| 0. Additional Definitions. |
| As used herein, "this License" refers to version 3 of the GNU Lesser |
| General Public License, and the "GNU GPL" refers to version 3 of the GNU |
| General Public License. |
| "The Library" refers to a covered work governed by this License, |
| other than an Application or a Combined Work as defined below. |
| An "Application" is any work that makes use of an interface provided |
| by the Library, but which is not otherwise based on the Library. |
| Defining a subclass of a class defined by the Library is deemed a mode |
| of using an interface provided by the Library. |
| A "Combined Work" is a work produced by combining or linking an |
| Application with the Library. The particular version of the Library |
| with which the Combined Work was made is also called the "Linked |
| Version". |
| The "Minimal Corresponding Source" for a Combined Work means the |
| Corresponding Source for the Combined Work, excluding any source code |
| for portions of the Combined Work that, considered in isolation, are |
| based on the Application, and not on the Linked Version. |
| The "Corresponding Application Code" for a Combined Work means the |
| object code and/or source code for the Application, including any data |
| and utility programs needed for reproducing the Combined Work from the |
| Application, but excluding the System Libraries of the Combined Work. |
| 1. Exception to Section 3 of the GNU GPL. |
| You may convey a covered work under sections 3 and 4 of this License |
| without being bound by section 3 of the GNU GPL. |
| 2. Conveying Modified Versions. |
| If you modify a copy of the Library, and, in your modifications, a |
| facility refers to a function or data to be supplied by an Application |
| that uses the facility (other than as an argument passed when the |
| facility is invoked), then you may convey a copy of the modified |
| version: |
| a) under this License, provided that you make a good faith effort to |
| ensure that, in the event an Application does not supply the |
| function or data, the facility still operates, and performs |
| whatever part of its purpose remains meaningful, or |
| b) under the GNU GPL, with none of the additional permissions of |
| this License applicable to that copy. |
| 3. Object Code Incorporating Material from Library Header Files. |
| The object code form of an Application may incorporate material from |
| a header file that is part of the Library. You may convey such object |
| code under terms of your choice, provided that, if the incorporated |
| material is not limited to numerical parameters, data structure |
| layouts and accessors, or small macros, inline functions and templates |
| (ten or fewer lines in length), you do both of the following: |
| a) Give prominent notice with each copy of the object code that the |
| Library is used in it and that the Library and its use are |
| covered by this License. |
| b) Accompany the object code with a copy of the GNU GPL and this license |
| document. |
| 4. Combined Works. |
| You may convey a Combined Work under terms of your choice that, |
| taken together, effectively do not restrict modification of the |
| portions of the Library contained in the Combined Work and reverse |
| engineering for debugging such modifications, if you also do each of |
| the following: |
| a) Give prominent notice with each copy of the Combined Work that |
| the Library is used in it and that the Library and its use are |
| covered by this License. |
| b) Accompany the Combined Work with a copy of the GNU GPL and this license |
| document. |
| c) For a Combined Work that displays copyright notices during |
| execution, include the copyright notice for the Library among |
| these notices, as well as a reference directing the user to the |
| copies of the GNU GPL and this license document. |
| d) Do one of the following: |
| 0) Convey the Minimal Corresponding Source under the terms of this |
| License, and the Corresponding Application Code in a form |
| suitable for, and under terms that permit, the user to |
| recombine or relink the Application with a modified version of |
| the Linked Version to produce a modified Combined Work, in the |
| manner specified by section 6 of the GNU GPL for conveying |
| Corresponding Source. |
| 1) Use a suitable shared library mechanism for linking with the |
| Library. A suitable mechanism is one that (a) uses at run time |
| a copy of the Library already present on the user's computer |
| system, and (b) will operate properly with a modified version |
| of the Library that is interface-compatible with the Linked |
| Version. |
| e) Provide Installation Information, but only if you would otherwise |
| be required to provide such information under section 6 of the |
| GNU GPL, and only to the extent that such information is |
| necessary to install and execute a modified version of the |
| Combined Work produced by recombining or relinking the |
| Application with a modified version of the Linked Version. (If |
| you use option 4d0, the Installation Information must accompany |
| the Minimal Corresponding Source and Corresponding Application |
| Code. If you use option 4d1, you must provide the Installation |
| Information in the manner specified by section 6 of the GNU GPL |
| for conveying Corresponding Source.) |
| 5. Combined Libraries. |
| You may place library facilities that are a work based on the |
| Library side by side in a single library together with other library |
| facilities that are not Applications and are not covered by this |
| License, and convey such a combined library under terms of your |
| choice, if you do both of the following: |
| a) Accompany the combined library with a copy of the same work based |
| on the Library, uncombined with any other library facilities, |
| conveyed under the terms of this License. |
| b) Give prominent notice with the combined library that part of it |
| is a work based on the Library, and explaining where to find the |
| accompanying uncombined form of the same work. |
| 6. Revised Versions of the GNU Lesser General Public License. |
| The Free Software Foundation may publish revised and/or new versions |
| of the GNU Lesser General Public License from time to time. Such new |
| versions will be similar in spirit to the present version, but may |
| differ in detail to address new problems or concerns. |
| Each version is given a distinguishing version number. If the |
| Library as you received it specifies that a certain numbered version |
| of the GNU Lesser General Public License "or any later version" |
| applies to it, you have the option of following the terms and |
| conditions either of that published version or of any later version |
| published by the Free Software Foundation. If the Library as you |
| received it does not specify a version number of the GNU Lesser |
| General Public License, you may choose any version of the GNU Lesser |
| General Public License ever published by the Free Software Foundation. |
| If the Library as you received it specifies that a proxy can decide |
| whether future versions of the GNU Lesser General Public License shall |
| apply, that proxy's public statement of acceptance of any version is |
| permanent authorization for you to choose that version for the |
| Library. |
| include ${PETSC_DIR}/conf/variables |
| include ${SLEPC_DIR}/${PETSC_ARCH}/conf/slepcvariables |
| SLEPC_LIB_DIR = ${SLEPC_DIR}/${PETSC_ARCH}/lib |
| SLEPC_INCLUDE = -I${SLEPC_DIR} -I${SLEPC_DIR}/${PETSC_ARCH}/include -I${SLEPC_DIR}/include |
| CC_INCLUDES = ${PETSC_INCLUDE} ${SLEPC_INCLUDE} |
| FC_INCLUDES = ${PETSC_INCLUDE} ${SLEPC_INCLUDE} |
| PCONF = ${SLEPC_HAVE_ARPACK} ${SLEPC_HAVE_BLZPACK} ${SLEPC_HAVE_PLANSO} ${SLEPC_HAVE_TRLAN} ${SLEPC_MISSING_LAPACK} ${SLEPC_HAVE_PRIMME} |
| SLEPC_EXTERNAL_LIB = ${ARPACK_LIB} ${BLZPACK_LIB} ${PLANSO_LIB} ${TRLAN_LIB} ${PRIMME_LIB} |
| OTHERSHAREDLIBS = ${SLEPC_EXTERNAL_LIB} |
| INSTALL_LIB_DIR = ${SLEPC_LIB_DIR} |
| CCPPFLAGS = ${PETSC_CCPPFLAGS} ${SLEPC_INCLUDE} ${PCONF} |
| FCPPFLAGS = ${PETSC_FCPPFLAGS} ${SLEPC_INCLUDE} |
| SLEPC_LIB = ${CC_LINKER_SLFLAG}${SLEPC_LIB_DIR} -L${SLEPC_LIB_DIR} -lslepc ${SLEPC_EXTERNAL_LIB} ${PETSC_KSP_LIB} |
| # no longer required |
| SLEPC_FORTRAN_LIB = |
| SHLIBS = libslepc |
| include ${PETSC_DIR}/conf/rules |
| chkslepc_dir: |
| @mypwd=`pwd`; cd ${true_SLEPC_DIR} 2>&1 > /dev/null; true_SLEPC_DIR=`pwd`; cd $${mypwd} 2>&1 >/dev/null; \ |
| newpwd=`echo $${mypwd} | sed "s+$${true_SLEPC_DIR}+DUMMY+g"`;\ |
| hasslepc=`echo $${mypwd} | sed "s+slepc-+DUMMY+g"`;\ |
| if [ $${mypwd} = $${newpwd} -a $${hasslepc} != $${mypwd} ]; then \ |
| echo "*********************Warning*************************" ; \ |
| echo "Your true_SLEPC_DIR may not match the directory you are in";\ |
| echo "true_SLEPC_DIR " $${true_SLEPC_DIR} "Current directory" $${mypwd};\ |
| echo "******************************************************" ; \ |
| fi |
| slepc_manualpages: |
| -@if [ "${MANSEC}" != "" ] ; then \ |
| DOCTEXT_PATH=${PETSC_DIR}/src/docs/tex/doctext; export DOCTEXT_PATH; \ |
| ${DOCTEXT} -html \ |
| -mpath ${LOC}/docs/manualpages/${MANSEC} -heading SLEPc \ |
| -defn ${SLEPC_DIR}/src/docs/tex/doctext/html.def \ |
| -locdir ${LOCDIR} -mapref ${LOC}/docs/manualpages/manualpages.cit \ |
| ${SOURCEC} ${SOURCEH}; \ |
| chmod -f g+w ${LOC}/docs/manualpages/${MANSEC}/* ; fi |
| slepc_html: |
| -@sed -e s?man+../?man+ROOT/docs/manualpages/? ${LOC}/docs/manualpages/manualpages.cit > /tmp/$$USER.htmlmap |
| -@cat ${PETSC_DIR}/src/docs/mpi.www.index >> /tmp/$$USER.htmlmap |
| -@ROOT=`echo ${LOCDIR} | sed -e s?/[a-z]*?/..?g -e s?src/??g -e s?include/??g` ;\ |
| loc=`pwd | sed -e s?\$${PETSC_DIR}?$${LOC}/?g -e s?/disks??g`; \ |
| ${MKDIR} -p $${loc} ;\ |
| for i in ${SOURCEC} ${SOURCEF} ${SOURCEH} ${EXAMPLESC} ${EXAMPLESF} ${EXAMPLESCH} ${EXAMPLESFH} ${EXAMPLESMATLAB} foo ; do\ |
| if [ -f $$i ]; then \ |
| iroot=`echo $$i | sed -e "s?[a-z.]*/??g"`;\ |
| IROOT=`echo $${i} | sed -e s?[.][.]??g` ;\ |
| if [ "$${IROOT}" != "$${i}" ] ; then \ |
| IROOT=".."; \ |
| else \ |
| IROOT=$${ROOT};\ |
| fi;\ |
| ${RM} $${loc}/$$i.html; \ |
| echo "<center><a href=\"$${iroot}\">Actual source code: $${iroot}</a></center><br>" > $${loc}/$$i.html; \ |
| sed -e "s/CHKERRQ(ierr);//g" -e "s/PetscFunctionReturn(0)/return(0)/g" \ |
| -e "s/ierr [ ]*= //g" $$i | ${C2HTML} -n | ${PETSC_DIR}/bin/maint/fixinclude $$i $${ROOT} | \ |
| egrep -v '(PetscValid|PetscFunctionBegin|PetscCheck|PetscErrorCode ierr;|#if !defined\(__|#define __|#undef __|EXTERN_C|extern )' | \ |
| ${MAPNAMES} -map /tmp/$$USER.htmlmap -inhtml | sed -e s?ROOT?$${IROOT}?g >> $${loc}/$$i.html ; \ |
| fi; \ |
| done |
| -@ROOT=`echo ${LOCDIR} | sed -e s?/[a-z]*?/..?g -e s?src/??g -e s?include/??g` ;\ |
| loc=`pwd | sed -e s?\$${PETSC_DIR}?$${LOC}/?g -e s?/disks??g`; ${RM} $${loc}/index.html; \ |
| cat ${SLEPC_DIR}/src/docs/manualpages-sec/header_${MANSEC} | sed -e "s?<A HREF=\"PETSC_DIR[a-z/]*\">Examples</A>?<A HREF=\"$${ROOT}/docs/manualpages/${MANSEC}\">Manual pages</A>?g" -e "s?PETSC_DIR?$${ROOT}/?g"> $${loc}/index.html; \ |
| echo "<p>" >> $${loc}/index.html |
| -@loc=`pwd | sed -e s?\$${PETSC_DIR}?$${LOC}/?g -e s?/disks??g`;\ |
| if [ "${EXAMPLESC}" != "" ] ; then \ |
| for file in ${EXAMPLESC} foo ; do \ |
| if [ -f $$file ]; then \ |
| cmess=`grep "static char help" $${file} | cut -d\" -f2 | cut -d\. -f1`; \ |
| echo "<a href=\"$${file}.html\">$${file}: $${cmess}</a><br>" >> $${loc}/index.html;\ |
| fi; \ |
| done ;\ |
| else \ |
| for file in ${DIRS} foo; do \ |
| if [ -d $$file ]; then \ |
| echo "<a href=\"$${file}/\">$${file}/</a><br>" >> $${loc}/index.html; \ |
| fi; \ |
| done; \ |
| echo " " >> $${loc}/index.html; \ |
| for file in ${SOURCEH} ${SOURCEC} ${SOURCEF} foo ; do \ |
| if [ -f $$file ]; then \ |
| echo "<a href=\"$${file}.html\">$${file}</a><br>" >> $${loc}/index.html; \ |
| fi; \ |
| done; \ |
| fi ;\ |
| echo " " >> $${loc}/index.html; \ |
| echo "<a href=\"makefile.html\">makefile</a><br>" >> $${loc}/index.html |
| -@loc=`pwd | sed -e s?\$${PETSC_DIR}?$${LOC}/?g -e s?/disks??g`; \ |
| cat makefile | ${C2HTML} | ${MAPNAMES} -map /tmp/$$USER.htmlmap -inhtml > $${loc}/makefile.html |
| -@${RM} /tmp/$$USER.htmlmap tmp |
| include ${PETSC_DIR}/conf/variables |
| include ${SLEPC_DIR}/conf/slepcvariables |
| SLEPC_LIB_DIR = ${SLEPC_DIR}/lib |
| SLEPC_INCLUDE = -I${SLEPC_DIR} -I${SLEPC_DIR}/include |
| CC_INCLUDES = ${PETSC_INCLUDE} ${SLEPC_INCLUDE} |
| FC_INCLUDES = ${PETSC_INCLUDE} ${SLEPC_INCLUDE} |
| PCONF = ${SLEPC_HAVE_ARPACK} ${SLEPC_HAVE_BLZPACK} ${SLEPC_HAVE_PLANSO} ${SLEPC_HAVE_TRLAN} ${SLEPC_MISSING_LAPACK} ${SLEPC_HAVE_PRIMME} |
| SLEPC_EXTERNAL_LIB = ${ARPACK_LIB} ${BLZPACK_LIB} ${PLANSO_LIB} ${TRLAN_LIB} ${PRIMME_LIB} |
| INSTALL_LIB_DIR = ${SLEPC_LIB_DIR} |
| CCPPFLAGS = ${PETSC_CCPPFLAGS} ${SLEPC_INCLUDE} ${PCONF} |
| FCPPFLAGS = ${PETSC_FCPPFLAGS} ${SLEPC_INCLUDE} ${PCONF} |
| SLEPC_LIB = ${CC_LINKER_SLFLAG}${SLEPC_LIB_DIR} -L${SLEPC_LIB_DIR} -lslepc ${SLEPC_EXTERNAL_LIB} ${PETSC_KSP_LIB} |
| # no longer required |
| SLEPC_FORTRAN_LIB = |
| SHLIBS = libslepc |
| # |
| # 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! |
| # |
| # |
| # a dummy target which does nothing - just in case |
| # 'ALL: get mapped into this file' |
| # |
| all_dummy: |
| -@true |
| include ${SLEPC_DIR}/conf/slepc_common_variables |
| include ${SLEPC_DIR}/conf/slepc_common_rules |
| include ${PETSC_DIR}/conf/test |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| import os |
| import sys |
| import petscconf |
| import log |
| import check |
| def Check(conf,directory,libs): |
| log.Write('='*80) |
| log.Println('Checking PRIMME library...') |
| if petscconf.PRECISION == 'single': |
| sys.exit('ERROR: PRIMME does not support single precision.') |
| functions_base = ['primme_set_method','primme_Free','primme_initialize'] |
| if directory: |
| dirs = [directory] |
| else: |
| dirs = check.GenerateGuesses('Primme') |
| include = 'PRIMMESRC/COMMONSRC' |
| if not libs: |
| libs = ['-lprimme'] |
| if petscconf.SCALAR == 'real': |
| functions = functions_base + ['dprimme'] |
| else: |
| functions = functions_base + ['zprimme'] |
| for d in dirs: |
| if d: |
| l = ['-L' + d] + libs |
| f = ['-I' + d + '/' + include] |
| else: |
| l = libs |
| f = [] |
| if check.Link(functions,[],l+f): |
| conf.write('SLEPC_HAVE_PRIMME = -DSLEPC_HAVE_PRIMME\n') |
| conf.write('PRIMME_LIB =' + str.join(' ', l) + '\n') |
| conf.write('PRIMME_FLAGS =' + str.join(' ', f) + '\n') |
| return l+f |
| log.Println('ERROR: Unable to link with PRIMME library') |
| print 'ERROR: In directories',dirs |
| print 'ERROR: With flags',libs, |
| log.Exit('') |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| import os |
| import sys |
| import petscconf |
| import log |
| import check |
| def Check(conf): |
| log.Write('='*80) |
| log.Println('Checking LAPACK library...') |
| # LAPACK standard functions |
| l = ['laev2','gehrd','lanhs','lange','getri','hseqr','trexc','trevc','geevx','ggevx','gelqf','gesdd'] |
| # LAPACK functions with different real and complex versions |
| if petscconf.SCALAR == 'real': |
| l += ['orghr','syevr','sygvd','ormlq'] |
| if petscconf.PRECISION == 'single': |
| prefix = 's' |
| else: |
| prefix = 'd' |
| else: |
| l += ['unghr','heevr','hegvd','unmlq','ungtr','hetrd'] |
| if petscconf.PRECISION == 'single': |
| prefix = 'c' |
| else: |
| prefix = 'z' |
| # add prefix to LAPACK names |
| functions = [] |
| for i in l: |
| functions.append(prefix + i) |
| # LAPACK functions which are always used in real version |
| if petscconf.PRECISION == 'single': |
| functions += ['sstevr','sbdsdc','ssteqr','sorgtr','ssytrd'] |
| else: |
| functions += ['dstevr','dbdsdc','dsteqr','dorgtr','dsytrd'] |
| # check for all functions at once |
| all = [] |
| for i in functions: |
| f = '#if defined(PETSC_BLASLAPACK_UNDERSCORE)\n' |
| f += i + '_\n' |
| f += '#elif defined(PETSC_BLASLAPACK_CAPS) || defined(PETSC_BLASLAPACK_STDCALL)\n' |
| f += i.upper() + '\n' |
| f += '#else\n' |
| f += i + '\n' |
| f += '#endif\n' |
| all.append(f) |
| log.Write('=== Checking all LAPACK functions...') |
| if check.Link(all,[],[]): |
| return [] |
| # check functions one by one |
| missing = [] |
| conf.write('SLEPC_MISSING_LAPACK =') |
| for i in functions: |
| f = '#if defined(PETSC_BLASLAPACK_UNDERSCORE)\n' |
| f += i + '_\n' |
| f += '#elif defined(PETSC_BLASLAPACK_CAPS) || defined(PETSC_BLASLAPACK_STDCALL)\n' |
| f += i.upper() + '\n' |
| f += '#else\n' |
| f += i + '\n' |
| f += '#endif\n' |
| log.Write('=== Checking LAPACK '+i+' function...') |
| if not check.Link([f],[],[]): |
| missing.append(i) |
| conf.write(' -DSLEPC_MISSING_LAPACK_' + i[1:].upper()) |
| conf.write('\n') |
| return missing |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| import os |
| import sys |
| import commands |
| import petscconf |
| import log |
| def LinkWithOutput(functions,callbacks,flags): |
| code = '#include "petscksp.h"\n' |
| code += 'EXTERN_C_BEGIN\n' |
| for f in functions: |
| code += 'EXTERN int\n' + f + '();\n' |
| code += 'EXTERN_C_END\n' |
| for c in callbacks: |
| code += 'int '+ c + '() { return 0; } \n' |
| code += 'int main() {\n' |
| code += 'PetscInitialize(PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL);\n' |
| code += 'VecCreate(PETSC_NULL,PETSC_NULL);\n' |
| code += 'MatCreate(PETSC_NULL,PETSC_NULL);\n' |
| code += 'KSPCreate(PETSC_NULL,PETSC_NULL);\n' |
| for f in functions: |
| code += f + '();\n' |
| code += 'return 0;\n}\n' |
| os.chdir('config') |
| cfile = open('checklink.c','w') |
| cfile.write(code) |
| cfile.close() |
| (result, output) = commands.getstatusoutput(petscconf.MAKE + ' checklink TESTFLAGS="'+str.join(' ',flags)+'"') |
| if os.path.exists('checklink.o'): |
| os.unlink('checklink.o') |
| os.chdir(os.pardir) |
| if result: |
| return (0,code + output) |
| else: |
| return (1,code + output) |
| def Link(functions,callbacks,flags): |
| (result, output) = LinkWithOutput(functions,callbacks,flags) |
| log.Write(output) |
| return result |
| def FortranLink(functions,callbacks,flags): |
| output = '\n=== With linker flags: '+str.join(' ',flags) |
| f = [] |
| for i in functions: |
| f.append(i+'_') |
| c = [] |
| for i in callbacks: |
| c.append(i+'_') |
| (result, output1) = LinkWithOutput(f,c,flags) |
| output1 = '\n====== With underscore Fortran names\n' + output1 |
| if result: return ('UNDERSCORE',output1) |
| f = [] |
| for i in functions: |
| f.append(i.upper()) |
| c = [] |
| for i in callbacks: |
| c.append(i.upper()) |
| (result, output2) = LinkWithOutput(f,c,flags) |
| output2 = '\n====== With capital Fortran names\n' + output2 |
| if result: return ('CAPS',output2) |
| (result, output3) = LinkWithOutput(functions,callbacks,flags) |
| output3 = '\n====== With unmodified Fortran names\n' + output3 |
| if result: return ('STDCALL',output3) |
| return ('',output + output1 + output2 + output3) |
| def GenerateGuesses(name): |
| installdirs = ['/usr/local','/opt'] |
| if 'HOME' in os.environ: |
| installdirs.insert(0,os.environ['HOME']) |
| dirs = [] |
| for i in installdirs: |
| dirs = dirs + [i + '/lib'] |
| for d in [name,name.upper(),name.lower()]: |
| dirs = dirs + [i + '/' + d] |
| dirs = dirs + [i + '/' + d + '/lib'] |
| dirs = dirs + [i + '/lib/' + d] |
| for d in dirs[:]: |
| if not os.path.exists(d): |
| dirs.remove(d) |
| dirs = [''] + dirs |
| return dirs |
| def FortranLib(conf,name,dirs,libs,functions,callbacks = []): |
| log.Write('='*80) |
| log.Println('Checking '+name+' library...') |
| error = '' |
| mangling = '' |
| for d in dirs: |
| for l in libs: |
| if d: |
| flags = ['-L' + d] + l |
| else: |
| flags = l |
| (mangling, output) = FortranLink(functions,callbacks,flags) |
| error += output |
| if mangling: break |
| if mangling: break |
| if mangling: |
| log.Write(output) |
| else: |
| log.Write(error) |
| log.Println('ERROR: Unable to link with library '+ name) |
| print 'ERROR: In directories',dirs |
| print 'ERROR: With flags',libs, |
| log.Exit('') |
| conf.write('SLEPC_HAVE_' + name + ' = -DSLEPC_HAVE_' + name + ' -DSLEPC_' + name + '_HAVE_'+mangling+'\n') |
| conf.write(name + '_LIB = '+str.join(' ',flags)+'\n') |
| return flags |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| import os |
| import sys |
| import petscconf |
| import check |
| def Check(conf,directory,libs): |
| if petscconf.SCALAR == 'complex': |
| sys.exit('ERROR: TRLAN does not support complex numbers.') |
| if petscconf.PRECISION == 'single': |
| sys.exit('ERROR: TRLAN does not support single precision.') |
| functions = ['trlan77'] |
| if libs: |
| libs = [libs] |
| else: |
| libs = [['-ltrlan_mpi']] |
| if directory: |
| dirs = [directory] |
| else: |
| dirs = check.GenerateGuesses('TRLan') |
| return check.FortranLib(conf,'TRLAN',dirs,libs,functions) |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| import os |
| import sys |
| import petscconf |
| import check |
| def Check(conf,directory,libs): |
| if petscconf.SCALAR == 'real': |
| if petscconf.PRECISION == 'single': |
| functions = ['psnaupd','psneupd','pssaupd','psseupd'] |
| else: |
| functions = ['pdnaupd','pdneupd','pdsaupd','pdseupd'] |
| else: |
| if petscconf.PRECISION == 'single': |
| functions = ['pcnaupd','pcneupd'] |
| else: |
| functions = ['pznaupd','pzneupd'] |
| if libs: |
| libs = [libs] |
| else: |
| libs = [['-lparpack','-larpack'],['-lparpack_MPI','-larpack'],['-lparpack_MPI-LINUX','-larpack_LINUX'],['-lparpack_MPI-SUN4','-larpack_SUN4']] |
| if directory: |
| dirs = [directory] |
| else: |
| dirs = check.GenerateGuesses('Arpack') |
| return check.FortranLib(conf,'ARPACK',dirs,libs,functions) |
| #!/usr/bin/env python |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| import os |
| import sys |
| import time |
| import petscversion |
| import petscconf |
| import log |
| import check |
| import arpack |
| import blzpack |
| import trlan |
| import lapack |
| import primme |
| if not hasattr(sys, 'version_info') or not sys.version_info[1] >= 2: |
| print '**** You must have Python version 2.2 or higher to run config/configure.py ******' |
| print '* Python is easy to install for end users or sys-admin. *' |
| print '* http://www.python.org/download/ *' |
| print '* *' |
| print '* You CANNOT configure SLEPc without Python *' |
| print '*********************************************************************************' |
| sys.exit(4) |
| # support a few standard configure option types |
| for l in range(1,len(sys.argv)): |
| name = sys.argv[l] |
| if name.startswith('--enable'): |
| sys.argv[l] = name.replace('--enable','--with') |
| if name.find('=') == -1: sys.argv[l] += '=1' |
| if name.startswith('--disable'): |
| sys.argv[l] = name.replace('--disable','--with') |
| if name.find('=') == -1: sys.argv[l] += '=0' |
| elif name.endswith('=1'): sys.argv[l].replace('=1','=0') |
| if name.startswith('--without'): |
| sys.argv[l] = name.replace('--without','--with') |
| if name.find('=') == -1: sys.argv[l] += '=0' |
| elif name.endswith('=1'): sys.argv[l].replace('=1','=0') |
| # Check configure parameters |
| havearpack = 0 |
| arpackdir = '' |
| arpacklibs = [] |
| haveblzpack = 0 |
| blzpackdir = '' |
| blzpacklibs = [] |
| havetrlan = 0 |
| trlandir = '' |
| trlanlibs = [] |
| haveprimme = 0 |
| primmedir = '' |
| primmelibs = [] |
| prefixdir = '' |
| for i in sys.argv[1:]: |
| if i.startswith('--with-arpack-dir='): |
| arpackdir = i.split('=')[1] |
| havearpack = 1 |
| elif i.startswith('--with-arpack-flags='): |
| arpacklibs = i.split('=')[1].split(',') |
| havearpack = 1 |
| elif i.startswith('--with-arpack'): |
| havearpack = not i.endswith('=0') |
| elif i.startswith('--with-blzpack-dir='): |
| blzpackdir = i.split('=')[1] |
| haveblzpack = 1 |
| elif i.startswith('--with-blzpack-flags='): |
| blzpacklibs = i.split('=')[1].split(',') |
| haveblzpack = 1 |
| elif i.startswith('--with-blzpack'): |
| haveblzpack = not i.endswith('=0') |
| elif i.startswith('--with-trlan-dir='): |
| trlandir = i.split('=')[1] |
| havetrlan = 1 |
| elif i.startswith('--with-trlan-flags='): |
| trlanlibs = i.split('=')[1].split(',') |
| havetrlan = 1 |
| elif i.startswith('--with-trlan'): |
| havetrlan = not i.endswith('=0') |
| elif i.startswith('--with-primme-dir'): |
| primmedir = i.split('=')[1] |
| haveprimme = 1 |
| elif i.startswith('--with-primme-flags='): |
| primmelibs = i.split('=')[1].split(',') |
| haveprimme = 1 |
| elif i.startswith('--with-primme'): |
| haveprimme = not i.endswith('=0') |
| elif i.startswith('--prefix='): |
| prefixdir = i.split('=')[1] |
| elif i.startswith('--h') or i.startswith('-h') or i.startswith('-?'): |
| print 'SLEPc Configure Help' |
| print '-'*80 |
| print ' --prefix=<dir> : Specifiy location to install SLEPc (eg. /usr/local)' |
| print 'ARPACK:' |
| print ' --with-arpack : Indicate if you wish to test for ARPACK (PARPACK)' |
| print ' --with-arpack-dir=<dir> : Indicate the directory for ARPACK libraries' |
| print ' --with-arpack-flags=<flags> : Indicate comma-separated flags for linking ARPACK' |
| print 'BLZPACK:' |
| print ' --with-blzpack : Indicate if you wish to test for BLZPACK' |
| print ' --with-blzpack-dir=<dir> : Indicate the directory for BLZPACK libraries' |
| print ' --with-blzpack-flags=<flags> : Indicate comma-separated flags for linking BLZPACK' |
| print 'TRLAN:' |
| print ' --with-trlan : Indicate if you wish to test for TRLAN' |
| print ' --with-trlan-dir=<dir> : Indicate the directory for TRLAN libraries' |
| print ' --with-trlan-flags=<flags> : Indicate comma-separated flags for linking TRLAN' |
| print 'PRIMME:' |
| print ' --with-primme : Indicate if you wish to test for PRIMME' |
| print ' --with-primme-dir=<dir> : Indicate the directory for PRIMME libraries' |
| print ' --with-primme-flags=<flags> : Indicate comma-separated flags for linking PRIMME' |
| sys.exit(0) |
| else: |
| sys.exit('ERROR: Invalid argument ' + i +' use -h for help') |
| # Check if enviroment is ok |
| print 'Checking environment...' |
| if 'SLEPC_DIR' not in os.environ: |
| sys.exit('ERROR: SLEPC_DIR enviroment variable is not set') |
| slepcdir = os.environ['SLEPC_DIR'] |
| if not os.path.exists(slepcdir) or not os.path.exists(os.sep.join([slepcdir,'config'])): |
| sys.exit('ERROR: SLEPC_DIR enviroment variable is not valid') |
| if os.path.realpath(os.getcwd()) != os.path.realpath(slepcdir): |
| sys.exit('ERROR: SLEPC_DIR is not the current directory') |
| if 'PETSC_DIR' not in os.environ: |
| sys.exit('ERROR: PETSC_DIR enviroment variable is not set') |
| petscdir = os.environ['PETSC_DIR'] |
| if not os.path.exists(petscdir): |
| sys.exit('ERROR: PETSC_DIR enviroment variable is not valid') |
| # Check PETSc version |
| petscversion.Load(petscdir) |
| if petscversion.VERSION < '3.0.0': |
| sys.exit('ERROR: This SLEPc version is not compatible with PETSc version '+petscversion.VERSION) |
| # Check some information about PETSc configuration |
| petscconf.Load(petscdir) |
| if not petscconf.PRECISION in ['double','single','matsingle']: |
| sys.exit('ERROR: This SLEPc version does not work with '+petscconf.PRECISION+' precision') |
| if prefixdir and not petscconf.ISINSTALL: |
| sys.exit('ERROR: SLEPc cannot be configured for non-source installation if PETSc is not configured in the same way.') |
| # Create architecture directory and configuration file |
| archdir = os.sep.join([slepcdir,petscconf.ARCH]) |
| if not os.path.exists(archdir): |
| try: |
| os.mkdir(archdir) |
| except: |
| sys.exit('ERROR: cannot create architecture directory ' + archdir) |
| confdir = os.sep.join([archdir,'conf']) |
| if not os.path.exists(confdir): |
| try: |
| os.mkdir(confdir) |
| except: |
| sys.exit('ERROR: cannot create configuration directory ' + confdir) |
| incdir = os.sep.join([archdir,'include']) |
| if not os.path.exists(incdir): |
| try: |
| os.mkdir(incdir) |
| except: |
| sys.exit('ERROR: cannot create include directory ' + incdir) |
| try: |
| slepcconf = open(os.sep.join([confdir,'slepcvariables']),'w') |
| if not prefixdir: |
| prefixdir = archdir |
| slepcconf.write('SLEPC_INSTALL_DIR =' + prefixdir +'\n') |
| except: |
| sys.exit('ERROR: cannot create configuration file in ' + confdir) |
| # Open log file |
| log.Open(os.sep.join([confdir,'configure.log'])) |
| log.Write('='*80) |
| log.Write('Starting Configure Run at '+time.ctime(time.time())) |
| log.Write('Configure Options: '+str.join(' ',sys.argv)) |
| log.Write('Working directory: '+os.getcwd()) |
| log.Write('Python version:\n' + sys.version) |
| log.Write('make: ' + petscconf.MAKE) |
| log.Write('PETSc source directory: ' + petscdir) |
| log.Write('PETSc install directory: ' + petscconf.INSTALL_DIR) |
| log.Write('PETSc version: ' + petscversion.VERSION) |
| log.Write('PETSc architecture: ' + petscconf.ARCH) |
| log.Write('SLEPc source directory: ' + slepcdir) |
| log.Write('SLEPc install directory: ' + prefixdir) |
| log.Write('='*80) |
| # Check if PETSc is working |
| log.Println('Checking PETSc installation...') |
| if petscversion.VERSION > '3.0.0': |
| log.Println('WARNING: PETSc version '+petscversion.VERSION+' is newer than SLEPc version') |
| if petscversion.RELEASE != '1': |
| log.Println('WARNING: using PETSc development version') |
| if petscconf.ISINSTALL: |
| if petscconf.INSTALL_DIR != petscdir: |
| log.Println('WARNING: PETSC_DIR does not point to PETSc installation path') |
| if not check.Link([],[],[]): |
| log.Exit('ERROR: Unable to link with PETSc') |
| # Check for external packages |
| if havearpack: |
| arpacklibs = arpack.Check(slepcconf,arpackdir,arpacklibs) |
| if haveblzpack: |
| blzpacklibs = blzpack.Check(slepcconf,blzpackdir,blzpacklibs) |
| if havetrlan: |
| trlanlibs = trlan.Check(slepcconf,trlandir,trlanlibs) |
| if haveprimme: |
| primmelibs = primme.Check(slepcconf,primmedir,primmelibs) |
| # Check for missing LAPACK functions |
| missing = lapack.Check(slepcconf) |
| slepcconf.close() |
| log.Println('') |
| log.Println('='*80) |
| log.Println('SLEPc Configuration') |
| log.Println('='*80) |
| log.Println('') |
| log.Println('SLEPc source directory:') |
| log.Println(' '+slepcdir) |
| log.Println('SLEPc install directory:') |
| log.Println(' '+prefixdir) |
| log.Println('PETSc directory:') |
| log.Println(' '+petscdir) |
| log.Println('Architecture "'+petscconf.ARCH+'" with '+petscconf.PRECISION+' precision '+petscconf.SCALAR+' numbers') |
| if havearpack: |
| log.Println('ARPACK library flags:') |
| log.Println(' '+str.join(' ',arpacklibs)) |
| if haveblzpack: |
| log.Println('BLZPACK library flags:') |
| log.Println(' '+str.join(' ',blzpacklibs)) |
| if havetrlan: |
| log.Println('TRLAN library flags:') |
| log.Println(' '+str.join(' ',trlanlibs)) |
| if haveprimme: |
| log.Println('PRIMME library flags:') |
| log.Println(' '+str.join(' ',primmelibs)) |
| if missing: |
| log.Println('LAPACK missing functions:') |
| log.Print(' ') |
| for i in missing: log.Print(i) |
| log.Println('') |
| log.Println('') |
| log.Println('WARNING: Some SLEPc functionality will not be available') |
| log.Println('PLEASE reconfigure and recompile PETSc with a full LAPACK implementation') |
| if petscconf.ISINSTALL: |
| log.Println('') |
| log.Println(' **') |
| log.Println(' ** Before running "make" your PETSC_ARCH must be specified with:') |
| log.Println(' ** ** setenv PETSC_ARCH '+petscconf.ARCH+' (csh/tcsh)') |
| log.Println(' ** ** PETSC_ARCH='+petscconf.ARCH+' ; export PETSC_ARCH (sh/bash)') |
| log.Println(' **') |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| import sys |
| import petscconf |
| def Open(filename): |
| global f |
| f = open(filename,'w') |
| return |
| def Println(string): |
| print string |
| f.write(string) |
| f.write('\n') |
| def Print(string): |
| print string, |
| f.write(string+' ') |
| def Write(string): |
| f.write(string) |
| f.write('\n') |
| def Exit(string): |
| f.write(string) |
| f.write('\n') |
| f.close() |
| print string |
| sys.exit('ERROR: See "' + petscconf.ARCH + '/conf/configure.log" file for details') |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| import os |
| import sys |
| def Load(petscdir): |
| global ARCH,DIR,MAKE,SCALAR,PRECISION,ISINSTALL,INSTALL_DIR |
| if 'PETSC_ARCH' in os.environ: |
| ISINSTALL = 0 |
| ARCH = os.environ['PETSC_ARCH'] |
| PETSCVARIABLES = os.sep.join([petscdir,ARCH,'conf','petscvariables']) |
| else: |
| ISINSTALL = 1 |
| ARCH = 'unknown' |
| PETSCVARIABLES = os.sep.join([petscdir,'conf','petscvariables']) |
| try: |
| f = open(PETSCVARIABLES) |
| for l in f.readlines(): |
| (k,v) = l.split('=',1) |
| k = k.strip() |
| v = v.strip() |
| if k == 'PETSC_SCALAR': |
| SCALAR = v |
| elif k == 'PETSC_PRECISION': |
| PRECISION = v |
| elif k == 'MAKE': |
| MAKE = v |
| elif k == 'INSTALL_DIR': |
| INSTALL_DIR = v |
| elif k == 'PETSC_ARCH_NAME': |
| ARCH = v |
| f.close() |
| except: |
| sys.exit('ERROR: PETSc is not configured for architecture ' + ARCH) |
| if ISINSTALL and ARCH == 'unknown': |
| sys.exit('ERROR: PETSc architecture name is not defined') |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| import os |
| import sys |
| def Load(petscdir): |
| global VERSION,RELEASE |
| try: |
| f = open(os.sep.join([petscdir,'include','petscversion.h'])) |
| for l in f.readlines(): |
| l = l.split() |
| if len(l) == 3: |
| if l[1] == 'PETSC_VERSION_RELEASE': |
| RELEASE = l[2] |
| if l[1] == 'PETSC_VERSION_MAJOR': |
| major = l[2] |
| elif l[1] == 'PETSC_VERSION_MINOR': |
| minor = l[2] |
| elif l[1] == 'PETSC_VERSION_SUBMINOR': |
| subminor = l[2] |
| f.close() |
| VERSION = major + '.' + minor + '.' + subminor |
| except: |
| sys.exit('ERROR: file error while reading PETSC version') |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| import os |
| import sys |
| import petscconf |
| import check |
| def Check(conf,directory,libs): |
| if petscconf.SCALAR == 'complex': |
| sys.exit('ERROR: BLZPACK does not support complex numbers.') |
| if petscconf.PRECISION == 'single': |
| functions = ['blzdrs'] |
| else: |
| functions = ['blzdrd'] |
| if libs: |
| libs = [libs] |
| else: |
| libs = [['-lblzpack']] |
| if directory: |
| dirs = [directory] |
| else: |
| dirs = check.GenerateGuesses('Blzpack') |
| return check.FortranLib(conf,'BLZPACK',dirs,libs,functions) |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| include ${PETSC_DIR}/conf/base |
| checklink: checklink.o chkopts |
| ${CLINKER} -o checklink checklink.o ${TESTFLAGS} ${PETSC_KSP_LIB} |
| @${RM} -f checklink checklink.o |
| #!/usr/bin/env python |
| #!/bin/env python |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| # Generates fortran stubs for PETSc using Sowings bfort program |
| # |
| import os |
| # |
| # Opens all generated files and fixes them; also generates list in makefile.src |
| # |
| def FixFile(filename): |
| import re |
| ff = open(filename) |
| data = ff.read() |
| ff.close() |
| # gotta be a better way to do this |
| data = re.subn('\nvoid ','\nvoid PETSC_STDCALL ',data)[0] |
| data = re.subn('\nPetscErrorCode ','\nvoid PETSC_STDCALL ',data)[0] |
| data = re.subn('Petsc([ToRm]*)Pointer\(int\)','Petsc\\1Pointer(void*)',data)[0] |
| data = re.subn('PetscToPointer\(a\) \(a\)','PetscToPointer(a) (*(long *)(a))',data)[0] |
| data = re.subn('PetscFromPointer\(a\) \(int\)\(a\)','PetscFromPointer(a) (long)(a)',data)[0] |
| data = re.subn('PetscToPointer\( \*\(int\*\)','PetscToPointer(',data)[0] |
| data = re.subn('MPI_Comm comm','MPI_Comm *comm',data)[0] |
| data = re.subn('\(MPI_Comm\)PetscToPointer\( \(comm\) \)','MPI_Comm_f2c(*(MPI_Fint*)(comm))',data)[0] |
| data = re.subn('\(PetscInt\* \)PetscToPointer','',data)[0] |
| match = re.compile(r"""\b(PETSC)(_DLL|VEC_DLL|MAT_DLL|DM_DLL|KSP_DLL|SNES_DLL|TS_DLL|FORTRAN_DLL)(EXPORT)""") |
| data = match.sub(r'',data) |
| ff = open(filename, 'w') |
| ff.write('#include "petsc.h"\n#include "petscfix.h"\n'+data) |
| ff.close() |
| return |
| def FixDir(petscdir,dir): |
| mansec = 'unknown' |
| cnames = [] |
| hnames = [] |
| parentdir =os.path.abspath(os.path.join(dir,'..')) |
| for f in os.listdir(dir): |
| ext = os.path.splitext(f)[1] |
| if ext == '.c': |
| FixFile(os.path.join(dir, f)) |
| cnames.append(f) |
| elif ext == '.h90': |
| hnames.append(f) |
| if (cnames != [] or hnames != []): |
| mfile=os.path.abspath(os.path.join(parentdir,'makefile')) |
| try: |
| fd=open(mfile,'r') |
| except: |
| print 'Error! missing file:', mfile |
| return |
| inbuf = fd.read() |
| fd.close() |
| cppflags = "" |
| libbase = "" |
| locdir = "" |
| for line in inbuf.splitlines(): |
| if line.find('CPPFLAGS') >=0: |
| cppflags = line |
| if line.find('LIBBASE') >=0: |
| libbase = line |
| elif line.find('LOCDIR') >=0: |
| locdir = line.rstrip() + 'ftn-auto/' |
| elif line.find('MANSEC') >=0: |
| mansec = line.split('=')[1].lower().strip() |
| # now assemble the makefile |
| outbuf = '\n' |
| outbuf += "#requirespackage 'PETSC_HAVE_FORTRAN'\n" |
| outbuf += 'ALL: lib\n' |
| outbuf += cppflags + '\n' |
| outbuf += 'CFLAGS =\n' |
| outbuf += 'FFLAGS =\n' |
| outbuf += 'SOURCEC = ' +' '.join(cnames)+ '\n' |
| outbuf += 'OBJSC = ' +' '.join(cnames).replace('.c','.o')+ '\n' |
| outbuf += 'SOURCEF =\n' |
| outbuf += 'SOURCEH = ' +' '.join(hnames)+ '\n' |
| outbuf += 'DIRS =\n' |
| outbuf += libbase + '\n' |
| outbuf += locdir + '\n' |
| # outbuf += 'include ${PETSC_DIR}/conf/base\n' |
| # outbuf += 'include ${PETSC_DIR}/conf/test\n' |
| outbuf += 'include ${SLEPC_DIR}/conf/slepc_common \n' |
| ff = open(os.path.join(dir, 'makefile'), 'w') |
| ff.write(outbuf) |
| ff.close() |
| # if dir is empty - remove it |
| if os.path.exists(dir) and os.path.isdir(dir) and os.listdir(dir) == []: |
| os.rmdir(dir) |
| # Now process f90module.f90 file - and update include/finclude/ftn-auto |
| modfile = os.path.join(parentdir,'f90module.f90') |
| if os.path.exists(modfile): |
| fd = open(modfile) |
| txt = fd.read() |
| fd.close() |
| if txt and mansec == 'unknown': |
| print 'makefile has missing MANSEC',parentdir |
| elif txt: |
| ftype = 'w' |
| f90inc = os.path.join(petscdir,'include','finclude','ftn-auto','slepc'+mansec+'.h90') |
| if os.path.exists(f90inc): ftype = 'a' |
| fd = open(f90inc,ftype) |
| fd.write(txt) |
| fd.close() |
| os.remove(modfile) |
| return |
| def PrepFtnDir(dir): |
| if os.path.exists(dir) and not os.path.isdir(dir): |
| raise RuntimeError('Error - specified path is not a dir: ' + dir) |
| elif not os.path.exists(dir): |
| os.mkdir(dir) |
| else: |
| files = os.listdir(dir) |
| for file in files: |
| os.remove(os.path.join(dir,file)) |
| return |
| def processDir(arg,dirname,names): |
| import commands |
| petscdir = arg[0] |
| bfort = arg[1] |
| newls = [] |
| outdir = os.path.join(dirname,'ftn-auto') |
| # skip include/finclude/ftn-auto - as this is processed separately |
| if os.path.realpath(os.path.join(petscdir,'include','finclude','ftn-auto')) == os.path.realpath(outdir): return |
| for l in names: |
| if os.path.splitext(l)[1] =='.c' or os.path.splitext(l)[1] == '.h': |
| newls.append(l) |
| if newls: |
| PrepFtnDir(outdir) |
| options = ['-dir '+outdir, '-mnative', '-ansi', '-nomsgs', '-noprofile', '-anyname', '-mapptr', |
| '-mpi', '-mpi2', '-ferr', '-ptrprefix Petsc', '-ptr64 PETSC_USE_POINTER_CONVERSION', |
| '-fcaps PETSC_HAVE_FORTRAN_CAPS', '-fuscore PETSC_HAVE_FORTRAN_UNDERSCORE','-f90mod_skip_header'] |
| (status,output) = commands.getstatusoutput('cd '+dirname+';'+bfort+' '+' '.join(options+newls)) |
| if status: |
| raise RuntimeError('Error running bfort '+output) |
| FixDir(petscdir,outdir) |
| for name in ['.hg','SCCS', 'output', 'BitKeeper', 'examples', 'externalpackages', 'bilinear', 'ftn-auto','fortran','bin','maint','ftn-custom','config','f90-custom']: |
| if name in names: |
| names.remove(name) |
| # check for configure generated PETSC_ARCHes |
| rmnames=[] |
| for name in names: |
| if os.path.isdir(os.path.join(name,'conf')): |
| rmnames.append(name) |
| for rmname in rmnames: |
| names.remove(rmname) |
| return |
| def main(bfort): |
| petscdir = os.getcwd() |
| tmpdir = os.path |
| ftnautoinc = os.path.join(petscdir,'include','finclude','ftn-auto') |
| PrepFtnDir(ftnautoinc) |
| os.path.walk(petscdir, processDir, [petscdir, bfort]) |
| FixDir(petscdir,ftnautoinc) |
| return |
| # |
| # The classes in this file can also be used in other python-programs by using 'import' |
| # |
| if __name__ == '__main__': |
| import sys |
| if len(sys.argv) < 2: |
| sys.exit('Must give the BFORT program as the first argument') |
| main(sys.argv[1]) |
| SLEPc example matrices |
| ---------------------- |
| Matrices taken from the Non-Hermitian Eigenvalue Problem Collection. |
| Matrix Market - NEP Collection (http://math.nist.gov/MatrixMarket/data/NEP). |
| Saved in MATMPIAIJ format with a PetscViewerBinary. |
| File Name Description |
| ---------------------------------------------------------------------------- |
| rdb200 Brusselator real unsymmetric, 200 by 200, 1120 entries |
| bfw62a Waveguide real unsymmetric, 62 by 62, 450 entries |
| bfw62b real symmetric indefinite, 62 by 62, 342 entries |
| /* |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/fortranimpl.h" |
| #include "slepcst.h" |
| #ifdef PETSC_HAVE_FORTRAN_CAPS |
| #define stsettype_ STSETTYPE |
| #define stgettype_ STGETTYPE |
| #define stcreate_ STCREATE |
| #define stgetoperators_ STGETOPERATORS |
| #define stsetoptionsprefix_ STSETOPTIONSPREFIX |
| #define stappendoptionsprefix_ STAPPENDOPTIONSPREFIX |
| #define stgetoptionsprefix_ STGETOPTIONSPREFIX |
| #define stview_ STVIEW |
| #define stgetmatmode_ STGETMATMODE |
| #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) |
| #define stsettype_ stsettype |
| #define stgettype_ stgettype |
| #define stcreate_ stcreate |
| #define stgetoperators_ stgetoperators |
| #define stsetoptionsprefix_ stsetoptionsprefix |
| #define stappendoptionsprefix_ stappendoptionsprefix |
| #define stgetoptionsprefix_ stgetoptionsprefix |
| #define stview_ stview |
| #define stgetmatmode_ stgetmatmode |
| #endif |
| EXTERN_C_BEGIN |
| void PETSC_STDCALL stsettype_(ST *st,CHAR type PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) |
| { |
| char *t; |
| FIXCHAR(type,len,t); |
| *ierr = STSetType(*st,t); |
| FREECHAR(type,t); |
| } |
| void PETSC_STDCALL stgettype_(ST *st,CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) |
| { |
| const STType tname; |
| *ierr = STGetType(*st,&tname); |
| *ierr = PetscStrncpy(name,tname,len);if (*ierr) return; |
| FIXRETURNCHAR(PETSC_TRUE,name,len); |
| } |
| void PETSC_STDCALL stcreate_(MPI_Fint *comm,ST *newst,PetscErrorCode *ierr) |
| { |
| *ierr = STCreate(MPI_Comm_f2c(*(comm)),newst); |
| } |
| void PETSC_STDCALL stgetoperators_(ST *st,Mat *mat,Mat *pmat,PetscErrorCode *ierr) |
| { |
| if (FORTRANNULLOBJECT(mat)) mat = PETSC_NULL; |
| if (FORTRANNULLOBJECT(pmat)) pmat = PETSC_NULL; |
| *ierr = STGetOperators(*st,mat,pmat); |
| } |
| void PETSC_STDCALL stsetoptionsprefix_(ST *st,CHAR prefix PETSC_MIXED_LEN(len), |
| PetscErrorCode *ierr PETSC_END_LEN(len)) |
| { |
| char *t; |
| FIXCHAR(prefix,len,t); |
| *ierr = STSetOptionsPrefix(*st,t); |
| FREECHAR(prefix,t); |
| } |
| void PETSC_STDCALL stappendoptionsprefix_(ST *st,CHAR prefix PETSC_MIXED_LEN(len), |
| PetscErrorCode *ierr PETSC_END_LEN(len)) |
| { |
| char *t; |
| FIXCHAR(prefix,len,t); |
| *ierr = STAppendOptionsPrefix(*st,t); |
| FREECHAR(prefix,t); |
| } |
| void PETSC_STDCALL stgetoptionsprefix_(ST *st,CHAR prefix PETSC_MIXED_LEN(len), |
| PetscErrorCode *ierr PETSC_END_LEN(len)) |
| { |
| const char *tname; |
| *ierr = STGetOptionsPrefix(*st,&tname); |
| *ierr = PetscStrncpy(prefix,tname,len);if (*ierr) return; |
| } |
| void PETSC_STDCALL stview_(ST *st,PetscViewer *viewer, PetscErrorCode *ierr) |
| { |
| PetscViewer v; |
| PetscPatchDefaultViewers_Fortran(viewer,v); |
| *ierr = STView(*st,v); |
| } |
| void PETSC_STDCALL stgetmatmode_(ST *st,STMatMode *mode,PetscErrorCode *ierr) |
| { |
| *ierr = STGetMatMode(*st,mode); |
| } |
| EXTERN_C_END |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| #requirespackage 'PETSC_HAVE_FORTRAN' |
| ALL: lib |
| CFLAGS = |
| FFLAGS = |
| SOURCEC = zstf.c |
| OBJSC = zstf.o |
| SOURCEF = |
| SOURCEH = |
| DIRS = |
| LIBBASE = libslepc |
| LOCDIR = src/st/interface/ftn-custom/ |
| include ${SLEPC_DIR}/conf/slepc_common |
| /* |
| The ST (spectral transformation) interface routines, callable by users. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/stimpl.h" /*I "slepcst.h" I*/ |
| #undef __FUNCT__ |
| #define __FUNCT__ "STApply" |
| /*@ |
| STApply - Applies the spectral transformation operator to a vector, for |
| instance (A - sB)^-1 B in the case of the shift-and-invert tranformation |
| and generalized eigenproblem. |
| Collective on ST and Vec |
| Input Parameters: |
| + st - the spectral transformation context |
| - x - input vector |
| Output Parameter: |
| . y - output vector |
| Level: developer |
| .seealso: STApplyTranspose() |
| @*/ |
| PetscErrorCode STApply(ST st,Vec x,Vec y) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| PetscValidHeaderSpecific(x,VEC_COOKIE,2); |
| PetscValidHeaderSpecific(y,VEC_COOKIE,3); |
| if (x == y) SETERRQ(PETSC_ERR_ARG_IDN,"x and y must be different vectors"); |
| if (!st->setupcalled) { ierr = STSetUp(st); CHKERRQ(ierr); } |
| ierr = PetscLogEventBegin(ST_Apply,st,x,y,0);CHKERRQ(ierr); |
| st->applys++; |
| ierr = (*st->ops->apply)(st,x,y);CHKERRQ(ierr); |
| ierr = PetscLogEventEnd(ST_Apply,st,x,y,0);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STGetBilinearForm" |
| /*@ |
| STGetBilinearForm - Returns the matrix used in the bilinear form with a semi-definite generalised problem. |
| Collective on ST and Mat |
| Input Parameters: |
| . st - the spectral transformation context |
| Output Parameter: |
| . B - output matrix |
| Note: |
| The output matrix B must be destroyed after use. |
| Level: developer |
| @*/ |
| PetscErrorCode STGetBilinearForm(ST st,Mat *B) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| PetscValidPointer(B,2); |
| ierr = (*st->ops->getbilinearform)(st,B);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STGetBilinearForm_Default" |
| PetscErrorCode STGetBilinearForm_Default(ST st,Mat *B) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| *B = st->B; |
| if (*B) { |
| ierr = PetscObjectReference((PetscObject)*B);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STApplyTranspose" |
| /*@ |
| STApplyTranspose - Applies the transpose of the operator to a vector, for |
| instance B^T(A - sB)^-T in the case of the shift-and-invert tranformation |
| and generalized eigenproblem. |
| Collective on ST and Vec |
| Input Parameters: |
| + st - the spectral transformation context |
| - x - input vector |
| Output Parameter: |
| . y - output vector |
| Level: developer |
| .seealso: STApply() |
| @*/ |
| PetscErrorCode STApplyTranspose(ST st,Vec x,Vec y) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| PetscValidHeaderSpecific(x,VEC_COOKIE,2); |
| PetscValidHeaderSpecific(y,VEC_COOKIE,3); |
| if (x == y) SETERRQ(PETSC_ERR_ARG_IDN,"x and y must be different vectors"); |
| if (!st->setupcalled) { ierr = STSetUp(st); CHKERRQ(ierr); } |
| ierr = PetscLogEventBegin(ST_ApplyTranspose,st,x,y,0);CHKERRQ(ierr); |
| ierr = (*st->ops->applytrans)(st,x,y);CHKERRQ(ierr); |
| ierr = PetscLogEventEnd(ST_ApplyTranspose,st,x,y,0);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STComputeExplicitOperator" |
| /*@ |
| STComputeExplicitOperator - Computes the explicit operator associated |
| to the eigenvalue problem with the specified spectral transformation. |
| Collective on ST |
| Input Parameter: |
| . st - the spectral transform context |
| Output Parameter: |
| . mat - the explicit operator |
| Notes: |
| This routine builds a matrix containing the explicit operator. For |
| example, in generalized problems with shift-and-invert spectral |
| transformation the result would be matrix (A - s B)^-1 B. |
| This computation is done by applying the operator to columns of the |
| identity matrix. Note that the result is a dense matrix. |
| Level: advanced |
| .seealso: STApply() |
| @*/ |
| PetscErrorCode STComputeExplicitOperator(ST st,Mat *mat) |
| { |
| PetscErrorCode ierr; |
| Vec in,out; |
| PetscInt i,M,m,*rows,start,end; |
| PetscScalar *array,one = 1.0; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| PetscValidPointer(mat,2); |
| ierr = MatGetVecs(st->A,&in,&out);CHKERRQ(ierr); |
| ierr = VecGetSize(out,&M);CHKERRQ(ierr); |
| ierr = VecGetLocalSize(out,&m);CHKERRQ(ierr); |
| ierr = VecGetOwnershipRange(out,&start,&end);CHKERRQ(ierr); |
| ierr = PetscMalloc(m*sizeof(PetscInt),&rows);CHKERRQ(ierr); |
| for (i=0; i<m; i++) rows[i] = start + i; |
| ierr = MatCreateMPIDense(((PetscObject)st)->comm,m,m,M,M,PETSC_NULL,mat);CHKERRQ(ierr); |
| for (i=0; i<M; i++) { |
| ierr = VecSet(in,0.0);CHKERRQ(ierr); |
| ierr = VecSetValues(in,1,&i,&one,INSERT_VALUES);CHKERRQ(ierr); |
| ierr = VecAssemblyBegin(in);CHKERRQ(ierr); |
| ierr = VecAssemblyEnd(in);CHKERRQ(ierr); |
| ierr = STApply(st,in,out); CHKERRQ(ierr); |
| ierr = VecGetArray(out,&array);CHKERRQ(ierr); |
| ierr = MatSetValues(*mat,m,rows,1,&i,array,INSERT_VALUES);CHKERRQ(ierr); |
| ierr = VecRestoreArray(out,&array);CHKERRQ(ierr); |
| } |
| ierr = PetscFree(rows);CHKERRQ(ierr); |
| ierr = VecDestroy(in);CHKERRQ(ierr); |
| ierr = VecDestroy(out);CHKERRQ(ierr); |
| ierr = MatAssemblyBegin(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); |
| ierr = MatAssemblyEnd(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STSetUp" |
| /*@ |
| STSetUp - Prepares for the use of a spectral transformation. |
| Collective on ST |
| Input Parameter: |
| . st - the spectral transformation context |
| Level: advanced |
| .seealso: STCreate(), STApply(), STDestroy() |
| @*/ |
| PetscErrorCode STSetUp(ST st) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| PetscInfo(st,"Setting up new ST\n"); |
| if (st->setupcalled) PetscFunctionReturn(0); |
| ierr = PetscLogEventBegin(ST_SetUp,st,0,0,0);CHKERRQ(ierr); |
| if (!st->A) {SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Matrix must be set first");} |
| if (!((PetscObject)st)->type_name) { |
| ierr = STSetType(st,STSHIFT);CHKERRQ(ierr); |
| } |
| if (st->w) { ierr = VecDestroy(st->w);CHKERRQ(ierr); } |
| ierr = MatGetVecs(st->A,&st->w,PETSC_NULL);CHKERRQ(ierr); |
| if (st->ops->setup) { |
| ierr = (*st->ops->setup)(st); CHKERRQ(ierr); |
| } |
| st->setupcalled = 1; |
| ierr = PetscLogEventEnd(ST_SetUp,st,0,0,0);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STPostSolve" |
| /*@ |
| STPostSolve - Optional post-solve phase, intended for any actions that must |
| be performed on the ST object after the eigensolver has finished. |
| Collective on ST |
| Input Parameters: |
| . st - the spectral transformation context |
| Level: developer |
| .seealso: EPSSolve() |
| @*/ |
| PetscErrorCode STPostSolve(ST st) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| if (st->ops->postsolve) { |
| ierr = (*st->ops->postsolve)(st);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STBackTransform" |
| /*@ |
| STBackTransform - Back-transformation phase, intended for |
| spectral transformations which require to transform the computed |
| eigenvalues back to the original eigenvalue problem. |
| Collective on ST |
| Input Parameters: |
| st - the spectral transformation context |
| eigr - real part of a computed eigenvalue |
| eigi - imaginary part of a computed eigenvalue |
| Level: developer |
| .seealso: EPSBackTransform() |
| @*/ |
| PetscErrorCode STBackTransform(ST st,PetscScalar* eigr,PetscScalar* eigi) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| if (st->ops->backtr) { |
| ierr = (*st->ops->backtr)(st,eigr,eigi);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| /* |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/stimpl.h" /*I "slepcst.h" I*/ |
| EXTERN_C_BEGIN |
| EXTERN PetscErrorCode STCreate_Shell(ST); |
| EXTERN PetscErrorCode STCreate_Shift(ST); |
| EXTERN PetscErrorCode STCreate_Sinvert(ST); |
| EXTERN PetscErrorCode STCreate_Cayley(ST); |
| EXTERN PetscErrorCode STCreate_Fold(ST); |
| EXTERN_C_END |
| #undef __FUNCT__ |
| #define __FUNCT__ "STRegisterAll" |
| /*@C |
| STRegisterAll - Registers all of the spectral transformations in the ST package. |
| Not Collective |
| Input Parameter: |
| . path - the library where the routines are to be found (optional) |
| Level: advanced |
| .seealso: STRegisterDynamic() |
| @*/ |
| PetscErrorCode STRegisterAll(char *path) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| ierr = STRegisterDynamic(STSHELL ,path,"STCreate_Shell",STCreate_Shell);CHKERRQ(ierr); |
| ierr = STRegisterDynamic(STSHIFT ,path,"STCreate_Shift",STCreate_Shift);CHKERRQ(ierr); |
| ierr = STRegisterDynamic(STSINV ,path,"STCreate_Sinvert",STCreate_Sinvert);CHKERRQ(ierr); |
| ierr = STRegisterDynamic(STCAYLEY ,path,"STCreate_Cayley",STCreate_Cayley);CHKERRQ(ierr); |
| ierr = STRegisterDynamic(STFOLD ,path,"STCreate_Fold",STCreate_Fold);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| /* |
| The ST (spectral transformation) interface routines, callable by users. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/stimpl.h" /*I "slepcst.h" I*/ |
| PetscCookie ST_COOKIE = 0; |
| PetscLogEvent ST_SetUp = 0, ST_Apply = 0, ST_ApplyTranspose = 0; |
| #undef __FUNCT__ |
| #define __FUNCT__ "STInitializePackage" |
| /*@C |
| STInitializePackage - This function initializes everything in the ST package. It is called |
| from PetscDLLibraryRegister() when using dynamic libraries, and on the first call to STCreate() |
| when using static libraries. |
| Input Parameter: |
| path - The dynamic library path, or PETSC_NULL |
| Level: developer |
| .seealso: SlepcInitialize() |
| @*/ |
| PetscErrorCode STInitializePackage(char *path) { |
| static PetscTruth initialized = PETSC_FALSE; |
| char logList[256]; |
| char *className; |
| PetscTruth opt; |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| if (initialized) PetscFunctionReturn(0); |
| initialized = PETSC_TRUE; |
| /* Register Classes */ |
| ierr = PetscCookieRegister("Spectral Transform",&ST_COOKIE);CHKERRQ(ierr); |
| /* Register Constructors */ |
| ierr = STRegisterAll(path);CHKERRQ(ierr); |
| /* Register Events */ |
| ierr = PetscLogEventRegister("STSetUp",ST_COOKIE,&ST_SetUp);CHKERRQ(ierr); |
| ierr = PetscLogEventRegister("STApply",ST_COOKIE,&ST_Apply);CHKERRQ(ierr); |
| ierr = PetscLogEventRegister("STApplyTranspose",ST_COOKIE,&ST_ApplyTranspose); CHKERRQ(ierr); |
| /* Process info exclusions */ |
| ierr = PetscOptionsGetString(PETSC_NULL, "-log_info_exclude", logList, 256, &opt);CHKERRQ(ierr); |
| if (opt) { |
| ierr = PetscStrstr(logList, "st", &className);CHKERRQ(ierr); |
| if (className) { |
| ierr = PetscInfoDeactivateClass(ST_COOKIE);CHKERRQ(ierr); |
| } |
| } |
| /* Process summary exclusions */ |
| ierr = PetscOptionsGetString(PETSC_NULL, "-log_summary_exclude", logList, 256, &opt);CHKERRQ(ierr); |
| if (opt) { |
| ierr = PetscStrstr(logList, "st", &className);CHKERRQ(ierr); |
| if (className) { |
| ierr = PetscLogEventDeactivateClass(ST_COOKIE);CHKERRQ(ierr); |
| } |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STDestroy" |
| /*@ |
| STDestroy - Destroys ST context that was created with STCreate(). |
| Collective on ST |
| Input Parameter: |
| . st - the spectral transformation context |
| Level: beginner |
| .seealso: STCreate(), STSetUp() |
| @*/ |
| PetscErrorCode STDestroy(ST st) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| if (--((PetscObject)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->A) { ierr = MatDestroy(st->A);CHKERRQ(ierr); } |
| if (st->B) { ierr = MatDestroy(st->B);CHKERRQ(ierr); } |
| if (st->ksp) { ierr = KSPDestroy(st->ksp);CHKERRQ(ierr); } |
| if (st->w) { ierr = VecDestroy(st->w);CHKERRQ(ierr); } |
| if (st->shift_matrix != STMATMODE_INPLACE && st->mat) { |
| ierr = MatDestroy(st->mat);CHKERRQ(ierr); |
| } |
| ierr = PetscHeaderDestroy(st);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STCreate" |
| /*@C |
| STCreate - Creates a spectral transformation context. |
| Collective on MPI_Comm |
| Input Parameter: |
| . comm - MPI communicator |
| Output Parameter: |
| . st - location to put the spectral transformation context |
| Level: beginner |
| .seealso: STSetUp(), STApply(), STDestroy(), ST |
| @*/ |
| PetscErrorCode STCreate(MPI_Comm comm,ST *newst) |
| { |
| PetscErrorCode ierr; |
| ST st; |
| const char *prefix; |
| PetscFunctionBegin; |
| PetscValidPointer(newst,2); |
| *newst = 0; |
| ierr = PetscHeaderCreate(st,_p_ST,struct _STOps,ST_COOKIE,-1,"ST",comm,STDestroy,STView);CHKERRQ(ierr); |
| ierr = PetscMemzero(st->ops,sizeof(struct _STOps));CHKERRQ(ierr); |
| st->A = 0; |
| st->B = 0; |
| st->sigma = 0.0; |
| st->data = 0; |
| st->setupcalled = 0; |
| st->w = 0; |
| st->shift_matrix = STMATMODE_COPY; |
| st->str = DIFFERENT_NONZERO_PATTERN; |
| ierr = KSPCreate(((PetscObject)st)->comm,&st->ksp);CHKERRQ(ierr); |
| ierr = STGetOptionsPrefix(st,&prefix);CHKERRQ(ierr); |
| ierr = KSPSetOptionsPrefix(st->ksp,prefix);CHKERRQ(ierr); |
| ierr = KSPAppendOptionsPrefix(st->ksp,"st_");CHKERRQ(ierr); |
| ierr = PetscObjectIncrementTabLevel((PetscObject)st->ksp,(PetscObject)st,1);CHKERRQ(ierr); |
| *newst = st; |
| ierr = PetscPublishAll(st);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STSetOperators" |
| /*@ |
| STSetOperators - Sets the matrices associated with the eigenvalue problem. |
| Collective on ST and Mat |
| Input Parameters: |
| + st - the spectral transformation context |
| . A - the matrix associated with the eigensystem |
| - B - the second matrix in the case of generalized eigenproblems |
| Notes: |
| To specify a standard eigenproblem, use PETSC_NULL for B. |
| Level: intermediate |
| .seealso: STGetOperators() |
| @*/ |
| PetscErrorCode STSetOperators(ST st,Mat A,Mat B) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| PetscValidHeaderSpecific(A,MAT_COOKIE,2); |
| if (B) PetscValidHeaderSpecific(B,MAT_COOKIE,3); |
| PetscCheckSameComm(st,1,A,2); |
| if (B) PetscCheckSameComm(st,1,B,3); |
| ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr); |
| if (st->A) { ierr = MatDestroy(st->A);CHKERRQ(ierr); } |
| st->A = A; |
| if (B) { ierr = PetscObjectReference((PetscObject)B);CHKERRQ(ierr); } |
| if (st->B) { ierr = MatDestroy(st->B);CHKERRQ(ierr); } |
| st->B = B; |
| st->setupcalled = 0; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STGetOperators" |
| /*@C |
| STGetOperators - Gets the matrices associated with the eigensystem. |
| Not collective, though parallel Mats are returned if the ST is parallel |
| Input Parameter: |
| . st - the spectral transformation context |
| Output Parameters: |
| . A - the matrix associated with the eigensystem |
| - B - the second matrix in the case of generalized eigenproblems |
| Level: intermediate |
| .seealso: STSetOperators() |
| @*/ |
| PetscErrorCode STGetOperators(ST st,Mat *A,Mat *B) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| if (A) *A = st->A; |
| if (B) *B = st->B; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STSetShift" |
| /*@ |
| STSetShift - Sets the shift associated with the spectral transformation |
| Not collective |
| Input Parameters: |
| + st - the spectral transformation context |
| - shift - the value of the shift |
| Note: |
| In some spectral transformations, changing the shift may have associated |
| a lot of work, for example recomputing a factorization. |
| Level: beginner |
| @*/ |
| PetscErrorCode STSetShift(ST st,PetscScalar shift) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| if (st->sigma != shift) { |
| if (st->ops->setshift) { |
| ierr = (*st->ops->setshift)(st,shift); CHKERRQ(ierr); |
| } |
| } |
| st->sigma = shift; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STGetShift" |
| /*@ |
| STGetShift - Gets the shift associated with the spectral transformation. |
| Not collective |
| Input Parameter: |
| . st - the spectral transformation context |
| Output Parameter: |
| . shift - the value of the shift |
| Level: beginner |
| @*/ |
| PetscErrorCode STGetShift(ST st,PetscScalar* shift) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| if (shift) *shift = st->sigma; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STSetOptionsPrefix" |
| /*@C |
| STSetOptionsPrefix - Sets the prefix used for searching for all |
| ST options in the database. |
| Collective on ST |
| Input Parameters: |
| + st - the spectral transformation context |
| - prefix - the prefix string to prepend to all ST option requests |
| Notes: |
| A hyphen (-) must NOT be given at the beginning of the prefix name. |
| The first character of all runtime options is AUTOMATICALLY the |
| hyphen. |
| Level: advanced |
| .seealso: STAppendOptionsPrefix(), STGetOptionsPrefix() |
| @*/ |
| PetscErrorCode STSetOptionsPrefix(ST st,const char *prefix) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| ierr = PetscObjectSetOptionsPrefix((PetscObject)st,prefix);CHKERRQ(ierr); |
| ierr = KSPSetOptionsPrefix(st->ksp,prefix);CHKERRQ(ierr); |
| ierr = KSPAppendOptionsPrefix(st->ksp,"st_");CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STAppendOptionsPrefix" |
| /*@C |
| STAppendOptionsPrefix - Appends to the prefix used for searching for all |
| ST options in the database. |
| Collective on ST |
| Input Parameters: |
| + st - the spectral transformation context |
| - prefix - the prefix string to prepend to all ST option requests |
| Notes: |
| A hyphen (-) must NOT be given at the beginning of the prefix name. |
| The first character of all runtime options is AUTOMATICALLY the |
| hyphen. |
| Level: advanced |
| .seealso: STSetOptionsPrefix(), STGetOptionsPrefix() |
| @*/ |
| PetscErrorCode STAppendOptionsPrefix(ST st,const char *prefix) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| ierr = PetscObjectAppendOptionsPrefix((PetscObject)st,prefix);CHKERRQ(ierr); |
| ierr = KSPSetOptionsPrefix(st->ksp,((PetscObject)st)->prefix);CHKERRQ(ierr); |
| ierr = KSPAppendOptionsPrefix(st->ksp,"st_");CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STGetOptionsPrefix" |
| /*@C |
| STGetOptionsPrefix - Gets the prefix used for searching for all |
| ST options in the database. |
| Not Collective |
| Input Parameters: |
| . st - the spectral transformation context |
| Output Parameters: |
| . prefix - pointer to the prefix string used, is returned |
| Notes: On the Fortran side, the user should pass in a string 'prefix' of |
| sufficient length to hold the prefix. |
| Level: advanced |
| .seealso: STSetOptionsPrefix(), STAppendOptionsPrefix() |
| @*/ |
| PetscErrorCode STGetOptionsPrefix(ST st,const char *prefix[]) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| ierr = PetscObjectGetOptionsPrefix((PetscObject)st, prefix);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STView" |
| /*@C |
| STView - Prints the ST data structure. |
| Collective on ST |
| Input Parameters: |
| + ST - the ST context |
| - viewer - optional visualization context |
| Note: |
| The available visualization contexts include |
| + PETSC_VIEWER_STDOUT_SELF - standard output (default) |
| - PETSC_VIEWER_STDOUT_WORLD - synchronized standard |
| output where only the first processor opens |
| the file. All other processors send their |
| data to the first processor to print. |
| The user can open an alternative visualization contexts with |
| PetscViewerASCIIOpen() (output to a specified file). |
| Level: beginner |
| .seealso: EPSView(), PetscViewerASCIIOpen() |
| @*/ |
| PetscErrorCode STView(ST st,PetscViewer viewer) |
| { |
| PetscErrorCode ierr; |
| const STType cstr; |
| const char* str; |
| PetscTruth isascii,isstring; |
| PetscViewerFormat format; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| if (!viewer) viewer = PETSC_VIEWER_STDOUT_(((PetscObject)st)->comm); |
| PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE,2); |
| PetscCheckSameComm(st,1,viewer,2); |
| ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);CHKERRQ(ierr); |
| ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_STRING,&isstring);CHKERRQ(ierr); |
| if (isascii) { |
| ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr); |
| ierr = PetscViewerASCIIPrintf(viewer,"ST Object:\n");CHKERRQ(ierr); |
| ierr = STGetType(st,&cstr);CHKERRQ(ierr); |
| if (cstr) { |
| ierr = PetscViewerASCIIPrintf(viewer," type: %s\n",cstr);CHKERRQ(ierr); |
| } else { |
| ierr = PetscViewerASCIIPrintf(viewer," type: not yet set\n");CHKERRQ(ierr); |
| } |
| #if !defined(PETSC_USE_COMPLEX) |
| ierr = PetscViewerASCIIPrintf(viewer," shift: %g\n",st->sigma);CHKERRQ(ierr); |
| #else |
| ierr = PetscViewerASCIIPrintf(viewer," shift: %g+%g i\n",PetscRealPart(st->sigma),PetscImaginaryPart(st->sigma));CHKERRQ(ierr); |
| #endif |
| switch (st->shift_matrix) { |
| case STMATMODE_COPY: |
| break; |
| case STMATMODE_INPLACE: |
| ierr = PetscViewerASCIIPrintf(viewer,"Shifting the matrix and unshifting at exit\n");CHKERRQ(ierr); |
| break; |
| case STMATMODE_SHELL: |
| ierr = PetscViewerASCIIPrintf(viewer,"Using a shell matrix\n");CHKERRQ(ierr); |
| break; |
| } |
| if (st->B && st->shift_matrix != STMATMODE_SHELL) { |
| switch (st->str) { |
| case SAME_NONZERO_PATTERN: str = "same nonzero pattern";break; |
| case DIFFERENT_NONZERO_PATTERN: str = "different nonzero pattern";break; |
| case SUBSET_NONZERO_PATTERN: str = "subset nonzero pattern";break; |
| default: SETERRQ(1,"Wrong structure flag"); |
| } |
| ierr = PetscViewerASCIIPrintf(viewer,"Matrices A and B have %s\n",str);CHKERRQ(ierr); |
| } |
| if (st->ops->view) { |
| ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr); |
| ierr = (*st->ops->view)(st,viewer);CHKERRQ(ierr); |
| ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr); |
| } |
| } else if (isstring) { |
| ierr = STGetType(st,&cstr);CHKERRQ(ierr); |
| ierr = PetscViewerStringSPrintf(viewer," %-7.7s",cstr);CHKERRQ(ierr); |
| if (st->ops->view) {ierr = (*st->ops->view)(st,viewer);CHKERRQ(ierr);} |
| } else { |
| SETERRQ1(1,"Viewer type %s not supported by ST",((PetscObject)viewer)->type_name); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STView_Default" |
| PetscErrorCode STView_Default(ST st,PetscViewer viewer) |
| { |
| PetscErrorCode ierr; |
| PetscTruth isascii,isstring; |
| PetscFunctionBegin; |
| ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);CHKERRQ(ierr); |
| ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_STRING,&isstring);CHKERRQ(ierr); |
| if (isascii) { |
| ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr); |
| ierr = PetscViewerASCIIPrintf(viewer,"Associated KSP object\n");CHKERRQ(ierr); |
| ierr = PetscViewerASCIIPrintf(viewer,"------------------------------\n");CHKERRQ(ierr); |
| ierr = KSPView(st->ksp,viewer);CHKERRQ(ierr); |
| ierr = PetscViewerASCIIPrintf(viewer,"------------------------------\n");CHKERRQ(ierr); |
| ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr); |
| } else if (isstring) { |
| ierr = KSPView(st->ksp,viewer);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| /*MC |
| STRegisterDynamic - Adds a method to the spectral transformation package. |
| Synopsis: |
| STRegisterDynamic(char *name_solver,char *path,char *name_create,PetscErrorCode (*routine_create)(ST)) |
| Not collective |
| Input Parameters: |
| + name_solver - name of a new user-defined solver |
| . path - path (either absolute or relative) the library containing this solver |
| . name_create - name of routine to create method context |
| - routine_create - routine to create method context |
| Notes: |
| STRegisterDynamic() may be called multiple times to add several user-defined spectral transformations. |
| If dynamic libraries are used, then the fourth input argument (routine_create) |
| is ignored. |
| Sample usage: |
| .vb |
| STRegisterDynamic("my_solver","/home/username/my_lib/lib/libO/solaris/mylib.a", |
| "MySolverCreate",MySolverCreate); |
| .ve |
| Then, your solver can be chosen with the procedural interface via |
| $ STSetType(st,"my_solver") |
| or at runtime via the option |
| $ -st_type my_solver |
| Level: advanced |
| $PETSC_DIR, $PETSC_ARCH and $PETSC_LIB_DIR occuring in pathname will be replaced with appropriate values. |
| .seealso: STRegisterDestroy(), STRegisterAll() |
| M*/ |
| #undef __FUNCT__ |
| #define __FUNCT__ "STRegister" |
| /*@C |
| STRegister - See STRegisterDynamic() |
| Level: advanced |
| @*/ |
| PetscErrorCode STRegister(const char *sname,const char *path,const char *name,PetscErrorCode (*function)(ST)) |
| { |
| PetscErrorCode ierr; |
| char fullname[256]; |
| PetscFunctionBegin; |
| ierr = PetscFListConcat(path,name,fullname);CHKERRQ(ierr); |
| ierr = PetscFListAdd(&STList,sname,fullname,(void (*)(void))function);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STRegisterDestroy" |
| /*@ |
| STRegisterDestroy - Frees the list of ST methods that were |
| registered by STRegisterDynamic(). |
| Not Collective |
| Level: advanced |
| .seealso: STRegisterDynamic(), STRegisterAll() |
| @*/ |
| PetscErrorCode STRegisterDestroy(void) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| ierr = PetscFListDestroy(&STList);CHKERRQ(ierr); |
| ierr = STRegisterAll(PETSC_NULL);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| /* |
| Routines to set ST methods and options. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/stimpl.h" /*I "slepcst.h" I*/ |
| #include "petscsys.h" |
| /* |
| Contains the list of registered ST routines |
| */ |
| PetscFList STList = 0; |
| #undef __FUNCT__ |
| #define __FUNCT__ "STSetType" |
| /*@C |
| STSetType - Builds ST for a particular spectral transformation. |
| Collective on ST |
| Input Parameter: |
| + st - the spectral transformation context. |
| - type - a known type |
| Options Database Key: |
| . -st_type <type> - Sets ST type |
| Use -help for a list of available transformations |
| Notes: |
| See "slepc/include/slepcst.h" for available transformations |
| Normally, it is best to use the EPSSetFromOptions() command and |
| then set the ST type from the options database rather than by using |
| this routine. Using the options database provides the user with |
| maximum flexibility in evaluating the many different transformations. |
| Level: intermediate |
| .seealso: EPSSetType() |
| @*/ |
| PetscErrorCode STSetType(ST st,const STType type) |
| { |
| PetscErrorCode ierr,(*r)(ST); |
| PetscTruth match; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| PetscValidCharPointer(type,2); |
| ierr = PetscTypeCompare((PetscObject)st,type,&match);CHKERRQ(ierr); |
| if (match) PetscFunctionReturn(0); |
| if (st->ops->destroy) {ierr = (*st->ops->destroy)(st);CHKERRQ(ierr);} |
| ierr = PetscFListDestroy(&((PetscObject)st)->qlist);CHKERRQ(ierr); |
| st->data = 0; |
| st->setupcalled = 0; |
| /* Determine the STCreateXXX routine for a particular type */ |
| ierr = PetscFListFind(STList, ((PetscObject)st)->comm, type,(void (**)(void)) &r );CHKERRQ(ierr); |
| if (!r) SETERRQ1(1,"Unable to find requested ST type %s",type); |
| ierr = PetscFree(st->data);CHKERRQ(ierr); |
| ierr = PetscMemzero(st->ops,sizeof(struct _STOps));CHKERRQ(ierr); |
| /* Call the STCreateXXX routine for this particular type */ |
| ierr = (*r)(st);CHKERRQ(ierr); |
| ierr = PetscObjectChangeTypeName((PetscObject)st,type);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STGetType" |
| /*@C |
| STGetType - Gets the ST type name (as a string) from the ST context. |
| Not Collective |
| Input Parameter: |
| . st - the spectral transformation context |
| Output Parameter: |
| . name - name of the spectral transformation |
| Level: intermediate |
| .seealso: STSetType() |
| @*/ |
| PetscErrorCode STGetType(ST st,const STType *type) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| PetscValidPointer(type,2); |
| *type = ((PetscObject)st)->type_name; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STSetFromOptions" |
| /*@ |
| STSetFromOptions - Sets ST options from the options database. |
| This routine must be called before STSetUp() if the user is to be |
| allowed to set the type of transformation. |
| Collective on ST |
| Input Parameter: |
| . st - the spectral transformation context |
| Level: beginner |
| .seealso: |
| @*/ |
| PetscErrorCode STSetFromOptions(ST st) |
| { |
| PetscErrorCode ierr; |
| PetscInt i; |
| char type[256]; |
| PetscTruth flg; |
| const char *mode_list[3] = { "copy", "inplace", "shell" }; |
| const char *structure_list[3] = { "same", "different", "subset" }; |
| PC pc; |
| const char *pctype; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| ierr = PetscOptionsBegin(((PetscObject)st)->comm,((PetscObject)st)->prefix,"Spectral Transformation (ST) Options","ST");CHKERRQ(ierr); |
| ierr = PetscOptionsList("-st_type","Spectral Transformation type","STSetType",STList,(char*)(((PetscObject)st)->type_name?((PetscObject)st)->type_name:STSHIFT),type,256,&flg);CHKERRQ(ierr); |
| if (flg) { |
| ierr = STSetType(st,type);CHKERRQ(ierr); |
| } |
| /* |
| Set the type if it was never set. |
| */ |
| if (!((PetscObject)st)->type_name) { |
| ierr = STSetType(st,STSHIFT);CHKERRQ(ierr); |
| } |
| ierr = PetscOptionsScalar("-st_shift","Value of the shift","STSetShift",st->sigma,&st->sigma,PETSC_NULL); CHKERRQ(ierr); |
| ierr = PetscOptionsEList("-st_matmode", "Shift matrix mode","STSetMatMode",mode_list,3,mode_list[st->shift_matrix],&i,&flg);CHKERRQ(ierr); |
| if (flg) { st->shift_matrix = (STMatMode)i; } |
| ierr = PetscOptionsEList("-st_matstructure", "Shift nonzero pattern","STSetMatStructure",structure_list,3,structure_list[st->str],&i,&flg);CHKERRQ(ierr); |
| if (flg) { st->str = (MatStructure)i; } |
| if (st->ops->setfromoptions) { |
| ierr = (*st->ops->setfromoptions)(st);CHKERRQ(ierr); |
| } |
| ierr = PetscOptionsEnd();CHKERRQ(ierr); |
| if (st->ksp) { |
| ierr = KSPGetPC(st->ksp,&pc);CHKERRQ(ierr); |
| ierr = PCGetType(pc,&pctype);CHKERRQ(ierr); |
| if (!pctype) { |
| if (st->shift_matrix == STMATMODE_SHELL) { |
| /* in shell mode use GMRES with Jacobi as the default */ |
| ierr = KSPSetType(st->ksp,KSPGMRES);CHKERRQ(ierr); |
| ierr = PCSetType(pc,PCJACOBI);CHKERRQ(ierr); |
| } else { |
| /* use direct solver as default */ |
| ierr = KSPSetType(st->ksp,KSPPREONLY);CHKERRQ(ierr); |
| ierr = PCSetType(pc,PCREDUNDANT);CHKERRQ(ierr); |
| } |
| } |
| ierr = KSPSetFromOptions(st->ksp);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STSetMatStructure" |
| /*@ |
| STSetMatStructure - Sets an internal MatStructure attribute to |
| indicate which is the relation of the sparsity pattern of the two matrices |
| A and B constituting the generalized eigenvalue problem. This function |
| has no effect in the case of standard eigenproblems. |
| Collective on ST |
| Input Parameters: |
| + st - the spectral transformation context |
| - str - either SAME_NONZERO_PATTERN, DIFFERENT_NONZERO_PATTERN or |
| SUBSET_NONZERO_PATTERN |
| Options Database Key: |
| . -st_matstructure <str> - Indicates the structure flag, where <str> is one |
| of 'same' (A and B have the same nonzero pattern), 'different' (A |
| and B have different nonzero pattern) or 'subset' (B's nonzero |
| pattern is a subset of A's). |
| Note: |
| By default, the sparsity patterns are assumed to be different. If the |
| patterns are equal or a subset then it is recommended to set this attribute |
| for efficiency reasons (in particular, for internal MatAXPY() operations). |
| Level: advanced |
| .seealso: STSetOperators(), MatAXPY() |
| @*/ |
| PetscErrorCode STSetMatStructure(ST st,MatStructure str) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| switch (str) { |
| case SAME_NONZERO_PATTERN: |
| case DIFFERENT_NONZERO_PATTERN: |
| case SUBSET_NONZERO_PATTERN: |
| st->str = str; |
| break; |
| default: |
| SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Invalid matrix structure flag"); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STSetMatMode" |
| /*@ |
| STSetMatMode - Sets a flag to indicate how the matrix is |
| being shifted in the shift-and-invert and Cayley spectral transformations. |
| Collective on ST |
| Input Parameters: |
| + st - the spectral transformation context |
| - mode - the mode flag, one of STMATMODE_COPY, |
| STMATMODE_INPLACE or STMATMODE_SHELL |
| Options Database Key: |
| . -st_matmode <mode> - Indicates the mode flag, where <mode> is one of |
| 'copy', 'inplace' or 'shell' (see explanation below). |
| Notes: |
| By default (STMATMODE_COPY), a copy of matrix A is made and then |
| this copy is shifted explicitly, e.g. A <- (A - s B). |
| With STMATMODE_INPLACE, the original matrix A is shifted at |
| STSetUp() and unshifted at the end of the computations. With respect to |
| the previous one, this mode avoids a copy of matrix A. However, a |
| backdraw is that the recovered matrix might be slightly different |
| from the original one (due to roundoff). |
| With STMATMODE_SHELL, the solver works with an implicit shell |
| matrix that represents the shifted matrix. This mode is the most efficient |
| in creating the shifted matrix but it places serious limitations to the |
| linear solves performed in each iteration of the eigensolver (typically, |
| only interative solvers with Jacobi preconditioning can be used). |
| In the case of generalized problems, in the two first modes the matrix |
| A - s B has to be computed explicitly. The efficiency of this computation |
| can be controlled with STSetMatStructure(). |
| Level: intermediate |
| .seealso: STSetOperators(), STSetMatStructure(), STGetMatMode(), STMatMode |
| @*/ |
| PetscErrorCode STSetMatMode(ST st,STMatMode mode) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| st->shift_matrix = mode; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STGetMatMode" |
| /*@C |
| STGetMatMode - Gets a flag that indicates how the matrix is being |
| shifted in the shift-and-invert and Cayley spectral transformations. |
| Collective on ST |
| Input Parameter: |
| . st - the spectral transformation context |
| Output Parameter: |
| . mode - the mode flag |
| Level: intermediate |
| .seealso: STSetMatMode(), STMatMode |
| @*/ |
| PetscErrorCode STGetMatMode(ST st,STMatMode *mode) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| *mode = st->shift_matrix; |
| PetscFunctionReturn(0); |
| } |
| /* |
| This file contains the subroutines which implement various operations |
| of the matrix associated to the shift-and-invert technique for eigenvalue |
| problems, and also a subroutine to create it. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/stimpl.h" |
| #undef __FUNCT__ |
| #define __FUNCT__ "STMatShellMult" |
| PetscErrorCode STMatShellMult(Mat A,Vec x,Vec y) |
| { |
| PetscErrorCode ierr; |
| ST ctx; |
| PetscFunctionBegin; |
| ierr = MatShellGetContext(A,(void**)&ctx);CHKERRQ(ierr); |
| ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr); |
| if (ctx->sigma != 0.0) { |
| if (ctx->B) { /* y = (A - sB) x */ |
| ierr = MatMult(ctx->B,x,ctx->w);CHKERRQ(ierr); |
| ierr = VecAXPY(y,-ctx->sigma,ctx->w);CHKERRQ(ierr); |
| } else { /* y = (A - sI) x */ |
| ierr = VecAXPY(y,-ctx->sigma,x);CHKERRQ(ierr); |
| } |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STMatShellMultTranspose" |
| PetscErrorCode STMatShellMultTranspose(Mat A,Vec x,Vec y) |
| { |
| PetscErrorCode ierr; |
| ST ctx; |
| PetscFunctionBegin; |
| ierr = MatShellGetContext(A,(void**)&ctx);CHKERRQ(ierr); |
| ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr); |
| if (ctx->sigma != 0.0) { |
| if (ctx->B) { /* y = (A - sB) x */ |
| ierr = MatMultTranspose(ctx->B,x,ctx->w);CHKERRQ(ierr); |
| ierr = VecAXPY(y,-ctx->sigma,ctx->w);CHKERRQ(ierr); |
| } else { /* y = (A - sI) x */ |
| ierr = VecAXPY(y,-ctx->sigma,x);CHKERRQ(ierr); |
| } |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STMatShellGetDiagonal" |
| PetscErrorCode STMatShellGetDiagonal(Mat A,Vec diag) |
| { |
| PetscErrorCode ierr; |
| ST ctx; |
| Vec diagb; |
| PetscFunctionBegin; |
| ierr = MatShellGetContext(A,(void**)&ctx);CHKERRQ(ierr); |
| ierr = MatGetDiagonal(ctx->A,diag);CHKERRQ(ierr); |
| if (ctx->sigma != 0.0) { |
| if (ctx->B) { |
| ierr = VecDuplicate(diag,&diagb);CHKERRQ(ierr); |
| ierr = MatGetDiagonal(ctx->B,diagb);CHKERRQ(ierr); |
| ierr = VecAXPY(diag,-ctx->sigma,diagb);CHKERRQ(ierr); |
| ierr = VecDestroy(diagb);CHKERRQ(ierr); |
| } else { |
| ierr = VecShift(diag,-ctx->sigma);CHKERRQ(ierr); |
| } |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STMatShellCreate" |
| PetscErrorCode STMatShellCreate(ST st,Mat *mat) |
| { |
| PetscErrorCode ierr; |
| PetscInt n, m, N, M; |
| PetscTruth hasA, hasB; |
| PetscFunctionBegin; |
| ierr = MatGetSize(st->A,&M,&N);CHKERRQ(ierr); |
| ierr = MatGetLocalSize(st->A,&m,&n);CHKERRQ(ierr); |
| ierr = MatCreateShell(((PetscObject)st)->comm,m,n,M,N,(void*)st,mat);CHKERRQ(ierr); |
| ierr = MatShellSetOperation(*mat,MATOP_MULT,(void(*)(void))STMatShellMult);CHKERRQ(ierr); |
| ierr = MatShellSetOperation(*mat,MATOP_MULT_TRANSPOSE,(void(*)(void))STMatShellMultTranspose);CHKERRQ(ierr); |
| ierr = MatHasOperation(st->A,MATOP_GET_DIAGONAL,&hasA);CHKERRQ(ierr); |
| if (st->B) { ierr = MatHasOperation(st->B,MATOP_GET_DIAGONAL,&hasB);CHKERRQ(ierr); } |
| if ( (hasA && !st->B) || (hasA && hasB) ) { |
| ierr = MatShellSetOperation(*mat,MATOP_GET_DIAGONAL,(void(*)(void))STMatShellGetDiagonal);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| ALL: lib |
| CFLAGS = |
| FFLAGS = |
| SOURCEC = stfunc.c stset.c stsolve.c stsles.c stregis.c shellmat.c |
| SOURCEF = |
| SOURCEH = |
| OBJSC = stfunc.o stset.o stsolve.o stsles.o stregis.o shellmat.o |
| LIBBASE = libslepc |
| DIRS = |
| MANSEC = ST |
| LOCDIR = src/st/interface/ |
| include ${SLEPC_DIR}/conf/slepc_common |
| /* |
| The ST (spectral transformation) interface routines related to the |
| KSP object associated to it. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/stimpl.h" /*I "slepcst.h" I*/ |
| #undef __FUNCT__ |
| #define __FUNCT__ "STAssociatedKSPSolve" |
| /* |
| STAssociatedKSPSolve - Solves the linear system of equations associated |
| to the spectral transformation. |
| Input Parameters: |
| . st - the spectral transformation context |
| . b - right hand side vector |
| Output Parameter: |
| . x - computed solution |
| */ |
| PetscErrorCode STAssociatedKSPSolve(ST st,Vec b,Vec x) |
| { |
| PetscErrorCode ierr; |
| PetscInt its; |
| KSPConvergedReason reason; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| PetscValidHeaderSpecific(b,VEC_COOKIE,2); |
| PetscValidHeaderSpecific(x,VEC_COOKIE,3); |
| if (!st->ksp) { SETERRQ(PETSC_ERR_SUP,"ST has no associated KSP"); } |
| ierr = KSPSolve(st->ksp,b,x);CHKERRQ(ierr); |
| ierr = KSPGetConvergedReason(st->ksp,&reason);CHKERRQ(ierr); |
| if (reason<0) { SETERRQ1(0,"Warning: KSP did not converge (%d)",reason); } |
| ierr = KSPGetIterationNumber(st->ksp,&its);CHKERRQ(ierr); |
| st->lineariterations += its; |
| PetscInfo1(st,"Linear solve iterations=%d\n",its); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STAssociatedKSPSolveTranspose" |
| /* |
| STAssociatedKSPSolveTranspose - Solves the transpose of the linear |
| system of equations associated to the spectral transformation. |
| Input Parameters: |
| . st - the spectral transformation context |
| . b - right hand side vector |
| Output Parameter: |
| . x - computed solution |
| */ |
| PetscErrorCode STAssociatedKSPSolveTranspose(ST st,Vec b,Vec x) |
| { |
| PetscErrorCode ierr; |
| PetscInt its; |
| KSPConvergedReason reason; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| PetscValidHeaderSpecific(b,VEC_COOKIE,2); |
| PetscValidHeaderSpecific(x,VEC_COOKIE,3); |
| if (!st->ksp) { SETERRQ(PETSC_ERR_SUP,"ST has no associated KSP"); } |
| ierr = KSPSolveTranspose(st->ksp,b,x);CHKERRQ(ierr); |
| ierr = KSPGetConvergedReason(st->ksp,&reason);CHKERRQ(ierr); |
| if (reason<0) { SETERRQ1(0,"Warning: KSP did not converge (%d)",reason); } |
| ierr = KSPGetIterationNumber(st->ksp,&its);CHKERRQ(ierr); |
| st->lineariterations += its; |
| PetscInfo1(st,"Linear solve iterations=%d\n",its); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STSetKSP" |
| /*@ |
| STSetKSP - Sets the KSP object associated with the spectral |
| transformation. |
| Not collective |
| Input Parameters: |
| + st - the spectral transformation context |
| - ksp - the linear system context |
| Level: advanced |
| @*/ |
| PetscErrorCode STSetKSP(ST st,KSP ksp) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| PetscValidHeaderSpecific(ksp,KSP_COOKIE,2); |
| PetscCheckSameComm(st,1,ksp,2); |
| ierr = PetscObjectReference((PetscObject)ksp);CHKERRQ(ierr); |
| if (st->ksp) { |
| ierr = KSPDestroy(st->ksp);CHKERRQ(ierr); |
| } |
| st->ksp = ksp; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STGetKSP" |
| /*@ |
| STGetKSP - Gets the KSP object associated with the spectral |
| transformation. |
| Not collective |
| Input Parameter: |
| . st - the spectral transformation context |
| Output Parameter: |
| . ksp - the linear system context |
| Notes: |
| On output, the value of ksp can be PETSC_NULL if the combination of |
| eigenproblem type and selected transformation does not require to |
| solve a linear system of equations. |
| Level: intermediate |
| @*/ |
| PetscErrorCode STGetKSP(ST st,KSP* ksp) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| if (!((PetscObject)st)->type_name) { SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Must call STSetType first"); } |
| if (ksp) *ksp = st->ksp; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STGetOperationCounters" |
| /*@ |
| STGetOperationCounters - Gets the total number of operator applications |
| and linear solver iterations used by the ST object. |
| Not Collective |
| Input Parameter: |
| . st - the spectral transformation context |
| Output Parameter: |
| + ops - number of operator applications |
| - lits - number of linear solver iterations |
| Notes: |
| Any output parameter may be PETSC_NULL on input if not needed. |
| Level: intermediate |
| .seealso: STResetOperationCounters() |
| @*/ |
| PetscErrorCode STGetOperationCounters(ST st,PetscInt* ops,PetscInt* lits) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| if (ops) *ops = st->applys; |
| if (lits) *lits = st->lineariterations; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STResetOperationCounters" |
| /*@ |
| STResetOperationCounters - Resets the counters for operator applications, |
| inner product operations and total number of linear iterations used by |
| the ST object. |
| Collective on ST |
| Input Parameter: |
| . st - the spectral transformation context |
| Level: intermediate |
| .seealso: STGetOperationCounters() |
| @*/ |
| PetscErrorCode STResetOperationCounters(ST st) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| st->lineariterations = 0; |
| st->applys = 0; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STCheckNullSpace_Default" |
| PetscErrorCode STCheckNullSpace_Default(ST st,PetscInt n,const Vec V[]) |
| { |
| PetscErrorCode ierr; |
| PetscInt i,c; |
| PetscReal norm; |
| Vec *T,w; |
| Mat A; |
| PC pc; |
| MatNullSpace nullsp; |
| PetscFunctionBegin; |
| ierr = PetscMalloc(n*sizeof(Vec),&T);CHKERRQ(ierr); |
| ierr = KSPGetPC(st->ksp,&pc);CHKERRQ(ierr); |
| ierr = PCGetOperators(pc,&A,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr); |
| ierr = MatGetVecs(A,PETSC_NULL,&w);CHKERRQ(ierr); |
| c = 0; |
| for (i=0;i<n;i++) { |
| ierr = MatMult(A,V[i],w);CHKERRQ(ierr); |
| ierr = VecNorm(w,NORM_2,&norm);CHKERRQ(ierr); |
| if (norm < 1e-8) { |
| PetscInfo2(st,"Vector %i norm=%g\n",i,norm); |
| T[c] = V[i]; |
| c++; |
| } |
| } |
| ierr = VecDestroy(w);CHKERRQ(ierr); |
| if (c>0) { |
| ierr = MatNullSpaceCreate(((PetscObject)st)->comm,PETSC_FALSE,c,T,&nullsp);CHKERRQ(ierr); |
| ierr = KSPSetNullSpace(st->ksp,nullsp);CHKERRQ(ierr); |
| ierr = MatNullSpaceDestroy(nullsp);CHKERRQ(ierr); |
| } |
| ierr = PetscFree(T);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STCheckNullSpace" |
| /*@ |
| STCheckNullSpace - Given a set of vectors, this function tests each of |
| them to be a nullspace vector of the coefficient matrix of the associated |
| KSP object. All these nullspace vectors are passed to the KSP object. |
| Collective on ST |
| Input Parameters: |
| + st - the spectral transformation context |
| . n - number of vectors |
| - V - vectors to be checked |
| Note: |
| This function allows to handle singular pencils and to solve some problems |
| in which the nullspace is important (see the users guide for details). |
| Level: developer |
| .seealso: EPSAttachDeflationSpace() |
| @*/ |
| PetscErrorCode STCheckNullSpace(ST st,PetscInt n,const Vec V[]) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| if (n>0 && st->checknullspace) { |
| ierr = (*st->checknullspace)(st,n,V);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| /* |
| Folding spectral transformation, applies (A + sigma I)^2 as operator, or |
| inv(B)(A + sigma I)^2 for generalized problems |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/stimpl.h" /*I "slepcst.h" I*/ |
| typedef struct { |
| PetscTruth left; |
| Vec w2; |
| } ST_FOLD; |
| #undef __FUNCT__ |
| #define __FUNCT__ "STApply_Fold" |
| PetscErrorCode STApply_Fold(ST st,Vec x,Vec y) |
| { |
| PetscErrorCode ierr; |
| ST_FOLD *ctx = (ST_FOLD *) st->data; |
| PetscFunctionBegin; |
| if (st->B) { |
| /* generalized eigenproblem: y = (B^-1 A + sI)^2 x */ |
| ierr = MatMult(st->A,x,st->w);CHKERRQ(ierr); |
| ierr = STAssociatedKSPSolve(st,st->w,ctx->w2);CHKERRQ(ierr); |
| if (st->sigma != 0.0) { |
| ierr = VecAXPY(ctx->w2,-st->sigma,x);CHKERRQ(ierr); |
| } |
| ierr = MatMult(st->A,ctx->w2,st->w);CHKERRQ(ierr); |
| ierr = STAssociatedKSPSolve(st,st->w,y);CHKERRQ(ierr); |
| if (st->sigma != 0.0) { |
| ierr = VecAXPY(y,-st->sigma,ctx->w2);CHKERRQ(ierr); |
| } |
| } else { |
| /* standard eigenproblem: y = (A + sI)^2 x */ |
| ierr = MatMult(st->A,x,st->w);CHKERRQ(ierr); |
| if (st->sigma != 0.0) { |
| ierr = VecAXPY(st->w,-st->sigma,x);CHKERRQ(ierr); |
| } |
| ierr = MatMult(st->A,st->w,y);CHKERRQ(ierr); |
| if (st->sigma != 0.0) { |
| ierr = VecAXPY(y,-st->sigma,st->w);CHKERRQ(ierr); |
| } |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STApplyTranspose_Fold" |
| PetscErrorCode STApplyTranspose_Fold(ST st,Vec x,Vec y) |
| { |
| PetscErrorCode ierr; |
| ST_FOLD *ctx = (ST_FOLD *) st->data; |
| PetscFunctionBegin; |
| if (st->B) { |
| /* generalized eigenproblem: y = (A^T B^-T + sI)^2 x */ |
| ierr = STAssociatedKSPSolveTranspose(st,x,st->w);CHKERRQ(ierr); |
| ierr = MatMult(st->A,st->w,ctx->w2);CHKERRQ(ierr); |
| if (st->sigma != 0.0) { |
| ierr = VecAXPY(ctx->w2,-st->sigma,x);CHKERRQ(ierr); |
| } |
| ierr = STAssociatedKSPSolveTranspose(st,ctx->w2,st->w);CHKERRQ(ierr); |
| ierr = MatMult(st->A,st->w,y);CHKERRQ(ierr); |
| if (st->sigma != 0.0) { |
| ierr = VecAXPY(y,-st->sigma,ctx->w2);CHKERRQ(ierr); |
| } |
| } else { |
| /* standard eigenproblem: y = (A^T + sI)^2 x */ |
| ierr = MatMultTranspose(st->A,x,st->w);CHKERRQ(ierr); |
| if (st->sigma != 0.0) { |
| ierr = VecAXPY(st->w,-st->sigma,x);CHKERRQ(ierr); |
| } |
| ierr = MatMultTranspose(st->A,st->w,y);CHKERRQ(ierr); |
| if (st->sigma != 0.0) { |
| ierr = VecAXPY(y,-st->sigma,st->w);CHKERRQ(ierr); |
| } |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STBackTransform_Fold" |
| PetscErrorCode STBackTransform_Fold(ST st,PetscScalar *eigr,PetscScalar *eigi) |
| { |
| ST_FOLD *ctx = (ST_FOLD *) st->data; |
| PetscFunctionBegin; |
| PetscValidScalarPointer(eigr,2); |
| PetscValidScalarPointer(eigi,3); |
| #if !defined(PETSC_USE_COMPLEX) |
| if (*eigi == 0) { |
| #endif |
| if (ctx->left) *eigr = st->sigma - PetscSqrtScalar(*eigr); |
| else *eigr = st->sigma + PetscSqrtScalar(*eigr); |
| #if !defined(PETSC_USE_COMPLEX) |
| } else { |
| PetscScalar r,x,y; |
| r = PetscSqrtScalar(*eigr * *eigr + *eigi * *eigi); |
| x = PetscSqrtScalar((r + *eigr) / 2); |
| y = PetscSqrtScalar((r - *eigr) / 2); |
| if (*eigi < 0) y = - y; |
| if (ctx->left) { |
| *eigr = st->sigma - x; |
| *eigi = - y; |
| } else { |
| *eigr = st->sigma + x; |
| *eigi = y; |
| } |
| } |
| #endif |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STSetUp_Fold" |
| PetscErrorCode STSetUp_Fold(ST st) |
| { |
| PetscErrorCode ierr; |
| ST_FOLD *ctx = (ST_FOLD *) st->data; |
| PetscFunctionBegin; |
| if (st->B) { |
| ierr = KSPSetOperators(st->ksp,st->B,st->B,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); |
| ierr = KSPSetUp(st->ksp);CHKERRQ(ierr); |
| if (ctx->w2) { ierr = VecDestroy(ctx->w2);CHKERRQ(ierr); } |
| ierr = MatGetVecs(st->B,&ctx->w2,PETSC_NULL);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| EXTERN_C_BEGIN |
| #undef __FUNCT__ |
| #define __FUNCT__ "STFoldSetLeftSide_Fold" |
| PetscErrorCode STFoldSetLeftSide_Fold(ST st,PetscTruth left) |
| { |
| ST_FOLD *ctx = (ST_FOLD *) st->data; |
| PetscFunctionBegin; |
| ctx->left = left; |
| PetscFunctionReturn(0); |
| } |
| EXTERN_C_END |
| #undef __FUNCT__ |
| #define __FUNCT__ "STFoldSetLeftSide" |
| /*@ |
| STFoldSetLeftSide - Sets a flag to compute eigenvalues on the left side of shift. |
| Collective on ST |
| Input Parameters: |
| + st - the spectral transformation context |
| - left - if true compute eigenvalues on the left side |
| Options Database Key: |
| . -st_fold_leftside - Sets the value of the flag |
| Level: intermediate |
| .seealso: STSetShift() |
| @*/ |
| PetscErrorCode STFoldSetLeftSide(ST st,PetscTruth left) |
| { |
| PetscErrorCode ierr, (*f)(ST,PetscTruth); |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| ierr = PetscObjectQueryFunction((PetscObject)st,"STFoldSetLeftSide_C",(void (**)(void))&f);CHKERRQ(ierr); |
| if (f) { |
| ierr = (*f)(st,left);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STView_Fold" |
| PetscErrorCode STView_Fold(ST st,PetscViewer viewer) |
| { |
| PetscErrorCode ierr; |
| ST_FOLD *ctx = (ST_FOLD *) st->data; |
| PetscFunctionBegin; |
| if (ctx->left) { |
| ierr = PetscViewerASCIIPrintf(viewer," computing eigenvalues on left side of shift\n");CHKERRQ(ierr); |
| } |
| if (st->B) { |
| ierr = STView_Default(st,viewer);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STSetFromOptions_Fold" |
| PetscErrorCode STSetFromOptions_Fold(ST st) |
| { |
| PetscErrorCode ierr; |
| ST_FOLD *ctx = (ST_FOLD *) st->data; |
| PetscFunctionBegin; |
| ierr = PetscOptionsHead("ST Fold Options");CHKERRQ(ierr); |
| ierr = PetscOptionsTruth("-st_fold_leftside","Compute eigenvalues on left side of shift","STFoldSetLeftSide",ctx->left,&ctx->left,PETSC_NULL); CHKERRQ(ierr); |
| ierr = PetscOptionsTail();CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STDestroy_Fold" |
| PetscErrorCode STDestroy_Fold(ST st) |
| { |
| PetscErrorCode ierr; |
| ST_FOLD *ctx = (ST_FOLD *) st->data; |
| PetscFunctionBegin; |
| if (ctx->w2) { ierr = VecDestroy(ctx->w2);CHKERRQ(ierr); } |
| ierr = PetscFree(ctx);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| EXTERN_C_BEGIN |
| #undef __FUNCT__ |
| #define __FUNCT__ "STCreate_Fold" |
| PetscErrorCode STCreate_Fold(ST st) |
| { |
| PetscErrorCode ierr; |
| ST_FOLD *ctx; |
| PetscFunctionBegin; |
| ierr = PetscNew(ST_FOLD,&ctx); CHKERRQ(ierr); |
| PetscLogObjectMemory(st,sizeof(ST_FOLD)); |
| st->data = (void *) ctx; |
| st->ops->apply = STApply_Fold; |
| st->ops->getbilinearform = STGetBilinearForm_Default; |
| st->ops->applytrans = STApplyTranspose_Fold; |
| st->ops->backtr = STBackTransform_Fold; |
| st->ops->setup = STSetUp_Fold; |
| st->ops->view = STView_Fold; |
| st->ops->setfromoptions = STSetFromOptions_Fold; |
| st->ops->destroy = STDestroy_Fold; |
| st->checknullspace = 0; |
| ctx->left = PETSC_FALSE; |
| ierr = PetscObjectComposeFunctionDynamic((PetscObject)st,"STFoldSetLeftSide_C","STFoldSetLeftSide_Fold", |
| STFoldSetLeftSide_Fold);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| EXTERN_C_END |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| ALL: lib |
| CFLAGS = |
| FFLAGS = |
| SOURCEC = fold.c |
| SOURCEF = |
| SOURCEH = |
| OBJSC = fold.o |
| LIBBASE = libslepc |
| DIRS = |
| MANSEC = ST |
| LOCDIR = src/st/impls/fold/ |
| include ${SLEPC_DIR}/conf/slepc_common |
| /* |
| Implements the Cayley spectral transform. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/stimpl.h" /*I "slepcst.h" I*/ |
| typedef struct { |
| PetscScalar tau; |
| PetscTruth tau_set; |
| Vec w2; |
| } ST_CAYLEY; |
| #undef __FUNCT__ |
| #define __FUNCT__ "STApply_Cayley" |
| PetscErrorCode STApply_Cayley(ST st,Vec x,Vec y) |
| { |
| PetscErrorCode ierr; |
| ST_CAYLEY *ctx = (ST_CAYLEY *) st->data; |
| PetscScalar tau = ctx->tau; |
| PetscFunctionBegin; |
| if (st->shift_matrix == STMATMODE_INPLACE) { tau = tau + st->sigma; }; |
| if (st->B) { |
| /* generalized eigenproblem: y = (A - sB)^-1 (A + tB)x */ |
| ierr = MatMult(st->A,x,st->w);CHKERRQ(ierr); |
| ierr = MatMult(st->B,x,ctx->w2);CHKERRQ(ierr); |
| ierr = VecAXPY(st->w,tau,ctx->w2);CHKERRQ(ierr); |
| ierr = STAssociatedKSPSolve(st,st->w,y);CHKERRQ(ierr); |
| } |
| else { |
| /* standard eigenproblem: y = (A - sI)^-1 (A + tI)x */ |
| ierr = MatMult(st->A,x,st->w);CHKERRQ(ierr); |
| ierr = VecAXPY(st->w,tau,x);CHKERRQ(ierr); |
| ierr = STAssociatedKSPSolve(st,st->w,y);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STApplyTranspose_Cayley" |
| PetscErrorCode STApplyTranspose_Cayley(ST st,Vec x,Vec y) |
| { |
| PetscErrorCode ierr; |
| ST_CAYLEY *ctx = (ST_CAYLEY *) st->data; |
| PetscScalar tau = ctx->tau; |
| PetscFunctionBegin; |
| if (st->shift_matrix == STMATMODE_INPLACE) { tau = tau + st->sigma; }; |
| if (st->B) { |
| /* generalized eigenproblem: y = (A + tB)^T (A - sB)^-T x */ |
| ierr = STAssociatedKSPSolve(st,x,st->w);CHKERRQ(ierr); |
| ierr = MatMult(st->A,st->w,y);CHKERRQ(ierr); |
| ierr = MatMult(st->B,st->w,ctx->w2);CHKERRQ(ierr); |
| ierr = VecAXPY(y,tau,ctx->w2);CHKERRQ(ierr); |
| } |
| else { |
| /* standard eigenproblem: y = (A + tI)^T (A - sI)^-T x */ |
| ierr = STAssociatedKSPSolve(st,x,st->w);CHKERRQ(ierr); |
| ierr = MatMult(st->A,st->w,y);CHKERRQ(ierr); |
| ierr = VecAXPY(y,tau,st->w);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STBilinearMatMult_Cayley" |
| PetscErrorCode STBilinearMatMult_Cayley(Mat B,Vec x,Vec y) |
| { |
| PetscErrorCode ierr; |
| ST st; |
| ST_CAYLEY *ctx; |
| PetscScalar tau; |
| PetscFunctionBegin; |
| ierr = MatShellGetContext(B,(void**)&st);CHKERRQ(ierr); |
| ctx = (ST_CAYLEY *) st->data; |
| tau = ctx->tau; |
| if (st->shift_matrix == STMATMODE_INPLACE) { tau = tau + st->sigma; }; |
| if (st->B) { |
| /* generalized eigenproblem: y = (A + tB)x */ |
| ierr = MatMult(st->A,x,y);CHKERRQ(ierr); |
| ierr = MatMult(st->B,x,ctx->w2);CHKERRQ(ierr); |
| ierr = VecAXPY(y,tau,ctx->w2);CHKERRQ(ierr); |
| } |
| else { |
| /* standard eigenproblem: y = (A + tI)x */ |
| ierr = MatMult(st->A,x,y);CHKERRQ(ierr); |
| ierr = VecAXPY(y,tau,x);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STGetBilinearForm_Cayley" |
| PetscErrorCode STGetBilinearForm_Cayley(ST st,Mat *B) |
| { |
| PetscErrorCode ierr; |
| PetscInt n,m; |
| PetscFunctionBegin; |
| ierr = MatGetLocalSize(st->B,&n,&m);CHKERRQ(ierr); |
| ierr = MatCreateShell(((PetscObject)st)->comm,n,m,PETSC_DETERMINE,PETSC_DETERMINE,st,B);CHKERRQ(ierr); |
| ierr = MatShellSetOperation(*B,MATOP_MULT,(void(*)(void))STBilinearMatMult_Cayley);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STBackTransform_Cayley" |
| PetscErrorCode STBackTransform_Cayley(ST st,PetscScalar *eigr,PetscScalar *eigi) |
| { |
| ST_CAYLEY *ctx = (ST_CAYLEY *) st->data; |
| #ifndef PETSC_USE_COMPLEX |
| PetscScalar t,i,r; |
| PetscFunctionBegin; |
| PetscValidPointer(eigr,2); |
| PetscValidPointer(eigi,3); |
| if (*eigi == 0.0) *eigr = (ctx->tau + *eigr * st->sigma) / (*eigr - 1.0); |
| else { |
| r = *eigr; |
| i = *eigi; |
| r = st->sigma * (r * r + i * i - r) + ctx->tau * (r - 1); |
| i = - st->sigma * i - ctx->tau * i; |
| t = i * i + r * (r - 2.0) + 1.0; |
| *eigr = r / t; |
| *eigi = i / t; |
| } |
| #else |
| PetscFunctionBegin; |
| PetscValidPointer(eigr,2); |
| *eigr = (ctx->tau + *eigr * st->sigma) / (*eigr - 1.0); |
| #endif |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STPostSolve_Cayley" |
| PetscErrorCode STPostSolve_Cayley(ST st) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| if (st->shift_matrix == STMATMODE_INPLACE) { |
| if (st->B) { |
| ierr = MatAXPY(st->A,st->sigma,st->B,st->str);CHKERRQ(ierr); |
| } else { |
| ierr = MatShift(st->A,st->sigma); CHKERRQ(ierr); |
| } |
| st->setupcalled = 0; |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STSetUp_Cayley" |
| PetscErrorCode STSetUp_Cayley(ST st) |
| { |
| PetscErrorCode ierr; |
| ST_CAYLEY *ctx = (ST_CAYLEY *) st->data; |
| PetscFunctionBegin; |
| if (st->mat) { ierr = MatDestroy(st->mat);CHKERRQ(ierr); } |
| if (!ctx->tau_set) { ctx->tau = st->sigma; } |
| if (ctx->tau == 0.0 && st->sigma == 0.0) { |
| SETERRQ(1,"Values of shift and antishift cannot be zero simultaneously"); |
| } |
| switch (st->shift_matrix) { |
| case STMATMODE_INPLACE: |
| st->mat = PETSC_NULL; |
| if (st->sigma != 0.0) { |
| if (st->B) { |
| ierr = MatAXPY(st->A,-st->sigma,st->B,st->str);CHKERRQ(ierr); |
| } else { |
| ierr = MatShift(st->A,-st->sigma);CHKERRQ(ierr); |
| } |
| } |
| ierr = KSPSetOperators(st->ksp,st->A,st->A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); |
| break; |
| case STMATMODE_SHELL: |
| ierr = STMatShellCreate(st,&st->mat);CHKERRQ(ierr); |
| ierr = KSPSetOperators(st->ksp,st->mat,st->mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); |
| break; |
| default: |
| ierr = MatDuplicate(st->A,MAT_COPY_VALUES,&st->mat);CHKERRQ(ierr); |
| if (st->sigma != 0.0) { |
| if (st->B) { |
| ierr = MatAXPY(st->mat,-st->sigma,st->B,st->str);CHKERRQ(ierr); |
| } else { |
| ierr = MatShift(st->mat,-st->sigma);CHKERRQ(ierr); |
| } |
| } |
| ierr = KSPSetOperators(st->ksp,st->mat,st->mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); |
| } |
| if (st->B) { |
| if (ctx->w2) { ierr = VecDestroy(ctx->w2);CHKERRQ(ierr); } |
| ierr = MatGetVecs(st->B,&ctx->w2,PETSC_NULL);CHKERRQ(ierr); |
| } |
| ierr = KSPSetUp(st->ksp);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STSetShift_Cayley" |
| PetscErrorCode STSetShift_Cayley(ST st,PetscScalar newshift) |
| { |
| PetscErrorCode ierr; |
| ST_CAYLEY *ctx = (ST_CAYLEY *) st->data; |
| MatStructure flg; |
| PetscFunctionBegin; |
| if (!ctx->tau_set) { ctx->tau = newshift; } |
| if (ctx->tau == 0.0 && newshift == 0.0) { |
| SETERRQ(1,"Values of shift and antishift cannot be zero simultaneously"); |
| } |
| /* Nothing to be done if STSetUp has not been called yet */ |
| if (!st->setupcalled) PetscFunctionReturn(0); |
| /* Check if the new KSP matrix has the same zero structure */ |
| if (st->B && st->str == DIFFERENT_NONZERO_PATTERN && (st->sigma == 0.0 || newshift == 0.0)) { |
| flg = DIFFERENT_NONZERO_PATTERN; |
| } else { |
| flg = SAME_NONZERO_PATTERN; |
| } |
| switch (st->shift_matrix) { |
| case STMATMODE_INPLACE: |
| /* Undo previous operations */ |
| if (st->sigma != 0.0) { |
| if (st->B) { |
| ierr = MatAXPY(st->A,st->sigma,st->B,st->str);CHKERRQ(ierr); |
| } else { |
| ierr = MatShift(st->A,st->sigma);CHKERRQ(ierr); |
| } |
| } |
| /* Apply new shift */ |
| if (newshift != 0.0) { |
| if (st->B) { |
| ierr = MatAXPY(st->A,-newshift,st->B,st->str);CHKERRQ(ierr); |
| } else { |
| ierr = MatShift(st->A,-newshift);CHKERRQ(ierr); |
| } |
| } |
| ierr = KSPSetOperators(st->ksp,st->A,st->A,flg);CHKERRQ(ierr); |
| break; |
| case STMATMODE_SHELL: |
| ierr = KSPSetOperators(st->ksp,st->mat,st->mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); |
| break; |
| default: |
| ierr = MatCopy(st->A, st->mat,SUBSET_NONZERO_PATTERN); CHKERRQ(ierr); |
| if (newshift != 0.0) { |
| if (st->B) { ierr = MatAXPY(st->mat,-newshift,st->B,st->str);CHKERRQ(ierr); } |
| else { ierr = MatShift(st->mat,-newshift);CHKERRQ(ierr); } |
| } |
| ierr = KSPSetOperators(st->ksp,st->mat,st->mat,flg);CHKERRQ(ierr); |
| } |
| st->sigma = newshift; |
| ierr = KSPSetUp(st->ksp);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STSetFromOptions_Cayley" |
| PetscErrorCode STSetFromOptions_Cayley(ST st) |
| { |
| PetscErrorCode ierr; |
| PetscScalar tau; |
| PetscTruth flg; |
| ST_CAYLEY *ctx = (ST_CAYLEY *) st->data; |
| PetscFunctionBegin; |
| ierr = PetscOptionsHead("ST Cayley Options");CHKERRQ(ierr); |
| ierr = PetscOptionsScalar("-st_antishift","Value of the antishift","STSetAntishift",ctx->tau,&tau,&flg); CHKERRQ(ierr); |
| if (flg) { |
| ierr = STCayleySetAntishift(st,tau);CHKERRQ(ierr); |
| } |
| ierr = PetscOptionsTail();CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| EXTERN_C_BEGIN |
| #undef __FUNCT__ |
| #define __FUNCT__ "STCayleySetAntishift_Cayley" |
| PetscErrorCode STCayleySetAntishift_Cayley(ST st,PetscScalar newshift) |
| { |
| ST_CAYLEY *ctx = (ST_CAYLEY *) st->data; |
| PetscFunctionBegin; |
| ctx->tau = newshift; |
| ctx->tau_set = PETSC_TRUE; |
| PetscFunctionReturn(0); |
| } |
| EXTERN_C_END |
| #undef __FUNCT__ |
| #define __FUNCT__ "STCayleySetAntishift" |
| /*@ |
| STCayleySetAntishift - Sets the value of the anti-shift for the Cayley |
| spectral transformation. |
| Collective on ST |
| Input Parameters: |
| + st - the spectral transformation context |
| - tau - the anti-shift |
| Options Database Key: |
| . -st_antishift - Sets the value of the anti-shift |
| Level: intermediate |
| Note: |
| In the generalized Cayley transform, the operator can be expressed as |
| OP = inv(A - sigma B)*(A + tau B). This function sets the value of tau. |
| Use STSetShift() for setting sigma. |
| .seealso: STSetShift() |
| @*/ |
| PetscErrorCode STCayleySetAntishift(ST st,PetscScalar tau) |
| { |
| PetscErrorCode ierr, (*f)(ST,PetscScalar); |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| ierr = PetscObjectQueryFunction((PetscObject)st,"STCayleySetAntishift_C",(void (**)(void))&f);CHKERRQ(ierr); |
| if (f) { |
| ierr = (*f)(st,tau);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STView_Cayley" |
| PetscErrorCode STView_Cayley(ST st,PetscViewer viewer) |
| { |
| PetscErrorCode ierr; |
| ST_CAYLEY *ctx = (ST_CAYLEY *) st->data; |
| PetscFunctionBegin; |
| #if !defined(PETSC_USE_COMPLEX) |
| ierr = PetscViewerASCIIPrintf(viewer," antishift: %g\n",ctx->tau);CHKERRQ(ierr); |
| #else |
| ierr = PetscViewerASCIIPrintf(viewer," antishift: %g+%g i\n",PetscRealPart(ctx->tau),PetscImaginaryPart(ctx->tau));CHKERRQ(ierr); |
| #endif |
| ierr = STView_Default(st,viewer);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STDestroy_Cayley" |
| PetscErrorCode STDestroy_Cayley(ST st) |
| { |
| PetscErrorCode ierr; |
| ST_CAYLEY *ctx = (ST_CAYLEY *) st->data; |
| PetscFunctionBegin; |
| if (ctx->w2) { ierr = VecDestroy(ctx->w2);CHKERRQ(ierr); } |
| ierr = PetscFree(ctx);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| EXTERN_C_BEGIN |
| #undef __FUNCT__ |
| #define __FUNCT__ "STCreate_Cayley" |
| PetscErrorCode STCreate_Cayley(ST st) |
| { |
| PetscErrorCode ierr; |
| ST_CAYLEY *ctx; |
| PetscFunctionBegin; |
| ierr = PetscNew(ST_CAYLEY,&ctx); CHKERRQ(ierr); |
| PetscLogObjectMemory(st,sizeof(ST_CAYLEY)); |
| st->data = (void *) ctx; |
| st->ops->apply = STApply_Cayley; |
| st->ops->getbilinearform = STGetBilinearForm_Cayley; |
| st->ops->applytrans = STApplyTranspose_Cayley; |
| st->ops->postsolve = STPostSolve_Cayley; |
| st->ops->backtr = STBackTransform_Cayley; |
| st->ops->setfromoptions = STSetFromOptions_Cayley; |
| st->ops->setup = STSetUp_Cayley; |
| st->ops->setshift = STSetShift_Cayley; |
| st->ops->destroy = STDestroy_Cayley; |
| st->ops->view = STView_Cayley; |
| st->checknullspace = STCheckNullSpace_Default; |
| ctx->tau = 0.0; |
| ctx->tau_set = PETSC_FALSE; |
| ierr = PetscObjectComposeFunctionDynamic((PetscObject)st,"STCayleySetAntishift_C","STCayleySetAntishift_Cayley", |
| STCayleySetAntishift_Cayley);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| EXTERN_C_END |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| ALL: lib |
| CFLAGS = |
| FFLAGS = |
| SOURCEC = cayley.c |
| SOURCEF = |
| SOURCEH = |
| OBJSC = cayley.o |
| LIBBASE = libslepc |
| DIRS = |
| MANSEC = ST |
| LOCDIR = src/st/impls/cayley/ |
| include ${SLEPC_DIR}/conf/slepc_common |
| /* |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/fortranimpl.h" |
| #include "slepcst.h" |
| #ifdef PETSC_HAVE_FORTRAN_CAPS |
| #define stshellsetapply_ STSHELLSETAPPLY |
| #define stshellsetapplytranspose_ STSHELLSETAPPLYTRANSPOSE |
| #define stshellsetbacktransform_ STSHELLSETBACKTRANSFORM |
| #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) |
| #define stshellsetapply_ stshellsetapply |
| #define stshellsetapplytranspose_ stshellsetapplytranspose |
| #define stshellsetbacktransform_ stshellsetbacktransform |
| #endif |
| EXTERN_C_BEGIN |
| static void (PETSC_STDCALL *f1)(void*,Vec*,Vec*,PetscErrorCode*); |
| static void (PETSC_STDCALL *f2)(void*,Vec*,Vec*,PetscErrorCode*); |
| static void (PETSC_STDCALL *f3)(void*,PetscScalar*,PetscScalar*,PetscErrorCode*); |
| EXTERN_C_END |
| /* These are not extern C because they are passed into non-extern C user level functions */ |
| static PetscErrorCode ourshellapply(void *ctx,Vec x,Vec y) |
| { |
| PetscErrorCode ierr = 0; |
| (*f1)(ctx,&x,&y,&ierr);CHKERRQ(ierr); |
| return 0; |
| } |
| static PetscErrorCode ourshellapplytranspose(void *ctx,Vec x,Vec y) |
| { |
| PetscErrorCode ierr = 0; |
| (*f2)(ctx,&x,&y,&ierr);CHKERRQ(ierr); |
| return 0; |
| } |
| static PetscErrorCode ourshellbacktransform(void *ctx,PetscScalar *eigr,PetscScalar *eigi) |
| { |
| PetscErrorCode ierr = 0; |
| (*f3)(ctx,eigr,eigi,&ierr);CHKERRQ(ierr); |
| return 0; |
| } |
| EXTERN_C_BEGIN |
| void PETSC_STDCALL stshellsetapply_(ST *st,void (PETSC_STDCALL *apply)(void*,Vec *,Vec *,PetscErrorCode*), |
| PetscErrorCode *ierr) |
| { |
| f1 = apply; |
| *ierr = STShellSetApply(*st,ourshellapply); |
| } |
| void PETSC_STDCALL stshellsetapplytranspose_(ST *st,void (PETSC_STDCALL *applytranspose)(void*,Vec *,Vec *,PetscErrorCode*), |
| PetscErrorCode *ierr) |
| { |
| f2 = applytranspose; |
| *ierr = STShellSetApplyTranspose(*st,ourshellapplytranspose); |
| } |
| void PETSC_STDCALL stshellsetbacktransform_(ST *st,void (PETSC_STDCALL *backtransform)(void*,PetscScalar*,PetscScalar*,PetscErrorCode*), |
| PetscErrorCode *ierr) |
| { |
| f3 = backtransform; |
| *ierr = STShellSetBackTransform(*st,ourshellbacktransform); |
| } |
| EXTERN_C_END |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| #requirespackage 'PETSC_HAVE_FORTRAN' |
| ALL: lib |
| CFLAGS = |
| FFLAGS = |
| SOURCEC = zshell.c |
| OBJSC = zshell.o |
| SOURCEF = |
| SOURCEH = |
| DIRS = |
| LIBBASE = libslepc |
| LOCDIR = src/st/impls/shell/ftn-custom/ |
| include ${SLEPC_DIR}/conf/slepc_common |
| /* |
| This provides a simple shell interface for programmers to |
| create their own spectral transformations without writing much |
| interface code. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/stimpl.h" /*I "slepcst.h" I*/ |
| #include "slepceps.h" |
| EXTERN_C_BEGIN |
| typedef struct { |
| void *ctx; /* user provided context */ |
| PetscErrorCode (*apply)(void *,Vec,Vec); |
| PetscErrorCode (*applytrans)(void *,Vec,Vec); |
| PetscErrorCode (*backtr)(void *,PetscScalar*,PetscScalar*); |
| char *name; |
| } ST_Shell; |
| EXTERN_C_END |
| #undef __FUNCT__ |
| #define __FUNCT__ "STShellGetContext" |
| /*@C |
| STShellGetContext - Returns the user-provided context associated with a shell ST |
| Not Collective |
| Input Parameter: |
| . st - spectral transformation context |
| Output Parameter: |
| . ctx - the user provided context |
| Level: advanced |
| Notes: |
| This routine is intended for use within various shell routines |
| .seealso: STShellSetContext() |
| @*/ |
| PetscErrorCode STShellGetContext(ST st,void **ctx) |
| { |
| PetscErrorCode ierr; |
| PetscTruth flg; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| PetscValidPointer(ctx,2); |
| ierr = PetscTypeCompare((PetscObject)st,STSHELL,&flg);CHKERRQ(ierr); |
| if (!flg) *ctx = 0; |
| else *ctx = ((ST_Shell*)(st->data))->ctx; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STShellSetContext" |
| /*@C |
| STShellSetContext - sets the context for a shell ST |
| Collective on ST |
| Input Parameters: |
| + st - the shell ST |
| - ctx - the context |
| Level: advanced |
| Fortran Notes: The context can only be an integer or a PetscObject; |
| unfortunately it cannot be a Fortran array or derived type. |
| .seealso: STShellGetContext() |
| @*/ |
| PetscErrorCode STShellSetContext(ST st,void *ctx) |
| { |
| ST_Shell *shell = (ST_Shell*)st->data; |
| PetscErrorCode ierr; |
| PetscTruth flg; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| ierr = PetscTypeCompare((PetscObject)st,STSHELL,&flg);CHKERRQ(ierr); |
| if (flg) { |
| shell->ctx = ctx; |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STApply_Shell" |
| PetscErrorCode STApply_Shell(ST st,Vec x,Vec y) |
| { |
| PetscErrorCode ierr; |
| ST_Shell *shell = (ST_Shell*)st->data; |
| PetscFunctionBegin; |
| if (!shell->apply) SETERRQ(PETSC_ERR_USER,"No apply() routine provided to Shell ST"); |
| PetscStackPush("STSHELL user function"); |
| CHKMEMQ; |
| ierr = (*shell->apply)(shell->ctx,x,y);CHKERRQ(ierr); |
| CHKMEMQ; |
| PetscStackPop; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STApplyTranspose_Shell" |
| PetscErrorCode STApplyTranspose_Shell(ST st,Vec x,Vec y) |
| { |
| PetscErrorCode ierr; |
| ST_Shell *shell = (ST_Shell*)st->data; |
| PetscFunctionBegin; |
| if (!shell->applytrans) SETERRQ(PETSC_ERR_USER,"No applytranspose() routine provided to Shell ST"); |
| ierr = (*shell->applytrans)(shell->ctx,x,y);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STBackTransform_Shell" |
| PetscErrorCode STBackTransform_Shell(ST st,PetscScalar *eigr,PetscScalar *eigi) |
| { |
| PetscErrorCode ierr; |
| ST_Shell *shell = (ST_Shell*)st->data; |
| PetscFunctionBegin; |
| if (shell->backtr) { |
| ierr = (*shell->backtr)(shell->ctx,eigr,eigi);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STDestroy_Shell" |
| PetscErrorCode STDestroy_Shell(ST st) |
| { |
| PetscErrorCode ierr; |
| ST_Shell *shell = (ST_Shell*)st->data; |
| PetscFunctionBegin; |
| ierr = PetscFree(shell->name);CHKERRQ(ierr); |
| ierr = PetscFree(shell);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STView_Shell" |
| PetscErrorCode STView_Shell(ST st,PetscViewer viewer) |
| { |
| PetscErrorCode ierr; |
| ST_Shell *ctx = (ST_Shell*)st->data; |
| PetscTruth isascii; |
| PetscFunctionBegin; |
| ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);CHKERRQ(ierr); |
| if (isascii) { |
| if (ctx->name) {ierr = PetscViewerASCIIPrintf(viewer," ST Shell: %s\n",ctx->name);CHKERRQ(ierr);} |
| else {ierr = PetscViewerASCIIPrintf(viewer," ST Shell: no name\n");CHKERRQ(ierr);} |
| } else { |
| SETERRQ1(1,"Viewer type %s not supported for STShell",((PetscObject)viewer)->type_name); |
| } |
| PetscFunctionReturn(0); |
| } |
| EXTERN_C_BEGIN |
| #undef __FUNCT__ |
| #define __FUNCT__ "STShellSetApply_Shell" |
| PetscErrorCode STShellSetApply_Shell(ST st,PetscErrorCode (*apply)(void*,Vec,Vec)) |
| { |
| ST_Shell *shell = (ST_Shell*)st->data; |
| PetscFunctionBegin; |
| shell->apply = apply; |
| PetscFunctionReturn(0); |
| } |
| EXTERN_C_END |
| EXTERN_C_BEGIN |
| #undef __FUNCT__ |
| #define __FUNCT__ "STShellSetApplyTranspose_Shell" |
| PetscErrorCode STShellSetApplyTranspose_Shell(ST st,PetscErrorCode (*applytrans)(void*,Vec,Vec)) |
| { |
| ST_Shell *shell = (ST_Shell*)st->data; |
| PetscFunctionBegin; |
| shell->applytrans = applytrans; |
| PetscFunctionReturn(0); |
| } |
| EXTERN_C_END |
| EXTERN_C_BEGIN |
| #undef __FUNCT__ |
| #define __FUNCT__ "STShellSetBackTransform_Shell" |
| PetscErrorCode STShellSetBackTransform_Shell(ST st,PetscErrorCode (*backtr)(void*,PetscScalar*,PetscScalar*)) |
| { |
| ST_Shell *shell = (ST_Shell *) st->data; |
| PetscFunctionBegin; |
| shell->backtr = backtr; |
| PetscFunctionReturn(0); |
| } |
| EXTERN_C_END |
| EXTERN_C_BEGIN |
| #undef __FUNCT__ |
| #define __FUNCT__ "STShellSetName_Shell" |
| PetscErrorCode STShellSetName_Shell(ST st,const char name[]) |
| { |
| ST_Shell *shell = (ST_Shell*)st->data; |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| ierr = PetscStrfree(shell->name);CHKERRQ(ierr); |
| ierr = PetscStrallocpy(name,&shell->name);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| EXTERN_C_END |
| EXTERN_C_BEGIN |
| #undef __FUNCT__ |
| #define __FUNCT__ "STShellGetName_Shell" |
| PetscErrorCode STShellGetName_Shell(ST st,char *name[]) |
| { |
| ST_Shell *shell = (ST_Shell*)st->data; |
| PetscFunctionBegin; |
| *name = shell->name; |
| PetscFunctionReturn(0); |
| } |
| EXTERN_C_END |
| #undef __FUNCT__ |
| #define __FUNCT__ "STShellSetApply" |
| /*@C |
| STShellSetApply - Sets routine to use as the application of the |
| operator to a vector in the user-defined spectral transformation. |
| Collective on ST |
| Input Parameters: |
| + st - the spectral transformation context |
| - apply - the application-provided transformation routine |
| Calling sequence of apply: |
| .vb |
| PetscErrorCode apply (void *ptr,Vec xin,Vec xout) |
| .ve |
| + ptr - the application context |
| . xin - input vector |
| - xout - output vector |
| Level: developer |
| .seealso: STShellSetBackTransform(), STShellSetApplyTranspose() |
| @*/ |
| PetscErrorCode STShellSetApply(ST st,PetscErrorCode (*apply)(void*,Vec,Vec)) |
| { |
| PetscErrorCode ierr, (*f)(ST,PetscErrorCode (*)(void*,Vec,Vec)); |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| ierr = PetscObjectQueryFunction((PetscObject)st,"STShellSetApply_C",(void (**)(void))&f);CHKERRQ(ierr); |
| if (f) { |
| ierr = (*f)(st,apply);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STShellSetApplyTranspose" |
| /*@C |
| STShellSetApplyTranspose - Sets routine to use as the application of the |
| transposed operator to a vector in the user-defined spectral transformation. |
| Collective on ST |
| Input Parameters: |
| + st - the spectral transformation context |
| - applytrans - the application-provided transformation routine |
| Calling sequence of apply: |
| .vb |
| PetscErrorCode applytrans (void *ptr,Vec xin,Vec xout) |
| .ve |
| + ptr - the application context |
| . xin - input vector |
| - xout - output vector |
| Level: developer |
| .seealso: STShellSetApply(), STShellSetBackTransform() |
| @*/ |
| PetscErrorCode STShellSetApplyTranspose(ST st,PetscErrorCode (*applytrans)(void*,Vec,Vec)) |
| { |
| PetscErrorCode ierr, (*f)(ST,PetscErrorCode (*)(void*,Vec,Vec)); |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| ierr = PetscObjectQueryFunction((PetscObject)st,"STShellSetApplyTranspose_C",(void (**)(void))&f);CHKERRQ(ierr); |
| if (f) { |
| ierr = (*f)(st,applytrans);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STShellSetBackTransform" |
| /*@C |
| STShellSetBackTransform - Sets the routine to be called after the |
| eigensolution process has finished in order to transform back the |
| computed eigenvalues. |
| Collective on ST |
| Input Parameters: |
| + st - the spectral transformation context |
| - backtr - the application-provided backtransform routine |
| Calling sequence of backtr: |
| .vb |
| PetscErrorCode backtr (void *ptr,PetscScalar *eigr,PetscScalar *eigi) |
| .ve |
| + ptr - the application context |
| . eigr - pointer ot the real part of the eigenvalue to transform back |
| - eigi - pointer ot the imaginary part |
| Level: developer |
| .seealso: STShellSetApply(), STShellSetApplyTranspose() |
| @*/ |
| PetscErrorCode STShellSetBackTransform(ST st,PetscErrorCode (*backtr)(void*,PetscScalar*,PetscScalar*)) |
| { |
| PetscErrorCode ierr, (*f)(ST,PetscErrorCode (*)(void*,PetscScalar*,PetscScalar*)); |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| ierr = PetscObjectQueryFunction((PetscObject)st,"STShellSetBackTransform_C",(void (**)(void))&f);CHKERRQ(ierr); |
| if (f) { |
| ierr = (*f)(st,(PetscErrorCode (*)(void*,PetscScalar*,PetscScalar*))backtr);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STShellSetName" |
| /*@C |
| STShellSetName - Sets an optional name to associate with a shell |
| spectral transformation. |
| Not Collective |
| Input Parameters: |
| + st - the spectral transformation context |
| - name - character string describing the shell spectral transformation |
| Level: developer |
| .seealso: STShellGetName() |
| @*/ |
| PetscErrorCode STShellSetName(ST st,const char name[]) |
| { |
| PetscErrorCode ierr, (*f)(ST,const char []); |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| ierr = PetscObjectQueryFunction((PetscObject)st,"STShellSetName_C",(void (**)(void))&f);CHKERRQ(ierr); |
| if (f) { |
| ierr = (*f)(st,name);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STShellGetName" |
| /*@C |
| STShellGetName - Gets an optional name that the user has set for a shell |
| spectral transformation. |
| Not Collective |
| Input Parameter: |
| . st - the spectral transformation context |
| Output Parameter: |
| . name - character string describing the shell spectral transformation |
| (you should not free this) |
| Level: developer |
| .seealso: STShellSetName() |
| @*/ |
| PetscErrorCode STShellGetName(ST st,char *name[]) |
| { |
| PetscErrorCode ierr, (*f)(ST,char *[]); |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(st,ST_COOKIE,1); |
| ierr = PetscObjectQueryFunction((PetscObject)st,"STShellGetName_C",(void (**)(void))&f);CHKERRQ(ierr); |
| if (f) { |
| ierr = (*f)(st,name);CHKERRQ(ierr); |
| } else { |
| SETERRQ(PETSC_ERR_ARG_WRONG,"Not shell spectral transformation, cannot get name"); |
| } |
| PetscFunctionReturn(0); |
| } |
| /*MC |
| STSHELL - Creates a new spectral transformation class. |
| This is intended to provide a simple class to use with EPS. |
| You should not use this if you plan to make a complete class. |
| Level: advanced |
| Usage: |
| $ PetscErrorCode (*apply)(void*,Vec,Vec); |
| $ PetscErrorCode (*applytrans)(void*,Vec,Vec); |
| $ PetscErrorCode (*backtr)(void*,PetscScalar*,PetscScalar*); |
| $ STCreate(comm,&st); |
| $ STSetType(st,STSHELL); |
| $ STShellSetApply(st,apply); |
| $ STShellSetApplyTranspose(st,applytrans); |
| $ STShellSetBackTransform(st,backtr); (optional) |
| M*/ |
| EXTERN_C_BEGIN |
| #undef __FUNCT__ |
| #define __FUNCT__ "STCreate_Shell" |
| PetscErrorCode STCreate_Shell(ST st) |
| { |
| PetscErrorCode ierr; |
| ST_Shell *shell; |
| PetscFunctionBegin; |
| st->ops->destroy = STDestroy_Shell; |
| ierr = PetscNew(ST_Shell,&shell);CHKERRQ(ierr); |
| ierr = PetscLogObjectMemory(st,sizeof(ST_Shell));CHKERRQ(ierr); |
| st->data = (void *) shell; |
| ((PetscObject)st)->name = 0; |
| st->ops->apply = STApply_Shell; |
| st->ops->applytrans= STApplyTranspose_Shell; |
| st->ops->backtr = STBackTransform_Shell; |
| st->ops->view = STView_Shell; |
| shell->apply = 0; |
| shell->applytrans = 0; |
| shell->backtr = 0; |
| shell->name = 0; |
| shell->ctx = 0; |
| ierr = PetscObjectComposeFunctionDynamic((PetscObject)st,"STShellSetApply_C","STShellSetApply_Shell", |
| STShellSetApply_Shell);CHKERRQ(ierr); |
| ierr = PetscObjectComposeFunctionDynamic((PetscObject)st,"STShellSetApplyTranspose_C","STShellSetApplyTranspose_Shell", |
| STShellSetApplyTranspose_Shell);CHKERRQ(ierr); |
| ierr = PetscObjectComposeFunctionDynamic((PetscObject)st,"STShellSetBackTransform_C","STShellSetBackTransform_Shell", |
| STShellSetBackTransform_Shell);CHKERRQ(ierr); |
| ierr = PetscObjectComposeFunctionDynamic((PetscObject)st,"STShellSetName_C","STShellSetName_Shell", |
| STShellSetName_Shell);CHKERRQ(ierr); |
| ierr = PetscObjectComposeFunctionDynamic((PetscObject)st,"STShellGetName_C","STShellGetName_Shell", |
| STShellGetName_Shell);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| EXTERN_C_END |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| 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}/conf/slepc_common |
| /* |
| Implements the shift-and-invert technique for eigenvalue problems. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/stimpl.h" /*I "slepcst.h" I*/ |
| #undef __FUNCT__ |
| #define __FUNCT__ "STApply_Sinvert" |
| PetscErrorCode STApply_Sinvert(ST st,Vec x,Vec y) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| if (st->B) { |
| /* generalized eigenproblem: y = (A - sB)^-1 B x */ |
| ierr = MatMult(st->B,x,st->w);CHKERRQ(ierr); |
| ierr = STAssociatedKSPSolve(st,st->w,y);CHKERRQ(ierr); |
| } |
| else { |
| /* standard eigenproblem: y = (A - sI)^-1 x */ |
| ierr = STAssociatedKSPSolve(st,x,y);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STApplyTranspose_Sinvert" |
| PetscErrorCode STApplyTranspose_Sinvert(ST st,Vec x,Vec y) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| if (st->B) { |
| /* generalized eigenproblem: y = B^T (A - sB)^-T x */ |
| ierr = STAssociatedKSPSolveTranspose(st,x,st->w);CHKERRQ(ierr); |
| ierr = MatMultTranspose(st->B,st->w,y);CHKERRQ(ierr); |
| } |
| else { |
| /* standard eigenproblem: y = (A - sI)^-T x */ |
| ierr = STAssociatedKSPSolveTranspose(st,x,y);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STBackTransform_Sinvert" |
| PetscErrorCode STBackTransform_Sinvert(ST st,PetscScalar *eigr,PetscScalar *eigi) |
| { |
| #ifndef PETSC_USE_COMPLEX |
| PetscScalar t; |
| PetscFunctionBegin; |
| PetscValidPointer(eigr,2); |
| PetscValidPointer(eigi,3); |
| if (*eigi == 0) *eigr = 1.0 / *eigr + st->sigma; |
| else { |
| t = *eigr * *eigr + *eigi * *eigi; |
| *eigr = *eigr / t + st->sigma; |
| *eigi = - *eigi / t; |
| } |
| #else |
| PetscFunctionBegin; |
| PetscValidPointer(eigr,2); |
| *eigr = 1.0 / *eigr + st->sigma; |
| #endif |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STPostSolve_Sinvert" |
| PetscErrorCode STPostSolve_Sinvert(ST st) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| if (st->shift_matrix == STMATMODE_INPLACE) { |
| if( st->B ) { |
| ierr = MatAXPY(st->A,st->sigma,st->B,st->str);CHKERRQ(ierr); |
| } else { |
| ierr = MatShift(st->A,st->sigma); CHKERRQ(ierr); |
| } |
| st->setupcalled = 0; |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STSetUp_Sinvert" |
| PetscErrorCode STSetUp_Sinvert(ST st) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| if (st->mat) { ierr = MatDestroy(st->mat);CHKERRQ(ierr); } |
| switch (st->shift_matrix) { |
| case STMATMODE_INPLACE: |
| st->mat = PETSC_NULL; |
| if (st->sigma != 0.0) { |
| if (st->B) { |
| ierr = MatAXPY(st->A,-st->sigma,st->B,st->str);CHKERRQ(ierr); |
| } else { |
| ierr = MatShift(st->A,-st->sigma);CHKERRQ(ierr); |
| } |
| } |
| ierr = KSPSetOperators(st->ksp,st->A,st->A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); |
| break; |
| case STMATMODE_SHELL: |
| ierr = STMatShellCreate(st,&st->mat);CHKERRQ(ierr); |
| ierr = KSPSetOperators(st->ksp,st->mat,st->mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); |
| break; |
| default: |
| if (st->sigma != 0.0) { |
| ierr = MatDuplicate(st->A,MAT_COPY_VALUES,&st->mat);CHKERRQ(ierr); |
| if (st->B) { |
| ierr = MatAXPY(st->mat,-st->sigma,st->B,st->str);CHKERRQ(ierr); |
| } else { |
| ierr = MatShift(st->mat,-st->sigma);CHKERRQ(ierr); |
| } |
| ierr = KSPSetOperators(st->ksp,st->mat,st->mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); |
| } else { |
| st->mat = PETSC_NULL; |
| ierr = KSPSetOperators(st->ksp,st->A,st->A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); |
| } |
| } |
| ierr = KSPSetUp(st->ksp);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STSetShift_Sinvert" |
| PetscErrorCode STSetShift_Sinvert(ST st,PetscScalar newshift) |
| { |
| PetscErrorCode ierr; |
| MatStructure flg; |
| PetscFunctionBegin; |
| /* Nothing to be done if STSetUp has not been called yet */ |
| if (!st->setupcalled) PetscFunctionReturn(0); |
| /* Check if the new KSP matrix has the same zero structure */ |
| if (st->B && st->str == DIFFERENT_NONZERO_PATTERN && (st->sigma == 0.0 || newshift == 0.0)) { |
| flg = DIFFERENT_NONZERO_PATTERN; |
| } else { |
| flg = SAME_NONZERO_PATTERN; |
| } |
| switch (st->shift_matrix) { |
| case STMATMODE_INPLACE: |
| /* Undo previous operations */ |
| if (st->sigma != 0.0) { |
| if (st->B) { |
| ierr = MatAXPY(st->A,st->sigma,st->B,st->str);CHKERRQ(ierr); |
| } else { |
| ierr = MatShift(st->A,st->sigma);CHKERRQ(ierr); |
| } |
| } |
| /* Apply new shift */ |
| if (newshift != 0.0) { |
| if (st->B) { |
| ierr = MatAXPY(st->A,-newshift,st->B,st->str);CHKERRQ(ierr); |
| } else { |
| ierr = MatShift(st->A,-newshift);CHKERRQ(ierr); |
| } |
| } |
| ierr = KSPSetOperators(st->ksp,st->A,st->A,flg);CHKERRQ(ierr); |
| break; |
| case STMATMODE_SHELL: |
| ierr = KSPSetOperators(st->ksp,st->mat,st->mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); |
| break; |
| default: |
| if (st->mat) { |
| ierr = MatCopy(st->A,st->mat,SUBSET_NONZERO_PATTERN); CHKERRQ(ierr); |
| } else { |
| ierr = MatDuplicate(st->A,MAT_COPY_VALUES,&st->mat);CHKERRQ(ierr); |
| } |
| if (newshift != 0.0) { |
| if (st->B) { |
| ierr = MatAXPY(st->mat,-newshift,st->B,st->str);CHKERRQ(ierr); |
| } else { |
| ierr = MatShift(st->mat,-newshift);CHKERRQ(ierr); |
| } |
| } |
| ierr = KSPSetOperators(st->ksp,st->mat,st->mat,flg);CHKERRQ(ierr); |
| } |
| st->sigma = newshift; |
| ierr = KSPSetUp(st->ksp);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| EXTERN_C_BEGIN |
| #undef __FUNCT__ |
| #define __FUNCT__ "STCreate_Sinvert" |
| PetscErrorCode STCreate_Sinvert(ST st) |
| { |
| PetscFunctionBegin; |
| st->data = 0; |
| st->ops->apply = STApply_Sinvert; |
| st->ops->getbilinearform = STGetBilinearForm_Default; |
| st->ops->applytrans = STApplyTranspose_Sinvert; |
| st->ops->postsolve = STPostSolve_Sinvert; |
| st->ops->backtr = STBackTransform_Sinvert; |
| st->ops->setup = STSetUp_Sinvert; |
| st->ops->setshift = STSetShift_Sinvert; |
| st->ops->view = STView_Default; |
| st->checknullspace = STCheckNullSpace_Default; |
| PetscFunctionReturn(0); |
| } |
| EXTERN_C_END |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| ALL: lib |
| CFLAGS = |
| FFLAGS = |
| SOURCEC = sinvert.c |
| SOURCEF = |
| SOURCEH = |
| OBJSC = sinvert.o |
| LIBBASE = libslepc |
| DIRS = |
| MANSEC = ST |
| LOCDIR = src/st/impls/sinvert/ |
| include ${SLEPC_DIR}/conf/slepc_common |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| ALL: lib |
| LIBBASE = libslepc |
| DIRS = shell shift sinvert cayley fold |
| LOCDIR = src/st/impls/ |
| MANSEC = ST |
| include ${SLEPC_DIR}/conf/slepc_common |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| 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}/conf/slepc_common |
| /* |
| Shift spectral transformation, applies (A + sigma I) as operator, or |
| inv(B)(A + sigma B) for generalized problems |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/stimpl.h" /*I "slepcst.h" I*/ |
| #undef __FUNCT__ |
| #define __FUNCT__ "STApply_Shift" |
| PetscErrorCode STApply_Shift(ST st,Vec x,Vec y) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| if (st->B) { |
| /* generalized eigenproblem: y = (B^-1 A + sI) x */ |
| ierr = MatMult(st->A,x,st->w);CHKERRQ(ierr); |
| ierr = STAssociatedKSPSolve(st,st->w,y);CHKERRQ(ierr); |
| } |
| else { |
| /* standard eigenproblem: y = (A + sI) x */ |
| ierr = MatMult(st->A,x,y);CHKERRQ(ierr); |
| } |
| if (st->sigma != 0.0) { |
| ierr = VecAXPY(y,st->sigma,x);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STApplyTranspose_Shift" |
| PetscErrorCode STApplyTranspose_Shift(ST st,Vec x,Vec y) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| if (st->B) { |
| /* generalized eigenproblem: y = (A^T B^-T + sI) x */ |
| ierr = STAssociatedKSPSolveTranspose(st,x,st->w);CHKERRQ(ierr); |
| ierr = MatMultTranspose(st->A,st->w,y);CHKERRQ(ierr); |
| } |
| else { |
| /* standard eigenproblem: y = (A^T + sI) x */ |
| ierr = MatMultTranspose(st->A,x,y);CHKERRQ(ierr); |
| } |
| if (st->sigma != 0.0) { |
| ierr = VecAXPY(y,st->sigma,x);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STBackTransform_Shift" |
| PetscErrorCode STBackTransform_Shift(ST st,PetscScalar *eigr,PetscScalar *eigi) |
| { |
| PetscFunctionBegin; |
| if (eigr) *eigr -= st->sigma; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STSetUp_Shift" |
| PetscErrorCode STSetUp_Shift(ST st) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| if (st->B) { |
| ierr = KSPSetOperators(st->ksp,st->B,st->B,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); |
| ierr = KSPSetUp(st->ksp);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "STView_Shift" |
| PetscErrorCode STView_Shift(ST st,PetscViewer viewer) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| if (st->B) { |
| ierr = STView_Default(st,viewer);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| EXTERN_C_BEGIN |
| #undef __FUNCT__ |
| #define __FUNCT__ "STCreate_Shift" |
| PetscErrorCode STCreate_Shift(ST st) |
| { |
| PetscFunctionBegin; |
| st->ops->apply = STApply_Shift; |
| st->ops->getbilinearform = STGetBilinearForm_Default; |
| st->ops->applytrans = STApplyTranspose_Shift; |
| st->ops->backtr = STBackTransform_Shift; |
| st->ops->setup = STSetUp_Shift; |
| st->ops->view = STView_Shift; |
| st->checknullspace = 0; |
| PetscFunctionReturn(0); |
| } |
| EXTERN_C_END |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| ALL: lib |
| SOURCEH = ../../include/private/stimpl.h ../../include/slepcst.h |
| DIRS = interface impls |
| LOCDIR = src/st/ |
| MANSEC = ST |
| include ${SLEPC_DIR}/conf/slepc_common |
| /* |
| This file contains routines for handling small-size dense problems. |
| All routines are simply wrappers to LAPACK routines. Matrices passed in |
| as arguments are assumed to be square matrices stored in column-major |
| format with a leading dimension equal to the number of rows. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/epsimpl.h" /*I "slepceps.h" I*/ |
| #include "slepcblaslapack.h" |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSDenseNHEP" |
| /*@ |
| EPSDenseNHEP - Solves a dense standard non-Hermitian Eigenvalue Problem. |
| Not Collective |
| Input Parameters: |
| + n - dimension of the eigenproblem |
| - A - pointer to the array containing the matrix values |
| Output Parameters: |
| + w - pointer to the array to store the computed eigenvalues |
| . wi - imaginary part of the eigenvalues (only when using real numbers) |
| . V - pointer to the array to store right eigenvectors |
| - W - pointer to the array to store left eigenvectors |
| Notes: |
| If either V or W are PETSC_NULL then the corresponding eigenvectors are |
| not computed. |
| Matrix A is overwritten. |
| This routine uses LAPACK routines xGEEVX. |
| Level: developer |
| .seealso: EPSDenseGNHEP(), EPSDenseHEP(), EPSDenseGHEP() |
| @*/ |
| PetscErrorCode EPSDenseNHEP(PetscInt n_,PetscScalar *A,PetscScalar *w,PetscScalar *wi,PetscScalar *V,PetscScalar *W) |
| { |
| #if defined(SLEPC_MISSING_LAPACK_GEEVX) |
| PetscFunctionBegin; |
| SETERRQ(PETSC_ERR_SUP,"GEEVX - Lapack routine is unavailable."); |
| #else |
| PetscErrorCode ierr; |
| PetscReal abnrm,*scale,dummy; |
| PetscScalar *work; |
| PetscBLASInt ilo,ihi,n,lwork,info; |
| const char *jobvr,*jobvl; |
| #if defined(PETSC_USE_COMPLEX) |
| PetscReal *rwork; |
| #else |
| PetscBLASInt idummy; |
| #endif |
| PetscFunctionBegin; |
| ierr = PetscLogEventBegin(EPS_Dense,0,0,0,0);CHKERRQ(ierr); |
| n = PetscBLASIntCast(n_); |
| lwork = PetscBLASIntCast(4*n_); |
| if (V) jobvr = "V"; |
| else jobvr = "N"; |
| if (W) jobvl = "V"; |
| else jobvl = "N"; |
| ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr); |
| ierr = PetscMalloc(n*sizeof(PetscReal),&scale);CHKERRQ(ierr); |
| #if defined(PETSC_USE_COMPLEX) |
| ierr = PetscMalloc(2*n*sizeof(PetscReal),&rwork);CHKERRQ(ierr); |
| LAPACKgeevx_("B",jobvl,jobvr,"N",&n,A,&n,w,W,&n,V,&n,&ilo,&ihi,scale,&abnrm,&dummy,&dummy,work,&lwork,rwork,&info); |
| if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack ZGEEVX %d",info); |
| ierr = PetscFree(rwork);CHKERRQ(ierr); |
| #else |
| LAPACKgeevx_("B",jobvl,jobvr,"N",&n,A,&n,w,wi,W,&n,V,&n,&ilo,&ihi,scale,&abnrm,&dummy,&dummy,work,&lwork,&idummy,&info); |
| if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack DGEEVX %d",info); |
| #endif |
| ierr = PetscFree(work);CHKERRQ(ierr); |
| ierr = PetscFree(scale);CHKERRQ(ierr); |
| ierr = PetscLogEventEnd(EPS_Dense,0,0,0,0);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| #endif |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSDenseGNHEP" |
| /*@ |
| EPSDenseGNHEP - Solves a dense Generalized non-Hermitian Eigenvalue Problem. |
| Not Collective |
| Input Parameters: |
| + n - dimension of the eigenproblem |
| . A - pointer to the array containing the matrix values for A |
| - B - pointer to the array containing the matrix values for B |
| Output Parameters: |
| + w - pointer to the array to store the computed eigenvalues |
| . wi - imaginary part of the eigenvalues (only when using real numbers) |
| . V - pointer to the array to store right eigenvectors |
| - W - pointer to the array to store left eigenvectors |
| Notes: |
| If either V or W are PETSC_NULL then the corresponding eigenvectors are |
| not computed. |
| Matrices A and B are overwritten. |
| This routine uses LAPACK routines xGGEVX. |
| Level: developer |
| .seealso: EPSDenseNHEP(), EPSDenseHEP(), EPSDenseGHEP() |
| @*/ |
| PetscErrorCode EPSDenseGNHEP(PetscInt n_,PetscScalar *A,PetscScalar *B,PetscScalar *w,PetscScalar *wi,PetscScalar *V,PetscScalar *W) |
| { |
| #if defined(SLEPC_MISSING_LAPACK_GGEVX) |
| PetscFunctionBegin; |
| SETERRQ(PETSC_ERR_SUP,"GGEVX - Lapack routine is unavailable."); |
| #else |
| PetscErrorCode ierr; |
| PetscReal *rscale,*lscale,abnrm,bbnrm,dummy; |
| PetscScalar *alpha,*beta,*work; |
| PetscInt i; |
| PetscBLASInt ilo,ihi,idummy,info,n; |
| const char *jobvr,*jobvl; |
| #if defined(PETSC_USE_COMPLEX) |
| PetscReal *rwork; |
| PetscBLASInt lwork; |
| #else |
| PetscReal *alphai; |
| PetscBLASInt lwork; |
| #endif |
| PetscFunctionBegin; |
| ierr = PetscLogEventBegin(EPS_Dense,0,0,0,0);CHKERRQ(ierr); |
| n = PetscBLASIntCast(n_); |
| #if defined(PETSC_USE_COMPLEX) |
| lwork = PetscBLASIntCast(2*n_); |
| #else |
| lwork = PetscBLASIntCast(6*n_); |
| #endif |
| if (V) jobvr = "V"; |
| else jobvr = "N"; |
| if (W) jobvl = "V"; |
| else jobvl = "N"; |
| ierr = PetscMalloc(n*sizeof(PetscScalar),&alpha);CHKERRQ(ierr); |
| ierr = PetscMalloc(n*sizeof(PetscScalar),&beta);CHKERRQ(ierr); |
| ierr = PetscMalloc(n*sizeof(PetscReal),&rscale);CHKERRQ(ierr); |
| ierr = PetscMalloc(n*sizeof(PetscReal),&lscale);CHKERRQ(ierr); |
| ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr); |
| #if defined(PETSC_USE_COMPLEX) |
| ierr = PetscMalloc(6*n*sizeof(PetscReal),&rwork);CHKERRQ(ierr); |
| LAPACKggevx_("B",jobvl,jobvr,"N",&n,A,&n,B,&n,alpha,beta,W,&n,V,&n,&ilo,&ihi,lscale,rscale,&abnrm,&bbnrm,&dummy,&dummy,work,&lwork,rwork,&idummy,&idummy,&info); |
| if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack ZGGEVX %d",info); |
| for (i=0;i<n;i++) { |
| w[i] = alpha[i]/beta[i]; |
| } |
| ierr = PetscFree(rwork);CHKERRQ(ierr); |
| #else |
| ierr = PetscMalloc(n*sizeof(PetscReal),&alphai);CHKERRQ(ierr); |
| LAPACKggevx_("B",jobvl,jobvr,"N",&n,A,&n,B,&n,alpha,alphai,beta,W,&n,V,&n,&ilo,&ihi,lscale,rscale,&abnrm,&bbnrm,&dummy,&dummy,work,&lwork,&idummy,&idummy,&info); |
| if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack DGGEVX %d",info); |
| for (i=0;i<n;i++) { |
| w[i] = alpha[i]/beta[i]; |
| wi[i] = alphai[i]/beta[i]; |
| } |
| ierr = PetscFree(alphai);CHKERRQ(ierr); |
| #endif |
| ierr = PetscFree(alpha);CHKERRQ(ierr); |
| ierr = PetscFree(beta);CHKERRQ(ierr); |
| ierr = PetscFree(rscale);CHKERRQ(ierr); |
| ierr = PetscFree(lscale);CHKERRQ(ierr); |
| ierr = PetscFree(work);CHKERRQ(ierr); |
| ierr = PetscLogEventEnd(EPS_Dense,0,0,0,0);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| #endif |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSDenseHEP" |
| /*@ |
| EPSDenseHEP - Solves a dense standard Hermitian Eigenvalue Problem. |
| Not Collective |
| Input Parameters: |
| + n - dimension of the eigenproblem |
| . A - pointer to the array containing the matrix values |
| - lda - leading dimension of A |
| Output Parameters: |
| + w - pointer to the array to store the computed eigenvalues |
| - V - pointer to the array to store the eigenvectors |
| Notes: |
| If V is PETSC_NULL then the eigenvectors are not computed. |
| Matrix A is overwritten. |
| This routine uses LAPACK routines DSYEVR or ZHEEVR. |
| Level: developer |
| .seealso: EPSDenseNHEP(), EPSDenseGNHEP(), EPSDenseGHEP() |
| @*/ |
| PetscErrorCode EPSDenseHEP(PetscInt n_,PetscScalar *A,PetscInt lda_,PetscReal *w,PetscScalar *V) |
| { |
| #if defined(SLEPC_MISSING_LAPACK_SYEVR) || defined(SLEPC_MISSING_LAPACK_HEEVR) |
| PetscFunctionBegin; |
| SETERRQ(PETSC_ERR_SUP,"DSYEVR/ZHEEVR - Lapack routine is unavailable."); |
| #else |
| PetscErrorCode ierr; |
| PetscReal abstol = 0.0,vl,vu; |
| PetscScalar *work; |
| PetscBLASInt il,iu,m,*isuppz,*iwork,n,lda,liwork,info; |
| const char *jobz; |
| #if defined(PETSC_USE_COMPLEX) |
| PetscReal *rwork; |
| PetscBLASInt lwork,lrwork; |
| #else |
| PetscBLASInt lwork; |
| #endif |
| PetscFunctionBegin; |
| ierr = PetscLogEventBegin(EPS_Dense,0,0,0,0);CHKERRQ(ierr); |
| n = PetscBLASIntCast(n_); |
| lda = PetscBLASIntCast(lda_); |
| liwork = PetscBLASIntCast(10*n_); |
| #if defined(PETSC_USE_COMPLEX) |
| lwork = PetscBLASIntCast(18*n_); |
| lrwork = PetscBLASIntCast(24*n_); |
| #else |
| lwork = PetscBLASIntCast(26*n_); |
| #endif |
| if (V) jobz = "V"; |
| else jobz = "N"; |
| ierr = PetscMalloc(2*n*sizeof(PetscBLASInt),&isuppz);CHKERRQ(ierr); |
| ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr); |
| ierr = PetscMalloc(liwork*sizeof(PetscBLASInt),&iwork);CHKERRQ(ierr); |
| #if defined(PETSC_USE_COMPLEX) |
| ierr = PetscMalloc(lrwork*sizeof(PetscReal),&rwork);CHKERRQ(ierr); |
| LAPACKsyevr_(jobz,"A","L",&n,A,&lda,&vl,&vu,&il,&iu,&abstol,&m,w,V,&n,isuppz,work,&lwork,rwork,&lrwork,iwork,&liwork,&info); |
| if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack ZHEEVR %d",info); |
| ierr = PetscFree(rwork);CHKERRQ(ierr); |
| #else |
| LAPACKsyevr_(jobz,"A","L",&n,A,&lda,&vl,&vu,&il,&iu,&abstol,&m,w,V,&n,isuppz,work,&lwork,iwork,&liwork,&info); |
| if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack DSYEVR %d",info); |
| #endif |
| ierr = PetscFree(isuppz);CHKERRQ(ierr); |
| ierr = PetscFree(work);CHKERRQ(ierr); |
| ierr = PetscFree(iwork);CHKERRQ(ierr); |
| ierr = PetscLogEventEnd(EPS_Dense,0,0,0,0);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| #endif |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSDenseGHEP" |
| /*@ |
| EPSDenseGHEP - Solves a dense Generalized Hermitian Eigenvalue Problem. |
| Not Collective |
| Input Parameters: |
| + n - dimension of the eigenproblem |
| . A - pointer to the array containing the matrix values for A |
| - B - pointer to the array containing the matrix values for B |
| Output Parameters: |
| + w - pointer to the array to store the computed eigenvalues |
| - V - pointer to the array to store the eigenvectors |
| Notes: |
| If V is PETSC_NULL then the eigenvectors are not computed. |
| Matrices A and B are overwritten. |
| This routine uses LAPACK routines DSYGVD or ZHEGVD. |
| Level: developer |
| .seealso: EPSDenseNHEP(), EPSDenseGNHEP(), EPSDenseHEP() |
| @*/ |
| PetscErrorCode EPSDenseGHEP(PetscInt n_,PetscScalar *A,PetscScalar *B,PetscReal *w,PetscScalar *V) |
| { |
| #if defined(SLEPC_MISSING_LAPACK_SYGVD) || defined(SLEPC_MISSING_LAPACK_HEGVD) |
| PetscFunctionBegin; |
| SETERRQ(PETSC_ERR_SUP,"DSYGVD/ZHEGVD - Lapack routine is unavailable."); |
| #else |
| PetscErrorCode ierr; |
| PetscScalar *work; |
| PetscBLASInt itype = 1,*iwork,info,n, |
| liwork; |
| const char *jobz; |
| #if defined(PETSC_USE_COMPLEX) |
| PetscReal *rwork; |
| PetscBLASInt lwork,lrwork; |
| #else |
| PetscBLASInt lwork; |
| #endif |
| PetscFunctionBegin; |
| ierr = PetscLogEventBegin(EPS_Dense,0,0,0,0);CHKERRQ(ierr); |
| n = PetscBLASIntCast(n_); |
| if (V) { |
| jobz = "V"; |
| liwork = PetscBLASIntCast(5*n_+3); |
| #if defined(PETSC_USE_COMPLEX) |
| lwork = PetscBLASIntCast(n_*n_+2*n_); |
| lrwork = PetscBLASIntCast(2*n_*n_+5*n_+1); |
| #else |
| lwork = PetscBLASIntCast(2*n_*n_+6*n_+1); |
| #endif |
| } else { |
| jobz = "N"; |
| liwork = 1; |
| #if defined(PETSC_USE_COMPLEX) |
| lwork = PetscBLASIntCast(n_+1); |
| lrwork = PetscBLASIntCast(n_); |
| #else |
| lwork = PetscBLASIntCast(2*n_+1); |
| #endif |
| } |
| ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr); |
| ierr = PetscMalloc(liwork*sizeof(PetscBLASInt),&iwork);CHKERRQ(ierr); |
| #if defined(PETSC_USE_COMPLEX) |
| ierr = PetscMalloc(lrwork*sizeof(PetscReal),&rwork);CHKERRQ(ierr); |
| LAPACKsygvd_(&itype,jobz,"U",&n,A,&n,B,&n,w,work,&lwork,rwork,&lrwork,iwork,&liwork,&info); |
| if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack ZHEGVD %d",info); |
| ierr = PetscFree(rwork);CHKERRQ(ierr); |
| #else |
| LAPACKsygvd_(&itype,jobz,"U",&n,A,&n,B,&n,w,work,&lwork,iwork,&liwork,&info); |
| if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack DSYGVD %d",info); |
| #endif |
| if (V) { |
| ierr = PetscMemcpy(V,A,n*n*sizeof(PetscScalar));CHKERRQ(ierr); |
| } |
| ierr = PetscFree(work);CHKERRQ(ierr); |
| ierr = PetscFree(iwork);CHKERRQ(ierr); |
| ierr = PetscLogEventEnd(EPS_Dense,0,0,0,0);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| #endif |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSDenseHessenberg" |
| /*@ |
| EPSDenseHessenberg - Computes the Hessenberg form of a dense matrix. |
| Not Collective |
| Input Parameters: |
| + n - dimension of the matrix |
| . k - first active column |
| - lda - leading dimension of A |
| Input/Output Parameters: |
| + A - on entry, the full matrix; on exit, the upper Hessenberg matrix (H) |
| - Q - on exit, orthogonal matrix of vectors A = Q*H*Q' |
| Notes: |
| Only active columns (from k to n) are computed. |
| Both A and Q are overwritten. |
| This routine uses LAPACK routines xGEHRD and xORGHR/xUNGHR. |
| Level: developer |
| .seealso: EPSDenseSchur(), EPSSortDenseSchur(), EPSDenseTridiagonal() |
| @*/ |
| PetscErrorCode EPSDenseHessenberg(PetscInt n_,PetscInt k,PetscScalar *A,PetscInt lda_,PetscScalar *Q) |
| { |
| #if defined(SLEPC_MISSING_LAPACK_GEHRD) || defined(SLEPC_MISSING_LAPACK_ORGHR) || defined(SLEPC_MISSING_LAPACK_UNGHR) |
| PetscFunctionBegin; |
| SETERRQ(PETSC_ERR_SUP,"GEHRD,ORGHR/UNGHR - Lapack routines are unavailable."); |
| #else |
| PetscScalar *tau,*work; |
| PetscErrorCode ierr; |
| PetscInt i,j; |
| PetscBLASInt ilo,lwork,info,n,lda; |
| PetscFunctionBegin; |
| ierr = PetscLogEventBegin(EPS_Dense,0,0,0,0);CHKERRQ(ierr); |
| n = PetscBLASIntCast(n_); |
| lda = PetscBLASIntCast(lda_); |
| ierr = PetscMalloc(n*sizeof(PetscScalar),&tau);CHKERRQ(ierr); |
| lwork = n; |
| ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr); |
| ilo = PetscBLASIntCast(k+1); |
| LAPACKgehrd_(&n,&ilo,&n,A,&lda,tau,work,&lwork,&info); |
| if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack xGEHRD %d",info); |
| for (j=0;j<n-1;j++) { |
| for (i=j+2;i<n;i++) { |
| Q[i+j*n] = A[i+j*lda]; |
| A[i+j*lda] = 0.0; |
| } |
| } |
| LAPACKorghr_(&n,&ilo,&n,Q,&n,tau,work,&lwork,&info); |
| if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack xORGHR %d",info); |
| ierr = PetscFree(tau);CHKERRQ(ierr); |
| ierr = PetscFree(work);CHKERRQ(ierr); |
| ierr = PetscLogEventEnd(EPS_Dense,0,0,0,0);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| #endif |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSDenseSchur" |
| /*@ |
| EPSDenseSchur - Computes the upper (quasi-)triangular form of a dense |
| upper Hessenberg matrix. |
| Not Collective |
| Input Parameters: |
| + n - dimension of the matrix |
| . k - first active column |
| - ldh - leading dimension of H |
| Input/Output Parameters: |
| + H - on entry, the upper Hessenber matrix; on exit, the upper |
| (quasi-)triangular matrix (T) |
| - Z - on entry, initial transformation matrix; on exit, orthogonal |
| matrix of Schur vectors |
| Output Parameters: |
| + wr - pointer to the array to store the computed eigenvalues |
| - wi - imaginary part of the eigenvalues (only when using real numbers) |
| Notes: |
| This function computes the (real) Schur decomposition of an upper |
| Hessenberg matrix H: H*Z = Z*T, where T is an upper (quasi-)triangular |
| matrix (returned in H), and Z is the orthogonal matrix of Schur vectors. |
| Eigenvalues are extracted from the diagonal blocks of T and returned in |
| wr,wi. Transformations are accumulated in Z so that on entry it can |
| contain the transformation matrix associated to the Hessenberg reduction. |
| Only active columns (from k to n) are computed. |
| Both H and Z are overwritten. |
| This routine uses LAPACK routines xHSEQR. |
| Level: developer |
| .seealso: EPSDenseHessenberg(), EPSSortDenseSchur(), EPSDenseTridiagonal() |
| @*/ |
| PetscErrorCode EPSDenseSchur(PetscInt n_,PetscInt k,PetscScalar *H,PetscInt ldh_,PetscScalar *Z,PetscScalar *wr,PetscScalar *wi) |
| { |
| #if defined(SLEPC_MISSING_LAPACK_HSEQR) |
| PetscFunctionBegin; |
| SETERRQ(PETSC_ERR_SUP,"HSEQR - Lapack routine is unavailable."); |
| #else |
| PetscErrorCode ierr; |
| PetscBLASInt ilo,lwork,info,n,ldh; |
| PetscScalar *work; |
| #if !defined(PETSC_USE_COMPLEX) |
| PetscInt j; |
| #endif |
| PetscFunctionBegin; |
| ierr = PetscLogEventBegin(EPS_Dense,0,0,0,0);CHKERRQ(ierr); |
| n = PetscBLASIntCast(n_); |
| ldh = PetscBLASIntCast(ldh_); |
| lwork = n; |
| ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr); |
| ilo = PetscBLASIntCast(k+1); |
| #if !defined(PETSC_USE_COMPLEX) |
| LAPACKhseqr_("S","V",&n,&ilo,&n,H,&ldh,wr,wi,Z,&n,work,&lwork,&info); |
| for (j=0;j<k;j++) { |
| if (j==n-1 || H[j*ldh+j+1] == 0.0) { |
| /* real eigenvalue */ |
| wr[j] = H[j*ldh+j]; |
| wi[j] = 0.0; |
| } else { |
| /* complex eigenvalue */ |
| wr[j] = H[j*ldh+j]; |
| wr[j+1] = H[j*ldh+j]; |
| wi[j] = sqrt(PetscAbsReal(H[j*ldh+j+1])) * |
| sqrt(PetscAbsReal(H[(j+1)*ldh+j])); |
| wi[j+1] = -wi[j]; |
| j++; |
| } |
| } |
| #else |
| LAPACKhseqr_("S","V",&n,&ilo,&n,H,&ldh,wr,Z,&n,work,&lwork,&info); |
| #endif |
| if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack xHSEQR %d",info); |
| ierr = PetscFree(work);CHKERRQ(ierr); |
| ierr = PetscLogEventEnd(EPS_Dense,0,0,0,0);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| #endif |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSSortDenseSchur" |
| /*@ |
| EPSSortDenseSchur - Reorders the Schur decomposition computed by |
| EPSDenseSchur(). |
| Not Collective |
| Input Parameters: |
| + n - dimension of the matrix |
| . k - first active column |
| . ldt - leading dimension of T |
| - which - eigenvalue sort order |
| Input/Output Parameters: |
| + T - the upper (quasi-)triangular matrix |
| . Z - the orthogonal matrix of Schur vectors |
| . wr - pointer to the array to store the computed eigenvalues |
| - wi - imaginary part of the eigenvalues (only when using real numbers) |
| Notes: |
| This function reorders the eigenvalues in wr,wi located in positions k |
| to n according to the sort order specified in which. The Schur |
| decomposition Z*T*Z^T, is also reordered by means of rotations so that |
| eigenvalues in the diagonal blocks of T follow the same order. |
| Both T and Z are overwritten. |
| This routine uses LAPACK routines xTREXC. |
| Level: developer |
| .seealso: EPSDenseHessenberg(), EPSDenseSchur(), EPSDenseTridiagonal() |
| @*/ |
| PetscErrorCode EPSSortDenseSchur(PetscInt n_,PetscInt k,PetscScalar *T,PetscInt ldt_,PetscScalar *Z,PetscScalar *wr,PetscScalar *wi,EPSWhich which) |
| { |
| #if defined(SLEPC_MISSING_LAPACK_TREXC) |
| PetscFunctionBegin; |
| SETERRQ(PETSC_ERR_SUP,"TREXC - Lapack routine is unavailable."); |
| #else |
| PetscErrorCode ierr; |
| PetscReal value,v; |
| PetscInt i,j; |
| PetscBLASInt ifst,ilst,info,pos,n,ldt; |
| #if !defined(PETSC_USE_COMPLEX) |
| PetscScalar *work; |
| #endif |
| PetscFunctionBegin; |
| ierr = PetscLogEventBegin(EPS_Dense,0,0,0,0);CHKERRQ(ierr); |
| n = PetscBLASIntCast(n_); |
| ldt = PetscBLASIntCast(ldt_); |
| #if !defined(PETSC_USE_COMPLEX) |
| ierr = PetscMalloc(n*sizeof(PetscScalar),&work);CHKERRQ(ierr); |
| #endif |
| for (i=k;i<n-1;i++) { |
| switch(which) { |
| case EPS_LARGEST_MAGNITUDE: |
| case EPS_SMALLEST_MAGNITUDE: |
| value = SlepcAbsEigenvalue(wr[i],wi[i]); |
| break; |
| case EPS_LARGEST_REAL: |
| case EPS_SMALLEST_REAL: |
| value = PetscRealPart(wr[i]); |
| break; |
| case EPS_LARGEST_IMAGINARY: |
| case EPS_SMALLEST_IMAGINARY: |
| #if !defined(PETSC_USE_COMPLEX) |
| value = PetscAbsReal(wi[i]); |
| #else |
| value = PetscImaginaryPart(wr[i]); |
| #endif |
| break; |
| default: SETERRQ(1,"Wrong value of which"); |
| } |
| pos = 0; |
| for (j=i+1;j<n;j++) { |
| switch(which) { |
| case EPS_LARGEST_MAGNITUDE: |
| case EPS_SMALLEST_MAGNITUDE: |
| v = SlepcAbsEigenvalue(wr[j],wi[j]); |
| break; |
| case EPS_LARGEST_REAL: |
| case EPS_SMALLEST_REAL: |
| v = PetscRealPart(wr[j]); |
| break; |
| case EPS_LARGEST_IMAGINARY: |
| case EPS_SMALLEST_IMAGINARY: |
| #if !defined(PETSC_USE_COMPLEX) |
| v = PetscAbsReal(wi[j]); |
| #else |
| v = PetscImaginaryPart(wr[j]); |
| #endif |
| break; |
| default: SETERRQ(1,"Wrong value of which"); |
| } |
| switch(which) { |
| case EPS_LARGEST_MAGNITUDE: |
| case EPS_LARGEST_REAL: |
| case EPS_LARGEST_IMAGINARY: |
| if (v > value) { |
| value = v; |
| pos = j; |
| } |
| break; |
| case EPS_SMALLEST_MAGNITUDE: |
| case EPS_SMALLEST_REAL: |
| case EPS_SMALLEST_IMAGINARY: |
| if (v < value) { |
| value = v; |
| pos = j; |
| } |
| break; |
| default: SETERRQ(1,"Wrong value of which"); |
| } |
| #if !defined(PETSC_USE_COMPLEX) |
| if (wi[j] != 0) j++; |
| #endif |
| } |
| if (pos) { |
| ifst = PetscBLASIntCast(pos + 1); |
| ilst = PetscBLASIntCast(i + 1); |
| #if !defined(PETSC_USE_COMPLEX) |
| LAPACKtrexc_("V",&n,T,&ldt,Z,&n,&ifst,&ilst,work,&info); |
| #else |
| LAPACKtrexc_("V",&n,T,&ldt,Z,&n,&ifst,&ilst,&info); |
| #endif |
| if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack xTREXC %d",info); |
| for (j=k;j<n;j++) { |
| #if !defined(PETSC_USE_COMPLEX) |
| if (j==n-1 || T[j*ldt+j+1] == 0.0) { |
| /* real eigenvalue */ |
| wr[j] = T[j*ldt+j]; |
| wi[j] = 0.0; |
| } else { |
| /* complex eigenvalue */ |
| wr[j] = T[j*ldt+j]; |
| wr[j+1] = T[j*ldt+j]; |
| wi[j] = sqrt(PetscAbsReal(T[j*ldt+j+1])) * |
| sqrt(PetscAbsReal(T[(j+1)*ldt+j])); |
| wi[j+1] = -wi[j]; |
| j++; |
| } |
| #else |
| wr[j] = T[j*(ldt+1)]; |
| #endif |
| } |
| } |
| #if !defined(PETSC_USE_COMPLEX) |
| if (wi[i] != 0) i++; |
| #endif |
| } |
| #if !defined(PETSC_USE_COMPLEX) |
| ierr = PetscFree(work);CHKERRQ(ierr); |
| #endif |
| ierr = PetscLogEventEnd(EPS_Dense,0,0,0,0);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| #endif |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSSortDenseSchurTarget" |
| /*@ |
| EPSSortDenseSchurTarget - Reorders the Schur decomposition computed by |
| EPSDenseSchur(). |
| Not Collective |
| Input Parameters: |
| + n - dimension of the matrix |
| . k - first active column |
| . ldt - leading dimension of T |
| . target - the target value |
| - which - eigenvalue sort order |
| Input/Output Parameters: |
| + T - the upper (quasi-)triangular matrix |
| . Z - the orthogonal matrix of Schur vectors |
| . wr - pointer to the array to store the computed eigenvalues |
| - wi - imaginary part of the eigenvalues (only when using real numbers) |
| Notes: |
| This function reorders the eigenvalues in wr,wi located in positions k |
| to n according to increasing distance to the target. The parameter which |
| is used to determine if distance is relative to magnitude, real axis, |
| or imaginary axis. The Schur decomposition Z*T*Z^T, is also reordered |
| by means of rotations so that eigenvalues in the diagonal blocks of T |
| follow the same order. |
| Both T and Z are overwritten. |
| This routine uses LAPACK routines xTREXC. |
| Level: developer |
| .seealso: EPSDenseHessenberg(), EPSDenseSchur(), EPSDenseTridiagonal() |
| @*/ |
| PetscErrorCode EPSSortDenseSchurTarget(PetscInt n_,PetscInt k,PetscScalar *T,PetscInt ldt_,PetscScalar *Z,PetscScalar *wr,PetscScalar *wi,PetscScalar target,EPSWhich which) |
| { |
| #if defined(SLEPC_MISSING_LAPACK_TREXC) |
| PetscFunctionBegin; |
| SETERRQ(PETSC_ERR_SUP,"TREXC - Lapack routine is unavailable."); |
| #else |
| PetscErrorCode ierr; |
| PetscReal value,v; |
| PetscInt i,j; |
| PetscBLASInt ifst,ilst,info,pos,n,ldt; |
| #if !defined(PETSC_USE_COMPLEX) |
| PetscScalar *work; |
| #endif |
| PetscFunctionBegin; |
| ierr = PetscLogEventBegin(EPS_Dense,0,0,0,0);CHKERRQ(ierr); |
| n = PetscBLASIntCast(n_); |
| ldt = PetscBLASIntCast(ldt_); |
| #if !defined(PETSC_USE_COMPLEX) |
| ierr = PetscMalloc(n*sizeof(PetscScalar),&work);CHKERRQ(ierr); |
| #endif |
| for (i=k;i<n-1;i++) { |
| switch(which) { |
| case EPS_LARGEST_MAGNITUDE: |
| /* complex target only allowed if scalartype=complex */ |
| value = SlepcAbsEigenvalue(wr[i]-target,wi[i]); |
| break; |
| case EPS_LARGEST_REAL: |
| value = PetscAbsReal(PetscRealPart(wr[i]-target)); |
| break; |
| case EPS_LARGEST_IMAGINARY: |
| #if !defined(PETSC_USE_COMPLEX) |
| /* complex target only allowed if scalartype=complex */ |
| value = PetscAbsReal(wi[i]); |
| #else |
| value = PetscAbsReal(PetscImaginaryPart(wr[i]-target)); |
| #endif |
| break; |
| default: SETERRQ(1,"Wrong value of which"); |
| } |
| pos = 0; |
| for (j=i+1;j<n;j++) { |
| switch(which) { |
| case EPS_LARGEST_MAGNITUDE: |
| /* complex target only allowed if scalartype=complex */ |
| v = SlepcAbsEigenvalue(wr[j]-target,wi[j]); |
| break; |
| case EPS_LARGEST_REAL: |
| v = PetscAbsReal(PetscRealPart(wr[j]-target)); |
| break; |
| case EPS_LARGEST_IMAGINARY: |
| #if !defined(PETSC_USE_COMPLEX) |
| /* complex target only allowed if scalartype=complex */ |
| v = PetscAbsReal(wi[j]); |
| #else |
| v = PetscAbsReal(PetscImaginaryPart(wr[j]-target)); |
| #endif |
| break; |
| default: SETERRQ(1,"Wrong value of which"); |
| } |
| if (v < value) { |
| value = v; |
| pos = j; |
| } |
| #if !defined(PETSC_USE_COMPLEX) |
| if (wi[j] != 0) j++; |
| #endif |
| } |
| if (pos) { |
| ifst = PetscBLASIntCast(pos + 1); |
| ilst = PetscBLASIntCast(i + 1); |
| #if !defined(PETSC_USE_COMPLEX) |
| LAPACKtrexc_("V",&n,T,&ldt,Z,&n,&ifst,&ilst,work,&info); |
| #else |
| LAPACKtrexc_("V",&n,T,&ldt,Z,&n,&ifst,&ilst,&info); |
| #endif |
| if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack xTREXC %d",info); |
| for (j=k;j<n;j++) { |
| #if !defined(PETSC_USE_COMPLEX) |
| if (j==n-1 || T[j*ldt+j+1] == 0.0) { |
| /* real eigenvalue */ |
| wr[j] = T[j*ldt+j]; |
| wi[j] = 0.0; |
| } else { |
| /* complex eigenvalue */ |
| wr[j] = T[j*ldt+j]; |
| wr[j+1] = T[j*ldt+j]; |
| wi[j] = sqrt(PetscAbsReal(T[j*ldt+j+1])) * |
| sqrt(PetscAbsReal(T[(j+1)*ldt+j])); |
| wi[j+1] = -wi[j]; |
| j++; |
| } |
| #else |
| wr[j] = T[j*(ldt+1)]; |
| #endif |
| } |
| } |
| #if !defined(PETSC_USE_COMPLEX) |
| if (wi[i] != 0) i++; |
| #endif |
| } |
| #if !defined(PETSC_USE_COMPLEX) |
| ierr = PetscFree(work);CHKERRQ(ierr); |
| #endif |
| ierr = PetscLogEventEnd(EPS_Dense,0,0,0,0);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| #endif |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSDenseTridiagonal" |
| /*@ |
| EPSDenseTridiagonal - Solves a real tridiagonal Hermitian Eigenvalue Problem. |
| Not Collective |
| Input Parameters: |
| + n - dimension of the eigenproblem |
| . A - pointer to the array containing the matrix values |
| - lda - leading dimension of A |
| Output Parameters: |
| + w - pointer to the array to store the computed eigenvalues |
| - V - pointer to the array to store the eigenvectors |
| Notes: |
| If V is PETSC_NULL then the eigenvectors are not computed. |
| This routine use LAPACK routines DSTEVR. |
| Level: developer |
| .seealso: EPSDenseNHEP(), EPSDenseHEP(), EPSDenseGNHEP(), EPSDenseGHEP() |
| @*/ |
| PetscErrorCode EPSDenseTridiagonal(PetscInt n_,PetscReal *D,PetscReal *E,PetscReal *w,PetscScalar *V) |
| { |
| #if defined(SLEPC_MISSING_LAPACK_STEVR) |
| PetscFunctionBegin; |
| SETERRQ(PETSC_ERR_SUP,"STEVR - Lapack routine is unavailable."); |
| #else |
| PetscErrorCode ierr; |
| PetscReal abstol = 0.0,vl,vu,*work; |
| PetscBLASInt il,iu,m,*isuppz,n,lwork,*iwork,liwork,info; |
| const char *jobz; |
| #if defined(PETSC_USE_COMPLEX) |
| PetscInt i,j; |
| PetscReal *VV; |
| #endif |
| PetscFunctionBegin; |
| ierr = PetscLogEventBegin(EPS_Dense,0,0,0,0);CHKERRQ(ierr); |
| n = PetscBLASIntCast(n_); |
| lwork = PetscBLASIntCast(20*n_); |
| liwork = PetscBLASIntCast(10*n_); |
| if (V) { |
| jobz = "V"; |
| #if defined(PETSC_USE_COMPLEX) |
| ierr = PetscMalloc(n*n*sizeof(PetscReal),&VV);CHKERRQ(ierr); |
| #endif |
| } else jobz = "N"; |
| ierr = PetscMalloc(2*n*sizeof(PetscBLASInt),&isuppz);CHKERRQ(ierr); |
| ierr = PetscMalloc(lwork*sizeof(PetscReal),&work);CHKERRQ(ierr); |
| ierr = PetscMalloc(liwork*sizeof(PetscBLASInt),&iwork);CHKERRQ(ierr); |
| #if defined(PETSC_USE_COMPLEX) |
| LAPACKstevr_(jobz,"A",&n,D,E,&vl,&vu,&il,&iu,&abstol,&m,w,VV,&n,isuppz,work,&lwork,iwork,&liwork,&info); |
| #else |
| LAPACKstevr_(jobz,"A",&n,D,E,&vl,&vu,&il,&iu,&abstol,&m,w,V,&n,isuppz,work,&lwork,iwork,&liwork,&info); |
| #endif |
| if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack DSTEVR %d",info); |
| #if defined(PETSC_USE_COMPLEX) |
| if (V) { |
| for (i=0;i<n;i++) |
| for (j=0;j<n;j++) |
| V[i*n+j] = VV[i*n+j]; |
| ierr = PetscFree(VV);CHKERRQ(ierr); |
| } |
| #endif |
| ierr = PetscFree(isuppz);CHKERRQ(ierr); |
| ierr = PetscFree(work);CHKERRQ(ierr); |
| ierr = PetscFree(iwork);CHKERRQ(ierr); |
| ierr = PetscLogEventEnd(EPS_Dense,0,0,0,0);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| #endif |
| } |
| /* |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/fortranimpl.h" |
| #include "slepceps.h" |
| #include "private/epsimpl.h" |
| #ifdef PETSC_HAVE_FORTRAN_CAPS |
| #define epsview_ EPSVIEW |
| #define epssetoptionsprefix_ EPSSETOPTIONSPREFIX |
| #define epsappendoptionsprefix_ EPSAPPENDOPTIONSPREFIX |
| #define epsgetoptionsprefix_ EPSGETOPTIONSPREFIX |
| #define epscreate_ EPSCREATE |
| #define epssettype_ EPSSETTYPE |
| #define epsgettype_ EPSGETTYPE |
| #define epsmonitordefault_ EPSMONITORDEFAULT |
| #define epsmonitorlg_ EPSMONITORLG |
| #define epsmonitorset_ EPSMONITORSET |
| #define epsgetst_ EPSGETST |
| #define epsgetip_ EPSGETIP |
| #define epsgetwhicheigenpairs_ EPSGETWHICHEIGENPAIRS |
| #define epsgetproblemtype_ EPSGETPROBLEMTYPE |
| #define epsgetextraction_ EPSGETEXTRACTION |
| #define epsgetclass_ EPSGETCLASS |
| #define epsgetconvergedreason_ EPSGETCONVERGEDREASON |
| #define epspowergetshifttype_ EPSPOWERGETSHIFTTYPE |
| #define epslanczosgetreorthog_ EPSLANCZOSGETREORTHOG |
| #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) |
| #define epsview_ epsview |
| #define epssetoptionsprefix_ epssetoptionsprefix |
| #define epsappendoptionsprefix_ epsappendoptionsprefix |
| #define epsgetoptionsprefix_ epsgetoptionsprefix |
| #define epscreate_ epscreate |
| #define epssettype_ epssettype |
| #define epsgettype_ epsgettype |
| #define epsmonitordefault_ epsmonitordefault |
| #define epsmonitorlg_ epsmonitorlg |
| #define epsmonitorset_ epsmonitorset |
| #define epsgetst_ epsgetst |
| #define epsgetip_ epsgetip |
| #define epsgetwhicheigenpairs_ epsgetwhicheigenpairs |
| #define epsgetproblemtype_ epsgetproblemtype |
| #define epsgetextraction_ epsgetextraction |
| #define epsgetclass_ epsgetclass |
| #define epsgetconvergedreason_ epsgetconvergedreason |
| #define epspowergetshifttype_ epspowergetshifttype |
| #define epslanczosgetreorthog_ epslanczosgetreorthog |
| #endif |
| EXTERN_C_BEGIN |
| static void (PETSC_STDCALL *f1)(EPS*,PetscInt*,PetscInt*,PetscScalar*,PetscScalar*,PetscReal*,PetscInt*,void*,PetscErrorCode*); |
| static void (PETSC_STDCALL *f2)(void*,PetscErrorCode*); |
| /* |
| These are not usually called from Fortran but allow Fortran users |
| to transparently set these monitors from .F code, hence no STDCALL |
| */ |
| void epsmonitordefault_(EPS *eps,PetscInt *it,PetscInt *nconv,PetscScalar *eigr,PetscScalar *eigi,PetscReal *errest,PetscInt *nest,void *ctx,PetscErrorCode *ierr) |
| { |
| *ierr = EPSMonitorDefault(*eps,*it,*nconv,eigr,eigi,errest,*nest,ctx); |
| } |
| void epsmonitorlg_(EPS *eps,PetscInt *it,PetscInt *nconv,PetscScalar *eigr,PetscScalar *eigi,PetscReal *errest,PetscInt *nest,void *ctx,PetscErrorCode *ierr) |
| { |
| *ierr = EPSMonitorLG(*eps,*it,*nconv,eigr,eigi,errest,*nest,ctx); |
| } |
| EXTERN_C_END |
| /* These are not extern C because they are passed into non-extern C user level functions */ |
| static PetscErrorCode ourmonitor(EPS eps,PetscInt i,PetscInt nc,PetscScalar *er,PetscScalar *ei,PetscReal *d,PetscInt l,void* ctx) |
| { |
| PetscErrorCode ierr = 0; |
| (*f1)(&eps,&i,&nc,er,ei,d,&l,ctx,&ierr);CHKERRQ(ierr); |
| return 0; |
| } |
| static PetscErrorCode ourdestroy(void* ctx) |
| { |
| PetscErrorCode ierr = 0; |
| (*f2)(ctx,&ierr);CHKERRQ(ierr); |
| return 0; |
| } |
| EXTERN_C_BEGIN |
| void PETSC_STDCALL epsview_(EPS *eps,PetscViewer *viewer, PetscErrorCode *ierr) |
| { |
| PetscViewer v; |
| PetscPatchDefaultViewers_Fortran(viewer,v); |
| *ierr = EPSView(*eps,v); |
| } |
| void PETSC_STDCALL epssettype_(EPS *eps,CHAR type PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) |
| { |
| char *t; |
| FIXCHAR(type,len,t); |
| *ierr = EPSSetType(*eps,t); |
| FREECHAR(type,t); |
| } |
| void PETSC_STDCALL epsgettype_(EPS *eps,CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) |
| { |
| const EPSType tname; |
| *ierr = EPSGetType(*eps,&tname);if (*ierr) return; |
| *ierr = PetscStrncpy(name,tname,len); |
| FIXRETURNCHAR(PETSC_TRUE,name,len); |
| } |
| void PETSC_STDCALL epssetoptionsprefix_(EPS *eps,CHAR prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) |
| { |
| char *t; |
| FIXCHAR(prefix,len,t); |
| *ierr = EPSSetOptionsPrefix(*eps,t); |
| FREECHAR(prefix,t); |
| } |
| void PETSC_STDCALL epsappendoptionsprefix_(EPS *eps,CHAR prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) |
| { |
| char *t; |
| FIXCHAR(prefix,len,t); |
| *ierr = EPSAppendOptionsPrefix(*eps,t); |
| FREECHAR(prefix,t); |
| } |
| void PETSC_STDCALL epscreate_(MPI_Fint *comm,EPS *eps,PetscErrorCode *ierr) |
| { |
| *ierr = EPSCreate(MPI_Comm_f2c(*(comm)),eps); |
| } |
| void PETSC_STDCALL epsmonitorset_(EPS *eps,void (PETSC_STDCALL *monitor)(EPS*,PetscInt*,PetscInt*,PetscScalar*,PetscScalar*,PetscReal*,PetscInt*,void*,PetscErrorCode*), |
| void *mctx,void (PETSC_STDCALL *monitordestroy)(void *,PetscErrorCode *),PetscErrorCode *ierr) |
| { |
| if ((void(*)())monitor == (void(*)())epsmonitordefault_) { |
| *ierr = EPSMonitorSet(*eps,EPSMonitorDefault,0,0); |
| } else if ((void(*)())monitor == (void(*)())epsmonitorlg_) { |
| *ierr = EPSMonitorSet(*eps,EPSMonitorLG,0,0); |
| } else { |
| f1 = monitor; |
| if (FORTRANNULLFUNCTION(monitordestroy)) { |
| *ierr = EPSMonitorSet(*eps,ourmonitor,mctx,0); |
| } else { |
| f2 = monitordestroy; |
| *ierr = EPSMonitorSet(*eps,ourmonitor,mctx,ourdestroy); |
| } |
| } |
| } |
| void PETSC_STDCALL epsgetoptionsprefix_(EPS *eps,CHAR prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) |
| { |
| const char *tname; |
| *ierr = EPSGetOptionsPrefix(*eps,&tname); |
| *ierr = PetscStrncpy(prefix,tname,len); if (*ierr) return; |
| } |
| void PETSC_STDCALL epsgetst_(EPS *eps,ST *st,PetscErrorCode *ierr) |
| { |
| *ierr = EPSGetST(*eps,st); |
| } |
| void PETSC_STDCALL epsgetip_(EPS *eps,IP *ip,PetscErrorCode *ierr) |
| { |
| *ierr = EPSGetIP(*eps,ip); |
| } |
| void PETSC_STDCALL epsgetwhicheigenpairs_(EPS *eps,EPSWhich *which,PetscErrorCode *ierr) |
| { |
| *ierr = EPSGetWhichEigenpairs(*eps,which); |
| } |
| void PETSC_STDCALL epsgetproblemtype_(EPS *eps,EPSProblemType *type,PetscErrorCode *ierr) |
| { |
| *ierr = EPSGetProblemType(*eps,type); |
| } |
| void PETSC_STDCALL epsgetextraction_(EPS *eps,EPSExtraction *proj,PetscErrorCode *ierr) |
| { |
| *ierr = EPSGetExtraction(*eps,proj); |
| } |
| void PETSC_STDCALL epsgetclass_(EPS *eps,EPSClass *cl,PetscErrorCode *ierr) |
| { |
| *ierr = EPSGetClass(*eps,cl); |
| } |
| void PETSC_STDCALL epsgetconvergedreason_(EPS *eps,EPSConvergedReason *reason,PetscErrorCode *ierr) |
| { |
| *ierr = EPSGetConvergedReason(*eps,reason); |
| } |
| void PETSC_STDCALL epspowergetshifttype_(EPS *eps,EPSPowerShiftType *shift,PetscErrorCode *ierr) |
| { |
| *ierr = EPSPowerGetShiftType(*eps,shift); |
| } |
| void PETSC_STDCALL epslanczosgetreorthog_(EPS *eps,EPSLanczosReorthogType *reorthog,PetscErrorCode *ierr) |
| { |
| *ierr = EPSLanczosGetReorthog(*eps,reorthog); |
| } |
| EXTERN_C_END |
| # |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # SLEPc - Scalable Library for Eigenvalue Problem Computations |
| # Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| # |
| # This file is part of SLEPc. |
| # |
| # SLEPc is free software: you can redistribute it and/or modify it under the |
| # terms of version 3 of the GNU Lesser General Public License as published by |
| # the Free Software Foundation. |
| # |
| # SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| # FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| # more details. |
| # |
| # You should have received a copy of the GNU Lesser General Public License |
| # along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| # |
| #requirespackage 'PETSC_HAVE_FORTRAN' |
| ALL: lib |
| CFLAGS = |
| FFLAGS = |
| SOURCEC = zepsf.c |
| OBJSC = zepsf.o |
| SOURCEF = |
| SOURCEH = |
| DIRS = |
| LIBBASE = libslepc |
| LOCDIR = src/eps/interface/ftn-custom/ |
| include ${SLEPC_DIR}/conf/slepc_common |
| /* |
| EPS routines related to memory management. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/epsimpl.h" /*I "slepceps.h" I*/ |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSAllocateSolution" |
| /* |
| EPSAllocateSolution - Allocate memory storage for common variables such |
| as eigenvalues and eigenvectors. In this version, all |
| vectors in V (and W) share a contiguous chunk of memory. |
| */ |
| PetscErrorCode EPSAllocateSolution(EPS eps) |
| { |
| PetscErrorCode ierr; |
| PetscInt i,nloc; |
| PetscScalar *pV,*pW; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| if (eps->allocated_ncv != eps->ncv) { |
| if (eps->allocated_ncv > 0) { |
| ierr = PetscFree(eps->eigr);CHKERRQ(ierr); |
| ierr = PetscFree(eps->eigi);CHKERRQ(ierr); |
| ierr = PetscFree(eps->errest);CHKERRQ(ierr); |
| ierr = PetscFree(eps->errest_left);CHKERRQ(ierr); |
| ierr = VecGetArray(eps->V[0],&pV);CHKERRQ(ierr); |
| for (i=0;i<eps->allocated_ncv;i++) { |
| ierr = VecDestroy(eps->V[i]);CHKERRQ(ierr); |
| } |
| ierr = PetscFree(pV);CHKERRQ(ierr); |
| ierr = PetscFree(eps->V);CHKERRQ(ierr); |
| if (eps->AV) { ierr = VecDestroyVecs(eps->AV,eps->allocated_ncv);CHKERRQ(ierr); } |
| if (eps->solverclass == EPS_TWO_SIDE) { |
| ierr = VecGetArray(eps->W[0],&pW);CHKERRQ(ierr); |
| for (i=0;i<eps->allocated_ncv;i++) { |
| ierr = VecDestroy(eps->W[i]);CHKERRQ(ierr); |
| } |
| ierr = PetscFree(pW);CHKERRQ(ierr); |
| ierr = PetscFree(eps->W);CHKERRQ(ierr); |
| } |
| } |
| ierr = PetscMalloc(eps->ncv*sizeof(PetscScalar),&eps->eigr);CHKERRQ(ierr); |
| ierr = PetscMalloc(eps->ncv*sizeof(PetscScalar),&eps->eigi);CHKERRQ(ierr); |
| ierr = PetscMalloc(eps->ncv*sizeof(PetscReal),&eps->errest);CHKERRQ(ierr); |
| ierr = PetscMalloc(eps->ncv*sizeof(PetscReal),&eps->errest_left);CHKERRQ(ierr); |
| ierr = VecGetLocalSize(eps->vec_initial,&nloc);CHKERRQ(ierr); |
| ierr = PetscMalloc(eps->ncv*sizeof(Vec),&eps->V);CHKERRQ(ierr); |
| ierr = PetscMalloc(eps->ncv*nloc*sizeof(PetscScalar),&pV);CHKERRQ(ierr); |
| for (i=0;i<eps->ncv;i++) { |
| ierr = VecCreateMPIWithArray(((PetscObject)eps)->comm,nloc,PETSC_DECIDE,pV+i*nloc,&eps->V[i]);CHKERRQ(ierr); |
| } |
| eps->AV = PETSC_NULL; |
| if (eps->solverclass == EPS_TWO_SIDE) { |
| ierr = PetscMalloc(eps->ncv*sizeof(Vec),&eps->W);CHKERRQ(ierr); |
| ierr = PetscMalloc(eps->ncv*nloc*sizeof(PetscScalar),&pW);CHKERRQ(ierr); |
| for (i=0;i<eps->ncv;i++) { |
| ierr = VecCreateMPIWithArray(((PetscObject)eps)->comm,nloc,PETSC_DECIDE,pW+i*nloc,&eps->W[i]);CHKERRQ(ierr); |
| } |
| } |
| eps->allocated_ncv = eps->ncv; |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSFreeSolution" |
| /* |
| EPSFreeSolution - Free memory storage. This routine is related to |
| EPSAllocateSolution(). |
| */ |
| PetscErrorCode EPSFreeSolution(EPS eps) |
| { |
| PetscErrorCode ierr; |
| PetscInt i; |
| PetscScalar *pV,*pW; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| if (eps->allocated_ncv > 0) { |
| ierr = PetscFree(eps->eigr);CHKERRQ(ierr); |
| ierr = PetscFree(eps->eigi);CHKERRQ(ierr); |
| ierr = PetscFree(eps->errest);CHKERRQ(ierr); |
| ierr = PetscFree(eps->errest_left);CHKERRQ(ierr); |
| ierr = VecGetArray(eps->V[0],&pV);CHKERRQ(ierr); |
| for (i=0;i<eps->allocated_ncv;i++) { |
| ierr = VecDestroy(eps->V[i]);CHKERRQ(ierr); |
| } |
| ierr = PetscFree(pV);CHKERRQ(ierr); |
| ierr = PetscFree(eps->V);CHKERRQ(ierr); |
| if (eps->AV) { ierr = VecDestroyVecs(eps->AV,eps->allocated_ncv);CHKERRQ(ierr); } |
| if (eps->solverclass == EPS_TWO_SIDE) { |
| ierr = VecGetArray(eps->W[0],&pW);CHKERRQ(ierr); |
| for (i=0;i<eps->allocated_ncv;i++) { |
| ierr = VecDestroy(eps->W[i]);CHKERRQ(ierr); |
| } |
| ierr = PetscFree(pW);CHKERRQ(ierr); |
| ierr = PetscFree(eps->W);CHKERRQ(ierr); |
| } |
| eps->allocated_ncv = 0; |
| } |
| PetscFunctionReturn(0); |
| } |
| /* |
| EPS routines related to problem setup. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/epsimpl.h" /*I "slepceps.h" I*/ |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSSetUp" |
| /*@ |
| EPSSetUp - Sets up all the internal data structures necessary for the |
| execution of the eigensolver. Then calls STSetUp() for any set-up |
| operations associated to the ST object. |
| Collective on EPS |
| Input Parameter: |
| . eps - eigenproblem solver context |
| Level: advanced |
| Notes: |
| This function need not be called explicitly in most cases, since EPSSolve() |
| calls it. It can be useful when one wants to measure the set-up time |
| separately from the solve time. |
| This function sets a random initial vector if none has been provided. |
| .seealso: EPSCreate(), EPSSolve(), EPSDestroy(), STSetUp() |
| @*/ |
| PetscErrorCode EPSSetUp(EPS eps) |
| { |
| PetscErrorCode ierr; |
| PetscInt i; |
| Vec v0,w0; |
| Mat A,B; |
| PetscInt N; |
| PetscTruth isCayley; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| if (eps->setupcalled) PetscFunctionReturn(0); |
| ierr = PetscLogEventBegin(EPS_SetUp,eps,0,0,0);CHKERRQ(ierr); |
| /* Set default solver type */ |
| if (!((PetscObject)eps)->type_name) { |
| ierr = EPSSetType(eps,EPSKRYLOVSCHUR);CHKERRQ(ierr); |
| } |
| ierr = STGetOperators(eps->OP,&A,&B);CHKERRQ(ierr); |
| /* Set default problem type */ |
| if (!eps->problem_type) { |
| if (B==PETSC_NULL) { |
| ierr = EPSSetProblemType(eps,EPS_NHEP);CHKERRQ(ierr); |
| } |
| else { |
| ierr = EPSSetProblemType(eps,EPS_GNHEP);CHKERRQ(ierr); |
| } |
| } else if ((B && !eps->isgeneralized) || (!B && eps->isgeneralized)) { |
| SETERRQ(0,"Warning: Inconsistent EPS state"); |
| } |
| if (eps->ispositive) { |
| ierr = STGetBilinearForm(eps->OP,&B);CHKERRQ(ierr); |
| ierr = IPSetBilinearForm(eps->ip,B,IPINNER_HERMITIAN);CHKERRQ(ierr); |
| ierr = MatDestroy(B);CHKERRQ(ierr); |
| } else { |
| ierr = IPSetBilinearForm(eps->ip,PETSC_NULL,IPINNER_HERMITIAN);CHKERRQ(ierr); |
| } |
| /* Create random initial vectors if not set */ |
| /* right */ |
| ierr = EPSGetInitialVector(eps,&v0);CHKERRQ(ierr); |
| if (!v0) { |
| ierr = MatGetVecs(A,&v0,PETSC_NULL);CHKERRQ(ierr); |
| ierr = SlepcVecSetRandom(v0);CHKERRQ(ierr); |
| eps->vec_initial = v0; |
| } |
| /* left */ |
| ierr = EPSGetLeftInitialVector(eps,&w0);CHKERRQ(ierr); |
| if (!w0) { |
| ierr = MatGetVecs(A,PETSC_NULL,&w0);CHKERRQ(ierr); |
| ierr = SlepcVecSetRandom(w0);CHKERRQ(ierr); |
| eps->vec_initial_left = w0; |
| } |
| ierr = VecGetSize(eps->vec_initial,&N);CHKERRQ(ierr); |
| if (eps->nev > N) eps->nev = N; |
| if (eps->ncv > N) eps->ncv = N; |
| ierr = (*eps->ops->setup)(eps);CHKERRQ(ierr); |
| ierr = STSetUp(eps->OP); CHKERRQ(ierr); |
| ierr = PetscTypeCompare((PetscObject)eps->OP,STCAYLEY,&isCayley);CHKERRQ(ierr); |
| if (isCayley && eps->problem_type == EPS_PGNHEP) { |
| SETERRQ(PETSC_ERR_SUP,"Cayley spectral transformation is not compatible with PGNHEP"); |
| } |
| /* DSV is equal to the columns of DS followed by the ones in V */ |
| ierr = PetscFree(eps->DSV);CHKERRQ(ierr); |
| ierr = PetscMalloc((eps->ncv+eps->nds)*sizeof(Vec),&eps->DSV);CHKERRQ(ierr); |
| for (i = 0; i < eps->nds; i++) eps->DSV[i] = eps->DS[i]; |
| for (i = 0; i < eps->ncv; i++) eps->DSV[i+eps->nds] = eps->V[i]; |
| if (eps->nds>0) { |
| if (!eps->ds_ortho) { |
| /* orthonormalize vectors in DS if necessary */ |
| ierr = IPQRDecomposition(eps->ip,eps->DS,0,eps->nds,PETSC_NULL,0,PETSC_NULL);CHKERRQ(ierr); |
| } |
| ierr = IPOrthogonalize(eps->ip,eps->nds,PETSC_NULL,eps->DS,eps->vec_initial,PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr); |
| } |
| ierr = STCheckNullSpace(eps->OP,eps->nds,eps->DS);CHKERRQ(ierr); |
| ierr = PetscLogEventEnd(EPS_SetUp,eps,0,0,0);CHKERRQ(ierr); |
| eps->setupcalled = 1; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSSetInitialVector" |
| /*@ |
| EPSSetInitialVector - Sets the initial vector from which the |
| eigensolver starts to iterate. |
| Collective on EPS and Vec |
| Input Parameters: |
| + eps - the eigensolver context |
| - vec - the vector |
| Level: intermediate |
| .seealso: EPSGetInitialVector(), EPSSetLeftInitialVector() |
| @*/ |
| PetscErrorCode EPSSetInitialVector(EPS eps,Vec vec) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| PetscValidHeaderSpecific(vec,VEC_COOKIE,2); |
| PetscCheckSameComm(eps,1,vec,2); |
| ierr = PetscObjectReference((PetscObject)vec);CHKERRQ(ierr); |
| if (eps->vec_initial) { |
| ierr = VecDestroy(eps->vec_initial); CHKERRQ(ierr); |
| } |
| eps->vec_initial = vec; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSGetInitialVector" |
| /*@ |
| EPSGetInitialVector - Gets the initial vector associated with the |
| eigensolver; if the vector was not set it will return a 0 pointer or |
| a vector randomly generated by EPSSetUp(). |
| Not collective, but vector is shared by all processors that share the EPS |
| Input Parameter: |
| . eps - the eigensolver context |
| Output Parameter: |
| . vec - the vector |
| Level: intermediate |
| .seealso: EPSSetInitialVector(), EPSGetLeftInitialVector() |
| @*/ |
| PetscErrorCode EPSGetInitialVector(EPS eps,Vec *vec) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| PetscValidPointer(vec,2); |
| *vec = eps->vec_initial; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSSetLeftInitialVector" |
| /*@ |
| EPSSetLeftInitialVector - Sets the initial vector from which the eigensolver |
| starts to iterate, corresponding to the left recurrence (two-sided solvers). |
| Collective on EPS and Vec |
| Input Parameters: |
| + eps - the eigensolver context |
| - vec - the vector |
| Level: intermediate |
| .seealso: EPSGetLeftInitialVector(), EPSSetInitialVector() |
| @*/ |
| PetscErrorCode EPSSetLeftInitialVector(EPS eps,Vec vec) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| PetscValidHeaderSpecific(vec,VEC_COOKIE,2); |
| PetscCheckSameComm(eps,1,vec,2); |
| ierr = PetscObjectReference((PetscObject)vec);CHKERRQ(ierr); |
| if (eps->vec_initial_left) { |
| ierr = VecDestroy(eps->vec_initial_left); CHKERRQ(ierr); |
| } |
| eps->vec_initial_left = vec; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSGetLeftInitialVector" |
| /*@ |
| EPSGetLeftInitialVector - Gets the left initial vector associated with the |
| eigensolver; if the vector was not set it will return a 0 pointer or |
| a vector randomly generated by EPSSetUp(). |
| Not collective, but vector is shared by all processors that share the EPS |
| Input Parameter: |
| . eps - the eigensolver context |
| Output Parameter: |
| . vec - the vector |
| Level: intermediate |
| .seealso: EPSSetLeftInitialVector(), EPSGetLeftInitialVector() |
| @*/ |
| PetscErrorCode EPSGetLeftInitialVector(EPS eps,Vec *vec) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| PetscValidPointer(vec,2); |
| *vec = eps->vec_initial_left; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSSetOperators" |
| /*@ |
| EPSSetOperators - Sets the matrices associated with the eigenvalue problem. |
| Collective on EPS and Mat |
| Input Parameters: |
| + eps - the eigenproblem solver context |
| . A - the matrix associated with the eigensystem |
| - B - the second matrix in the case of generalized eigenproblems |
| Notes: |
| To specify a standard eigenproblem, use PETSC_NULL for parameter B. |
| Level: beginner |
| .seealso: EPSSolve(), EPSGetST(), STGetOperators() |
| @*/ |
| PetscErrorCode EPSSetOperators(EPS eps,Mat A,Mat B) |
| { |
| PetscErrorCode ierr; |
| PetscInt m,n; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| PetscValidHeaderSpecific(A,MAT_COOKIE,2); |
| if (B) PetscValidHeaderSpecific(B,MAT_COOKIE,3); |
| PetscCheckSameComm(eps,1,A,2); |
| if (B) PetscCheckSameComm(eps,1,B,3); |
| /* Check for square matrices */ |
| ierr = MatGetSize(A,&m,&n);CHKERRQ(ierr); |
| if (m!=n) { SETERRQ(1,"A is a non-square matrix"); } |
| if (B) { |
| ierr = MatGetSize(B,&m,&n);CHKERRQ(ierr); |
| if (m!=n) { SETERRQ(1,"B is a non-square matrix"); } |
| } |
| ierr = STSetOperators(eps->OP,A,B);CHKERRQ(ierr); |
| eps->setupcalled = 0; /* so that next solve call will call setup */ |
| /* Destroy randomly generated initial vectors */ |
| if (eps->vec_initial) { |
| ierr = VecDestroy(eps->vec_initial);CHKERRQ(ierr); |
| eps->vec_initial = PETSC_NULL; |
| } |
| if (eps->vec_initial_left) { |
| ierr = VecDestroy(eps->vec_initial_left);CHKERRQ(ierr); |
| eps->vec_initial_left = PETSC_NULL; |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSGetOperators" |
| /*@ |
| EPSGetOperators - Gets the matrices associated with the eigensystem. |
| Collective on EPS and Mat |
| Input Parameter: |
| . eps - the EPS context |
| Output Parameters: |
| + A - the matrix associated with the eigensystem |
| - B - the second matrix in the case of generalized eigenproblems |
| Level: intermediate |
| .seealso: EPSSolve(), EPSGetST(), STGetOperators(), STSetOperators() |
| @*/ |
| PetscErrorCode EPSGetOperators(EPS eps, Mat *A, Mat *B) |
| { |
| PetscErrorCode ierr; |
| ST st; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| if (A) PetscValidPointer(A,2); |
| if (B) PetscValidPointer(B,3); |
| ierr = EPSGetST(eps,&st);CHKERRQ(ierr); |
| ierr = STGetOperators(st,A,B);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSAttachDeflationSpace" |
| /*@ |
| EPSAttachDeflationSpace - Add vectors to the basis of the deflation space. |
| Not Collective |
| Input Parameter: |
| + eps - the eigenproblem solver context |
| . n - number of vectors to add |
| . ds - set of basis vectors of the deflation space |
| - ortho - PETSC_TRUE if basis vectors of deflation space are orthonormal |
| Notes: |
| When a deflation space is given, the eigensolver seeks the eigensolution |
| in the restriction of the problem to the orthogonal complement of this |
| space. This can be used for instance in the case that an invariant |
| subspace is known beforehand (such as the nullspace of the matrix). |
| The basis vectors can be provided all at once or incrementally with |
| several calls to EPSAttachDeflationSpace(). |
| Use a value of PETSC_TRUE for parameter ortho if all the vectors passed |
| in are known to be mutually orthonormal. |
| Level: intermediate |
| .seealso: EPSRemoveDeflationSpace() |
| @*/ |
| PetscErrorCode EPSAttachDeflationSpace(EPS eps,PetscInt n,Vec *ds,PetscTruth ortho) |
| { |
| PetscErrorCode ierr; |
| PetscInt i; |
| Vec *tvec; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| tvec = eps->DS; |
| if (n+eps->nds > 0) { |
| ierr = PetscMalloc((n+eps->nds)*sizeof(Vec), &eps->DS);CHKERRQ(ierr); |
| } |
| if (eps->nds > 0) { |
| for (i=0; i<eps->nds; i++) eps->DS[i] = tvec[i]; |
| ierr = PetscFree(tvec);CHKERRQ(ierr); |
| } |
| for (i=0; i<n; i++) { |
| ierr = VecDuplicate(ds[i],&eps->DS[i + eps->nds]);CHKERRQ(ierr); |
| ierr = VecCopy(ds[i],eps->DS[i + eps->nds]);CHKERRQ(ierr); |
| } |
| eps->nds += n; |
| if (!ortho) eps->ds_ortho = PETSC_FALSE; |
| eps->setupcalled = 0; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSRemoveDeflationSpace" |
| /*@ |
| EPSRemoveDeflationSpace - Removes the deflation space. |
| Not Collective |
| Input Parameter: |
| . eps - the eigenproblem solver context |
| Level: intermediate |
| .seealso: EPSAttachDeflationSpace() |
| @*/ |
| PetscErrorCode EPSRemoveDeflationSpace(EPS eps) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| if (eps->nds > 0) { |
| ierr = VecDestroyVecs(eps->DS, eps->nds);CHKERRQ(ierr); |
| } |
| eps->ds_ortho = PETSC_TRUE; |
| eps->setupcalled = 0; |
| PetscFunctionReturn(0); |
| } |
| /* |
| The basic EPS routines, Create, View, etc. are here. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/epsimpl.h" /*I "slepceps.h" I*/ |
| PetscFList EPSList = 0; |
| PetscCookie EPS_COOKIE = 0; |
| PetscLogEvent EPS_SetUp = 0, EPS_Solve = 0, EPS_Dense = 0; |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSInitializePackage" |
| /*@C |
| EPSInitializePackage - This function initializes everything in the EPS package. It is called |
| from PetscDLLibraryRegister() when using dynamic libraries, and on the first call to EPSCreate() |
| when using static libraries. |
| Input Parameter: |
| path - The dynamic library path, or PETSC_NULL |
| Level: developer |
| .seealso: SlepcInitialize() |
| @*/ |
| PetscErrorCode EPSInitializePackage(char *path) { |
| static PetscTruth initialized = PETSC_FALSE; |
| char logList[256]; |
| char *className; |
| PetscTruth opt; |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| if (initialized) PetscFunctionReturn(0); |
| initialized = PETSC_TRUE; |
| /* Register Classes */ |
| ierr = PetscCookieRegister("Eigenproblem Solver",&EPS_COOKIE);CHKERRQ(ierr); |
| /* Register Constructors */ |
| ierr = EPSRegisterAll(path);CHKERRQ(ierr); |
| /* Register Events */ |
| ierr = PetscLogEventRegister("EPSSetUp",EPS_COOKIE,&EPS_SetUp);CHKERRQ(ierr); |
| ierr = PetscLogEventRegister("EPSSolve",EPS_COOKIE,&EPS_Solve);CHKERRQ(ierr); |
| ierr = PetscLogEventRegister("EPSDense",EPS_COOKIE,&EPS_Dense); CHKERRQ(ierr); |
| /* Process info exclusions */ |
| ierr = PetscOptionsGetString(PETSC_NULL, "-log_info_exclude", logList, 256, &opt);CHKERRQ(ierr); |
| if (opt) { |
| ierr = PetscStrstr(logList, "eps", &className);CHKERRQ(ierr); |
| if (className) { |
| ierr = PetscInfoDeactivateClass(EPS_COOKIE);CHKERRQ(ierr); |
| } |
| } |
| /* Process summary exclusions */ |
| ierr = PetscOptionsGetString(PETSC_NULL, "-log_summary_exclude", logList, 256, &opt);CHKERRQ(ierr); |
| if (opt) { |
| ierr = PetscStrstr(logList, "eps", &className);CHKERRQ(ierr); |
| if (className) { |
| ierr = PetscLogEventDeactivateClass(EPS_COOKIE);CHKERRQ(ierr); |
| } |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSView" |
| /*@C |
| EPSView - Prints the EPS data structure. |
| Collective on EPS |
| Input Parameters: |
| + eps - the eigenproblem solver context |
| - viewer - optional visualization context |
| Options Database Key: |
| . -eps_view - Calls EPSView() at end of EPSSolve() |
| Note: |
| The available visualization contexts include |
| + PETSC_VIEWER_STDOUT_SELF - standard output (default) |
| - PETSC_VIEWER_STDOUT_WORLD - synchronized standard |
| output where only the first processor opens |
| the file. All other processors send their |
| data to the first processor to print. |
| The user can open an alternative visualization context with |
| PetscViewerASCIIOpen() - output to a specified file. |
| Level: beginner |
| .seealso: STView(), PetscViewerASCIIOpen() |
| @*/ |
| PetscErrorCode EPSView(EPS eps,PetscViewer viewer) |
| { |
| PetscErrorCode ierr; |
| const EPSType type; |
| const char *extr, *which; |
| PetscTruth isascii; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| if (!viewer) viewer = PETSC_VIEWER_STDOUT_(((PetscObject)eps)->comm); |
| PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE,2); |
| PetscCheckSameComm(eps,1,viewer,2); |
| #if defined(PETSC_USE_COMPLEX) |
| #define HERM "hermitian" |
| #else |
| #define HERM "symmetric" |
| #endif |
| ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);CHKERRQ(ierr); |
| if (isascii) { |
| ierr = PetscViewerASCIIPrintf(viewer,"EPS Object:\n");CHKERRQ(ierr); |
| switch (eps->problem_type) { |
| case EPS_HEP: type = HERM " eigenvalue problem"; break; |
| case EPS_GHEP: type = "generalized " HERM " eigenvalue problem"; break; |
| case EPS_NHEP: type = "non-" HERM " eigenvalue problem"; break; |
| case EPS_GNHEP: type = "generalized non-" HERM " eigenvalue problem"; break; |
| case EPS_PGNHEP: type = "generalized non-" HERM " eigenvalue problem with " HERM " positive definite B"; break; |
| case 0: type = "not yet set"; break; |
| default: SETERRQ(1,"Wrong value of eps->problem_type"); |
| } |
| ierr = PetscViewerASCIIPrintf(viewer," problem type: %s\n",type);CHKERRQ(ierr); |
| ierr = EPSGetType(eps,&type);CHKERRQ(ierr); |
| if (type) { |
| ierr = PetscViewerASCIIPrintf(viewer," method: %s",type);CHKERRQ(ierr); |
| switch (eps->solverclass) { |
| case EPS_ONE_SIDE: |
| ierr = PetscViewerASCIIPrintf(viewer,"\n",type);CHKERRQ(ierr); break; |
| case EPS_TWO_SIDE: |
| ierr = PetscViewerASCIIPrintf(viewer," (two-sided)\n",type);CHKERRQ(ierr); break; |
| default: SETERRQ(1,"Wrong value of eps->solverclass"); |
| } |
| } else { |
| ierr = PetscViewerASCIIPrintf(viewer," method: not yet set\n");CHKERRQ(ierr); |
| } |
| if (eps->ops->view) { |
| ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr); |
| ierr = (*eps->ops->view)(eps,viewer);CHKERRQ(ierr); |
| ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr); |
| } |
| if (eps->extraction) { |
| switch (eps->extraction) { |
| case EPS_RITZ: extr = "Rayleigh-Ritz"; break; |
| case EPS_HARMONIC: extr = "harmonic Ritz"; break; |
| case EPS_REFINED: extr = "refined Ritz"; break; |
| case EPS_REFINED_HARMONIC: extr = "refined harmonic Ritz"; break; |
| default: SETERRQ(1,"Wrong value of eps->extraction"); |
| } |
| ierr = PetscViewerASCIIPrintf(viewer," extraction type: %s\n",extr);CHKERRQ(ierr); |
| } |
| ierr = PetscViewerASCIIPrintf(viewer," selected portion of the spectrum: ");CHKERRQ(ierr); |
| if (eps->target_set) { |
| #if !defined(PETSC_USE_COMPLEX) |
| ierr = PetscViewerASCIIPrintf(viewer,"closest to target: %g\n",eps->target);CHKERRQ(ierr); |
| #else |
| ierr = PetscViewerASCIIPrintf(viewer,"closest to target: %g+%g i\n",PetscRealPart(eps->target),PetscImaginaryPart(eps->target));CHKERRQ(ierr); |
| #endif |
| } else { |
| switch (eps->which) { |
| case EPS_LARGEST_MAGNITUDE: which = "largest eigenvalues in magnitude"; break; |
| case EPS_SMALLEST_MAGNITUDE: which = "smallest eigenvalues in magnitude"; break; |
| case EPS_LARGEST_REAL: which = "largest real parts"; break; |
| case EPS_SMALLEST_REAL: which = "smallest real parts"; break; |
| case EPS_LARGEST_IMAGINARY: which = "largest imaginary parts"; break; |
| case EPS_SMALLEST_IMAGINARY: which = "smallest imaginary parts"; break; |
| default: SETERRQ(1,"Wrong value of eps->which"); |
| } |
| ierr = PetscViewerASCIIPrintf(viewer,"%s\n",which);CHKERRQ(ierr); |
| } |
| ierr = PetscViewerASCIIPrintf(viewer," number of eigenvalues (nev): %d\n",eps->nev);CHKERRQ(ierr); |
| ierr = PetscViewerASCIIPrintf(viewer," number of column vectors (ncv): %d\n",eps->ncv);CHKERRQ(ierr); |
| ierr = PetscViewerASCIIPrintf(viewer," maximum dimension of projected problem (mpd): %d\n",eps->mpd);CHKERRQ(ierr); |
| ierr = PetscViewerASCIIPrintf(viewer," maximum number of iterations: %d\n", eps->max_it); |
| ierr = PetscViewerASCIIPrintf(viewer," tolerance: %g\n",eps->tol);CHKERRQ(ierr); |
| ierr = PetscViewerASCIIPrintf(viewer," dimension of user-provided deflation space: %d\n",eps->nds);CHKERRQ(ierr); |
| ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr); |
| ierr = IPView(eps->ip,viewer); CHKERRQ(ierr); |
| ierr = STView(eps->OP,viewer); CHKERRQ(ierr); |
| ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr); |
| } else { |
| if (eps->ops->view) { |
| ierr = (*eps->ops->view)(eps,viewer);CHKERRQ(ierr); |
| } |
| ierr = STView(eps->OP,viewer); CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSCreate" |
| /*@C |
| EPSCreate - Creates the default EPS context. |
| Collective on MPI_Comm |
| Input Parameter: |
| . comm - MPI communicator |
| Output Parameter: |
| . eps - location to put the EPS context |
| Note: |
| The default EPS type is EPSKRYLOVSCHUR |
| Level: beginner |
| .seealso: EPSSetUp(), EPSSolve(), EPSDestroy(), EPS |
| @*/ |
| PetscErrorCode EPSCreate(MPI_Comm comm,EPS *outeps) |
| { |
| PetscErrorCode ierr; |
| EPS eps; |
| PetscFunctionBegin; |
| PetscValidPointer(outeps,2); |
| *outeps = 0; |
| ierr = PetscHeaderCreate(eps,_p_EPS,struct _EPSOps,EPS_COOKIE,-1,"EPS",comm,EPSDestroy,EPSView);CHKERRQ(ierr); |
| *outeps = eps; |
| ierr = PetscMemzero(eps->ops,sizeof(struct _EPSOps));CHKERRQ(ierr); |
| eps->max_it = 0; |
| eps->nev = 1; |
| eps->ncv = 0; |
| eps->mpd = 0; |
| eps->allocated_ncv = 0; |
| eps->nds = 0; |
| eps->tol = 1e-7; |
| eps->which = EPS_LARGEST_MAGNITUDE; |
| eps->target = 0.0; |
| eps->target_set = PETSC_FALSE; |
| eps->evecsavailable = PETSC_FALSE; |
| eps->problem_type = (EPSProblemType)0; |
| eps->extraction = (EPSExtraction)0; |
| eps->solverclass = (EPSClass)0; |
| eps->vec_initial = 0; |
| eps->vec_initial_left= 0; |
| eps->V = 0; |
| eps->AV = 0; |
| eps->W = 0; |
| eps->T = 0; |
| eps->DS = 0; |
| eps->ds_ortho = PETSC_TRUE; |
| eps->eigr = 0; |
| eps->eigi = 0; |
| eps->errest = 0; |
| eps->errest_left = 0; |
| eps->OP = 0; |
| eps->ip = 0; |
| eps->data = 0; |
| eps->nconv = 0; |
| eps->its = 0; |
| eps->perm = PETSC_NULL; |
| eps->nwork = 0; |
| eps->work = 0; |
| eps->isgeneralized = PETSC_FALSE; |
| eps->ishermitian = PETSC_FALSE; |
| eps->ispositive = PETSC_FALSE; |
| eps->setupcalled = 0; |
| eps->reason = EPS_CONVERGED_ITERATING; |
| eps->numbermonitors = 0; |
| ierr = STCreate(comm,&eps->OP); CHKERRQ(ierr); |
| PetscLogObjectParent(eps,eps->OP); |
| ierr = IPCreate(comm,&eps->ip); CHKERRQ(ierr); |
| ierr = IPSetOptionsPrefix(eps->ip,((PetscObject)eps)->prefix); |
| ierr = IPAppendOptionsPrefix(eps->ip,"eps_"); |
| PetscLogObjectParent(eps,eps->ip); |
| ierr = PetscPublishAll(eps);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSSetType" |
| /*@C |
| EPSSetType - Selects the particular solver to be used in the EPS object. |
| Collective on EPS |
| Input Parameters: |
| + eps - the eigensolver context |
| - type - a known method |
| Options Database Key: |
| . -eps_type <method> - Sets the method; use -help for a list |
| of available methods |
| Notes: |
| See "slepc/include/slepceps.h" for available methods. The default |
| is EPSKRYLOVSCHUR. |
| Normally, it is best to use the EPSSetFromOptions() command and |
| then set the EPS type from the options database rather than by using |
| this routine. Using the options database provides the user with |
| maximum flexibility in evaluating the different available methods. |
| The EPSSetType() routine is provided for those situations where it |
| is necessary to set the iterative solver independently of the command |
| line or options database. |
| Level: intermediate |
| .seealso: STSetType(), EPSType |
| @*/ |
| PetscErrorCode EPSSetType(EPS eps,const EPSType type) |
| { |
| PetscErrorCode ierr,(*r)(EPS); |
| PetscTruth match; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| PetscValidCharPointer(type,2); |
| ierr = PetscTypeCompare((PetscObject)eps,type,&match);CHKERRQ(ierr); |
| if (match) PetscFunctionReturn(0); |
| if (eps->data) { |
| /* destroy the old private EPS context */ |
| ierr = (*eps->ops->destroy)(eps); CHKERRQ(ierr); |
| eps->data = 0; |
| } |
| ierr = PetscFListFind(EPSList,((PetscObject)eps)->comm,type,(void (**)(void)) &r);CHKERRQ(ierr); |
| if (!r) SETERRQ1(1,"Unknown EPS type given: %s",type); |
| eps->setupcalled = 0; |
| ierr = PetscMemzero(eps->ops,sizeof(struct _EPSOps));CHKERRQ(ierr); |
| ierr = (*r)(eps); CHKERRQ(ierr); |
| ierr = PetscObjectChangeTypeName((PetscObject)eps,type);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSGetType" |
| /*@C |
| EPSGetType - Gets the EPS type as a string from the EPS object. |
| Not Collective |
| Input Parameter: |
| . eps - the eigensolver context |
| Output Parameter: |
| . name - name of EPS method |
| Level: intermediate |
| .seealso: EPSSetType() |
| @*/ |
| PetscErrorCode EPSGetType(EPS eps,const EPSType *type) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| PetscValidPointer(type,2); |
| *type = ((PetscObject)eps)->type_name; |
| PetscFunctionReturn(0); |
| } |
| /*MC |
| EPSRegisterDynamic - Adds a method to the eigenproblem solver package. |
| Synopsis: |
| EPSRegisterDynamic(char *name_solver,char *path,char *name_create,PetscErrorCode (*routine_create)(EPS)) |
| Not Collective |
| Input Parameters: |
| + name_solver - name of a new user-defined solver |
| . path - path (either absolute or relative) the library containing this solver |
| . name_create - name of routine to create the solver context |
| - routine_create - routine to create the solver context |
| Notes: |
| EPSRegisterDynamic() may be called multiple times to add several user-defined solvers. |
| If dynamic libraries are used, then the fourth input argument (routine_create) |
| is ignored. |
| Sample usage: |
| .vb |
| EPSRegisterDynamic("my_solver",/home/username/my_lib/lib/libO/solaris/mylib.a, |
| "MySolverCreate",MySolverCreate); |
| .ve |
| Then, your solver can be chosen with the procedural interface via |
| $ EPSSetType(eps,"my_solver") |
| or at runtime via the option |
| $ -eps_type my_solver |
| Level: advanced |
| Environmental variables such as ${PETSC_ARCH}, ${PETSC_DIR}, ${PETSC_LIB_DIR}, |
| and others of the form ${any_environmental_variable} occuring in pathname will be |
| replaced with appropriate values. |
| .seealso: EPSRegisterDestroy(), EPSRegisterAll() |
| M*/ |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSRegister" |
| /*@C |
| EPSRegister - See EPSRegisterDynamic() |
| Level: advanced |
| @*/ |
| PetscErrorCode EPSRegister(const char *sname,const char *path,const char *name,PetscErrorCode (*function)(EPS)) |
| { |
| PetscErrorCode ierr; |
| char fullname[256]; |
| PetscFunctionBegin; |
| ierr = PetscFListConcat(path,name,fullname);CHKERRQ(ierr); |
| ierr = PetscFListAdd(&EPSList,sname,fullname,(void (*)(void))function);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSRegisterDestroy" |
| /*@ |
| EPSRegisterDestroy - Frees the list of EPS methods that were |
| registered by EPSRegisterDynamic(). |
| Not Collective |
| Level: advanced |
| .seealso: EPSRegisterDynamic(), EPSRegisterAll() |
| @*/ |
| PetscErrorCode EPSRegisterDestroy(void) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| ierr = PetscFListDestroy(&EPSList);CHKERRQ(ierr); |
| ierr = EPSRegisterAll(PETSC_NULL);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSDestroy" |
| /*@ |
| EPSDestroy - Destroys the EPS context. |
| Collective on EPS |
| Input Parameter: |
| . eps - eigensolver context obtained from EPSCreate() |
| Level: beginner |
| .seealso: EPSCreate(), EPSSetUp(), EPSSolve() |
| @*/ |
| PetscErrorCode EPSDestroy(EPS eps) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| if (--((PetscObject)eps)->refct > 0) PetscFunctionReturn(0); |
| /* if memory was published with AMS then destroy it */ |
| ierr = PetscObjectDepublish(eps);CHKERRQ(ierr); |
| ierr = STDestroy(eps->OP);CHKERRQ(ierr); |
| ierr = IPDestroy(eps->ip);CHKERRQ(ierr); |
| if (eps->ops->destroy) { |
| ierr = (*eps->ops->destroy)(eps); CHKERRQ(ierr); |
| } |
| ierr = PetscFree(eps->T);CHKERRQ(ierr); |
| ierr = PetscFree(eps->Tl);CHKERRQ(ierr); |
| ierr = PetscFree(eps->perm);CHKERRQ(ierr); |
| if (eps->vec_initial) { |
| ierr = VecDestroy(eps->vec_initial);CHKERRQ(ierr); |
| } |
| if (eps->vec_initial_left) { |
| ierr = VecDestroy(eps->vec_initial_left);CHKERRQ(ierr); |
| } |
| if (eps->nds > 0) { |
| ierr = VecDestroyVecs(eps->DS, eps->nds);CHKERRQ(ierr); |
| } |
| ierr = PetscFree(eps->DSV);CHKERRQ(ierr); |
| ierr = EPSMonitorCancel(eps);CHKERRQ(ierr); |
| ierr = PetscHeaderDestroy(eps);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSSetTarget" |
| /*@ |
| EPSSetTarget - Sets the value of the target. |
| Not collective |
| Input Parameters: |
| + eps - eigensolver context |
| - target - the value of the target |
| Notes: |
| The target is a scalar value used to determine the portion of the spectrum |
| of interest. |
| If the target is not specified, then eigenvalues are computed according to |
| the which parameter (see EPSSetWhichEigenpairs()). |
| If the target is specified, then the sought-after eigenvalues are those |
| closest to the target. |
| Level: beginner |
| .seealso: EPSGetTarget(), EPSSetWhichEigenpairs() |
| @*/ |
| PetscErrorCode EPSSetTarget(EPS eps,PetscScalar target) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| eps->target = target; |
| eps->target_set = PETSC_TRUE; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSGetTarget" |
| /*@ |
| EPSGetTarget - Gets the value of the target. |
| Not collective |
| Input Parameter: |
| . eps - eigensolver context |
| Output Parameter: |
| . target - the value of the target |
| Level: beginner |
| Note: |
| If the target was not set by the user, then zero is returned. |
| .seealso: EPSSetTarget() |
| @*/ |
| PetscErrorCode EPSGetTarget(EPS eps,PetscScalar* target) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| if (target) { |
| if (eps->target_set) *target = eps->target; |
| else *target = 0.0; |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSSetST" |
| /*@ |
| EPSSetST - Associates a spectral transformation object to the |
| eigensolver. |
| Collective on EPS |
| Input Parameters: |
| + eps - eigensolver context obtained from EPSCreate() |
| - st - the spectral transformation object |
| Note: |
| Use EPSGetST() to retrieve the spectral transformation context (for example, |
| to free it at the end of the computations). |
| Level: advanced |
| .seealso: EPSGetST() |
| @*/ |
| PetscErrorCode EPSSetST(EPS eps,ST st) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| PetscValidHeaderSpecific(st,ST_COOKIE,2); |
| PetscCheckSameComm(eps,1,st,2); |
| ierr = PetscObjectReference((PetscObject)st);CHKERRQ(ierr); |
| ierr = STDestroy(eps->OP); CHKERRQ(ierr); |
| eps->OP = st; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSGetST" |
| /*@C |
| EPSGetST - Obtain the spectral transformation (ST) object associated |
| to the eigensolver object. |
| Not Collective |
| Input Parameters: |
| . eps - eigensolver context obtained from EPSCreate() |
| Output Parameter: |
| . st - spectral transformation context |
| Level: beginner |
| .seealso: EPSSetST() |
| @*/ |
| PetscErrorCode EPSGetST(EPS eps, ST *st) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| PetscValidPointer(st,2); |
| *st = eps->OP; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSSetIP" |
| /*@ |
| EPSSetIP - Associates an inner product object to the |
| eigensolver. |
| Collective on EPS |
| Input Parameters: |
| + eps - eigensolver context obtained from EPSCreate() |
| - ip - the inner product object |
| Note: |
| Use EPSGetIP() to retrieve the inner product context (for example, |
| to free it at the end of the computations). |
| Level: advanced |
| .seealso: EPSGetIP() |
| @*/ |
| PetscErrorCode EPSSetIP(EPS eps,IP ip) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| PetscValidHeaderSpecific(ip,IP_COOKIE,2); |
| PetscCheckSameComm(eps,1,ip,2); |
| ierr = PetscObjectReference((PetscObject)ip);CHKERRQ(ierr); |
| ierr = IPDestroy(eps->ip); CHKERRQ(ierr); |
| eps->ip = ip; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSGetIP" |
| /*@C |
| EPSGetIP - Obtain the inner product object associated |
| to the eigensolver object. |
| Not Collective |
| Input Parameters: |
| . eps - eigensolver context obtained from EPSCreate() |
| Output Parameter: |
| . ip - inner product context |
| Level: advanced |
| .seealso: EPSSetIP() |
| @*/ |
| PetscErrorCode EPSGetIP(EPS eps,IP *ip) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| PetscValidPointer(ip,2); |
| *ip = eps->ip; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSIsGeneralized" |
| /*@ |
| EPSIsGeneralized - Ask if the EPS object corresponds to a generalized |
| eigenvalue problem. |
| Not collective |
| Input Parameter: |
| . eps - the eigenproblem solver context |
| Output Parameter: |
| . is - the answer |
| Level: intermediate |
| @*/ |
| PetscErrorCode EPSIsGeneralized(EPS eps,PetscTruth* is) |
| { |
| PetscErrorCode ierr; |
| Mat B; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| ierr = STGetOperators(eps->OP,PETSC_NULL,&B);CHKERRQ(ierr); |
| if( B ) *is = PETSC_TRUE; |
| else *is = PETSC_FALSE; |
| if( eps->setupcalled ) { |
| if( eps->isgeneralized != *is ) { |
| SETERRQ(0,"Warning: Inconsistent EPS state"); |
| } |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSIsHermitian" |
| /*@ |
| EPSIsHermitian - Ask if the EPS object corresponds to a Hermitian |
| eigenvalue problem. |
| Not collective |
| Input Parameter: |
| . eps - the eigenproblem solver context |
| Output Parameter: |
| . is - the answer |
| Level: intermediate |
| @*/ |
| PetscErrorCode EPSIsHermitian(EPS eps,PetscTruth* is) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| if( eps->ishermitian ) *is = PETSC_TRUE; |
| else *is = PETSC_FALSE; |
| PetscFunctionReturn(0); |
| } |
| /* |
| This file contains some simple default routines for common operations. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/epsimpl.h" /*I "slepceps.h" I*/ |
| #include "slepcblaslapack.h" |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSDestroy_Default" |
| PetscErrorCode EPSDestroy_Default(EPS eps) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| ierr = PetscFree(eps->data);CHKERRQ(ierr); |
| /* free work vectors */ |
| ierr = EPSDefaultFreeWork(eps);CHKERRQ(ierr); |
| ierr = EPSFreeSolution(eps);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSBackTransform_Default" |
| PetscErrorCode EPSBackTransform_Default(EPS eps) |
| { |
| PetscErrorCode ierr; |
| PetscInt i; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| for (i=0;i<eps->nconv;i++) { |
| ierr = STBackTransform(eps->OP,&eps->eigr[i],&eps->eigi[i]);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSComputeVectors_Default" |
| /* |
| EPSComputeVectors_Default - Compute eigenvectors from the vectors |
| provided by the eigensolver. This version just copies the vectors |
| and is intended for solvers such as power that provide the eigenvector. |
| */ |
| PetscErrorCode EPSComputeVectors_Default(EPS eps) |
| { |
| PetscFunctionBegin; |
| eps->evecsavailable = PETSC_TRUE; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSComputeVectors_Hermitian" |
| /* |
| EPSComputeVectors_Hermitian - Copies the Lanczos vectors as eigenvectors |
| using purification for generalized eigenproblems. |
| */ |
| PetscErrorCode EPSComputeVectors_Hermitian(EPS eps) |
| { |
| PetscErrorCode ierr; |
| PetscInt i; |
| PetscReal norm; |
| Vec w; |
| PetscFunctionBegin; |
| if (eps->isgeneralized) { |
| /* Purify eigenvectors */ |
| ierr = VecDuplicate(eps->V[0],&w);CHKERRQ(ierr); |
| for (i=0;i<eps->nconv;i++) { |
| ierr = VecCopy(eps->V[i],w);CHKERRQ(ierr); |
| ierr = STApply(eps->OP,w,eps->V[i]);CHKERRQ(ierr); |
| ierr = IPNorm(eps->ip,eps->V[i],&norm);CHKERRQ(ierr); |
| ierr = VecScale(eps->V[i],1.0/norm);CHKERRQ(ierr); |
| } |
| ierr = VecDestroy(w);CHKERRQ(ierr); |
| } |
| eps->evecsavailable = PETSC_TRUE; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSComputeVectors_Schur" |
| /* |
| EPSComputeVectors_Schur - Compute eigenvectors from the vectors |
| provided by the eigensolver. This version is intended for solvers |
| that provide Schur vectors. Given the partial Schur decomposition |
| OP*V=V*T, the following steps are performed: |
| 1) compute eigenvectors of T: T*Z=Z*D |
| 2) compute eigenvectors of OP: X=V*Z |
| If left eigenvectors are required then also do Z'*Tl=D*Z', Y=W*Z |
| */ |
| PetscErrorCode EPSComputeVectors_Schur(EPS eps) |
| { |
| #if defined(SLEPC_MISSING_LAPACK_TREVC) |
| SETERRQ(PETSC_ERR_SUP,"TREVC - Lapack routine is unavailable."); |
| #else |
| PetscErrorCode ierr; |
| PetscInt i; |
| PetscBLASInt ncv,nconv,mout,info; |
| PetscScalar *Z,*work; |
| #if defined(PETSC_USE_COMPLEX) |
| PetscReal *rwork; |
| #endif |
| PetscReal norm; |
| Vec w; |
| PetscFunctionBegin; |
| ncv = PetscBLASIntCast(eps->ncv); |
| nconv = PetscBLASIntCast(eps->nconv); |
| if (eps->ishermitian) { |
| ierr = EPSComputeVectors_Hermitian(eps);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| if (eps->ispositive) { |
| ierr = VecDuplicate(eps->V[0],&w);CHKERRQ(ierr); |
| } |
| ierr = PetscMalloc(nconv*nconv*sizeof(PetscScalar),&Z);CHKERRQ(ierr); |
| ierr = PetscMalloc(3*nconv*sizeof(PetscScalar),&work);CHKERRQ(ierr); |
| #if defined(PETSC_USE_COMPLEX) |
| ierr = PetscMalloc(nconv*sizeof(PetscReal),&rwork);CHKERRQ(ierr); |
| #endif |
| /* right eigenvectors */ |
| #if !defined(PETSC_USE_COMPLEX) |
| LAPACKtrevc_("R","A",PETSC_NULL,&nconv,eps->T,&ncv,PETSC_NULL,&nconv,Z,&nconv,&nconv,&mout,work,&info); |
| #else |
| LAPACKtrevc_("R","A",PETSC_NULL,&nconv,eps->T,&ncv,PETSC_NULL,&nconv,Z,&nconv,&nconv,&mout,work,rwork,&info); |
| #endif |
| if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack xTREVC %i",info); |
| /* AV = V * Z */ |
| ierr = SlepcUpdateVectors(eps->nconv,eps->V,0,eps->nconv,Z,eps->nconv,PETSC_FALSE);CHKERRQ(ierr); |
| if (eps->ispositive) { |
| /* Purify eigenvectors */ |
| for (i=0;i<eps->nconv;i++) { |
| ierr = VecCopy(eps->V[i],w);CHKERRQ(ierr); |
| ierr = STApply(eps->OP,w,eps->V[i]);CHKERRQ(ierr); |
| ierr = VecNormalize(eps->V[i],&norm);CHKERRQ(ierr); |
| } |
| } |
| /* left eigenvectors */ |
| if (eps->solverclass == EPS_TWO_SIDE) { |
| #if !defined(PETSC_USE_COMPLEX) |
| LAPACKtrevc_("R","A",PETSC_NULL,&nconv,eps->Tl,&ncv,PETSC_NULL,&nconv,Z,&nconv,&nconv,&mout,work,&info); |
| #else |
| LAPACKtrevc_("R","A",PETSC_NULL,&nconv,eps->Tl,&ncv,PETSC_NULL,&nconv,Z,&nconv,&nconv,&mout,work,rwork,&info); |
| #endif |
| if (info) SETERRQ1(PETSC_ERR_LIB,"Error in Lapack xTREVC %i",info); |
| /* AW = W * Z */ |
| ierr = SlepcUpdateVectors(eps->nconv,eps->W,0,eps->nconv,Z,eps->nconv,PETSC_FALSE);CHKERRQ(ierr); |
| } |
| ierr = PetscFree(Z);CHKERRQ(ierr); |
| ierr = PetscFree(work);CHKERRQ(ierr); |
| #if defined(PETSC_USE_COMPLEX) |
| ierr = PetscFree(rwork);CHKERRQ(ierr); |
| #endif |
| if (eps->ispositive) { |
| ierr = VecDestroy(w);CHKERRQ(ierr); |
| } |
| eps->evecsavailable = PETSC_TRUE; |
| PetscFunctionReturn(0); |
| #endif |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSDefaultGetWork" |
| /* |
| EPSDefaultGetWork - Gets a number of work vectors. |
| Input Parameters: |
| + eps - eigensolver context |
| - nw - number of work vectors to allocate |
| Notes: |
| Call this only if no work vectors have been allocated. |
| */ |
| PetscErrorCode EPSDefaultGetWork(EPS eps, PetscInt nw) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| if (eps->nwork != nw) { |
| if (eps->nwork > 0) { |
| ierr = VecDestroyVecs(eps->work,eps->nwork); CHKERRQ(ierr); |
| } |
| eps->nwork = nw; |
| ierr = VecDuplicateVecs(eps->vec_initial,nw,&eps->work); CHKERRQ(ierr); |
| ierr = PetscLogObjectParents(eps,nw,eps->work); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSDefaultFreeWork" |
| /* |
| EPSDefaultFreeWork - Free work vectors. |
| Input Parameters: |
| . eps - eigensolver context |
| */ |
| PetscErrorCode EPSDefaultFreeWork(EPS eps) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| if (eps->work) { |
| ierr = VecDestroyVecs(eps->work,eps->nwork); CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| /* |
| EPS routines related to options that can be set via the command-line |
| or procedurally. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/epsimpl.h" /*I "slepceps.h" I*/ |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSSetFromOptions" |
| /*@ |
| EPSSetFromOptions - Sets EPS options from the options database. |
| This routine must be called before EPSSetUp() if the user is to be |
| allowed to set the solver type. |
| Collective on EPS |
| Input Parameters: |
| . eps - the eigensolver context |
| Notes: |
| To see all options, run your program with the -help option. |
| Level: beginner |
| .seealso: |
| @*/ |
| PetscErrorCode EPSSetFromOptions(EPS eps) |
| { |
| PetscErrorCode ierr; |
| char type[256],monfilename[PETSC_MAX_PATH_LEN]; |
| PetscTruth flg; |
| PetscReal r; |
| PetscScalar s; |
| PetscInt i,j,k; |
| PetscViewerASCIIMonitor monviewer; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| ierr = PetscOptionsBegin(((PetscObject)eps)->comm,((PetscObject)eps)->prefix,"Eigenproblem Solver (EPS) Options","EPS");CHKERRQ(ierr); |
| ierr = PetscOptionsList("-eps_type","Eigenproblem Solver method","EPSSetType",EPSList,(char*)(((PetscObject)eps)->type_name?((PetscObject)eps)->type_name:EPSKRYLOVSCHUR),type,256,&flg);CHKERRQ(ierr); |
| if (flg) { |
| ierr = EPSSetType(eps,type);CHKERRQ(ierr); |
| } |
| ierr = PetscOptionsTruthGroupBegin("-eps_hermitian","hermitian eigenvalue problem","EPSSetProblemType",&flg);CHKERRQ(ierr); |
| if (flg) {ierr = EPSSetProblemType(eps,EPS_HEP);CHKERRQ(ierr);} |
| ierr = PetscOptionsTruthGroup("-eps_gen_hermitian","generalized hermitian eigenvalue problem","EPSSetProblemType",&flg);CHKERRQ(ierr); |
| if (flg) {ierr = EPSSetProblemType(eps,EPS_GHEP);CHKERRQ(ierr);} |
| ierr = PetscOptionsTruthGroup("-eps_non_hermitian","non-hermitian eigenvalue problem","EPSSetProblemType",&flg);CHKERRQ(ierr); |
| if (flg) {ierr = EPSSetProblemType(eps,EPS_NHEP);CHKERRQ(ierr);} |
| ierr = PetscOptionsTruthGroup("-eps_gen_non_hermitian","generalized non-hermitian eigenvalue problem","EPSSetProblemType",&flg);CHKERRQ(ierr); |
| if (flg) {ierr = EPSSetProblemType(eps,EPS_GNHEP);CHKERRQ(ierr);} |
| ierr = PetscOptionsTruthGroupEnd("-eps_pos_gen_non_hermitian","generalized non-hermitian eigenvalue problem with positive semi-definite B","EPSSetProblemType",&flg);CHKERRQ(ierr); |
| if (flg) {ierr = EPSSetProblemType(eps,EPS_PGNHEP);CHKERRQ(ierr);} |
| /* |
| Set the type if it was never set. |
| */ |
| if (!((PetscObject)eps)->type_name) { |
| ierr = EPSSetType(eps,EPSKRYLOVSCHUR);CHKERRQ(ierr); |
| } |
| ierr = PetscOptionsTruthGroupBegin("-eps_ritz","Rayleigh-Ritz extraction","EPSSetExtraction",&flg);CHKERRQ(ierr); |
| if (flg) {ierr = EPSSetExtraction(eps,EPS_RITZ);CHKERRQ(ierr);} |
| ierr = PetscOptionsTruthGroup("-eps_harmonic","harmonic Ritz extraction","EPSSetExtraction",&flg);CHKERRQ(ierr); |
| if (flg) {ierr = EPSSetExtraction(eps,EPS_HARMONIC);CHKERRQ(ierr);} |
| ierr = PetscOptionsTruthGroup("-eps_refined","refined Ritz extraction","EPSSetExtraction",&flg);CHKERRQ(ierr); |
| if (flg) {ierr = EPSSetExtraction(eps,EPS_REFINED);CHKERRQ(ierr);} |
| ierr = PetscOptionsTruthGroupEnd("-eps_refined_harmonic","refined harmonic Ritz extraction","EPSSetExtraction",&flg);CHKERRQ(ierr); |
| if (flg) {ierr = EPSSetExtraction(eps,EPS_REFINED_HARMONIC);CHKERRQ(ierr);} |
| ierr = PetscOptionsTruthGroupBegin("-eps_oneside","one-sided eigensolver","EPSSetClass",&flg);CHKERRQ(ierr); |
| if (flg) {ierr = EPSSetClass(eps,EPS_ONE_SIDE);CHKERRQ(ierr);} |
| ierr = PetscOptionsTruthGroupEnd("-eps_twoside","two-sided eigensolver","EPSSetClass",&flg);CHKERRQ(ierr); |
| if (flg) {ierr = EPSSetClass(eps,EPS_TWO_SIDE);CHKERRQ(ierr);} |
| r = i = PETSC_IGNORE; |
| ierr = PetscOptionsInt("-eps_max_it","Maximum number of iterations","EPSSetTolerances",eps->max_it,&i,PETSC_NULL);CHKERRQ(ierr); |
| ierr = PetscOptionsReal("-eps_tol","Tolerance","EPSSetTolerances",eps->tol,&r,PETSC_NULL);CHKERRQ(ierr); |
| ierr = EPSSetTolerances(eps,r,i);CHKERRQ(ierr); |
| i = j = k = PETSC_IGNORE; |
| ierr = PetscOptionsInt("-eps_nev","Number of eigenvalues to compute","EPSSetDimensions",eps->nev,&i,PETSC_NULL);CHKERRQ(ierr); |
| ierr = PetscOptionsInt("-eps_ncv","Number of basis vectors","EPSSetDimensions",eps->ncv,&j,PETSC_NULL);CHKERRQ(ierr); |
| ierr = PetscOptionsInt("-eps_mpd","Maximum dimension of projected problem","EPSSetDimensions",eps->mpd,&k,PETSC_NULL);CHKERRQ(ierr); |
| ierr = EPSSetDimensions(eps,i,j,k);CHKERRQ(ierr); |
| /* -----------------------------------------------------------------------*/ |
| /* |
| Cancels all monitors hardwired into code before call to EPSSetFromOptions() |
| */ |
| ierr = PetscOptionsName("-eps_monitor_cancel","Remove any hardwired monitor routines","EPSMonitorCancel",&flg);CHKERRQ(ierr); |
| if (flg) { |
| ierr = EPSMonitorCancel(eps); CHKERRQ(ierr); |
| } |
| /* |
| Prints approximate eigenvalues and error estimates at each iteration |
| */ |
| ierr = PetscOptionsString("-eps_monitor","Monitor approximate eigenvalues and error estimates","EPSMonitorSet","stdout",monfilename,PETSC_MAX_PATH_LEN,&flg);CHKERRQ(ierr); |
| if (flg) { |
| ierr = PetscViewerASCIIMonitorCreate(((PetscObject)eps)->comm,monfilename,((PetscObject)eps)->tablevel,&monviewer);CHKERRQ(ierr); |
| ierr = EPSMonitorSet(eps,EPSMonitorDefault,monviewer,(PetscErrorCode (*)(void*))PetscViewerASCIIMonitorDestroy);CHKERRQ(ierr); |
| } |
| ierr = PetscOptionsName("-eps_monitor_draw","Monitor error estimates graphically","EPSMonitorSet",&flg);CHKERRQ(ierr); |
| if (flg) { |
| ierr = EPSMonitorSet(eps,EPSMonitorLG,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr); |
| } |
| /* -----------------------------------------------------------------------*/ |
| ierr = PetscOptionsTruthGroupBegin("-eps_largest_magnitude","compute largest eigenvalues in magnitude","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr); |
| if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_LARGEST_MAGNITUDE);CHKERRQ(ierr);} |
| ierr = PetscOptionsTruthGroup("-eps_smallest_magnitude","compute smallest eigenvalues in magnitude","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr); |
| if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_SMALLEST_MAGNITUDE);CHKERRQ(ierr);} |
| ierr = PetscOptionsTruthGroup("-eps_largest_real","compute largest real parts","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr); |
| if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_LARGEST_REAL);CHKERRQ(ierr);} |
| ierr = PetscOptionsTruthGroup("-eps_smallest_real","compute smallest real parts","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr); |
| if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_SMALLEST_REAL);CHKERRQ(ierr);} |
| ierr = PetscOptionsTruthGroup("-eps_largest_imaginary","compute largest imaginary parts","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr); |
| if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_LARGEST_IMAGINARY);CHKERRQ(ierr);} |
| ierr = PetscOptionsTruthGroupEnd("-eps_smallest_imaginary","compute smallest imaginary parts","EPSSetWhichEigenpairs",&flg);CHKERRQ(ierr); |
| if (flg) {ierr = EPSSetWhichEigenpairs(eps,EPS_SMALLEST_IMAGINARY);CHKERRQ(ierr);} |
| ierr = PetscOptionsScalar("-eps_target","Value of the target","EPSSetTarget",eps->target,&s,&flg);CHKERRQ(ierr); |
| if (flg) {ierr = EPSSetTarget(eps,s);CHKERRQ(ierr);} |
| ierr = PetscOptionsName("-eps_view","Print detailed information on solver used","EPSView",0);CHKERRQ(ierr); |
| ierr = PetscOptionsName("-eps_view_binary","Save the matrices associated to the eigenproblem","EPSSetFromOptions",0);CHKERRQ(ierr); |
| ierr = PetscOptionsName("-eps_plot_eigs","Make a plot of the computed eigenvalues","EPSSolve",0);CHKERRQ(ierr); |
| if (eps->ops->setfromoptions) { |
| ierr = (*eps->ops->setfromoptions)(eps);CHKERRQ(ierr); |
| } |
| ierr = PetscOptionsEnd();CHKERRQ(ierr); |
| ierr = IPSetFromOptions(eps->ip); CHKERRQ(ierr); |
| ierr = STSetFromOptions(eps->OP); CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSGetTolerances" |
| /*@ |
| EPSGetTolerances - Gets the tolerance and maximum |
| iteration count used by the default EPS convergence tests. |
| Not Collective |
| Input Parameter: |
| . eps - the eigensolver context |
| Output Parameters: |
| + tol - the convergence tolerance |
| - maxits - maximum number of iterations |
| Notes: |
| The user can specify PETSC_NULL for any parameter that is not needed. |
| Level: intermediate |
| .seealso: EPSSetTolerances() |
| @*/ |
| PetscErrorCode EPSGetTolerances(EPS eps,PetscReal *tol,PetscInt *maxits) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| if (tol) *tol = eps->tol; |
| if (maxits) *maxits = eps->max_it; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSSetTolerances" |
| /*@ |
| EPSSetTolerances - Sets the tolerance and maximum |
| iteration count used by the default EPS convergence testers. |
| Collective on EPS |
| Input Parameters: |
| + eps - the eigensolver context |
| . tol - the convergence tolerance |
| - maxits - maximum number of iterations to use |
| Options Database Keys: |
| + -eps_tol <tol> - Sets the convergence tolerance |
| - -eps_max_it <maxits> - Sets the maximum number of iterations allowed |
| Notes: |
| Use PETSC_IGNORE for an argument that need not be changed. |
| Use PETSC_DECIDE for maxits to assign a reasonably good value, which is |
| dependent on the solution method. |
| Level: intermediate |
| .seealso: EPSGetTolerances() |
| @*/ |
| PetscErrorCode EPSSetTolerances(EPS eps,PetscReal tol,PetscInt maxits) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| if (tol != PETSC_IGNORE) { |
| if (tol == PETSC_DEFAULT) { |
| eps->tol = 1e-7; |
| } else { |
| if (tol < 0.0) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of tol. Must be > 0"); |
| eps->tol = tol; |
| } |
| } |
| if (maxits != PETSC_IGNORE) { |
| if (maxits == PETSC_DEFAULT || maxits == PETSC_DECIDE) { |
| eps->max_it = 0; |
| } else { |
| if (maxits < 0) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of maxits. Must be > 0"); |
| eps->max_it = maxits; |
| } |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSGetDimensions" |
| /*@ |
| EPSGetDimensions - Gets the number of eigenvalues to compute |
| and the dimension of the subspace. |
| Not Collective |
| Input Parameter: |
| . eps - the eigensolver context |
| Output Parameters: |
| + nev - number of eigenvalues to compute |
| . ncv - the maximum dimension of the subspace to be used by the solver |
| - mpd - the maximum dimension allowed for the projected problem |
| Notes: |
| The user can specify PETSC_NULL for any parameter that is not needed. |
| Level: intermediate |
| .seealso: EPSSetDimensions() |
| @*/ |
| PetscErrorCode EPSGetDimensions(EPS eps,PetscInt *nev,PetscInt *ncv,PetscInt *mpd) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| if (nev) *nev = eps->nev; |
| if (ncv) *ncv = eps->ncv; |
| if (mpd) *mpd = eps->mpd; |
| 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 |
| - mpd - the maximum dimension allowed for the projected problem |
| Options Database Keys: |
| + -eps_nev <nev> - Sets the number of eigenvalues |
| . -eps_ncv <ncv> - Sets the dimension of the subspace |
| - -eps_mpd <mpd> - Sets the maximum projected dimension |
| Notes: |
| Use PETSC_IGNORE to retain the previous value of any parameter. |
| Use PETSC_DECIDE for ncv and mpd to assign a reasonably good value, which is |
| dependent on the solution method. |
| The parameters ncv and mpd are intimately related, so that the user is advised |
| to set one of them at most. Normal usage is the following: |
| + - In cases where nev is small, the user sets ncv (a reasonable default is 2*nev). |
| - - In cases where nev is large, the user sets mpd. |
| The value of ncv should always be between nev and (nev+mpd), typically |
| ncv=nev+mpd. If nev is not too large, mpd=nev is a reasonable choice, otherwise |
| a smaller value should be used. |
| Level: intermediate |
| .seealso: EPSGetDimensions() |
| @*/ |
| PetscErrorCode EPSSetDimensions(EPS eps,PetscInt nev,PetscInt ncv,PetscInt mpd) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| if( nev != PETSC_IGNORE ) { |
| if (nev<1) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of nev. Must be > 0"); |
| eps->nev = nev; |
| eps->setupcalled = 0; |
| } |
| if( ncv != PETSC_IGNORE ) { |
| if (ncv == PETSC_DECIDE || ncv == PETSC_DEFAULT) { |
| eps->ncv = 0; |
| } else { |
| if (ncv<1) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of ncv. Must be > 0"); |
| eps->ncv = ncv; |
| } |
| eps->setupcalled = 0; |
| } |
| if( mpd != PETSC_IGNORE ) { |
| if (mpd == PETSC_DECIDE || mpd == PETSC_DEFAULT) { |
| eps->mpd = 0; |
| } else { |
| if (mpd<1) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Illegal value of mpd. Must be > 0"); |
| eps->mpd = mpd; |
| } |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSSetWhichEigenpairs" |
| /*@ |
| EPSSetWhichEigenpairs - Specifies which portion of the spectrum is |
| to be sought. |
| Collective on EPS |
| Input Parameter: |
| . eps - eigensolver context obtained from EPSCreate() |
| Output Parameter: |
| . which - the portion of the spectrum to be sought |
| Possible values: |
| The parameter 'which' can have one of these values: |
| + EPS_LARGEST_MAGNITUDE - largest eigenvalues in magnitude (default) |
| . EPS_SMALLEST_MAGNITUDE - smallest eigenvalues in magnitude |
| . EPS_LARGEST_REAL - largest real parts |
| . EPS_SMALLEST_REAL - smallest real parts |
| . EPS_LARGEST_IMAGINARY - largest imaginary parts |
| - EPS_SMALLEST_IMAGINARY - smallest imaginary parts |
| Options Database Keys: |
| + -eps_largest_magnitude - Sets largest eigenvalues in magnitude |
| . -eps_smallest_magnitude - Sets smallest eigenvalues in magnitude |
| . -eps_largest_real - Sets largest real parts |
| . -eps_smallest_real - Sets smallest real parts |
| . -eps_largest_imaginary - Sets largest imaginary parts in magnitude |
| - -eps_smallest_imaginary - Sets smallest imaginary parts in magnitude |
| Notes: |
| Not all eigensolvers implemented in EPS account for all the possible values |
| stated above. Also, some values make sense only for certain types of |
| problems. If SLEPc is compiled for real numbers EPS_LARGEST_IMAGINARY |
| and EPS_SMALLEST_IMAGINARY use the absolute value of the imaginary part |
| for eigenvalue selection. |
| Level: intermediate |
| .seealso: EPSGetWhichEigenpairs(), EPSSortEigenvalues(), EPSWhich |
| @*/ |
| PetscErrorCode EPSSetWhichEigenpairs(EPS eps,EPSWhich which) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| switch (which) { |
| case EPS_LARGEST_MAGNITUDE: |
| case EPS_SMALLEST_MAGNITUDE: |
| case EPS_LARGEST_REAL: |
| case EPS_SMALLEST_REAL: |
| case EPS_LARGEST_IMAGINARY: |
| case EPS_SMALLEST_IMAGINARY: |
| if (eps->which != which) { |
| eps->setupcalled = 0; |
| eps->which = which; |
| } |
| break; |
| default: |
| SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Invalid 'which' value"); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSGetWhichEigenpairs" |
| /*@C |
| EPSGetWhichEigenpairs - Returns which portion of the spectrum is to be |
| sought. |
| Not Collective |
| Input Parameter: |
| . eps - eigensolver context obtained from EPSCreate() |
| Output Parameter: |
| . which - the portion of the spectrum to be sought |
| Notes: |
| See EPSSetWhichEigenpairs() for possible values of which |
| Level: intermediate |
| .seealso: EPSSetWhichEigenpairs(), EPSWhich |
| @*/ |
| PetscErrorCode EPSGetWhichEigenpairs(EPS eps,EPSWhich *which) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| PetscValidPointer(which,2); |
| *which = eps->which; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSSetProblemType" |
| /*@ |
| EPSSetProblemType - Specifies the type of the eigenvalue problem. |
| Collective on EPS |
| Input Parameters: |
| + eps - the eigensolver context |
| - type - a known type of eigenvalue problem |
| Options Database Keys: |
| + -eps_hermitian - Hermitian eigenvalue problem |
| . -eps_gen_hermitian - generalized Hermitian eigenvalue problem |
| . -eps_non_hermitian - non-Hermitian eigenvalue problem |
| . -eps_gen_non_hermitian - generalized non-Hermitian eigenvalue problem |
| - -eps_pos_gen_non_hermitian - generalized non-Hermitian eigenvalue problem |
| with positive semi-definite B |
| Notes: |
| Allowed values for the problem type are: Hermitian (EPS_HEP), non-Hermitian |
| (EPS_NHEP), generalized Hermitian (EPS_GHEP) and generalized non-Hermitian |
| (EPS_GNHEP). |
| This function must be used to instruct SLEPc to exploit symmetry. If no |
| problem type is specified, by default a non-Hermitian problem is assumed |
| (either standard or generalized). If the user knows that the problem is |
| Hermitian (i.e. A=A^H) of generalized Hermitian (i.e. A=A^H, B=B^H, and |
| B positive definite) then it is recommended to set the problem type so |
| that eigensolver can exploit these properties. |
| Level: beginner |
| .seealso: EPSSetOperators(), EPSSetType(), EPSGetProblemType(), EPSProblemType |
| @*/ |
| PetscErrorCode EPSSetProblemType(EPS eps,EPSProblemType type) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| switch (type) { |
| case EPS_HEP: |
| eps->isgeneralized = PETSC_FALSE; |
| eps->ishermitian = PETSC_TRUE; |
| eps->ispositive = PETSC_FALSE; |
| break; |
| case EPS_NHEP: |
| eps->isgeneralized = PETSC_FALSE; |
| eps->ishermitian = PETSC_FALSE; |
| eps->ispositive = PETSC_FALSE; |
| break; |
| case EPS_GHEP: |
| eps->isgeneralized = PETSC_TRUE; |
| eps->ishermitian = PETSC_TRUE; |
| eps->ispositive = PETSC_TRUE; |
| break; |
| case EPS_GNHEP: |
| eps->isgeneralized = PETSC_TRUE; |
| eps->ishermitian = PETSC_FALSE; |
| eps->ispositive = PETSC_FALSE; |
| break; |
| case EPS_PGNHEP: |
| eps->isgeneralized = PETSC_TRUE; |
| eps->ishermitian = PETSC_FALSE; |
| eps->ispositive = PETSC_TRUE; |
| break; |
| /* |
| case EPS_CSEP: |
| eps->isgeneralized = PETSC_FALSE; |
| eps->ishermitian = PETSC_FALSE; |
| ierr = STSetBilinearForm(eps->OP,STINNER_SYMMETRIC);CHKERRQ(ierr); |
| break; |
| case EPS_GCSEP: |
| eps->isgeneralized = PETSC_TRUE; |
| eps->ishermitian = PETSC_FALSE; |
| ierr = STSetBilinearForm(eps->OP,STINNER_B_SYMMETRIC);CHKERRQ(ierr); |
| break; |
| */ |
| default: |
| SETERRQ(PETSC_ERR_ARG_WRONG,"Unknown eigenvalue problem type"); |
| } |
| eps->problem_type = type; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSGetProblemType" |
| /*@C |
| EPSGetProblemType - Gets the problem type from the EPS object. |
| Not Collective |
| Input Parameter: |
| . eps - the eigensolver context |
| Output Parameter: |
| . type - name of EPS problem type |
| Level: intermediate |
| .seealso: EPSSetProblemType(), EPSProblemType |
| @*/ |
| PetscErrorCode EPSGetProblemType(EPS eps,EPSProblemType *type) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| PetscValidPointer(type,2); |
| *type = eps->problem_type; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSSetExtraction" |
| /*@ |
| EPSSetExtraction - Specifies the type of extraction technique to be employed |
| by the eigensolver. |
| Collective on EPS |
| Input Parameters: |
| + eps - the eigensolver context |
| - extr - a known type of extraction |
| Options Database Keys: |
| + -eps_ritz - Rayleigh-Ritz extraction |
| . -eps_harmonic - hamonic Ritz extraction |
| . -eps_refined - refined Ritz extraction |
| - -eps_refined_harmonic - refined harmonic Ritz extraction |
| Notes: |
| Not all eigensolvers support all types of extraction. See the SLEPc |
| Users Manual for details. |
| By default, a standard Rayleigh-Ritz extraction is used. Other extractions |
| may be useful when computing interior eigenvalues. |
| Harmonic-type extractions are used in combination with a 'target'. |
| Level: beginner |
| .seealso: EPSSetTarget(), EPSGetExtraction(), EPSExtraction |
| @*/ |
| PetscErrorCode EPSSetExtraction(EPS eps,EPSExtraction extr) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| eps->extraction = extr; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSGetExtraction" |
| /*@C |
| EPSGetExtraction - Gets the extraction type used by the EPS object. |
| Not Collective |
| Input Parameter: |
| . eps - the eigensolver context |
| Output Parameter: |
| . extr - name of extraction type |
| Level: intermediate |
| .seealso: EPSSetExtraction(), EPSExtraction |
| @*/ |
| PetscErrorCode EPSGetExtraction(EPS eps,EPSExtraction *extr) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| PetscValidPointer(extr,2); |
| *extr = eps->extraction; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSSetClass" |
| /*@ |
| EPSSetClass - Specifies the eigensolver class: either one-sided or two-sided. |
| Collective on EPS |
| Input Parameters: |
| + eps - the eigensolver context |
| - class - the class of solver |
| Options Database Keys: |
| + -eps_oneside - one-sided solver |
| - -eps_twoside - two-sided solver |
| Note: |
| Allowed solver classes are: one-sided (EPS_ONE_SIDE) and two-sided (EPS_TWO_SIDE). |
| One-sided eigensolvers are the standard ones, which allow the computation of |
| eigenvalues and (right) eigenvectors, whereas two-sided eigensolvers compute |
| left eigenvectors as well. |
| Level: intermediate |
| .seealso: EPSGetLeftVector(), EPSComputeRelativeErrorLeft(), EPSSetLeftInitialVector(), |
| EPSGetClass(), EPSClass |
| @*/ |
| PetscErrorCode EPSSetClass(EPS eps,EPSClass cl) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| if (cl != EPS_ONE_SIDE && cl != EPS_TWO_SIDE) SETERRQ(PETSC_ERR_ARG_WRONG,"Unknown eigensolver class"); |
| if (eps->solverclass!=cl) { |
| if (eps->solverclass == EPS_TWO_SIDE) { ierr = EPSFreeSolution(eps);CHKERRQ(ierr); } |
| eps->solverclass = cl; |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSGetClass" |
| /*@C |
| EPSGetClass - Gets the eigensolver class from the EPS object. |
| Not Collective |
| Input Parameter: |
| . eps - the eigensolver context |
| Output Parameter: |
| . class - class of EPS solver (either one-sided or two-sided) |
| Level: intermediate |
| .seealso: EPSSetClass(), EPSClass |
| @*/ |
| PetscErrorCode EPSGetClass(EPS eps,EPSClass *cl) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| PetscValidPointer(cl,2); |
| *cl = eps->solverclass; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSSetOptionsPrefix" |
| /*@C |
| EPSSetOptionsPrefix - Sets the prefix used for searching for all |
| EPS options in the database. |
| Collective on EPS |
| Input Parameters: |
| + eps - the eigensolver context |
| - prefix - the prefix string to prepend to all EPS option requests |
| Notes: |
| A hyphen (-) must NOT be given at the beginning of the prefix name. |
| The first character of all runtime options is AUTOMATICALLY the |
| hyphen. |
| For example, to distinguish between the runtime options for two |
| different EPS contexts, one could call |
| .vb |
| EPSSetOptionsPrefix(eps1,"eig1_") |
| EPSSetOptionsPrefix(eps2,"eig2_") |
| .ve |
| Level: advanced |
| .seealso: EPSAppendOptionsPrefix(), EPSGetOptionsPrefix() |
| @*/ |
| PetscErrorCode EPSSetOptionsPrefix(EPS eps,const char *prefix) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| ierr = PetscObjectSetOptionsPrefix((PetscObject)eps, prefix);CHKERRQ(ierr); |
| ierr = STSetOptionsPrefix(eps->OP,prefix);CHKERRQ(ierr); |
| ierr = IPSetOptionsPrefix(eps->ip,prefix);CHKERRQ(ierr); |
| ierr = IPAppendOptionsPrefix(eps->ip,"eps_");CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSAppendOptionsPrefix" |
| /*@C |
| EPSAppendOptionsPrefix - Appends to the prefix used for searching for all |
| EPS options in the database. |
| Collective on EPS |
| Input Parameters: |
| + eps - the eigensolver context |
| - prefix - the prefix string to prepend to all EPS option requests |
| Notes: |
| A hyphen (-) must NOT be given at the beginning of the prefix name. |
| The first character of all runtime options is AUTOMATICALLY the hyphen. |
| Level: advanced |
| .seealso: EPSSetOptionsPrefix(), EPSGetOptionsPrefix() |
| @*/ |
| PetscErrorCode EPSAppendOptionsPrefix(EPS eps,const char *prefix) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| ierr = PetscObjectAppendOptionsPrefix((PetscObject)eps, prefix);CHKERRQ(ierr); |
| ierr = STAppendOptionsPrefix(eps->OP,prefix); CHKERRQ(ierr); |
| ierr = IPSetOptionsPrefix(eps->ip,prefix);CHKERRQ(ierr); |
| ierr = IPAppendOptionsPrefix(eps->ip,"eps_");CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSGetOptionsPrefix" |
| /*@C |
| EPSGetOptionsPrefix - Gets the prefix used for searching for all |
| EPS options in the database. |
| Not Collective |
| Input Parameters: |
| . eps - the eigensolver context |
| Output Parameters: |
| . prefix - pointer to the prefix string used is returned |
| Notes: On the fortran side, the user should pass in a string 'prefix' of |
| sufficient length to hold the prefix. |
| Level: advanced |
| .seealso: EPSSetOptionsPrefix(), EPSAppendOptionsPrefix() |
| @*/ |
| PetscErrorCode EPSGetOptionsPrefix(EPS eps,const char *prefix[]) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| PetscValidPointer(prefix,2); |
| ierr = PetscObjectGetOptionsPrefix((PetscObject)eps, prefix);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| /* |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/epsimpl.h" /*I "slepceps.h" I*/ |
| EXTERN_C_BEGIN |
| EXTERN PetscErrorCode EPSCreate_POWER(EPS); |
| EXTERN PetscErrorCode EPSCreate_SUBSPACE(EPS); |
| EXTERN PetscErrorCode EPSCreate_ARNOLDI(EPS); |
| EXTERN PetscErrorCode EPSCreate_LANCZOS(EPS); |
| EXTERN PetscErrorCode EPSCreate_KRYLOVSCHUR(EPS); |
| #if defined(SLEPC_HAVE_ARPACK) |
| EXTERN PetscErrorCode EPSCreate_ARPACK(EPS); |
| #endif |
| EXTERN PetscErrorCode EPSCreate_LAPACK(EPS); |
| #if defined(SLEPC_HAVE_BLZPACK) && !defined(PETSC_USE_COMPLEX) |
| EXTERN PetscErrorCode EPSCreate_BLZPACK(EPS); |
| #endif |
| #if defined(SLEPC_HAVE_TRLAN) && !defined(PETSC_USE_COMPLEX) |
| EXTERN PetscErrorCode EPSCreate_TRLAN(EPS); |
| #endif |
| #if defined(PETSC_HAVE_BLOPEX) && !defined(PETSC_USE_COMPLEX) |
| EXTERN PetscErrorCode EPSCreate_BLOPEX(EPS); |
| #endif |
| #if defined(SLEPC_HAVE_PRIMME) |
| EXTERN PetscErrorCode EPSCreate_PRIMME(EPS eps); |
| #endif |
| EXTERN_C_END |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSRegisterAll" |
| /*@C |
| EPSRegisterAll - Registers all the eigenvalue solvers in the EPS package. |
| Not Collective |
| Level: advanced |
| .seealso: EPSRegisterDynamic() |
| @*/ |
| PetscErrorCode EPSRegisterAll(char *path) |
| { |
| PetscErrorCode ierr; |
| PetscFunctionBegin; |
| ierr = EPSRegisterDynamic(EPSPOWER, path,"EPSCreate_POWER", |
| EPSCreate_POWER);CHKERRQ(ierr); |
| ierr = EPSRegisterDynamic(EPSSUBSPACE, path,"EPSCreate_SUBSPACE", |
| EPSCreate_SUBSPACE);CHKERRQ(ierr); |
| ierr = EPSRegisterDynamic(EPSARNOLDI, path,"EPSCreate_ARNOLDI", |
| EPSCreate_ARNOLDI);CHKERRQ(ierr); |
| ierr = EPSRegisterDynamic(EPSLANCZOS, path,"EPSCreate_LANCZOS", |
| EPSCreate_LANCZOS);CHKERRQ(ierr); |
| ierr = EPSRegisterDynamic(EPSKRYLOVSCHUR, path,"EPSCreate_KRYLOVSCHUR", |
| EPSCreate_KRYLOVSCHUR);CHKERRQ(ierr); |
| #if defined(SLEPC_HAVE_ARPACK) |
| ierr = EPSRegisterDynamic(EPSARPACK, path,"EPSCreate_ARPACK", |
| EPSCreate_ARPACK);CHKERRQ(ierr); |
| #endif |
| ierr = EPSRegisterDynamic(EPSLAPACK, path,"EPSCreate_LAPACK", |
| EPSCreate_LAPACK);CHKERRQ(ierr); |
| #if defined(SLEPC_HAVE_BLZPACK) && !defined(PETSC_USE_COMPLEX) |
| ierr = EPSRegisterDynamic(EPSBLZPACK, path,"EPSCreate_BLZPACK", |
| EPSCreate_BLZPACK);CHKERRQ(ierr); |
| #endif |
| #if defined(SLEPC_HAVE_TRLAN) && !defined(PETSC_USE_COMPLEX) |
| ierr = EPSRegisterDynamic(EPSTRLAN, path,"EPSCreate_TRLAN", |
| EPSCreate_TRLAN);CHKERRQ(ierr); |
| #endif |
| #if defined(PETSC_HAVE_BLOPEX) && !defined(PETSC_USE_COMPLEX) |
| ierr = EPSRegisterDynamic(EPSBLOPEX, path,"EPSCreate_BLOPEX", |
| EPSCreate_BLOPEX);CHKERRQ(ierr); |
| #endif |
| #if defined(SLEPC_HAVE_PRIMME) |
| ierr = EPSRegisterDynamic(EPSPRIMME, path, "EPSCreate_PRIMME", |
| EPSCreate_PRIMME);CHKERRQ(ierr); |
| #endif |
| PetscFunctionReturn(0); |
| } |
| /* |
| EPS routines related to monitors. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/epsimpl.h" /*I "slepceps.h" I*/ |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSMonitorSet" |
| /*@C |
| EPSMonitorSet - Sets an ADDITIONAL function to be called at every |
| iteration to monitor the error estimates for each requested eigenpair. |
| Collective on EPS |
| Input Parameters: |
| + eps - eigensolver context obtained from EPSCreate() |
| . monitor - pointer to function (if this is PETSC_NULL, it turns off monitoring) |
| . mctx - [optional] context for private data for the |
| monitor routine (use PETSC_NULL if no context is desired) |
| - monitordestroy - [optional] routine that frees monitor context |
| (may be PETSC_NULL) |
| Calling Sequence of monitor: |
| $ monitor (EPS eps, int its, int nconv, PetscScalar *eigr, PetscScalar *eigi, PetscReal* errest, int nest, void *mctx) |
| + eps - eigensolver context obtained from EPSCreate() |
| . its - iteration number |
| . nconv - number of converged eigenpairs |
| . eigr - real part of the eigenvalues |
| . eigi - imaginary part of the eigenvalues |
| . errest - relative error estimates for each eigenpair |
| . nest - number of error estimates |
| - mctx - optional monitoring context, as set by EPSMonitorSet() |
| Options Database Keys: |
| + -eps_monitor - print error estimates at each iteration |
| . -eps_monitor_draw - sets line graph monitor |
| - -eps_monitor_cancel - cancels all monitors that have been hardwired into |
| a code by calls to EPSMonitorSet(), but does not cancel those set via |
| the options database. |
| Notes: |
| Several different monitoring routines may be set by calling |
| EPSMonitorSet() multiple times; all will be called in the |
| order in which they were set. |
| Level: intermediate |
| .seealso: EPSMonitorDefault(), EPSMonitorCancel() |
| @*/ |
| PetscErrorCode EPSMonitorSet(EPS eps,PetscErrorCode (*monitor)(EPS,PetscInt,PetscInt,PetscScalar*,PetscScalar*,PetscReal*,PetscInt,void*), |
| void *mctx,PetscErrorCode (*monitordestroy)(void*)) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| if (eps->numbermonitors >= MAXEPSMONITORS) { |
| SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Too many EPS monitors set"); |
| } |
| eps->monitor[eps->numbermonitors] = monitor; |
| eps->monitorcontext[eps->numbermonitors] = (void*)mctx; |
| eps->monitordestroy[eps->numbermonitors++] = monitordestroy; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSMonitorCancel" |
| /*@ |
| EPSMonitorCancel - Clears all monitors for an EPS object. |
| Collective on EPS |
| Input Parameters: |
| . eps - eigensolver context obtained from EPSCreate() |
| Options Database Key: |
| . -eps_monitor_cancel - Cancels all monitors that have been hardwired |
| into a code by calls to EPSMonitorSet(), |
| but does not cancel those set via the options database. |
| Level: intermediate |
| .seealso: EPSMonitorSet() |
| @*/ |
| PetscErrorCode EPSMonitorCancel(EPS eps) |
| { |
| PetscErrorCode ierr; |
| PetscInt i; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| for (i=0; i<eps->numbermonitors; i++) { |
| if (eps->monitordestroy[i]) { |
| ierr = (*eps->monitordestroy[i])(eps->monitorcontext[i]);CHKERRQ(ierr); |
| } |
| } |
| eps->numbermonitors = 0; |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSGetMonitorContext" |
| /*@C |
| EPSGetMonitorContext - Gets the monitor context, as set by |
| EPSSetMonitor() for the FIRST monitor only. |
| Not Collective |
| Input Parameter: |
| . eps - eigensolver context obtained from EPSCreate() |
| Output Parameter: |
| . ctx - monitor context |
| Level: intermediate |
| .seealso: EPSSetMonitor(), EPSDefaultMonitor() |
| @*/ |
| PetscErrorCode EPSGetMonitorContext(EPS eps, void **ctx) |
| { |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| *ctx = (eps->monitorcontext[0]); |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSMonitorDefault" |
| /*@C |
| EPSMonitorDefault - Print the current approximate values and |
| error estimates at each iteration of the eigensolver. |
| Collective on EPS |
| Input Parameters: |
| + eps - eigensolver context |
| . its - iteration number |
| . nconv - number of converged eigenpairs so far |
| . eigr - real part of the eigenvalues |
| . eigi - imaginary part of the eigenvalues |
| . errest - error estimates |
| . nest - number of error estimates to display |
| - dummy - unused monitor context |
| Level: intermediate |
| .seealso: EPSMonitorSet() |
| @*/ |
| PetscErrorCode EPSMonitorDefault(EPS eps,PetscInt its,PetscInt nconv,PetscScalar *eigr,PetscScalar *eigi,PetscReal *errest,PetscInt nest,void *dummy) |
| { |
| PetscErrorCode ierr; |
| PetscInt i; |
| PetscViewerASCIIMonitor viewer = (PetscViewerASCIIMonitor) dummy; |
| PetscFunctionBegin; |
| if (its) { |
| if (!dummy) {ierr = PetscViewerASCIIMonitorCreate(((PetscObject)eps)->comm,"stdout",0,&viewer);CHKERRQ(ierr);} |
| ierr = PetscViewerASCIIMonitorPrintf(viewer,"%3d EPS nconv=%d Values (Errors)",its,nconv);CHKERRQ(ierr); |
| for (i=0;i<nest;i++) { |
| #if defined(PETSC_USE_COMPLEX) |
| ierr = PetscViewerASCIIMonitorPrintf(viewer," %g%+gi",PetscRealPart(eigr[i]),PetscImaginaryPart(eigr[i]));CHKERRQ(ierr); |
| #else |
| ierr = PetscViewerASCIIMonitorPrintf(viewer," %g",eigr[i]);CHKERRQ(ierr); |
| if (eigi[i]!=0.0) { ierr = PetscViewerASCIIMonitorPrintf(viewer,"%+gi",eigi[i]);CHKERRQ(ierr); } |
| #endif |
| ierr = PetscViewerASCIIMonitorPrintf(viewer," (%10.8e)",errest[i]);CHKERRQ(ierr); |
| } |
| ierr = PetscViewerASCIIMonitorPrintf(viewer,"\n");CHKERRQ(ierr); |
| if (!dummy) {ierr = PetscViewerASCIIMonitorDestroy(viewer);CHKERRQ(ierr);} |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSMonitorLG" |
| PetscErrorCode EPSMonitorLG(EPS eps,PetscInt its,PetscInt nconv,PetscScalar *eigr,PetscScalar *eigi,PetscReal *errest,PetscInt nest,void *monctx) |
| { |
| PetscViewer viewer = (PetscViewer) monctx; |
| PetscDraw draw; |
| PetscDrawLG lg; |
| PetscErrorCode ierr; |
| PetscReal *x,*y; |
| PetscInt i; |
| int n = eps->nev; |
| #if !defined(PETSC_USE_COMPLEX) |
| int p; |
| PetscDraw draw1; |
| PetscDrawLG lg1; |
| #endif |
| PetscFunctionBegin; |
| if (!viewer) { viewer = PETSC_VIEWER_DRAW_(((PetscObject)eps)->comm); } |
| ierr = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr); |
| ierr = PetscViewerDrawGetDrawLG(viewer,0,&lg);CHKERRQ(ierr); |
| if (!its) { |
| ierr = PetscDrawSetTitle(draw,"Error estimates");CHKERRQ(ierr); |
| ierr = PetscDrawSetDoubleBuffer(draw);CHKERRQ(ierr); |
| ierr = PetscDrawLGSetDimension(lg,n);CHKERRQ(ierr); |
| ierr = PetscDrawLGReset(lg);CHKERRQ(ierr); |
| ierr = PetscDrawLGSetLimits(lg,0,1.0,log10(eps->tol)-2,0.0);CHKERRQ(ierr); |
| } |
| #if !defined(PETSC_USE_COMPLEX) |
| if (eps->ishermitian) { |
| ierr = PetscViewerDrawGetDraw(viewer,1,&draw1);CHKERRQ(ierr); |
| ierr = PetscViewerDrawGetDrawLG(viewer,1,&lg1);CHKERRQ(ierr); |
| if (!its) { |
| ierr = PetscDrawSetTitle(draw1,"Approximate eigenvalues");CHKERRQ(ierr); |
| ierr = PetscDrawSetDoubleBuffer(draw1);CHKERRQ(ierr); |
| ierr = PetscDrawLGSetDimension(lg1,n);CHKERRQ(ierr); |
| ierr = PetscDrawLGReset(lg1);CHKERRQ(ierr); |
| ierr = PetscDrawLGSetLimits(lg1,0,1.0,1.e20,-1.e20);CHKERRQ(ierr); |
| } |
| } |
| #endif |
| ierr = PetscMalloc(sizeof(PetscReal)*n,&x);CHKERRQ(ierr); |
| ierr = PetscMalloc(sizeof(PetscReal)*n,&y);CHKERRQ(ierr); |
| for (i=0;i<n;i++) { |
| x[i] = (PetscReal) its; |
| if (errest[i] > 0.0) y[i] = log10(errest[i]); else y[i] = 0.0; |
| } |
| ierr = PetscDrawLGAddPoint(lg,x,y);CHKERRQ(ierr); |
| #if !defined(PETSC_USE_COMPLEX) |
| if (eps->ishermitian) { |
| ierr = PetscDrawLGAddPoint(lg1,x,eps->eigr);CHKERRQ(ierr); |
| ierr = PetscDrawGetPause(draw1,&p);CHKERRQ(ierr); |
| ierr = PetscDrawSetPause(draw1,0);CHKERRQ(ierr); |
| ierr = PetscDrawLGDraw(lg1);CHKERRQ(ierr); |
| ierr = PetscDrawSetPause(draw1,p);CHKERRQ(ierr); |
| } |
| #endif |
| ierr = PetscDrawLGDraw(lg);CHKERRQ(ierr); |
| ierr = PetscFree(x);CHKERRQ(ierr); |
| ierr = PetscFree(y);CHKERRQ(ierr); |
| PetscFunctionReturn(0); |
| } |
| /* |
| EPS routines related to the solution process. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| SLEPc - Scalable Library for Eigenvalue Problem Computations |
| Copyright (c) 2002-2009, Universidad Politecnica de Valencia, Spain |
| This file is part of SLEPc. |
| SLEPc is free software: you can redistribute it and/or modify it under the |
| terms of version 3 of the GNU Lesser General Public License as published by |
| the Free Software Foundation. |
| SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
| FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for |
| more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with SLEPc. If not, see <http://www.gnu.org/licenses/>. |
| - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - |
| */ |
| #include "private/epsimpl.h" /*I "slepceps.h" I*/ |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSSolve" |
| /*@ |
| EPSSolve - Solves the eigensystem. |
| Collective on EPS |
| Input Parameter: |
| . eps - eigensolver context obtained from EPSCreate() |
| Options Database: |
| + -eps_view - print information about the solver used |
| . -eps_view_binary - save the matrices to the default binary file |
| - -eps_plot_eigs - plot computed eigenvalues |
| Level: beginner |
| .seealso: EPSCreate(), EPSSetUp(), EPSDestroy(), EPSSetTolerances() |
| @*/ |
| PetscErrorCode EPSSolve(EPS eps) |
| { |
| PetscErrorCode ierr; |
| PetscInt i; |
| PetscReal re,im; |
| PetscTruth flg; |
| PetscViewer viewer; |
| PetscDraw draw; |
| PetscDrawSP drawsp; |
| STMatMode matmode; |
| PetscFunctionBegin; |
| PetscValidHeaderSpecific(eps,EPS_COOKIE,1); |
| ierr = PetscOptionsHasName(((PetscObject)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_(((PetscObject)eps)->comm));CHKERRQ(ierr); |
| if (B) ierr = MatView(B,PETSC_VIEWER_BINARY_(((PetscObject)eps)->comm));CHKERRQ(ierr); |
| } |
| /* reset the convergence flag from the previous solves */ |
| eps->reason = EPS_CONVERGED_ITERATING; |
| if (!eps->setupcalled){ ierr = EPSSetUp(eps);CHKERRQ(ierr); } |
| ierr = STResetOperationCounters(eps->OP);CHKERRQ(ierr); |
| ierr = IPResetOperationCounters(eps->ip);CHKERRQ(ierr); |
| eps->evecsavailable = PETSC_FALSE; |
| eps->nconv = 0; |
| eps->its = 0; |
| for (i=0;i<eps->ncv;i++) eps->eigr[i]=eps->eigi[i]=eps->errest[i]=0.0; |
| EPSMonitor(eps,eps->its,eps->nconv,eps->eigr,eps->eigi,eps->errest,eps->ncv); |
| ierr = PetscLogEventBegin(EPS_Solve,eps,eps->V[0],eps->V[0],0);CHKERRQ(ierr); |
| switch (eps->solverclass) { |
| case EPS_ONE_SIDE: |
| ierr = (*eps->ops->solve)(eps);CHKERRQ(ierr); break; |
| case EPS_TWO_SIDE: |
| if (eps->ops->solvets) { |
| ierr = (*eps->ops->solvets)(eps);CHKERRQ(ierr); break; |
| } else { |
| SETERRQ(1,"Two-sided version unavailable for this solver"); |
| } |
| default: |
| SETERRQ(1,"Wrong value of eps->solverclass"); |
| } |
| ierr = STGetMatMode(eps->OP,&matmode);CHKERRQ(ierr); |
| if (matmode == STMATMODE_INPLACE && eps->ispositive) { |
| /* Purge eigenvectors before reverting operator */ |
| ierr = (*eps->ops->computevectors)(eps);CHKERRQ(ierr); |
| } |
| ierr = STPostSolve(eps->OP);CHKERRQ(ierr); |
| ierr = PetscLogEventEnd(EPS_Solve,eps,eps->V[0],eps->V[0],0);CHKERRQ(ierr); |
| if (!eps->reason) { |
| SETERRQ(1,"Internal error, solver returned without setting converged reason"); |
| } |
| /* Map eigenvalues back to the original problem, necessary in some |
| * spectral transformations */ |
| ierr = (*eps->ops->backtransform)(eps);CHKERRQ(ierr); |
| /* Adjust left eigenvectors in generalized problems: y = B^T y */ |
| if (eps->isgeneralized && eps->solverclass == EPS_TWO_SIDE) { |
| Mat B; |
| KSP ksp; |
| Vec w; |
| ierr = STGetOperators(eps->OP,PETSC_NULL,&B);CHKERRQ(ierr); |
| ierr = KSPCreate(((PetscObject)eps)->comm,&ksp);CHKERRQ(ierr); |
| ierr = KSPSetOperators(ksp,B,B,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); |
| ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr); |
| ierr = MatGetVecs(B,PETSC_NULL,&w);CHKERRQ(ierr); |
| for (i=0;i<eps->nconv;i++) { |
| ierr = VecCopy(eps->W[i],w);CHKERRQ(ierr); |
| ierr = KSPSolveTranspose(ksp,w,eps->W[i]);CHKERRQ(ierr); |
| } |
| ierr = KSPDestroy(ksp);CHKERRQ(ierr); |
| ierr = VecDestroy(w);CHKERRQ(ierr); |
| } |
| #ifndef PETSC_USE_COMPLEX |
| /* reorder conjugate eigenvalues (positive imaginary first) */ |
| for (i=0; i<eps->nconv-1; i++) { |
| if (eps->eigi[i] != 0) { |
| if (eps->eigi[i] < 0) { |
| eps->eigi[i] = -eps->eigi[i]; |
| eps->eigi[i+1] = -eps->eigi[i+1]; |
| if (!eps->evecsavailable) { |
| /* the next correction only works with eigenvectors */ |
| ierr = (*eps->ops->computevectors)(eps);CHKERRQ(ierr); |
| } |
| ierr = VecScale(eps->V[i+1],-1.0); CHKERRQ(ierr); |
| } |
| i++; |
| } |
| } |
| #endif |
| /* sort eigenvalues according to eps->which parameter */ |
| ierr = PetscFree(eps->perm);CHKERRQ(ierr); |
| if (eps->nconv > 0) { |
| ierr = PetscMalloc(sizeof(PetscInt)*eps->nconv, &eps->perm); CHKERRQ(ierr); |
| ierr = EPSSortEigenvalues(eps->nconv, eps->eigr, eps->eigi, eps->which, eps->nconv, eps->perm); CHKERRQ(ierr); |
| } |
| ierr = PetscOptionsHasName(((PetscObject)eps)->prefix,"-eps_view",&flg);CHKERRQ(ierr); |
| if (flg && !PetscPreLoadingOn) { ierr = EPSView(eps,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); } |
| ierr = PetscOptionsHasName(((PetscObject)eps)->prefix,"-eps_plot_eigs",&flg);CHKERRQ(ierr); |
| if (flg) { |
| ierr = PetscViewerDrawOpen(PETSC_COMM_SELF,0,"Computed Eigenvalues", |
| PETSC_DECIDE,PETSC_DECIDE,300,300,&viewer);CHKERRQ(ierr); |
| ierr = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr); |
| ierr = PetscDrawSPCreate(draw,1,&drawsp);CHKERRQ(ierr); |
| for( i=0; i<eps->nconv; i++ ) { |
| #if defined(PETSC_USE_COMPLEX) |
| re = PetscRealPart(eps->eigr[i]); |
| im = PetscImaginaryPart(eps->eigi[i]); |
| #else |
| re = eps->eigr[i]; |
| im = eps->eigi[i]; |
| #endif |
| ierr = PetscDrawSPAddPoint(drawsp,&re,&im);CHKERRQ(ierr); |
| } |
| ierr = PetscDrawSPDraw(drawsp);CHKERRQ(ierr); |
| ierr = PetscDrawSPDestroy(drawsp);CHKERRQ(ierr); |
| ierr = PetscViewerDestroy(viewer);CHKERRQ(ierr); |
| } |
| PetscFunctionReturn(0); |
| } |
| #undef __FUNCT__ |
| #define __FUNCT__ "EPSGetIterationNumber" |
| /*@ |
| EPSGetIterationNumber - Gets the current iteration number. If the |
| call to EPSSolve() is complete, then it returns the number of iterations |
| carried out by the solution method. |
| Not Collective |
| Input Parameter: |
| . eps - the eigensolver context |
| Output Parameter: |
| . its - number of iterations |
| Level: intermediate |
| Note: |
| D |