/*
PEPComputeScaleFactor - compute sfactor as described in [Betcke 2008].
*/
PetscErrorCode PEPComputeScaleFactor(PEP pep)
{
PetscErrorCode ierr;
PetscBool has0,has1,flg;
PetscReal norm0,norm1;
Mat T[2];
PEPBasis basis;
PetscFunctionBegin;
if (pep->scale==PEP_SCALE_NONE || pep->scale==PEP_SCALE_DIAGONAL) { /* no scalar scaling */
pep->sfactor = 1.0;
PetscFunctionReturn(0);
}
if (pep->sfactor_set) PetscFunctionReturn(0); /* user provided value */
ierr = PEPGetBasis(pep,&basis);CHKERRQ(ierr);
if (basis==PEP_BASIS_MONOMIAL) {
ierr = STGetTransform(pep->st,&flg);CHKERRQ(ierr);
if (flg) {
ierr = STGetTOperators(pep->st,0,&T[0]);CHKERRQ(ierr);
ierr = STGetTOperators(pep->st,pep->nmat-1,&T[1]);CHKERRQ(ierr);
} else {
T[0] = pep->A[0];
T[1] = pep->A[pep->nmat-1];
}
if (pep->nmat>2) {
ierr = MatHasOperation(T[0],MATOP_NORM,&has0);CHKERRQ(ierr);
ierr = MatHasOperation(T[1],MATOP_NORM,&has1);CHKERRQ(ierr);
if (has0 && has1) {
ierr = MatNorm(T[0],NORM_INFINITY,&norm0);CHKERRQ(ierr);
ierr = MatNorm(T[1],NORM_INFINITY,&norm1);CHKERRQ(ierr);
pep->sfactor = PetscPowReal(norm0/norm1,1.0/(pep->nmat-1));
} else {
pep->sfactor = 1.0;
}
}
} else pep->sfactor = 1.0;
PetscFunctionReturn(0);
}
/*
PEPBuildDiagonalScaling - compute two diagonal matrices to be applied for balancing
in polynomial eigenproblems.
*/
PetscErrorCode PEPBuildDiagonalScaling(PEP pep)
{
PetscErrorCode ierr;
PetscInt it,i,j,k,nmat,nr,e,nz,lst,lend,nc=0,*cols,emax,emin,emaxl,eminl;
const PetscInt *cidx,*ridx;
Mat M,*T,A;
PetscMPIInt n;
PetscBool cont=PETSC_TRUE,flg=PETSC_FALSE;
PetscScalar *array,*Dr,*Dl,t;
PetscReal l2,d,*rsum,*aux,*csum,w=1.0;
MatStructure str;
MatInfo info;
PetscFunctionBegin;
l2 = 2*PetscLogReal(2.0);
nmat = pep->nmat;
ierr = PetscMPIIntCast(pep->n,&n);
ierr = STGetMatStructure(pep->st,&str);CHKERRQ(ierr);
ierr = PetscMalloc1(nmat,&T);CHKERRQ(ierr);
for (k=0;k<nmat;k++) {
ierr = STGetTOperators(pep->st,k,&T[k]);CHKERRQ(ierr);
}
/* Form local auxiliar matrix M */
ierr = PetscObjectTypeCompareAny((PetscObject)T[0],&cont,MATMPIAIJ,MATSEQAIJ);CHKERRQ(ierr);
if (!cont) SETERRQ(PetscObjectComm((PetscObject)T[0]),PETSC_ERR_SUP,"Only for MPIAIJ or SEQAIJ matrix types");
ierr = PetscObjectTypeCompare((PetscObject)T[0],MATMPIAIJ,&cont);CHKERRQ(ierr);
if (cont) {
ierr = MatMPIAIJGetLocalMat(T[0],MAT_INITIAL_MATRIX,&M);CHKERRQ(ierr);
flg = PETSC_TRUE;
} else {
ierr = MatDuplicate(T[0],MAT_COPY_VALUES,&M);CHKERRQ(ierr);
}
ierr = MatGetInfo(M,MAT_LOCAL,&info);CHKERRQ(ierr);
nz = info.nz_used;
ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr);
for (i=0;i<nz;i++) {
t = PetscAbsScalar(array[i]);
array[i] = t*t;
}
ierr = MatSeqAIJRestoreArray(M,&array);CHKERRQ(ierr);
for (k=1;k<nmat;k++) {
if (flg) {
ierr = MatMPIAIJGetLocalMat(T[k],MAT_INITIAL_MATRIX,&A);CHKERRQ(ierr);
} else {
if (str==SAME_NONZERO_PATTERN) {
ierr = MatCopy(T[k],A,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
} else {
ierr = MatDuplicate(T[k],MAT_COPY_VALUES,&A);CHKERRQ(ierr);
}
}
ierr = MatGetInfo(A,MAT_LOCAL,&info);CHKERRQ(ierr);
nz = info.nz_used;
ierr = MatSeqAIJGetArray(A,&array);CHKERRQ(ierr);
for (i=0;i<nz;i++) {
t = PetscAbsScalar(array[i]);
array[i] = t*t;
}
ierr = MatSeqAIJRestoreArray(A,&array);CHKERRQ(ierr);
w *= pep->slambda*pep->slambda*pep->sfactor;
ierr = MatAXPY(M,w,A,str);CHKERRQ(ierr);
if (flg || str!=SAME_NONZERO_PATTERN || k==nmat-2) {
ierr = MatDestroy(&A);CHKERRQ(ierr);
}
}
ierr = MatGetRowIJ(M,0,PETSC_FALSE,PETSC_FALSE,&nr,&ridx,&cidx,&cont);CHKERRQ(ierr);
if (!cont) SETERRQ(PetscObjectComm((PetscObject)T[0]), PETSC_ERR_SUP,"It is not possible to compute scaling diagonals for these PEP matrices");
ierr = MatGetInfo(M,MAT_LOCAL,&info);CHKERRQ(ierr);
nz = info.nz_used;
ierr = VecGetOwnershipRange(pep->Dl,&lst,&lend);CHKERRQ(ierr);
ierr = PetscMalloc4(nr,&rsum,pep->n,&csum,pep->n,&aux,PetscMin(pep->n-lend+lst,nz),&cols);CHKERRQ(ierr);
ierr = VecSet(pep->Dr,1.0);CHKERRQ(ierr);
ierr = VecSet(pep->Dl,1.0);CHKERRQ(ierr);
ierr = VecGetArray(pep->Dl,&Dl);CHKERRQ(ierr);
ierr = VecGetArray(pep->Dr,&Dr);CHKERRQ(ierr);
ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr);
ierr = PetscMemzero(aux,pep->n*sizeof(PetscReal));CHKERRQ(ierr);
for (j=0;j<nz;j++) {
/* Search non-zero columns outsize lst-lend */
if (aux[cidx[j]]==0 && (cidx[j]<lst || lend<=cidx[j])) cols[nc++] = cidx[j];
/* Local column sums */
aux[cidx[j]] += PetscAbsScalar(array[j]);
}
for (it=0;it<pep->sits && cont;it++) {
emaxl = 0; eminl = 0;
/* Column sum */
if (it>0) { /* it=0 has been already done*/
ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr);
ierr = PetscMemzero(aux,pep->n*sizeof(PetscReal));CHKERRQ(ierr);
for (j=0;j<nz;j++) aux[cidx[j]] += PetscAbsScalar(array[j]);
ierr = MatSeqAIJRestoreArray(M,&array);CHKERRQ(ierr);
}
ierr = MPI_Allreduce(aux,csum,n,MPIU_REAL,MPIU_SUM,PetscObjectComm((PetscObject)pep->Dr));
/* Update Dr */
for (j=lst;j<lend;j++) {
d = PetscLogReal(csum[j])/l2;
e = -(PetscInt)((d < 0)?(d-0.5):(d+0.5));
d = PetscPowReal(2.0,e);
Dr[j-lst] *= d;
aux[j] = d*d;
emaxl = PetscMax(emaxl,e);
eminl = PetscMin(eminl,e);
}
for (j=0;j<nc;j++) {
d = PetscLogReal(csum[cols[j]])/l2;
e = -(PetscInt)((d < 0)?(d-0.5):(d+0.5));
d = PetscPowReal(2.0,e);
aux[cols[j]] = d*d;
emaxl = PetscMax(emaxl,e);
eminl = PetscMin(eminl,e);
}
/* Scale M */
ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr);
for (j=0;j<nz;j++) {
array[j] *= aux[cidx[j]];
}
ierr = MatSeqAIJRestoreArray(M,&array);CHKERRQ(ierr);
/* Row sum */
ierr = PetscMemzero(rsum,nr*sizeof(PetscReal));CHKERRQ(ierr);
ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr);
for (i=0;i<nr;i++) {
for (j=ridx[i];j<ridx[i+1];j++) rsum[i] += PetscAbsScalar(array[j]);
/* Update Dl */
d = PetscLogReal(rsum[i])/l2;
e = -(PetscInt)((d < 0)?(d-0.5):(d+0.5));
d = PetscPowReal(2.0,e);
Dl[i] *= d;
/* Scale M */
for (j=ridx[i];j<ridx[i+1];j++) array[j] *= d*d;
emaxl = PetscMax(emaxl,e);
eminl = PetscMin(eminl,e);
}
ierr = MatSeqAIJRestoreArray(M,&array);CHKERRQ(ierr);
/* Compute global max and min */
ierr = MPI_Allreduce(&emaxl,&emax,1,MPIU_INT,MPIU_MAX,PetscObjectComm((PetscObject)pep->Dl));
ierr = MPI_Allreduce(&eminl,&emin,1,MPIU_INT,MPIU_MIN,PetscObjectComm((PetscObject)pep->Dl));
if (emax<=emin+2) cont = PETSC_FALSE;
}
ierr = VecRestoreArray(pep->Dr,&Dr);CHKERRQ(ierr);
ierr = VecRestoreArray(pep->Dl,&Dl);CHKERRQ(ierr);
/* Free memory*/
ierr = MatDestroy(&M);CHKERRQ(ierr);
ierr = PetscFree4(rsum,csum,aux,cols);CHKERRQ(ierr);
ierr = PetscFree(T);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PETSC_EXTERN void PETSC_STDCALL stgettoperators_(ST *st,PetscInt *k,Mat *T, int *__ierr ){
*__ierr = STGetTOperators(*st,*k,T);
}