| Line 69... |
Line 69... |
This routine uses Gaussian elimination with partial pivoting to
|
This routine uses Gaussian elimination with partial pivoting to
|
compute the inverse explicitly.
|
compute the inverse explicitly.
|
*/
|
*/
|
static PetscErrorCode EPSHessCond(PetscScalar* H,int n, PetscReal* cond)
|
static PetscErrorCode EPSHessCond(PetscScalar* H,int n, PetscReal* cond)
|
{
|
{
|
|
#if defined(PETSC_MISSING_LAPACK_GETRF) || defined(SLEPC_MISSING_LAPACK_GETRI) || defined(SLEPC_MISSING_LAPACK_LANGE) || defined(SLEPC_MISSING_LAPACK_LANHS)
|
|
SETERRQ(PETSC_ERR_SUP,"GETRF,GETRI - Lapack routines are unavailable.");
|
|
#else
|
PetscErrorCode ierr;
|
PetscErrorCode ierr;
|
int *ipiv,lwork,info;
|
int *ipiv,lwork,info;
|
PetscScalar *work;
|
PetscScalar *work;
|
PetscReal hn,hin,*rwork;
|
PetscReal hn,hin,*rwork;
|
|
|
PetscFunctionBegin;
|
PetscFunctionBegin;
|
#if defined(PETSC_MISSING_LAPACK_GETRF)
|
|
SETERRQ(PETSC_ERR_SUP,"GETRF - Lapack routine is unavailable.");
|
|
#endif
|
|
ierr = PetscMalloc(sizeof(int)*n,&ipiv);CHKERRQ(ierr);
|
ierr = PetscMalloc(sizeof(int)*n,&ipiv);CHKERRQ(ierr);
|
lwork = n*n;
|
lwork = n*n;
|
ierr = PetscMalloc(sizeof(PetscScalar)*lwork,&work);CHKERRQ(ierr);
|
ierr = PetscMalloc(sizeof(PetscScalar)*lwork,&work);CHKERRQ(ierr);
|
ierr = PetscMalloc(sizeof(PetscReal)*n,&rwork);CHKERRQ(ierr);
|
ierr = PetscMalloc(sizeof(PetscReal)*n,&rwork);CHKERRQ(ierr);
|
hn = LAPACKlanhs_("I",&n,H,&n,rwork,1);
|
hn = LAPACKlanhs_("I",&n,H,&n,rwork,1);
|
| Line 93... |
Line 93... |
*cond = hn * hin;
|
*cond = hn * hin;
|
ierr = PetscFree(ipiv);CHKERRQ(ierr);
|
ierr = PetscFree(ipiv);CHKERRQ(ierr);
|
ierr = PetscFree(work);CHKERRQ(ierr);
|
ierr = PetscFree(work);CHKERRQ(ierr);
|
ierr = PetscFree(rwork);CHKERRQ(ierr);
|
ierr = PetscFree(rwork);CHKERRQ(ierr);
|
PetscFunctionReturn(0);
|
PetscFunctionReturn(0);
|
|
#endif
|
}
|
}
|
|
|
#undef __FUNCT__
|
#undef __FUNCT__
|
#define __FUNCT__ "EPSFindGroup"
|
#define __FUNCT__ "EPSFindGroup"
|
/*
|
/*
|
| Line 195... |
Line 196... |
|
|
#undef __FUNCT__
|
#undef __FUNCT__
|
#define __FUNCT__ "EPSSolve_SUBSPACE"
|
#define __FUNCT__ "EPSSolve_SUBSPACE"
|
PetscErrorCode EPSSolve_SUBSPACE(EPS eps)
|
PetscErrorCode EPSSolve_SUBSPACE(EPS eps)
|
{
|
{
|
|
#if defined(SLEPC_MISSING_LAPACK_GEHRD) || defined(SLEPC_MISSING_LAPACK_ORGHR) || defined(SLEPC_MISSING_LAPACK_UNGHR)
|
|
SETERRQ(PETSC_ERR_SUP,"GEHRD,ORGHR/UNGHR - Lapack routines are unavailable.");
|
|
#else
|
PetscErrorCode ierr;
|
PetscErrorCode ierr;
|
int i,j,ilo,lwork,info,ngrp,nogrp,*itrsd,*itrsdold,
|
int i,j,ilo,lwork,info,ngrp,nogrp,*itrsd,*itrsdold,
|
nxtsrr,idsrr,*iwork,idort,nxtort,ncv = eps->ncv;
|
nxtsrr,idsrr,*iwork,idort,nxtort,ncv = eps->ncv;
|
PetscScalar *T=eps->T,*U,*tau,*work,t;
|
PetscScalar *T=eps->T,*U,*tau,*work,t;
|
PetscReal arsd,oarsd,ctr,octr,ae,oae,*rsd,*rsdold,norm,tcond;
|
PetscReal arsd,oarsd,ctr,octr,ae,oae,*rsd,*rsdold,norm,tcond;
|
| Line 212... |
Line 216... |
cnvtol = 1e-6; /* Convergence criterion for cnv */
|
cnvtol = 1e-6; /* Convergence criterion for cnv */
|
int orttol = 2; /* Number of decimal digits whose loss
|
int orttol = 2; /* Number of decimal digits whose loss
|
can be tolerated in orthogonalization */
|
can be tolerated in orthogonalization */
|
|
|
PetscFunctionBegin;
|
PetscFunctionBegin;
|
#if defined(PETSC_BLASLAPACK_ESSL_ONLY)
|
|
SETERRQ(PETSC_ERR_SUP,"GEHRD,ORGHR - Lapack routines are unavailable.");
|
|
#endif
|
|
eps->its = 0;
|
eps->its = 0;
|
eps->nconv = 0;
|
eps->nconv = 0;
|
ierr = PetscMalloc(sizeof(PetscScalar)*ncv*ncv,&U);CHKERRQ(ierr);
|
ierr = PetscMalloc(sizeof(PetscScalar)*ncv*ncv,&U);CHKERRQ(ierr);
|
ierr = PetscMalloc(sizeof(PetscReal)*ncv,&rsd);CHKERRQ(ierr);
|
ierr = PetscMalloc(sizeof(PetscReal)*ncv,&rsd);CHKERRQ(ierr);
|
ierr = PetscMalloc(sizeof(PetscReal)*ncv,&rsdold);CHKERRQ(ierr);
|
ierr = PetscMalloc(sizeof(PetscReal)*ncv,&rsdold);CHKERRQ(ierr);
|
| Line 376... |
Line 377... |
|
|
if( eps->nconv == eps->nev ) eps->reason = EPS_CONVERGED_TOL;
|
if( eps->nconv == eps->nev ) eps->reason = EPS_CONVERGED_TOL;
|
else eps->reason = EPS_DIVERGED_ITS;
|
else eps->reason = EPS_DIVERGED_ITS;
|
|
|
PetscFunctionReturn(0);
|
PetscFunctionReturn(0);
|
|
#endif
|
}
|
}
|
|
|
EXTERN_C_BEGIN
|
EXTERN_C_BEGIN
|
#undef __FUNCT__
|
#undef __FUNCT__
|
#define __FUNCT__ "EPSCreate_SUBSPACE"
|
#define __FUNCT__ "EPSCreate_SUBSPACE"
|