PetscErrorCode kernel_func1(PetscInt myrank,PetscInt *ranks,PetscScalar *values)
{
values[myrank] *= 1;
printf("First Kernel:My rank is %d, x = %f\n",ranks[myrank],PetscRealPart(values[myrank]));
return(0);
}
int main(int argc,char **args)
{
Mat A,Atrans,sA,*submatA,*submatsA;
PetscErrorCode ierr;
PetscMPIInt size,rank;
PetscInt bs=1,mbs=10,ov=1,i,j,k,*rows,*cols,nd=2,*idx,rstart,rend,sz,M,N,Mbs;
PetscScalar *vals,rval,one=1.0;
IS *is1,*is2;
PetscRandom rand;
PetscBool flg,TestOverlap,TestSubMat,TestAllcols;
PetscInt vid = -1;
#if defined(PETSC_USE_LOG)
PetscLogStage stages[2];
#endif
PetscInitialize(&argc,&args,(char*)0,help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-mat_block_size",&bs,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-mat_mbs",&mbs,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-ov",&ov,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-nd",&nd,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-view_id",&vid,NULL);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,NULL, "-test_overlap", &TestOverlap);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,NULL, "-test_submat", &TestSubMat);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,NULL, "-test_allcols", &TestAllcols);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,mbs*bs,mbs*bs,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
ierr = MatSetType(A,MATBAIJ);CHKERRQ(ierr);
ierr = MatSeqBAIJSetPreallocation(A,bs,PETSC_DEFAULT,NULL);
ierr = MatMPIBAIJSetPreallocation(A,bs,PETSC_DEFAULT,NULL,PETSC_DEFAULT,NULL);CHKERRQ(ierr);
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rand);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rand);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&rstart,&rend);CHKERRQ(ierr);
ierr = MatGetSize(A,&M,&N);
Mbs = M/bs;
ierr = PetscMalloc1(bs,&rows);CHKERRQ(ierr);
ierr = PetscMalloc1(bs,&cols);CHKERRQ(ierr);
ierr = PetscMalloc1(bs*bs,&vals);CHKERRQ(ierr);
ierr = PetscMalloc1(M,&idx);CHKERRQ(ierr);
/* Now set blocks of values */
for (j=0; j<bs*bs; j++) vals[j] = 0.0;
for (i=0; i<Mbs; i++) {
cols[0] = i*bs; rows[0] = i*bs;
for (j=1; j<bs; j++) {
rows[j] = rows[j-1]+1;
cols[j] = cols[j-1]+1;
}
ierr = MatSetValues(A,bs,rows,bs,cols,vals,ADD_VALUES);CHKERRQ(ierr);
}
/* second, add random blocks */
for (i=0; i<20*bs; i++) {
ierr = PetscRandomGetValue(rand,&rval);CHKERRQ(ierr);
cols[0] = bs*(PetscInt)(PetscRealPart(rval)*Mbs);
ierr = PetscRandomGetValue(rand,&rval);CHKERRQ(ierr);
rows[0] = rstart + bs*(PetscInt)(PetscRealPart(rval)*mbs);
for (j=1; j<bs; j++) {
rows[j] = rows[j-1]+1;
cols[j] = cols[j-1]+1;
}
for (j=0; j<bs*bs; j++) {
ierr = PetscRandomGetValue(rand,&rval);CHKERRQ(ierr);
vals[j] = rval;
}
ierr = MatSetValues(A,bs,rows,bs,cols,vals,ADD_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* make A a symmetric matrix: A <- A^T + A */
ierr = MatTranspose(A,MAT_INITIAL_MATRIX, &Atrans);CHKERRQ(ierr);
ierr = MatAXPY(A,one,Atrans,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatDestroy(&Atrans);CHKERRQ(ierr);
ierr = MatTranspose(A,MAT_INITIAL_MATRIX, &Atrans);
ierr = MatEqual(A, Atrans, &flg);
if (flg) {
ierr = MatSetOption(A,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
} else SETERRQ(PETSC_COMM_SELF,1,"A+A^T is non-symmetric");
ierr = MatDestroy(&Atrans);CHKERRQ(ierr);
/* create a SeqSBAIJ matrix sA (= A) */
ierr = MatConvert(A,MATSBAIJ,MAT_INITIAL_MATRIX,&sA);CHKERRQ(ierr);
if (vid >= 0 && vid < size) {
if (!rank) printf("A: \n");
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
if (!rank) printf("sA: \n");
ierr = MatView(sA,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
/* Test sA==A through MatMult() */
ierr = MatMultEqual(A,sA,10,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Error in MatConvert(): A != sA");
/* Test MatIncreaseOverlap() */
ierr = PetscMalloc1(nd,&is1);CHKERRQ(ierr);
ierr = PetscMalloc1(nd,&is2);CHKERRQ(ierr);
for (i=0; i<nd; i++) {
if (!TestAllcols) {
ierr = PetscRandomGetValue(rand,&rval);CHKERRQ(ierr);
sz = (PetscInt)((0.5+0.2*PetscRealPart(rval))*mbs); /* 0.5*mbs < sz < 0.7*mbs */
for (j=0; j<sz; j++) {
ierr = PetscRandomGetValue(rand,&rval);CHKERRQ(ierr);
idx[j*bs] = bs*(PetscInt)(PetscRealPart(rval)*Mbs);
for (k=1; k<bs; k++) idx[j*bs+k] = idx[j*bs]+k;
}
ierr = ISCreateGeneral(PETSC_COMM_SELF,sz*bs,idx,PETSC_COPY_VALUES,is1+i);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,sz*bs,idx,PETSC_COPY_VALUES,is2+i);CHKERRQ(ierr);
if (rank == vid) {
ierr = PetscPrintf(PETSC_COMM_SELF," [%d] IS sz[%d]: %d\n",rank,i,sz);CHKERRQ(ierr);
ierr = ISView(is2[i],PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
}
} else { /* Test all rows and colums */
sz = M;
ierr = ISCreateStride(PETSC_COMM_SELF,sz,0,1,is1+i);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF,sz,0,1,is2+i);CHKERRQ(ierr);
if (rank == vid) {
PetscBool colflag;
ierr = ISIdentity(is2[i],&colflag);CHKERRQ(ierr);
printf("[%d] is2[%d], colflag %d\n",rank,(int)i,(int)colflag);
ierr = ISView(is2[i],PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
}
}
}
ierr = PetscLogStageRegister("MatOv_SBAIJ",&stages[0]);
ierr = PetscLogStageRegister("MatOv_BAIJ",&stages[1]);
/* Test MatIncreaseOverlap */
if (TestOverlap) {
ierr = PetscLogStagePush(stages[0]);CHKERRQ(ierr);
ierr = MatIncreaseOverlap(sA,nd,is2,ov);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
ierr = PetscLogStagePush(stages[1]);CHKERRQ(ierr);
ierr = MatIncreaseOverlap(A,nd,is1,ov);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
if (rank == vid) {
printf("\n[%d] IS from BAIJ:\n",rank);
ierr = ISView(is1[0],PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
printf("\n[%d] IS from SBAIJ:\n",rank);
ierr = ISView(is2[0],PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
}
for (i=0; i<nd; ++i) {
ierr = ISEqual(is1[i],is2[i],&flg);CHKERRQ(ierr);
if (!flg) {
if (!rank) {
ierr = ISSort(is1[i]);CHKERRQ(ierr);
/* ISView(is1[i],PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); */
ierr = ISSort(is2[i]);CHKERRQ(ierr);
/* ISView(is2[i],PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); */
}
SETERRQ1(PETSC_COMM_SELF,1,"i=%D, is1 != is2",i);
}
}
}
/* Test MatGetSubmatrices */
if (TestSubMat) {
for (i = 0; i < nd; ++i) {
ierr = ISSort(is1[i]);CHKERRQ(ierr);
ierr = ISSort(is2[i]);CHKERRQ(ierr);
}
ierr = MatGetSubMatrices(A,nd,is1,is1,MAT_INITIAL_MATRIX,&submatA);CHKERRQ(ierr);
ierr = MatGetSubMatrices(sA,nd,is2,is2,MAT_INITIAL_MATRIX,&submatsA);CHKERRQ(ierr);
ierr = MatMultEqual(A,sA,10,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"A != sA");
/* Now test MatGetSubmatrices with MAT_REUSE_MATRIX option */
ierr = MatGetSubMatrices(A,nd,is1,is1,MAT_REUSE_MATRIX,&submatA);CHKERRQ(ierr);
ierr = MatGetSubMatrices(sA,nd,is2,is2,MAT_REUSE_MATRIX,&submatsA);CHKERRQ(ierr);
ierr = MatMultEqual(A,sA,10,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"MatGetSubmatrices(): A != sA");
for (i=0; i<nd; ++i) {
ierr = MatDestroy(&submatA[i]);CHKERRQ(ierr);
ierr = MatDestroy(&submatsA[i]);CHKERRQ(ierr);
}
ierr = PetscFree(submatA);CHKERRQ(ierr);
ierr = PetscFree(submatsA);CHKERRQ(ierr);
}
/* Free allocated memory */
for (i=0; i<nd; ++i) {
ierr = ISDestroy(&is1[i]);CHKERRQ(ierr);
ierr = ISDestroy(&is2[i]);CHKERRQ(ierr);
}
ierr = PetscFree(is1);CHKERRQ(ierr);
ierr = PetscFree(is2);CHKERRQ(ierr);
ierr = PetscFree(idx);CHKERRQ(ierr);
ierr = PetscFree(rows);CHKERRQ(ierr);
ierr = PetscFree(cols);CHKERRQ(ierr);
ierr = PetscFree(vals);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&sA);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&rand);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
static PetscErrorCode KSPSolve_LSQR(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i,size1,size2;
PetscScalar rho,rhobar,phi,phibar,theta,c,s,tmp,tau;
PetscReal beta,alpha,rnorm;
Vec X,B,V,V1,U,U1,TMP,W,W2,SE,Z = NULL;
Mat Amat,Pmat;
KSP_LSQR *lsqr = (KSP_LSQR*)ksp->data;
PetscBool diagonalscale,nopreconditioner;
PetscFunctionBegin;
ierr = PCGetDiagonalScale(ksp->pc,&diagonalscale);CHKERRQ(ierr);
if (diagonalscale) SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"Krylov method %s does not support diagonal scaling",((PetscObject)ksp)->type_name);
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)ksp->pc,PCNONE,&nopreconditioner);CHKERRQ(ierr);
/* nopreconditioner =PETSC_FALSE; */
/* Calculate norm of right hand side */
ierr = VecNorm(ksp->vec_rhs,NORM_2,&lsqr->rhs_norm);CHKERRQ(ierr);
/* mark norm of matrix with negative number to indicate it has not yet been computed */
lsqr->anorm = -1.0;
/* vectors of length m, where system size is mxn */
B = ksp->vec_rhs;
U = lsqr->vwork_m[0];
U1 = lsqr->vwork_m[1];
/* vectors of length n */
X = ksp->vec_sol;
W = lsqr->vwork_n[0];
V = lsqr->vwork_n[1];
V1 = lsqr->vwork_n[2];
W2 = lsqr->vwork_n[3];
if (!nopreconditioner) Z = lsqr->vwork_n[4];
/* standard error vector */
SE = lsqr->se;
if (SE) {
ierr = VecGetSize(SE,&size1);CHKERRQ(ierr);
ierr = VecGetSize(X,&size2);CHKERRQ(ierr);
if (size1 != size2) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Standard error vector (size %d) does not match solution vector (size %d)",size1,size2);
ierr = VecSet(SE,0.0);CHKERRQ(ierr);
}
/* Compute initial residual, temporarily use work vector u */
if (!ksp->guess_zero) {
ierr = KSP_MatMult(ksp,Amat,X,U);CHKERRQ(ierr); /* u <- b - Ax */
ierr = VecAYPX(U,-1.0,B);CHKERRQ(ierr);
} else {
ierr = VecCopy(B,U);CHKERRQ(ierr); /* u <- b (x is 0) */
}
/* Test for nothing to do */
ierr = VecNorm(U,NORM_2,&rnorm);CHKERRQ(ierr);
ierr = PetscObjectSAWsTakeAccess((PetscObject)ksp);CHKERRQ(ierr);
ksp->its = 0;
ksp->rnorm = rnorm;
ierr = PetscObjectSAWsGrantAccess((PetscObject)ksp);CHKERRQ(ierr);
ierr = KSPLogResidualHistory(ksp,rnorm);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,0,rnorm);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,0,rnorm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) PetscFunctionReturn(0);
beta = rnorm;
ierr = VecScale(U,1.0/beta);CHKERRQ(ierr);
ierr = KSP_MatMultTranspose(ksp,Amat,U,V);CHKERRQ(ierr);
if (nopreconditioner) {
ierr = VecNorm(V,NORM_2,&alpha);CHKERRQ(ierr);
} else {
ierr = PCApply(ksp->pc,V,Z);CHKERRQ(ierr);
ierr = VecDotRealPart(V,Z,&alpha);CHKERRQ(ierr);
if (alpha <= 0.0) {
ksp->reason = KSP_DIVERGED_BREAKDOWN;
PetscFunctionReturn(0);
}
alpha = PetscSqrtReal(alpha);
ierr = VecScale(Z,1.0/alpha);CHKERRQ(ierr);
}
ierr = VecScale(V,1.0/alpha);CHKERRQ(ierr);
if (nopreconditioner) {
ierr = VecCopy(V,W);CHKERRQ(ierr);
} else {
ierr = VecCopy(Z,W);CHKERRQ(ierr);
}
lsqr->arnorm = alpha * beta;
phibar = beta;
rhobar = alpha;
i = 0;
do {
if (nopreconditioner) {
ierr = KSP_MatMult(ksp,Amat,V,U1);CHKERRQ(ierr);
} else {
ierr = KSP_MatMult(ksp,Amat,Z,U1);CHKERRQ(ierr);
}
ierr = VecAXPY(U1,-alpha,U);CHKERRQ(ierr);
ierr = VecNorm(U1,NORM_2,&beta);CHKERRQ(ierr);
if (beta > 0.0) {
ierr = VecScale(U1,1.0/beta);CHKERRQ(ierr); /* beta*U1 = Amat*V - alpha*U */
}
ierr = KSP_MatMultTranspose(ksp,Amat,U1,V1);CHKERRQ(ierr);
ierr = VecAXPY(V1,-beta,V);CHKERRQ(ierr);
if (nopreconditioner) {
ierr = VecNorm(V1,NORM_2,&alpha);CHKERRQ(ierr);
} else {
ierr = PCApply(ksp->pc,V1,Z);CHKERRQ(ierr);
ierr = VecDotRealPart(V1,Z,&alpha);CHKERRQ(ierr);
if (alpha <= 0.0) {
ksp->reason = KSP_DIVERGED_BREAKDOWN;
break;
}
alpha = PetscSqrtReal(alpha);
ierr = VecScale(Z,1.0/alpha);CHKERRQ(ierr);
}
ierr = VecScale(V1,1.0/alpha);CHKERRQ(ierr); /* alpha*V1 = Amat^T*U1 - beta*V */
rho = PetscSqrtScalar(rhobar*rhobar + beta*beta);
c = rhobar / rho;
s = beta / rho;
theta = s * alpha;
rhobar = -c * alpha;
phi = c * phibar;
phibar = s * phibar;
tau = s * phi;
ierr = VecAXPY(X,phi/rho,W);CHKERRQ(ierr); /* x <- x + (phi/rho) w */
if (SE) {
ierr = VecCopy(W,W2);CHKERRQ(ierr);
ierr = VecSquare(W2);CHKERRQ(ierr);
ierr = VecScale(W2,1.0/(rho*rho));CHKERRQ(ierr);
ierr = VecAXPY(SE, 1.0, W2);CHKERRQ(ierr); /* SE <- SE + (w^2/rho^2) */
}
if (nopreconditioner) {
ierr = VecAYPX(W,-theta/rho,V1);CHKERRQ(ierr); /* w <- v - (theta/rho) w */
} else {
ierr = VecAYPX(W,-theta/rho,Z);CHKERRQ(ierr); /* w <- z - (theta/rho) w */
}
lsqr->arnorm = alpha*PetscAbsScalar(tau);
rnorm = PetscRealPart(phibar);
ierr = PetscObjectSAWsTakeAccess((PetscObject)ksp);CHKERRQ(ierr);
ksp->its++;
ksp->rnorm = rnorm;
ierr = PetscObjectSAWsGrantAccess((PetscObject)ksp);CHKERRQ(ierr);
ierr = KSPLogResidualHistory(ksp,rnorm);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,i+1,rnorm);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,i+1,rnorm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) break;
SWAP(U1,U,TMP);
SWAP(V1,V,TMP);
i++;
} while (i<ksp->max_it);
if (i >= ksp->max_it && !ksp->reason) ksp->reason = KSP_DIVERGED_ITS;
/* Finish off the standard error estimates */
if (SE) {
tmp = 1.0;
ierr = MatGetSize(Amat,&size1,&size2);CHKERRQ(ierr);
if (size1 > size2) tmp = size1 - size2;
tmp = rnorm / PetscSqrtScalar(tmp);
ierr = VecSqrtAbs(SE);CHKERRQ(ierr);
ierr = VecScale(SE,tmp);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
KSPSolve_CG - This routine actually applies the conjugate gradient method
Note : this routine can be replaced with another one (see below) which implements
another variant of CG.
Input Parameter:
. ksp - the Krylov space object that was set to use conjugate gradient, by, for
example, KSPCreate(MPI_Comm,KSP *ksp); KSPSetType(ksp,KSPCG);
*/
static PetscErrorCode KSPSolve_CG(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i,stored_max_it,eigs;
PetscScalar dpi = 0.0,a = 1.0,beta,betaold = 1.0,b = 0,*e = 0,*d = 0,dpiold;
PetscReal dp = 0.0;
Vec X,B,Z,R,P,W;
KSP_CG *cg;
Mat Amat,Pmat;
PetscBool diagonalscale;
PetscFunctionBegin;
ierr = PCGetDiagonalScale(ksp->pc,&diagonalscale);CHKERRQ(ierr);
if (diagonalscale) SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"Krylov method %s does not support diagonal scaling",((PetscObject)ksp)->type_name);
cg = (KSP_CG*)ksp->data;
eigs = ksp->calc_sings;
stored_max_it = ksp->max_it;
X = ksp->vec_sol;
B = ksp->vec_rhs;
R = ksp->work[0];
Z = ksp->work[1];
P = ksp->work[2];
W = Z;
if (eigs) {e = cg->e; d = cg->d; e[0] = 0.0; }
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat);CHKERRQ(ierr);
ksp->its = 0;
if (!ksp->guess_zero) {
ierr = KSP_MatMult(ksp,Amat,X,R);CHKERRQ(ierr); /* r <- b - Ax */
ierr = VecAYPX(R,-1.0,B);CHKERRQ(ierr);
} else {
ierr = VecCopy(B,R);CHKERRQ(ierr); /* r <- b (x is 0) */
}
switch (ksp->normtype) {
case KSP_NORM_PRECONDITIONED:
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- z'*z = e'*A'*B'*B*A'*e' */
break;
case KSP_NORM_UNPRECONDITIONED:
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- r'*r = e'*A'*A*e */
break;
case KSP_NORM_NATURAL:
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- z'*r */
KSPCheckDot(ksp,beta);
dp = PetscSqrtReal(PetscAbsScalar(beta)); /* dp <- r'*z = r'*B*r = e'*A'*B*A*e */
break;
case KSP_NORM_NONE:
dp = 0.0;
break;
default: SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"%s",KSPNormTypes[ksp->normtype]);
}
ierr = KSPLogResidualHistory(ksp,dp);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,0,dp);CHKERRQ(ierr);
ksp->rnorm = dp;
ierr = (*ksp->converged)(ksp,0,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr); /* test for convergence */
if (ksp->reason) PetscFunctionReturn(0);
if (ksp->normtype != KSP_NORM_PRECONDITIONED && (ksp->normtype != KSP_NORM_NATURAL)) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
}
if (ksp->normtype != KSP_NORM_NATURAL) {
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- z'*r */
KSPCheckDot(ksp,beta);
}
i = 0;
do {
ksp->its = i+1;
if (beta == 0.0) {
ksp->reason = KSP_CONVERGED_ATOL;
ierr = PetscInfo(ksp,"converged due to beta = 0\n");CHKERRQ(ierr);
break;
#if !defined(PETSC_USE_COMPLEX)
} else if ((i > 0) && (beta*betaold < 0.0)) {
ksp->reason = KSP_DIVERGED_INDEFINITE_PC;
ierr = PetscInfo(ksp,"diverging due to indefinite preconditioner\n");CHKERRQ(ierr);
break;
#endif
}
if (!i) {
ierr = VecCopy(Z,P);CHKERRQ(ierr); /* p <- z */
b = 0.0;
} else {
b = beta/betaold;
if (eigs) {
if (ksp->max_it != stored_max_it) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"Can not change maxit AND calculate eigenvalues");
e[i] = PetscSqrtReal(PetscAbsScalar(b))/a;
}
ierr = VecAYPX(P,b,Z);CHKERRQ(ierr); /* p <- z + b* p */
}
dpiold = dpi;
ierr = KSP_MatMult(ksp,Amat,P,W);CHKERRQ(ierr); /* w <- Ap */
ierr = VecXDot(P,W,&dpi);CHKERRQ(ierr); /* dpi <- p'w */
KSPCheckDot(ksp,dpi);
betaold = beta;
if ((dpi == 0.0) || ((i > 0) && (PetscRealPart(dpi*dpiold) <= 0.0))) {
ksp->reason = KSP_DIVERGED_INDEFINITE_MAT;
ierr = PetscInfo(ksp,"diverging due to indefinite or negative definite matrix\n");CHKERRQ(ierr);
break;
}
a = beta/dpi; /* a = beta/p'w */
if (eigs) d[i] = PetscSqrtReal(PetscAbsScalar(b))*e[i] + 1.0/a;
ierr = VecAXPY(X,a,P);CHKERRQ(ierr); /* x <- x + ap */
ierr = VecAXPY(R,-a,W);CHKERRQ(ierr); /* r <- r - aw */
if (ksp->normtype == KSP_NORM_PRECONDITIONED && ksp->chknorm < i+2) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- z'*z */
} else if (ksp->normtype == KSP_NORM_UNPRECONDITIONED && ksp->chknorm < i+2) {
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- r'*r */
} else if (ksp->normtype == KSP_NORM_NATURAL) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- r'*z */
KSPCheckDot(ksp,beta);
dp = PetscSqrtReal(PetscAbsScalar(beta));
} else {
dp = 0.0;
}
ksp->rnorm = dp;
ierr = KSPLogResidualHistory(ksp,dp);CHKERRQ(ierr);
if (eigs) cg->ned = ksp->its;
ierr = KSPMonitor(ksp,i+1,dp);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,i+1,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) break;
if ((ksp->normtype != KSP_NORM_PRECONDITIONED && (ksp->normtype != KSP_NORM_NATURAL)) || (ksp->chknorm >= i+2)) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
}
if ((ksp->normtype != KSP_NORM_NATURAL) || (ksp->chknorm >= i+2)) {
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- z'*r */
KSPCheckDot(ksp,beta);
}
i++;
} while (i<ksp->max_it);
if (i >= ksp->max_it) ksp->reason = KSP_DIVERGED_ITS;
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
PetscMPIInt rank,size,*toranks,*fromranks,nto,nfrom;
PetscInt i,n;
PetscBool verbose,build_twosided_f;
Unit *todata,*fromdata;
MPI_Datatype dtype;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
verbose = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,NULL,"-verbose",&verbose,NULL);CHKERRQ(ierr);
build_twosided_f = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,NULL,"-build_twosided_f",&build_twosided_f,NULL);CHKERRQ(ierr);
for (i=1,nto=0; i<size; i*=2) nto++;
ierr = PetscMalloc2(nto,&todata,nto,&toranks);CHKERRQ(ierr);
for (n=0,i=1; i<size; n++,i*=2) {
toranks[n] = (rank+i) % size;
todata[n].rank = (rank+i) % size;
todata[n].value = (PetscScalar)rank;
todata[n].ok[0] = 'o';
todata[n].ok[1] = 'k';
todata[n].ok[2] = 0;
}
if (verbose) {
for (i=0; i<nto; i++) {
ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD,"[%d] TO %d: {%D, %g, \"%s\"}\n",rank,toranks[i],todata[i].rank,(double)PetscRealPart(todata[i].value),todata[i].ok);CHKERRQ(ierr);
}
ierr = PetscSynchronizedFlush(PETSC_COMM_WORLD,PETSC_STDOUT);CHKERRQ(ierr);
}
ierr = MakeDatatype(&dtype);CHKERRQ(ierr);
if (build_twosided_f) {
struct FCtx fctx;
PetscMPIInt *todummy,*fromdummy;
fctx.rank = rank;
fctx.nto = nto;
fctx.toranks = toranks;
fctx.todata = todata;
ierr = PetscSegBufferCreate(sizeof(Unit),1,&fctx.seg);CHKERRQ(ierr);
ierr = PetscMalloc1(nto,&todummy);CHKERRQ(ierr);
for (i=0; i<nto; i++) todummy[i] = rank;
ierr = PetscCommBuildTwoSidedF(PETSC_COMM_WORLD,1,MPI_INT,nto,toranks,todummy,&nfrom,&fromranks,&fromdummy,2,FSend,FRecv,&fctx);CHKERRQ(ierr);
ierr = PetscFree(todummy);CHKERRQ(ierr);
ierr = PetscFree(fromdummy);CHKERRQ(ierr);
ierr = PetscSegBufferExtractAlloc(fctx.seg,&fromdata);CHKERRQ(ierr);
ierr = PetscSegBufferDestroy(&fctx.seg);CHKERRQ(ierr);
} else {
ierr = PetscCommBuildTwoSided(PETSC_COMM_WORLD,1,dtype,nto,toranks,todata,&nfrom,&fromranks,&fromdata);CHKERRQ(ierr);
}
ierr = MPI_Type_free(&dtype);CHKERRQ(ierr);
if (verbose) {
PetscInt *iranks,*iperm;
ierr = PetscMalloc2(nfrom,&iranks,nfrom,&iperm);CHKERRQ(ierr);
for (i=0; i<nfrom; i++) {
iranks[i] = fromranks[i];
iperm[i] = i;
}
/* Receive ordering is non-deterministic in general, so sort to make verbose output deterministic. */
ierr = PetscSortIntWithPermutation(nfrom,iranks,iperm);CHKERRQ(ierr);
for (i=0; i<nfrom; i++) {
PetscInt ip = iperm[i];
ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD,"[%d] FROM %d: {%D, %g, \"%s\"}\n",rank,fromranks[ip],fromdata[ip].rank,(double)PetscRealPart(fromdata[ip].value),fromdata[ip].ok);CHKERRQ(ierr);
}
ierr = PetscSynchronizedFlush(PETSC_COMM_WORLD,PETSC_STDOUT);CHKERRQ(ierr);
ierr = PetscFree2(iranks,iperm);CHKERRQ(ierr);
}
if (nto != nfrom) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"[%d] From ranks %d does not match To ranks %d",rank,nto,nfrom);
for (i=1; i<size; i*=2) {
PetscMPIInt expected_rank = (rank-i+size)%size;
PetscBool flg;
for (n=0; n<nfrom; n++) {
if (expected_rank == fromranks[n]) goto found;
}
SETERRQ2(PETSC_COMM_WORLD,PETSC_ERR_PLIB,"[%d] Could not find expected from rank %d",rank,expected_rank);
found:
if (PetscRealPart(fromdata[n].value) != expected_rank) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"[%d] Got data %g from rank %d",rank,(double)PetscRealPart(fromdata[n].value),expected_rank);
ierr = PetscStrcmp(fromdata[n].ok,"ok",&flg);CHKERRQ(ierr);
if (!flg) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"[%d] Got string %s from rank %d",rank,fromdata[n].ok,expected_rank);
}
ierr = PetscFree2(todata,toranks);CHKERRQ(ierr);
ierr = PetscFree(fromdata);CHKERRQ(ierr);
ierr = PetscFree(fromranks);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
PetscErrorCode SVDSolve_TRLanczos(SVD svd)
{
PetscErrorCode ierr;
SVD_TRLANCZOS *lanczos = (SVD_TRLANCZOS*)svd->data;
PetscReal *alpha,*beta,lastbeta,norm;
PetscScalar *Q,*swork=NULL,*w;
PetscInt i,k,l,nv,ld;
Mat U,VT;
PetscBool conv;
BVOrthogType orthog;
PetscFunctionBegin;
/* allocate working space */
ierr = DSGetLeadingDimension(svd->ds,&ld);CHKERRQ(ierr);
ierr = BVGetOrthogonalization(svd->V,&orthog,NULL,NULL);CHKERRQ(ierr);
ierr = PetscMalloc1(ld,&w);CHKERRQ(ierr);
if (lanczos->oneside && orthog == BV_ORTHOG_CGS) {
ierr = PetscMalloc1(svd->ncv+1,&swork);CHKERRQ(ierr);
}
/* normalize start vector */
if (!svd->nini) {
ierr = BVSetRandomColumn(svd->V,0,svd->rand);CHKERRQ(ierr);
ierr = BVNormColumn(svd->V,0,NORM_2,&norm);CHKERRQ(ierr);
ierr = BVScaleColumn(svd->V,0,1.0/norm);CHKERRQ(ierr);
}
l = 0;
while (svd->reason == SVD_CONVERGED_ITERATING) {
svd->its++;
/* inner loop */
nv = PetscMin(svd->nconv+svd->mpd,svd->ncv);
ierr = BVSetActiveColumns(svd->V,svd->nconv,nv);CHKERRQ(ierr);
ierr = BVSetActiveColumns(svd->U,svd->nconv,nv);CHKERRQ(ierr);
ierr = DSGetArrayReal(svd->ds,DS_MAT_T,&alpha);CHKERRQ(ierr);
beta = alpha + ld;
if (lanczos->oneside) {
if (orthog == BV_ORTHOG_MGS) {
ierr = SVDOneSideTRLanczosMGS(svd,alpha,beta,svd->V,svd->U,svd->nconv,l,nv);CHKERRQ(ierr);
} else {
ierr = SVDOneSideTRLanczosCGS(svd,alpha,beta,svd->V,svd->U,svd->nconv,l,nv,swork);CHKERRQ(ierr);
}
} else {
ierr = SVDTwoSideLanczos(svd,alpha,beta,svd->V,svd->U,svd->nconv+l,nv);CHKERRQ(ierr);
}
lastbeta = beta[nv-1];
ierr = DSRestoreArrayReal(svd->ds,DS_MAT_T,&alpha);CHKERRQ(ierr);
ierr = BVScaleColumn(svd->V,nv,1.0/lastbeta);CHKERRQ(ierr);
/* compute SVD of general matrix */
ierr = DSSetDimensions(svd->ds,nv,nv,svd->nconv,svd->nconv+l);CHKERRQ(ierr);
if (l==0) {
ierr = DSSetState(svd->ds,DS_STATE_INTERMEDIATE);CHKERRQ(ierr);
} else {
ierr = DSSetState(svd->ds,DS_STATE_RAW);CHKERRQ(ierr);
}
ierr = DSSolve(svd->ds,w,NULL);CHKERRQ(ierr);
ierr = DSSort(svd->ds,w,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
/* compute error estimates */
k = 0;
conv = PETSC_TRUE;
ierr = DSGetArray(svd->ds,DS_MAT_U,&Q);CHKERRQ(ierr);
ierr = DSGetArrayReal(svd->ds,DS_MAT_T,&alpha);CHKERRQ(ierr);
beta = alpha + ld;
for (i=svd->nconv;i<nv;i++) {
svd->sigma[i] = PetscRealPart(w[i]);
beta[i] = PetscRealPart(Q[nv-1+i*ld])*lastbeta;
svd->errest[i] = PetscAbsScalar(beta[i]);
if (svd->sigma[i] > svd->tol) svd->errest[i] /= svd->sigma[i];
if (conv) {
if (svd->errest[i] < svd->tol) k++;
else conv = PETSC_FALSE;
}
}
ierr = DSRestoreArrayReal(svd->ds,DS_MAT_T,&alpha);CHKERRQ(ierr);
ierr = DSRestoreArray(svd->ds,DS_MAT_U,&Q);CHKERRQ(ierr);
/* check convergence and update l */
if (svd->its >= svd->max_it) svd->reason = SVD_DIVERGED_ITS;
if (svd->nconv+k >= svd->nsv) svd->reason = SVD_CONVERGED_TOL;
if (svd->reason != SVD_CONVERGED_ITERATING) l = 0;
else l = PetscMax((nv-svd->nconv-k)/2,0);
/* compute converged singular vectors and restart vectors */
ierr = DSGetMat(svd->ds,DS_MAT_VT,&VT);CHKERRQ(ierr);
ierr = BVMultInPlaceTranspose(svd->V,VT,svd->nconv,svd->nconv+k+l);CHKERRQ(ierr);
ierr = MatDestroy(&VT);CHKERRQ(ierr);
ierr = DSGetMat(svd->ds,DS_MAT_U,&U);CHKERRQ(ierr);
ierr = BVMultInPlace(svd->U,U,svd->nconv,svd->nconv+k+l);CHKERRQ(ierr);
ierr = MatDestroy(&U);CHKERRQ(ierr);
/* copy the last vector to be the next initial vector */
if (svd->reason == SVD_CONVERGED_ITERATING) {
ierr = BVCopyColumn(svd->V,nv,svd->nconv+k+l);CHKERRQ(ierr);
}
svd->nconv += k;
ierr = SVDMonitor(svd,svd->its,svd->nconv,svd->sigma,svd->errest,nv);CHKERRQ(ierr);
}
/* orthonormalize U columns in one side method */
if (lanczos->oneside) {
for (i=0;i<svd->nconv;i++) {
ierr = BVOrthogonalizeColumn(svd->U,i,NULL,&norm,NULL);CHKERRQ(ierr);
ierr = BVScaleColumn(svd->U,i,1.0/norm);CHKERRQ(ierr);
}
}
/* free working space */
ierr = PetscFree(w);CHKERRQ(ierr);
if (swork) { ierr = PetscFree(swork);CHKERRQ(ierr); }
PetscFunctionReturn(0);
}
PetscErrorCode StokesWriteSolution(Stokes *s)
{
PetscMPIInt size;
PetscInt n,i,j;
const PetscScalar *array;
PetscErrorCode ierr;
PetscFunctionBeginUser;
/* write data (*warning* only works sequential) */
MPI_Comm_size(MPI_COMM_WORLD,&size);
/*ierr = PetscPrintf(PETSC_COMM_WORLD," number of processors = %D\n",size);CHKERRQ(ierr);*/
if (size == 1) {
PetscViewer viewer;
ierr = VecGetArrayRead(s->x, &array);CHKERRQ(ierr);
ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD, "solution.dat", &viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer, "# x, y, u, v, p\n");CHKERRQ(ierr);
for (j = 0; j < s->ny; j++) {
for (i = 0; i < s->nx; i++) {
n = j*s->nx+i;
ierr = PetscViewerASCIIPrintf(viewer, "%.12g %.12g %.12g %.12g %.12g\n", (double)(i*s->hx+s->hx/2),(double)(j*s->hy+s->hy/2), (double)PetscRealPart(array[n]), (double)PetscRealPart(array[n+s->nx*s->ny]),(double)PetscRealPart(array[n+2*s->nx*s->ny]));CHKERRQ(ierr);
}
}
ierr = VecRestoreArrayRead(s->x, &array);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
Mat A,B;
Vec xx,s1,s2,yy;
PetscErrorCode ierr;
PetscInt m=45,rows[2],cols[2],bs=1,i,row,col,*idx,M;
PetscScalar rval,vals1[4],vals2[4];
PetscRandom rdm;
IS is1,is2;
PetscReal s1norm,s2norm,rnorm,tol = 1.e-4;
PetscBool flg;
MatFactorInfo info;
PetscInitialize(&argc,&args,(char*)0,help);
/* Test MatSetValues() and MatGetValues() */
ierr = PetscOptionsGetInt(NULL,"-mat_block_size",&bs,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-mat_size",&m,NULL);CHKERRQ(ierr);
M = m*bs;
ierr = MatCreateSeqBAIJ(PETSC_COMM_SELF,bs,M,M,1,NULL,&A);CHKERRQ(ierr);
ierr = MatSetOption(A,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,M,M,15,NULL,&B);CHKERRQ(ierr);
ierr = MatSetOption(B,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscRandomCreate(PETSC_COMM_SELF,&rdm);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rdm);CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_SELF,M,&xx);CHKERRQ(ierr);
ierr = VecDuplicate(xx,&s1);CHKERRQ(ierr);
ierr = VecDuplicate(xx,&s2);CHKERRQ(ierr);
ierr = VecDuplicate(xx,&yy);CHKERRQ(ierr);
/* For each row add atleast 15 elements */
for (row=0; row<M; row++) {
for (i=0; i<25*bs; i++) {
ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr);
col = (PetscInt)(PetscRealPart(rval)*M);
ierr = MatSetValues(A,1,&row,1,&col,&rval,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(B,1,&row,1,&col,&rval,INSERT_VALUES);CHKERRQ(ierr);
}
}
/* Now set blocks of values */
for (i=0; i<20*bs; i++) {
ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr);
cols[0] = (PetscInt)(PetscRealPart(rval)*M);
vals1[0] = rval;
ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr);
cols[1] = (PetscInt)(PetscRealPart(rval)*M);
vals1[1] = rval;
ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr);
rows[0] = (PetscInt)(PetscRealPart(rval)*M);
vals1[2] = rval;
ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr);
rows[1] = (PetscInt)(PetscRealPart(rval)*M);
vals1[3] = rval;
ierr = MatSetValues(A,2,rows,2,cols,vals1,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValues(B,2,rows,2,cols,vals1,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* Test MatNorm() */
ierr = MatNorm(A,NORM_FROBENIUS,&s1norm);CHKERRQ(ierr);
ierr = MatNorm(B,NORM_FROBENIUS,&s2norm);CHKERRQ(ierr);
rnorm = PetscAbsScalar(s2norm-s1norm)/s2norm;
if (rnorm>tol) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatNorm_FROBENIUS()- NormA=%16.14e NormB=%16.14e bs = %D\n",s1norm,s2norm,bs);CHKERRQ(ierr);
}
ierr = MatNorm(A,NORM_INFINITY,&s1norm);CHKERRQ(ierr);
ierr = MatNorm(B,NORM_INFINITY,&s2norm);CHKERRQ(ierr);
rnorm = PetscAbsScalar(s2norm-s1norm)/s2norm;
if (rnorm>tol) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatNorm_INFINITY()- NormA=%16.14e NormB=%16.14e bs = %D\n",s1norm,s2norm,bs);CHKERRQ(ierr);
}
ierr = MatNorm(A,NORM_1,&s1norm);CHKERRQ(ierr);
ierr = MatNorm(B,NORM_1,&s2norm);CHKERRQ(ierr);
rnorm = PetscAbsScalar(s2norm-s1norm)/s2norm;
if (rnorm>tol) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatNorm_NORM_1()- NormA=%16.14e NormB=%16.14e bs = %D\n",s1norm,s2norm,bs);CHKERRQ(ierr);
}
/* MatShift() */
rval = 10*s1norm;
ierr = MatShift(A,rval);CHKERRQ(ierr);
ierr = MatShift(B,rval);CHKERRQ(ierr);
/* Test MatTranspose() */
ierr = MatTranspose(A,MAT_REUSE_MATRIX,&A);CHKERRQ(ierr);
ierr = MatTranspose(B,MAT_REUSE_MATRIX,&B);CHKERRQ(ierr);
/* Now do MatGetValues() */
for (i=0; i<30; i++) {
ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr);
cols[0] = (PetscInt)(PetscRealPart(rval)*M);
ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr);
cols[1] = (PetscInt)(PetscRealPart(rval)*M);
ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr);
rows[0] = (PetscInt)(PetscRealPart(rval)*M);
ierr = PetscRandomGetValue(rdm,&rval);CHKERRQ(ierr);
rows[1] = (PetscInt)(PetscRealPart(rval)*M);
ierr = MatGetValues(A,2,rows,2,cols,vals1);CHKERRQ(ierr);
ierr = MatGetValues(B,2,rows,2,cols,vals2);CHKERRQ(ierr);
ierr = PetscMemcmp(vals1,vals2,4*sizeof(PetscScalar),&flg);CHKERRQ(ierr);
if (!flg) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatGetValues bs = %D\n",bs);CHKERRQ(ierr);
}
}
/* Test MatMult(), MatMultAdd() */
for (i=0; i<40; i++) {
ierr = VecSetRandom(xx,rdm);CHKERRQ(ierr);
ierr = VecSet(s2,0.0);CHKERRQ(ierr);
ierr = MatMult(A,xx,s1);CHKERRQ(ierr);
ierr = MatMultAdd(A,xx,s2,s2);CHKERRQ(ierr);
ierr = VecNorm(s1,NORM_2,&s1norm);CHKERRQ(ierr);
ierr = VecNorm(s2,NORM_2,&s2norm);CHKERRQ(ierr);
rnorm = s2norm-s1norm;
if (rnorm<-tol || rnorm>tol) {
ierr = PetscPrintf(PETSC_COMM_SELF,"MatMult not equal to MatMultAdd Norm1=%e Norm2=%e bs = %D\n",s1norm,s2norm,bs);CHKERRQ(ierr);
}
}
/* Test MatMult() */
ierr = MatMultEqual(A,B,10,&flg);CHKERRQ(ierr);
if (!flg) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatMult()\n");CHKERRQ(ierr);
}
/* Test MatMultAdd() */
ierr = MatMultAddEqual(A,B,10,&flg);CHKERRQ(ierr);
if (!flg) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatMultAdd()\n");CHKERRQ(ierr);
}
/* Test MatMultTranspose() */
ierr = MatMultTransposeEqual(A,B,10,&flg);CHKERRQ(ierr);
if (!flg) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatMultTranspose()\n");CHKERRQ(ierr);
}
/* Test MatMultTransposeAdd() */
ierr = MatMultTransposeAddEqual(A,B,10,&flg);CHKERRQ(ierr);
if (!flg) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error: MatMultTransposeAdd()\n");CHKERRQ(ierr);
}
/* Do LUFactor() on both the matrices */
ierr = PetscMalloc1(M,&idx);CHKERRQ(ierr);
for (i=0; i<M; i++) idx[i] = i;
ierr = ISCreateGeneral(PETSC_COMM_SELF,M,idx,PETSC_COPY_VALUES,&is1);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,M,idx,PETSC_COPY_VALUES,&is2);CHKERRQ(ierr);
ierr = PetscFree(idx);CHKERRQ(ierr);
ierr = ISSetPermutation(is1);CHKERRQ(ierr);
ierr = ISSetPermutation(is2);CHKERRQ(ierr);
ierr = MatFactorInfoInitialize(&info);CHKERRQ(ierr);
info.fill = 2.0;
info.dtcol = 0.0;
info.zeropivot = 1.e-14;
info.pivotinblocks = 1.0;
ierr = MatLUFactor(B,is1,is2,&info);CHKERRQ(ierr);
ierr = MatLUFactor(A,is1,is2,&info);CHKERRQ(ierr);
/* Test MatSolveAdd() */
for (i=0; i<10; i++) {
ierr = VecSetRandom(xx,rdm);CHKERRQ(ierr);
ierr = VecSetRandom(yy,rdm);CHKERRQ(ierr);
ierr = MatSolveAdd(B,xx,yy,s2);CHKERRQ(ierr);
ierr = MatSolveAdd(A,xx,yy,s1);CHKERRQ(ierr);
ierr = VecNorm(s1,NORM_2,&s1norm);CHKERRQ(ierr);
ierr = VecNorm(s2,NORM_2,&s2norm);CHKERRQ(ierr);
rnorm = s2norm-s1norm;
if (rnorm<-tol || rnorm>tol) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error:MatSolveAdd - Norm1=%16.14e Norm2=%16.14e bs = %D\n",s1norm,s2norm,bs);CHKERRQ(ierr);
}
}
/* Test MatSolveAdd() when x = A'b +x */
for (i=0; i<10; i++) {
ierr = VecSetRandom(xx,rdm);CHKERRQ(ierr);
ierr = VecSetRandom(s1,rdm);CHKERRQ(ierr);
ierr = VecCopy(s2,s1);CHKERRQ(ierr);
ierr = MatSolveAdd(B,xx,s2,s2);CHKERRQ(ierr);
ierr = MatSolveAdd(A,xx,s1,s1);CHKERRQ(ierr);
ierr = VecNorm(s1,NORM_2,&s1norm);CHKERRQ(ierr);
ierr = VecNorm(s2,NORM_2,&s2norm);CHKERRQ(ierr);
rnorm = s2norm-s1norm;
if (rnorm<-tol || rnorm>tol) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error:MatSolveAdd(same) - Norm1=%16.14e Norm2=%16.14e bs = %D\n",s1norm,s2norm,bs);CHKERRQ(ierr);
}
}
/* Test MatSolve() */
for (i=0; i<10; i++) {
ierr = VecSetRandom(xx,rdm);CHKERRQ(ierr);
ierr = MatSolve(B,xx,s2);CHKERRQ(ierr);
ierr = MatSolve(A,xx,s1);CHKERRQ(ierr);
ierr = VecNorm(s1,NORM_2,&s1norm);CHKERRQ(ierr);
ierr = VecNorm(s2,NORM_2,&s2norm);CHKERRQ(ierr);
rnorm = s2norm-s1norm;
if (rnorm<-tol || rnorm>tol) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error:MatSolve - Norm1=%16.14e Norm2=%16.14e bs = %D\n",s1norm,s2norm,bs);CHKERRQ(ierr);
}
}
/* Test MatSolveTranspose() */
if (bs < 8) {
for (i=0; i<10; i++) {
ierr = VecSetRandom(xx,rdm);CHKERRQ(ierr);
ierr = MatSolveTranspose(B,xx,s2);CHKERRQ(ierr);
ierr = MatSolveTranspose(A,xx,s1);CHKERRQ(ierr);
ierr = VecNorm(s1,NORM_2,&s1norm);CHKERRQ(ierr);
ierr = VecNorm(s2,NORM_2,&s2norm);CHKERRQ(ierr);
rnorm = s2norm-s1norm;
if (rnorm<-tol || rnorm>tol) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error:MatSolveTranspose - Norm1=%16.14e Norm2=%16.14e bs = %D\n",s1norm,s2norm,bs);CHKERRQ(ierr);
}
}
}
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = VecDestroy(&xx);CHKERRQ(ierr);
ierr = VecDestroy(&s1);CHKERRQ(ierr);
ierr = VecDestroy(&s2);CHKERRQ(ierr);
ierr = VecDestroy(&yy);CHKERRQ(ierr);
ierr = ISDestroy(&is1);CHKERRQ(ierr);
ierr = ISDestroy(&is2);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&rdm);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
/* Uses Anderson-Bjorck variant of regula falsi method */
PETSC_STATIC_INLINE PetscReal TSEventComputeStepSize(PetscReal tleft,PetscReal t,PetscReal tright,PetscScalar fleft,PetscScalar f,PetscScalar fright,PetscInt side,PetscReal dt)
{
PetscReal new_dt, scal = 1.0;
if (PetscRealPart(fleft)*PetscRealPart(f) < 0) {
if (side == 1) {
scal = (PetscRealPart(fright) - PetscRealPart(f))/PetscRealPart(fright);
if (scal < PETSC_SMALL) scal = 0.5;
}
new_dt = (scal*PetscRealPart(fleft)*t - PetscRealPart(f)*tleft)/(scal*PetscRealPart(fleft) - PetscRealPart(f)) - tleft;
} else {
if (side == -1) {
scal = (PetscRealPart(fleft) - PetscRealPart(f))/PetscRealPart(fleft);
if (scal < PETSC_SMALL) scal = 0.5;
}
new_dt = (PetscRealPart(f)*tright - scal*PetscRealPart(fright)*t)/(PetscRealPart(f) - scal*PetscRealPart(fright)) - t;
}
return PetscMin(dt,new_dt);
}
PetscErrorCode maxIndSetAgg(IS perm,Mat Gmat,PetscBool strict_aggs,PetscInt verbose,PetscCoarsenData **a_locals_llist)
{
PetscErrorCode ierr;
PetscBool isMPI;
Mat_SeqAIJ *matA, *matB = 0;
MPI_Comm comm;
Vec locState, ghostState;
PetscInt num_fine_ghosts,kk,n,ix,j,*idx,*ii,iter,Iend,my0,nremoved;
Mat_MPIAIJ *mpimat = 0;
PetscScalar *cpcol_gid,*cpcol_state;
PetscMPIInt mype,npe;
const PetscInt *perm_ix;
PetscInt nDone, nselected = 0;
const PetscInt nloc = Gmat->rmap->n;
PetscInt *lid_cprowID, *lid_gid;
PetscBool *lid_removed;
PetscScalar *lid_parent_gid = NULL; /* only used for strict aggs */
PetscScalar *lid_state;
PetscCoarsenData *agg_lists;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)Gmat,&comm);
CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm, &mype);
CHKERRQ(ierr);
ierr = MPI_Comm_size(comm, &npe);
CHKERRQ(ierr);
/* get submatrices */
ierr = PetscObjectTypeCompare((PetscObject)Gmat, MATMPIAIJ, &isMPI);
CHKERRQ(ierr);
if (isMPI) {
mpimat = (Mat_MPIAIJ*)Gmat->data;
matA = (Mat_SeqAIJ*)mpimat->A->data;
matB = (Mat_SeqAIJ*)mpimat->B->data;
/* force compressed storage of B */
ierr = MatCheckCompressedRow(mpimat->B,matB->nonzerorowcnt,&matB->compressedrow,matB->i,Gmat->rmap->n,-1.0);
CHKERRQ(ierr);
} else {
PetscBool isAIJ;
ierr = PetscObjectTypeCompare((PetscObject)Gmat, MATSEQAIJ, &isAIJ);
CHKERRQ(ierr);
matA = (Mat_SeqAIJ*)Gmat->data;
}
/* get vector */
ierr = MatGetVecs(Gmat, &locState, 0);
CHKERRQ(ierr);
ierr = MatGetOwnershipRange(Gmat,&my0,&Iend);
CHKERRQ(ierr);
if (mpimat) {
PetscInt gid;
for (kk=0,gid=my0; kk<nloc; kk++,gid++) {
PetscScalar v = (PetscScalar)(gid);
ierr = VecSetValues(locState, 1, &gid, &v, INSERT_VALUES);
CHKERRQ(ierr); /* set with GID */
}
ierr = VecAssemblyBegin(locState);
CHKERRQ(ierr);
ierr = VecAssemblyEnd(locState);
CHKERRQ(ierr);
ierr = VecScatterBegin(mpimat->Mvctx,locState,mpimat->lvec,INSERT_VALUES,SCATTER_FORWARD);
CHKERRQ(ierr);
ierr = VecScatterEnd(mpimat->Mvctx,locState,mpimat->lvec,INSERT_VALUES,SCATTER_FORWARD);
CHKERRQ(ierr);
ierr = VecGetArray(mpimat->lvec, &cpcol_gid);
CHKERRQ(ierr); /* get proc ID in 'cpcol_gid' */
ierr = VecDuplicate(mpimat->lvec, &ghostState);
CHKERRQ(ierr); /* need 2nd compressed col. of off proc data */
ierr = VecGetLocalSize(mpimat->lvec, &num_fine_ghosts);
CHKERRQ(ierr);
ierr = VecSet(ghostState, (PetscScalar)((PetscReal)NOT_DONE));
CHKERRQ(ierr); /* set with UNKNOWN state */
} else num_fine_ghosts = 0;
ierr = PetscMalloc(nloc*sizeof(PetscInt), &lid_cprowID);
CHKERRQ(ierr);
ierr = PetscMalloc((nloc+1)*sizeof(PetscInt), &lid_gid);
CHKERRQ(ierr); /* explicit array needed */
ierr = PetscMalloc(nloc*sizeof(PetscBool), &lid_removed);
CHKERRQ(ierr); /* explicit array needed */
if (strict_aggs) {
ierr = PetscMalloc((nloc+1)*sizeof(PetscScalar), &lid_parent_gid);
CHKERRQ(ierr);
}
ierr = PetscMalloc((nloc+1)*sizeof(PetscScalar), &lid_state);
CHKERRQ(ierr);
/* has ghost nodes for !strict and uses local indexing (yuck) */
ierr = PetscCDCreate(strict_aggs ? nloc : num_fine_ghosts+nloc, &agg_lists);
CHKERRQ(ierr);
if (a_locals_llist) *a_locals_llist = agg_lists;
/* need an inverse map - locals */
for (kk=0; kk<nloc; kk++) {
lid_cprowID[kk] = -1;
lid_removed[kk] = PETSC_FALSE;
if (strict_aggs) {
lid_parent_gid[kk] = -1.0;
}
lid_gid[kk] = kk + my0;
lid_state[kk] = (PetscScalar)((PetscReal)NOT_DONE);
}
/* set index into cmpressed row 'lid_cprowID' */
if (matB) {
for (ix=0; ix<matB->compressedrow.nrows; ix++) {
PetscInt lid = matB->compressedrow.rindex[ix];
lid_cprowID[lid] = ix;
}
}
/* MIS */
iter = nremoved = nDone = 0;
ierr = ISGetIndices(perm, &perm_ix);
CHKERRQ(ierr);
while (nDone < nloc || PETSC_TRUE) { /* asyncronous not implemented */
iter++;
if (mpimat) {
ierr = VecGetArray(ghostState, &cpcol_state);
CHKERRQ(ierr);
}
/* check all vertices */
for (kk=0; kk<nloc; kk++) {
PetscInt lid = perm_ix[kk];
NState state = (NState)PetscRealPart(lid_state[lid]);
if (lid_removed[lid]) continue;
if (state == NOT_DONE) {
/* parallel test, delete if selected ghost */
PetscBool isOK = PETSC_TRUE;
if ((ix=lid_cprowID[lid]) != -1) { /* if I have any ghost neighbors */
ii = matB->compressedrow.i;
n = ii[ix+1] - ii[ix];
idx = matB->j + ii[ix];
for (j=0; j<n; j++) {
PetscInt cpid = idx[j]; /* compressed row ID in B mat */
PetscInt gid = (PetscInt)PetscRealPart(cpcol_gid[cpid]);
NState statej = (NState)PetscRealPart(cpcol_state[cpid]);
if (statej == NOT_DONE && gid >= Iend) { /* should be (pe>mype), use gid as pe proxy */
isOK = PETSC_FALSE; /* can not delete */
break;
}
}
} /* parallel test */
if (isOK) { /* select or remove this vertex */
nDone++;
/* check for singleton */
ii = matA->i;
n = ii[lid+1] - ii[lid];
if (n < 2) {
/* if I have any ghost adj then not a sing */
ix = lid_cprowID[lid];
if (ix==-1 || (matB->compressedrow.i[ix+1]-matB->compressedrow.i[ix])==0) {
nremoved++;
lid_removed[lid] = PETSC_TRUE;
/* should select this because it is technically in the MIS but lets not */
/* lid_state[lid] = (PetscScalar)(lid+my0); */
continue; /* one local adj (me) and no ghost - singleton */
}
}
/* SELECTED state encoded with global index */
lid_state[lid] = (PetscScalar)(lid+my0); /* needed???? */
nselected++;
if (strict_aggs) {
ierr = PetscCDAppendID(agg_lists, lid, lid+my0);
CHKERRQ(ierr);
} else {
ierr = PetscCDAppendID(agg_lists, lid, lid);
CHKERRQ(ierr);
}
/* delete local adj */
idx = matA->j + ii[lid];
for (j=0; j<n; j++) {
PetscInt lidj = idx[j];
NState statej = (NState)PetscRealPart(lid_state[lidj]);
if (statej == NOT_DONE) {
nDone++;
/* id_llist[lidj] = id_llist[lid]; id_llist[lid] = lidj; */ /* insert 'lidj' into head of llist */
if (strict_aggs) {
ierr = PetscCDAppendID(agg_lists, lid, lidj+my0);
CHKERRQ(ierr);
} else {
ierr = PetscCDAppendID(agg_lists, lid, lidj);
CHKERRQ(ierr);
}
lid_state[lidj] = (PetscScalar)(PetscReal)DELETED; /* delete this */
}
}
/* delete ghost adj of lid - deleted ghost done later for strict_aggs */
if (!strict_aggs) {
if ((ix=lid_cprowID[lid]) != -1) { /* if I have any ghost neighbors */
ii = matB->compressedrow.i;
n = ii[ix+1] - ii[ix];
idx = matB->j + ii[ix];
for (j=0; j<n; j++) {
PetscInt cpid = idx[j]; /* compressed row ID in B mat */
NState statej = (NState)PetscRealPart(cpcol_state[cpid]);
if (statej == NOT_DONE) {
/* cpcol_state[cpid] = (PetscScalar)DELETED; this should happen later ... */
/* id_llist[lidj] = id_llist[lid]; id_llist[lid] = lidj; */ /* insert 'lidj' into head of llist */
ierr = PetscCDAppendID(agg_lists, lid, nloc+cpid);
CHKERRQ(ierr);
}
}
}
}
} /* selected */
} /* not done vertex */
} /* vertex loop */
/* update ghost states and count todos */
if (mpimat) {
ierr = VecRestoreArray(ghostState, &cpcol_state);
CHKERRQ(ierr);
/* put lid state in 'locState' */
ierr = VecSetValues(locState, nloc, lid_gid, lid_state, INSERT_VALUES);
CHKERRQ(ierr);
ierr = VecAssemblyBegin(locState);
CHKERRQ(ierr);
ierr = VecAssemblyEnd(locState);
CHKERRQ(ierr);
/* scatter states, check for done */
ierr = VecScatterBegin(mpimat->Mvctx,locState,ghostState,INSERT_VALUES,SCATTER_FORWARD);
CHKERRQ(ierr);
ierr = VecScatterEnd(mpimat->Mvctx,locState,ghostState,INSERT_VALUES,SCATTER_FORWARD);
CHKERRQ(ierr);
/* delete locals from selected ghosts */
ierr = VecGetArray(ghostState, &cpcol_state);
CHKERRQ(ierr);
ii = matB->compressedrow.i;
for (ix=0; ix<matB->compressedrow.nrows; ix++) {
PetscInt lid = matB->compressedrow.rindex[ix]; /* local boundary node */
NState state = (NState)PetscRealPart(lid_state[lid]);
if (state == NOT_DONE) {
/* look at ghosts */
n = ii[ix+1] - ii[ix];
idx = matB->j + ii[ix];
for (j=0; j<n; j++) {
PetscInt cpid = idx[j]; /* compressed row ID in B mat */
NState statej = (NState)PetscRealPart(cpcol_state[cpid]);
if (IS_SELECTED(statej)) { /* lid is now deleted, do it */
nDone++;
lid_state[lid] = (PetscScalar)(PetscReal)DELETED; /* delete this */
if (!strict_aggs) {
PetscInt lidj = nloc + cpid;
/* id_llist[lid] = id_llist[lidj]; id_llist[lidj] = lid; */ /* insert 'lid' into head of ghost llist */
ierr = PetscCDAppendID(agg_lists, lidj, lid);
CHKERRQ(ierr);
} else {
PetscInt sgid = (PetscInt)PetscRealPart(cpcol_gid[cpid]);
lid_parent_gid[lid] = (PetscScalar)sgid; /* keep track of proc that I belong to */
}
break;
}
}
}
}
ierr = VecRestoreArray(ghostState, &cpcol_state);
CHKERRQ(ierr);
/* all done? */
{
PetscInt t1, t2;
t1 = nloc - nDone;
ierr = MPI_Allreduce(&t1, &t2, 1, MPIU_INT, MPI_SUM, comm);
CHKERRQ(ierr); /* synchronous version */
if (t2 == 0) break;
}
} else break; /* all done */
} /* outer parallel MIS loop */
ierr = ISRestoreIndices(perm,&perm_ix);
CHKERRQ(ierr);
if (verbose) {
if (verbose == 1) {
ierr = PetscPrintf(comm,"\t[%d]%s removed %d of %d vertices. %d selected.\n",mype,__FUNCT__,nremoved,nloc,nselected);
CHKERRQ(ierr);
} else {
ierr = MPI_Allreduce(&nremoved, &n, 1, MPIU_INT, MPI_SUM, comm);
CHKERRQ(ierr);
ierr = MatGetSize(Gmat, &kk, &j);
CHKERRQ(ierr);
ierr = MPI_Allreduce(&nselected, &j, 1, MPIU_INT, MPI_SUM, comm);
CHKERRQ(ierr);
ierr = PetscPrintf(comm,"\t[%d]%s removed %d of %d vertices. (%d local) %d selected.\n",mype,__FUNCT__,n,kk,nremoved,j);
CHKERRQ(ierr);
}
}
/* tell adj who my lid_parent_gid vertices belong to - fill in agg_lists selected ghost lists */
if (strict_aggs && matB) {
PetscScalar *cpcol_sel_gid;
PetscInt cpid,*icpcol_gid;
/* need to copy this to free buffer -- should do this globaly */
ierr = PetscMalloc(num_fine_ghosts*sizeof(PetscInt), &icpcol_gid);
CHKERRQ(ierr);
for (cpid=0; cpid<num_fine_ghosts; cpid++) icpcol_gid[cpid] = (PetscInt)PetscRealPart(cpcol_gid[cpid]);
/* get proc of deleted ghost */
ierr = VecSetValues(locState, nloc, lid_gid, lid_parent_gid, INSERT_VALUES);
CHKERRQ(ierr);
ierr = VecAssemblyBegin(locState);
CHKERRQ(ierr);
ierr = VecAssemblyEnd(locState);
CHKERRQ(ierr);
ierr = VecScatterBegin(mpimat->Mvctx,locState,mpimat->lvec,INSERT_VALUES,SCATTER_FORWARD);
CHKERRQ(ierr);
ierr = VecScatterEnd(mpimat->Mvctx,locState,mpimat->lvec,INSERT_VALUES,SCATTER_FORWARD);
CHKERRQ(ierr);
ierr = VecGetArray(mpimat->lvec, &cpcol_sel_gid);
CHKERRQ(ierr); /* has pe that owns ghost */
for (cpid=0; cpid<num_fine_ghosts; cpid++) {
PetscInt sgid = (PetscInt)PetscRealPart(cpcol_sel_gid[cpid]);
PetscInt gid = icpcol_gid[cpid];
if (sgid >= my0 && sgid < Iend) { /* I own this deleted */
PetscInt slid = sgid - my0;
/* id_llist[lidj] = id_llist[lid]; id_llist[lid] = lidj; */ /* insert 'lidj' into head of llist */
ierr = PetscCDAppendID(agg_lists, slid, gid);
CHKERRQ(ierr);
}
}
ierr = VecRestoreArray(mpimat->lvec, &cpcol_sel_gid);
CHKERRQ(ierr);
ierr = PetscFree(icpcol_gid);
CHKERRQ(ierr);
} else if (matB) {
ierr = VecRestoreArray(mpimat->lvec, &cpcol_gid);
CHKERRQ(ierr);
}
/* cache IS of removed nodes, use 'lid_gid' */
/* for (kk=n=0,ix=my0;kk<nloc;kk++,ix++) { */
/* if (lid_removed[kk]) lid_gid[n++] = ix; */
/* } */
/* ierr = PetscCDSetRemovedIS(agg_lists, comm, n, lid_gid);CHKERRQ(ierr); */
ierr = PetscFree(lid_cprowID);
CHKERRQ(ierr);
ierr = PetscFree(lid_gid);
CHKERRQ(ierr);
ierr = PetscFree(lid_removed);
CHKERRQ(ierr);
if (strict_aggs) {
ierr = PetscFree(lid_parent_gid);
CHKERRQ(ierr);
}
ierr = PetscFree(lid_state);
CHKERRQ(ierr);
if (mpimat) {
ierr = VecDestroy(&ghostState);
CHKERRQ(ierr);
}
ierr = VecDestroy(&locState);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
Vec x,b,u;
Mat A; /* linear system matrix */
KSP ksp; /* linear solver context */
PetscRandom rctx; /* random number generator context */
PetscReal norm; /* norm of solution error */
PetscInt i,j,k,l,n = 27,its,bs = 2,Ii,J;
PetscErrorCode ierr;
PetscScalar v;
ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr;
ierr = PetscOptionsGetInt(NULL,NULL,"-bs",&bs,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,n*bs,n*bs,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetBlockSize(A,bs);CHKERRQ(ierr);
ierr = MatSetType(A,MATSEQBAIJ);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
/*
Don't bother to preallocate matrix
*/
ierr = PetscRandomCreate(PETSC_COMM_SELF,&rctx);CHKERRQ(ierr);
for (i=0; i<n; i++) {
for (j=0; j<n; j++) {
ierr = PetscRandomGetValue(rctx,&v);CHKERRQ(ierr);
if (PetscRealPart(v) < .25 || i == j) {
for (k=0; k<bs; k++) {
for (l=0; l<bs; l++) {
ierr = PetscRandomGetValue(rctx,&v);CHKERRQ(ierr);
Ii = i*bs + k;
J = j*bs + l;
if (Ii == J) v += 10.;
ierr = MatSetValue(A,Ii,J,v,INSERT_VALUES);CHKERRQ(ierr);
}
}
}
}
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_WORLD,&u);CHKERRQ(ierr);
ierr = VecSetSizes(u,PETSC_DECIDE,n*bs);CHKERRQ(ierr);
ierr = VecSetFromOptions(u);CHKERRQ(ierr);
ierr = VecDuplicate(u,&b);CHKERRQ(ierr);
ierr = VecDuplicate(b,&x);CHKERRQ(ierr);
ierr = VecSet(u,1.0);CHKERRQ(ierr);
ierr = MatMult(A,u,b);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the linear solver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create linear solver context
*/
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
/*
Set operators. Here the matrix that defines the linear system
also serves as the preconditioning matrix.
*/
ierr = KSPSetOperators(ksp,A,A);CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the linear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Check solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Check the error
*/
ierr = VecAXPY(x,-1.0,u);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr);
/*
Print convergence information. PetscPrintf() produces a single
print statement from all processes that share a communicator.
An alternative is PetscFPrintf(), which prints to a file.
*/
if (norm > .1) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of residual %g iterations %D bs %D\n",(double)norm,its,bs);CHKERRQ(ierr);
}
/*
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
*/
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr);
/*
Always call PetscFinalize() before exiting a program. This routine
- finalizes the PETSc libraries as well as MPI
- provides summary and diagnostic information if certain runtime
options are chosen (e.g., -log_summary).
*/
ierr = PetscFinalize();
return ierr;
}
int main(int argc,char **argv)
{
Mat A,B,M,mat[2];
ST st;
Vec v,w;
STType type;
PetscScalar value[3],sigma,tau;
PetscInt n=10,i,Istart,Iend,col[3];
PetscBool FirstBlock=PETSC_FALSE,LastBlock=PETSC_FALSE;
PetscErrorCode ierr;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n1-D Laplacian plus diagonal, n=%D\n\n",n);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the operator matrix for the 1-D Laplacian
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&B);CHKERRQ(ierr);
ierr = MatSetSizes(B,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(B);CHKERRQ(ierr);
ierr = MatSetUp(B);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
if (Istart==0) FirstBlock=PETSC_TRUE;
if (Iend==n) LastBlock=PETSC_TRUE;
value[0]=-1.0; value[1]=2.0; value[2]=-1.0;
for (i=(FirstBlock? Istart+1: Istart); i<(LastBlock? Iend-1: Iend); i++) {
col[0]=i-1; col[1]=i; col[2]=i+1;
ierr = MatSetValues(A,1,&i,3,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(B,i,i,(PetscScalar)i,INSERT_VALUES);CHKERRQ(ierr);
}
if (LastBlock) {
i=n-1; col[0]=n-2; col[1]=n-1;
ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(B,i,i,(PetscScalar)i,INSERT_VALUES);CHKERRQ(ierr);
}
if (FirstBlock) {
i=0; col[0]=0; col[1]=1; value[0]=2.0; value[1]=-1.0;
ierr = MatSetValues(A,1,&i,2,col,value,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatSetValue(B,i,i,-1.0,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatGetVecs(A,&v,&w);CHKERRQ(ierr);
ierr = VecSet(v,1.0);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the spectral transformation object
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = STCreate(PETSC_COMM_WORLD,&st);CHKERRQ(ierr);
mat[0] = A;
mat[1] = B;
ierr = STSetOperators(st,2,mat);CHKERRQ(ierr);
ierr = STSetFromOptions(st);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Apply the transformed operator for several ST's
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* shift, sigma=0.0 */
ierr = STSetUp(st);CHKERRQ(ierr);
ierr = STGetType(st,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"ST type %s\n",type);CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* shift, sigma=0.1 */
sigma = 0.1;
ierr = STSetShift(st,sigma);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g\n",(double)PetscRealPart(sigma));CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* sinvert, sigma=0.1 */
ierr = STPostSolve(st);CHKERRQ(ierr); /* undo changes if inplace */
ierr = STSetType(st,STSINVERT);CHKERRQ(ierr);
ierr = STGetType(st,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"ST type %s\n",type);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g\n",(double)PetscRealPart(sigma));CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* sinvert, sigma=-0.5 */
sigma = -0.5;
ierr = STSetShift(st,sigma);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g\n",(double)PetscRealPart(sigma));CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* cayley, sigma=-0.5, tau=-0.5 (equal to sigma by default) */
ierr = STPostSolve(st);CHKERRQ(ierr); /* undo changes if inplace */
ierr = STSetType(st,STCAYLEY);CHKERRQ(ierr);
ierr = STSetUp(st);CHKERRQ(ierr);
ierr = STGetType(st,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"ST type %s\n",type);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = STCayleyGetAntishift(st,&tau);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g, antishift=%g\n",(double)PetscRealPart(sigma),(double)PetscRealPart(tau));CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* cayley, sigma=1.1, tau=1.1 (still equal to sigma) */
sigma = 1.1;
ierr = STSetShift(st,sigma);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = STCayleyGetAntishift(st,&tau);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g, antishift=%g\n",(double)PetscRealPart(sigma),(double)PetscRealPart(tau));CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* cayley, sigma=1.1, tau=-1.0 */
tau = -1.0;
ierr = STCayleySetAntishift(st,tau);CHKERRQ(ierr);
ierr = STGetShift(st,&sigma);CHKERRQ(ierr);
ierr = STCayleyGetAntishift(st,&tau);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"With shift=%g, antishift=%g\n",(double)PetscRealPart(sigma),(double)PetscRealPart(tau));CHKERRQ(ierr);
ierr = STApply(st,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Check inner product matrix in Cayley
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = STGetBilinearForm(st,&M);CHKERRQ(ierr);
ierr = MatMult(M,v,w);CHKERRQ(ierr);
ierr = VecView(w,NULL);CHKERRQ(ierr);
ierr = STDestroy(&st);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = MatDestroy(&M);CHKERRQ(ierr);
ierr = VecDestroy(&v);CHKERRQ(ierr);
ierr = VecDestroy(&w);CHKERRQ(ierr);
ierr = SlepcFinalize();
return 0;
}
PetscErrorCode VecView_Seq_ASCII(Vec xin,PetscViewer viewer)
{
PetscErrorCode ierr;
PetscInt i,n = xin->map->n;
const char *name;
PetscViewerFormat format;
const PetscScalar *xv;
PetscFunctionBegin;
ierr = VecGetArrayRead(xin,&xv);CHKERRQ(ierr);
ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
if (format == PETSC_VIEWER_ASCII_MATLAB) {
ierr = PetscObjectGetName((PetscObject)xin,&name);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"%s = [\n",name);CHKERRQ(ierr);
for (i=0; i<n; i++) {
#if defined(PETSC_USE_COMPLEX)
if (PetscImaginaryPart(xv[i]) > 0.0) {
ierr = PetscViewerASCIIPrintf(viewer,"%18.16e + %18.16ei\n",(double)PetscRealPart(xv[i]),(double)PetscImaginaryPart(xv[i]));CHKERRQ(ierr);
} else if (PetscImaginaryPart(xv[i]) < 0.0) {
ierr = PetscViewerASCIIPrintf(viewer,"%18.16e - %18.16ei\n",(double)PetscRealPart(xv[i]),-(double)PetscImaginaryPart(xv[i]));CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer,"%18.16e\n",(double)PetscRealPart(xv[i]));CHKERRQ(ierr);
}
#else
ierr = PetscViewerASCIIPrintf(viewer,"%18.16e\n",(double) xv[i]);CHKERRQ(ierr);
#endif
}
ierr = PetscViewerASCIIPrintf(viewer,"];\n");CHKERRQ(ierr);
} else if (format == PETSC_VIEWER_ASCII_SYMMODU) {
for (i=0; i<n; i++) {
#if defined(PETSC_USE_COMPLEX)
ierr = PetscViewerASCIIPrintf(viewer,"%18.16e %18.16e\n",(double)PetscRealPart(xv[i]),(double)PetscImaginaryPart(xv[i]));CHKERRQ(ierr);
#else
ierr = PetscViewerASCIIPrintf(viewer,"%18.16e\n",(double)xv[i]);CHKERRQ(ierr);
#endif
}
} else if (format == PETSC_VIEWER_ASCII_VTK || format == PETSC_VIEWER_ASCII_VTK_CELL) {
/*
state 0: No header has been output
state 1: Only POINT_DATA has been output
state 2: Only CELL_DATA has been output
state 3: Output both, POINT_DATA last
state 4: Output both, CELL_DATA last
*/
static PetscInt stateId = -1;
int outputState = 0;
PetscBool hasState;
int doOutput = 0;
PetscInt bs, b;
if (stateId < 0) {
ierr = PetscObjectComposedDataRegister(&stateId);CHKERRQ(ierr);
}
ierr = PetscObjectComposedDataGetInt((PetscObject) viewer, stateId, outputState, hasState);CHKERRQ(ierr);
if (!hasState) outputState = 0;
ierr = PetscObjectGetName((PetscObject) xin, &name);CHKERRQ(ierr);
ierr = VecGetBlockSize(xin, &bs);CHKERRQ(ierr);
if ((bs < 1) || (bs > 3)) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE, "VTK can only handle 3D objects, but vector dimension is %d", bs);
if (format == PETSC_VIEWER_ASCII_VTK) {
if (outputState == 0) {
outputState = 1;
doOutput = 1;
} else if (outputState == 1) doOutput = 0;
else if (outputState == 2) {
outputState = 3;
doOutput = 1;
} else if (outputState == 3) doOutput = 0;
else if (outputState == 4) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE, "Tried to output POINT_DATA again after intervening CELL_DATA");
if (doOutput) {
ierr = PetscViewerASCIIPrintf(viewer, "POINT_DATA %d\n", n/bs);CHKERRQ(ierr);
}
} else {
if (outputState == 0) {
outputState = 2;
doOutput = 1;
} else if (outputState == 1) {
outputState = 4;
doOutput = 1;
} else if (outputState == 2) doOutput = 0;
else if (outputState == 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE, "Tried to output CELL_DATA again after intervening POINT_DATA");
else if (outputState == 4) doOutput = 0;
if (doOutput) {
ierr = PetscViewerASCIIPrintf(viewer, "CELL_DATA %d\n", n);CHKERRQ(ierr);
}
}
ierr = PetscObjectComposedDataSetInt((PetscObject) viewer, stateId, outputState);CHKERRQ(ierr);
if (name) {
if (bs == 3) {
ierr = PetscViewerASCIIPrintf(viewer, "VECTORS %s double\n", name);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer, "SCALARS %s double %d\n", name, bs);CHKERRQ(ierr);
}
} else {
ierr = PetscViewerASCIIPrintf(viewer, "SCALARS scalars double %d\n", bs);CHKERRQ(ierr);
}
if (bs != 3) {
ierr = PetscViewerASCIIPrintf(viewer, "LOOKUP_TABLE default\n");CHKERRQ(ierr);
}
for (i=0; i<n/bs; i++) {
for (b=0; b<bs; b++) {
if (b > 0) {
ierr = PetscViewerASCIIPrintf(viewer," ");CHKERRQ(ierr);
}
#if !defined(PETSC_USE_COMPLEX)
ierr = PetscViewerASCIIPrintf(viewer,"%g",(double)xv[i*bs+b]);CHKERRQ(ierr);
#endif
}
ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
}
} else if (format == PETSC_VIEWER_ASCII_VTK_COORDS) {
PetscInt bs, b;
ierr = VecGetBlockSize(xin, &bs);CHKERRQ(ierr);
if ((bs < 1) || (bs > 3)) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE, "VTK can only handle 3D objects, but vector dimension is %d", bs);
for (i=0; i<n/bs; i++) {
for (b=0; b<bs; b++) {
if (b > 0) {
ierr = PetscViewerASCIIPrintf(viewer," ");CHKERRQ(ierr);
}
#if !defined(PETSC_USE_COMPLEX)
ierr = PetscViewerASCIIPrintf(viewer,"%g",(double)xv[i*bs+b]);CHKERRQ(ierr);
#endif
}
for (b=bs; b<3; b++) {
ierr = PetscViewerASCIIPrintf(viewer," 0.0");CHKERRQ(ierr);
}
ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
}
} else if (format == PETSC_VIEWER_ASCII_PCICE) {
PetscInt bs, b;
ierr = VecGetBlockSize(xin, &bs);CHKERRQ(ierr);
if ((bs < 1) || (bs > 3)) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE, "PCICE can only handle up to 3D objects, but vector dimension is %d", bs);
ierr = PetscViewerASCIIPrintf(viewer,"%D\n", xin->map->N/bs);CHKERRQ(ierr);
for (i=0; i<n/bs; i++) {
ierr = PetscViewerASCIIPrintf(viewer,"%7D ", i+1);CHKERRQ(ierr);
for (b=0; b<bs; b++) {
if (b > 0) {
ierr = PetscViewerASCIIPrintf(viewer," ");CHKERRQ(ierr);
}
#if !defined(PETSC_USE_COMPLEX)
ierr = PetscViewerASCIIPrintf(viewer,"% 12.5E",(double)xv[i*bs+b]);CHKERRQ(ierr);
#endif
}
ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr);
}
} else if (format == PETSC_VIEWER_ASCII_INFO || format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
/* No info */
} else {
for (i=0; i<n; i++) {
if (format == PETSC_VIEWER_ASCII_INDEX) {
ierr = PetscViewerASCIIPrintf(viewer,"%D: ",i);CHKERRQ(ierr);
}
#if defined(PETSC_USE_COMPLEX)
if (PetscImaginaryPart(xv[i]) > 0.0) {
ierr = PetscViewerASCIIPrintf(viewer,"%g + %g i\n",(double)PetscRealPart(xv[i]),(double)PetscImaginaryPart(xv[i]));CHKERRQ(ierr);
} else if (PetscImaginaryPart(xv[i]) < 0.0) {
ierr = PetscViewerASCIIPrintf(viewer,"%g - %g i\n",(double)PetscRealPart(xv[i]),-(double)PetscImaginaryPart(xv[i]));CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer,"%g\n",(double)PetscRealPart(xv[i]));CHKERRQ(ierr);
}
#else
ierr = PetscViewerASCIIPrintf(viewer,"%g\n",(double)xv[i]);CHKERRQ(ierr);
#endif
}
}
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(xin,&xv);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
Mat C,A;
PetscInt i,j,m = 3,n = 2,Ii,J,rstart,rend,nz;
PetscMPIInt rank,size;
PetscErrorCode ierr;
const PetscInt *idx;
PetscScalar v;
const PetscScalar *values;
PetscInitialize(&argc,&args,(char *)0,help);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
n = 2*size;
/* create the matrix for the five point stencil, YET AGAIN*/
ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr);
ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,m*n,m*n);CHKERRQ(ierr);
ierr = MatSetFromOptions(C);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(C,5,PETSC_NULL,5,PETSC_NULL);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(C,5,PETSC_NULL);CHKERRQ(ierr);
for (i=0; i<m; i++) {
for (j=2*rank; j<2*rank+2; j++) {
v = -1.0; Ii = j + n*i;
if (i>0) {J = Ii - n; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);}
if (i<m-1) {J = Ii + n; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);}
if (j>0) {J = Ii - 1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);}
if (j<n-1) {J = Ii + 1; ierr = MatSetValues(C,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);}
v = 4.0; ierr = MatSetValues(C,1,&Ii,1,&Ii,&v,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO);CHKERRQ(ierr);
ierr = MatView(C,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = MatView(C,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(C,&rstart,&rend);CHKERRQ(ierr);
for (i=rstart; i<rend; i++) {
ierr = MatGetRow(C,i,&nz,&idx,&values);CHKERRQ(ierr);
ierr = PetscSynchronizedFPrintf(PETSC_COMM_WORLD,stdout,"[%d] get row %D: ",rank,i);CHKERRQ(ierr);
for (j=0; j<nz; j++) {
ierr = PetscSynchronizedFPrintf(PETSC_COMM_WORLD,stdout,"%D %G ",idx[j],PetscRealPart(values[j]));CHKERRQ(ierr);
}
ierr = PetscSynchronizedFPrintf(PETSC_COMM_WORLD,stdout,"\n");CHKERRQ(ierr);
ierr = MatRestoreRow(C,i,&nz,&idx,&values);CHKERRQ(ierr);
}
ierr = PetscSynchronizedFlush(PETSC_COMM_WORLD);CHKERRQ(ierr);CHKERRQ(ierr);
ierr = MatConvert(C,MATSAME,MAT_INITIAL_MATRIX,&A);CHKERRQ(ierr);
ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO);CHKERRQ(ierr);
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
int main(int argc, char **argv)
{
AppCtx ctx;
PetscErrorCode (**funcs)(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nf, PetscScalar *u, void *ctx);
DM dm;
PetscFE fe;
DMInterpolationInfo interpolator;
Vec lu, fieldVals;
PetscScalar *vals;
const PetscScalar *ivals, *vcoords;
PetscReal *pcoords;
PetscBool pointsAllProcs=PETSC_TRUE;
PetscInt spaceDim, c, Np, p;
PetscMPIInt rank, size;
PetscViewer selfviewer;
PetscErrorCode ierr;
ierr = PetscInitialize(&argc, &argv, NULL,help);if (ierr) return ierr;
ierr = ProcessOptions(PETSC_COMM_WORLD, &ctx);CHKERRQ(ierr);
ierr = CreateMesh(PETSC_COMM_WORLD, &ctx, &dm);CHKERRQ(ierr);
ierr = DMGetCoordinateDim(dm, &spaceDim);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD, &rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD, &size);CHKERRQ(ierr);
/* Create points */
ierr = CreatePoints(dm, &Np, &pcoords, &pointsAllProcs, &ctx);CHKERRQ(ierr);
/* Create interpolator */
ierr = DMInterpolationCreate(PETSC_COMM_WORLD, &interpolator);CHKERRQ(ierr);
ierr = DMInterpolationSetDim(interpolator, spaceDim);CHKERRQ(ierr);
ierr = DMInterpolationAddPoints(interpolator, Np, pcoords);CHKERRQ(ierr);
ierr = DMInterpolationSetUp(interpolator, dm, pointsAllProcs);CHKERRQ(ierr);
/* Check locations */
for (c = 0; c < interpolator->n; ++c) {
ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD, "[%d]Point %D is in Cell %D\n", rank, c, interpolator->cells[c]);CHKERRQ(ierr);
}
ierr = PetscSynchronizedFlush(PETSC_COMM_WORLD, NULL);CHKERRQ(ierr);
ierr = VecView(interpolator->coords, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* Setup Discretization */
ierr = PetscFECreateDefault(PetscObjectComm((PetscObject) dm), ctx.dim, Nc, ctx.cellSimplex, NULL, -1, &fe);CHKERRQ(ierr);
ierr = DMSetField(dm, 0, NULL, (PetscObject) fe);CHKERRQ(ierr);
ierr = DMCreateDS(dm);CHKERRQ(ierr);
ierr = PetscFEDestroy(&fe);CHKERRQ(ierr);
/* Create function */
ierr = PetscCalloc2(Nc, &funcs, Nc, &vals);CHKERRQ(ierr);
for (c = 0; c < Nc; ++c) funcs[c] = linear;
ierr = DMGetLocalVector(dm, &lu);CHKERRQ(ierr);
ierr = DMProjectFunctionLocal(dm, 0.0, funcs, NULL, INSERT_ALL_VALUES, lu);CHKERRQ(ierr);
ierr = PetscViewerASCIIPushSynchronized(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscViewerGetSubViewer(PETSC_VIEWER_STDOUT_WORLD,PETSC_COMM_SELF,&selfviewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(selfviewer, "[%d]solution\n", rank);CHKERRQ(ierr);
ierr = VecView(lu,selfviewer);CHKERRQ(ierr);
ierr = PetscViewerRestoreSubViewer(PETSC_VIEWER_STDOUT_WORLD,PETSC_COMM_SELF,&selfviewer);CHKERRQ(ierr);
ierr = PetscViewerFlush(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscViewerASCIIPopSynchronized(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* Check interpolant */
ierr = VecCreateSeq(PETSC_COMM_SELF, interpolator->n * Nc, &fieldVals);CHKERRQ(ierr);
ierr = DMInterpolationSetDof(interpolator, Nc);CHKERRQ(ierr);
ierr = DMInterpolationEvaluate(interpolator, dm, lu, fieldVals);CHKERRQ(ierr);
for (p = 0; p < size; ++p) {
if (p == rank) {
ierr = PetscPrintf(PETSC_COMM_SELF, "[%d]Field values\n", rank);CHKERRQ(ierr);
ierr = VecView(fieldVals, PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
}
ierr = PetscBarrier((PetscObject) dm);CHKERRQ(ierr);
}
ierr = VecGetArrayRead(interpolator->coords, &vcoords);CHKERRQ(ierr);
ierr = VecGetArrayRead(fieldVals, &ivals);CHKERRQ(ierr);
for (p = 0; p < interpolator->n; ++p) {
for (c = 0; c < Nc; ++c) {
#if defined(PETSC_USE_COMPLEX)
PetscReal vcoordsReal[3];
PetscInt i;
for (i = 0; i < spaceDim; i++) vcoordsReal[i] = PetscRealPart(vcoords[p * spaceDim + i]);
#else
const PetscReal *vcoordsReal = &vcoords[p*spaceDim];
#endif
(*funcs[c])(ctx.dim, 0.0, vcoordsReal, 1, vals, NULL);
if (PetscAbsScalar(ivals[p*Nc+c] - vals[c]) > PETSC_SQRT_MACHINE_EPSILON)
SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid interpolated value %g != %g (%D, %D)", (double) PetscRealPart(ivals[p*Nc+c]), (double) PetscRealPart(vals[c]), p, c);
}
}
ierr = VecRestoreArrayRead(interpolator->coords, &vcoords);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(fieldVals, &ivals);CHKERRQ(ierr);
/* Cleanup */
ierr = PetscFree(pcoords);CHKERRQ(ierr);
ierr = PetscFree2(funcs, vals);CHKERRQ(ierr);
ierr = VecDestroy(&fieldVals);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm, &lu);CHKERRQ(ierr);
ierr = DMInterpolationDestroy(&interpolator);CHKERRQ(ierr);
ierr = DMDestroy(&dm);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
PetscErrorCode TSEventHandler(TS ts)
{
PetscErrorCode ierr;
TSEvent event;
PetscReal t;
Vec U;
PetscInt i;
PetscReal dt,dt_min;
PetscInt rollback=0,in[2],out[2];
PetscInt fvalue_sign,fvalueprev_sign;
PetscFunctionBegin;
PetscValidHeaderSpecific(ts,TS_CLASSID,1);
if (!ts->event) PetscFunctionReturn(0);
event = ts->event;
ierr = TSGetTime(ts,&t);CHKERRQ(ierr);
ierr = TSGetTimeStep(ts,&dt);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&U);CHKERRQ(ierr);
if (event->status == TSEVENT_NONE) {
if (ts->steps == 1) /* After first successful step */
event->timestep_orig = ts->ptime - ts->ptime_prev;
event->timestep_prev = dt;
}
if (event->status == TSEVENT_RESET_NEXTSTEP) {
/* Restore time step */
dt = PetscMin(event->timestep_orig,event->timestep_prev);
ierr = TSSetTimeStep(ts,dt);CHKERRQ(ierr);
event->status = TSEVENT_NONE;
}
if (event->status == TSEVENT_NONE) {
event->ptime_end = t;
}
ierr = (*event->eventhandler)(ts,t,U,event->fvalue,event->ctx);CHKERRQ(ierr);
for (i=0; i < event->nevents; i++) {
if (PetscAbsScalar(event->fvalue[i]) < event->vtol[i]) {
event->status = TSEVENT_ZERO;
event->fvalue_right[i] = event->fvalue[i];
continue;
}
fvalue_sign = PetscSign(PetscRealPart(event->fvalue[i]));
fvalueprev_sign = PetscSign(PetscRealPart(event->fvalue_prev[i]));
if (fvalueprev_sign != 0 && (fvalue_sign != fvalueprev_sign) && (PetscAbsScalar(event->fvalue_prev[i]) > event->vtol[i])) {
switch (event->direction[i]) {
case -1:
if (fvalue_sign < 0) {
rollback = 1;
/* Compute new time step */
dt = TSEventComputeStepSize(event->ptime_prev,t,event->ptime_right,event->fvalue_prev[i],event->fvalue[i],event->fvalue_right[i],event->side[i],dt);
if (event->monitor) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: iter %D - Event %D interval detected [%g - %g]\n",event->iterctr,i,(double)event->ptime_prev,(double)t);CHKERRQ(ierr);
}
event->fvalue_right[i] = event->fvalue[i];
event->side[i] = 1;
if (!event->iterctr) event->zerocrossing[i] = PETSC_TRUE;
event->status = TSEVENT_LOCATED_INTERVAL;
}
break;
case 1:
if (fvalue_sign > 0) {
rollback = 1;
/* Compute new time step */
dt = TSEventComputeStepSize(event->ptime_prev,t,event->ptime_right,event->fvalue_prev[i],event->fvalue[i],event->fvalue_right[i],event->side[i],dt);
if (event->monitor) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: iter %D - Event %D interval detected [%g - %g]\n",event->iterctr,i,(double)event->ptime_prev,(double)t);CHKERRQ(ierr);
}
event->fvalue_right[i] = event->fvalue[i];
event->side[i] = 1;
if (!event->iterctr) event->zerocrossing[i] = PETSC_TRUE;
event->status = TSEVENT_LOCATED_INTERVAL;
}
break;
case 0:
rollback = 1;
/* Compute new time step */
dt = TSEventComputeStepSize(event->ptime_prev,t,event->ptime_right,event->fvalue_prev[i],event->fvalue[i],event->fvalue_right[i],event->side[i],dt);
if (event->monitor) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: iter %D - Event %D interval detected [%g - %g]\n",event->iterctr,i,(double)event->ptime_prev,(double)t);CHKERRQ(ierr);
}
event->fvalue_right[i] = event->fvalue[i];
event->side[i] = 1;
if (!event->iterctr) event->zerocrossing[i] = PETSC_TRUE;
event->status = TSEVENT_LOCATED_INTERVAL;
break;
}
}
}
in[0] = event->status; in[1] = rollback;
ierr = MPIU_Allreduce(in,out,2,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)ts));CHKERRQ(ierr);
event->status = (TSEventStatus)out[0]; rollback = out[1];
if (rollback) event->status = TSEVENT_LOCATED_INTERVAL;
event->nevents_zero = 0;
if (event->status == TSEVENT_ZERO) {
for (i=0; i < event->nevents; i++) {
if (PetscAbsScalar(event->fvalue[i]) < event->vtol[i]) {
event->events_zero[event->nevents_zero++] = i;
if (event->monitor) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: Event %D zero crossing at time %g located in %D iterations\n",i,(double)t,event->iterctr);CHKERRQ(ierr);
}
event->zerocrossing[i] = PETSC_FALSE;
}
event->side[i] = 0;
}
ierr = TSPostEvent(ts,t,U);CHKERRQ(ierr);
dt = event->ptime_end - t;
if (PetscAbsReal(dt) < PETSC_SMALL) dt += PetscMin(event->timestep_orig,event->timestep_prev); /* XXX Should be done better */
ierr = TSSetTimeStep(ts,dt);CHKERRQ(ierr);
event->iterctr = 0;
PetscFunctionReturn(0);
}
if (event->status == TSEVENT_LOCATED_INTERVAL) {
ierr = TSRollBack(ts);CHKERRQ(ierr);
ierr = TSSetConvergedReason(ts,TS_CONVERGED_ITERATING);CHKERRQ(ierr);
event->status = TSEVENT_PROCESSING;
event->ptime_right = t;
} else {
for (i=0; i < event->nevents; i++) {
if (event->status == TSEVENT_PROCESSING && event->zerocrossing[i]) {
/* Compute new time step */
dt = TSEventComputeStepSize(event->ptime_prev,t,event->ptime_right,event->fvalue_prev[i],event->fvalue[i],event->fvalue_right[i],event->side[i],dt);
event->side[i] = -1;
}
event->fvalue_prev[i] = event->fvalue[i];
}
if (event->monitor && event->status == TSEVENT_PROCESSING) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: iter %D - Stepping forward as no event detected in interval [%g - %g]\n",event->iterctr,(double)event->ptime_prev,(double)t);CHKERRQ(ierr);
}
event->ptime_prev = t;
}
if (event->status == TSEVENT_PROCESSING) event->iterctr++;
ierr = MPIU_Allreduce(&dt,&dt_min,1,MPIU_REAL,MPIU_MIN,PetscObjectComm((PetscObject)ts));CHKERRQ(ierr);
ierr = TSSetTimeStep(ts,dt_min);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode SVDOneSideTRLanczosCGS(SVD svd,PetscReal *alpha,PetscReal *beta,BV V,BV U,PetscInt nconv,PetscInt l,PetscInt n,PetscScalar* work)
{
PetscErrorCode ierr;
PetscReal a,b,eta;
PetscScalar gamma;
PetscInt i,j,k=nconv+l;
Vec ui,ui1,vi;
BVOrthogRefineType refine;
PetscFunctionBegin;
ierr = BVGetColumn(V,k,&vi);CHKERRQ(ierr);
ierr = BVGetColumn(U,k,&ui);CHKERRQ(ierr);
ierr = SVDMatMult(svd,PETSC_FALSE,vi,ui);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,k,&vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(U,k,&ui);CHKERRQ(ierr);
if (l>0) {
ierr = BVMultColumn(U,-1.0,1.0,k,&gamma);CHKERRQ(ierr);
beta[nconv] = PetscRealPart(gamma);
}
ierr = BVGetOrthogonalization(V,NULL,&refine,&eta);CHKERRQ(ierr);
for (i=k+1;i<n;i++) {
ierr = BVGetColumn(V,i,&vi);CHKERRQ(ierr);
ierr = BVGetColumn(U,i-1,&ui1);CHKERRQ(ierr);
ierr = SVDMatMult(svd,PETSC_TRUE,ui1,vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,i,&vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(U,i-1,&ui1);CHKERRQ(ierr);
ierr = BVNormColumn(U,i-1,NORM_2,&a);CHKERRQ(ierr);
if (refine == BV_ORTHOG_REFINE_IFNEEDED) {
ierr = BVSetActiveColumns(V,0,i+1);CHKERRQ(ierr);
ierr = BVGetColumn(V,i,&vi);CHKERRQ(ierr);
ierr = BVDotVec(V,vi,work);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,i,&vi);CHKERRQ(ierr);
ierr = BVSetActiveColumns(V,0,i);CHKERRQ(ierr);
} else {
ierr = BVSetActiveColumns(V,0,i);CHKERRQ(ierr);
ierr = BVDotColumn(V,i,work);CHKERRQ(ierr);
}
ierr = BVScaleColumn(U,i-1,1.0/a);CHKERRQ(ierr);
for (j=0;j<i;j++) work[j] = work[j] / a;
ierr = BVMultColumn(V,-1.0,1.0/a,i,work);CHKERRQ(ierr);
ierr = SVDOrthogonalizeCGS(V,i,work,a,refine,eta,&b);CHKERRQ(ierr);
ierr = BVScaleColumn(V,i,1.0/b);CHKERRQ(ierr);
ierr = BVGetColumn(V,i,&vi);CHKERRQ(ierr);
ierr = BVGetColumn(U,i,&ui);CHKERRQ(ierr);
ierr = BVGetColumn(U,i-1,&ui1);CHKERRQ(ierr);
ierr = SVDMatMult(svd,PETSC_FALSE,vi,ui);CHKERRQ(ierr);
ierr = VecAXPY(ui,-b,ui1);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,i,&vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(U,i,&ui);CHKERRQ(ierr);
ierr = BVRestoreColumn(U,i-1,&ui1);CHKERRQ(ierr);
alpha[i-1] = a;
beta[i-1] = b;
}
ierr = BVGetColumn(V,n,&vi);CHKERRQ(ierr);
ierr = BVGetColumn(U,n-1,&ui1);CHKERRQ(ierr);
ierr = SVDMatMult(svd,PETSC_TRUE,ui1,vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,n,&vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(U,n-1,&ui1);CHKERRQ(ierr);
ierr = BVNormColumn(svd->U,n-1,NORM_2,&a);CHKERRQ(ierr);
if (refine == BV_ORTHOG_REFINE_IFNEEDED) {
ierr = BVSetActiveColumns(V,0,n+1);CHKERRQ(ierr);
ierr = BVGetColumn(V,n,&vi);CHKERRQ(ierr);
ierr = BVDotVec(V,vi,work);CHKERRQ(ierr);
ierr = BVRestoreColumn(V,n,&vi);CHKERRQ(ierr);
} else {
ierr = BVSetActiveColumns(V,0,n);CHKERRQ(ierr);
ierr = BVDotColumn(V,n,work);CHKERRQ(ierr);
}
ierr = BVScaleColumn(U,n-1,1.0/a);CHKERRQ(ierr);
for (j=0;j<n;j++) work[j] = work[j] / a;
ierr = BVMultColumn(V,-1.0,1.0/a,n,work);CHKERRQ(ierr);
ierr = SVDOrthogonalizeCGS(V,n,work,a,refine,eta,&b);CHKERRQ(ierr);
ierr = BVSetActiveColumns(V,nconv,n);CHKERRQ(ierr);
alpha[n-1] = a;
beta[n-1] = b;
PetscFunctionReturn(0);
}
PetscErrorCode KSPSolve_QCG(KSP ksp)
{
/*
Correpondence with documentation above:
B = g = gradient,
X = s = step
Note: This is not coded correctly for complex arithmetic!
*/
KSP_QCG *pcgP = (KSP_QCG*)ksp->data;
Mat Amat,Pmat;
Vec W,WA,WA2,R,P,ASP,BS,X,B;
PetscScalar scal,beta,rntrn,step;
PetscReal q1,q2,xnorm,step1,step2,rnrm,btx,xtax;
PetscReal ptasp,rtr,wtasp,bstp;
PetscReal dzero = 0.0,bsnrm;
PetscErrorCode ierr;
PetscInt i,maxit;
PC pc = ksp->pc;
PCSide side;
PetscBool diagonalscale;
PetscFunctionBegin;
ierr = PCGetDiagonalScale(ksp->pc,&diagonalscale);CHKERRQ(ierr);
if (diagonalscale) SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"Krylov method %s does not support diagonal scaling",((PetscObject)ksp)->type_name);
if (ksp->transpose_solve) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"Currently does not support transpose solve");
ksp->its = 0;
maxit = ksp->max_it;
WA = ksp->work[0];
R = ksp->work[1];
P = ksp->work[2];
ASP = ksp->work[3];
BS = ksp->work[4];
W = ksp->work[5];
WA2 = ksp->work[6];
X = ksp->vec_sol;
B = ksp->vec_rhs;
if (pcgP->delta <= dzero) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_ARG_OUTOFRANGE,"Input error: delta <= 0");
ierr = KSPGetPCSide(ksp,&side);CHKERRQ(ierr);
if (side != PC_SYMMETRIC) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_ARG_OUTOFRANGE,"Requires symmetric preconditioner!");
/* Initialize variables */
ierr = VecSet(W,0.0);CHKERRQ(ierr); /* W = 0 */
ierr = VecSet(X,0.0);CHKERRQ(ierr); /* X = 0 */
ierr = PCGetOperators(pc,&Amat,&Pmat);CHKERRQ(ierr);
/* Compute: BS = D^{-1} B */
ierr = PCApplySymmetricLeft(pc,B,BS);CHKERRQ(ierr);
ierr = VecNorm(BS,NORM_2,&bsnrm);CHKERRQ(ierr);
ierr = PetscObjectSAWsTakeAccess((PetscObject)ksp);CHKERRQ(ierr);
ksp->its = 0;
ksp->rnorm = bsnrm;
ierr = PetscObjectSAWsGrantAccess((PetscObject)ksp);CHKERRQ(ierr);
ierr = KSPLogResidualHistory(ksp,bsnrm);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,0,bsnrm);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,0,bsnrm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) PetscFunctionReturn(0);
/* Compute the initial scaled direction and scaled residual */
ierr = VecCopy(BS,R);CHKERRQ(ierr);
ierr = VecScale(R,-1.0);CHKERRQ(ierr);
ierr = VecCopy(R,P);CHKERRQ(ierr);
ierr = VecDotRealPart(R,R,&rtr);CHKERRQ(ierr);
for (i=0; i<=maxit; i++) {
ierr = PetscObjectSAWsTakeAccess((PetscObject)ksp);CHKERRQ(ierr);
ksp->its++;
ierr = PetscObjectSAWsGrantAccess((PetscObject)ksp);CHKERRQ(ierr);
/* Compute: asp = D^{-T}*A*D^{-1}*p */
ierr = PCApplySymmetricRight(pc,P,WA);CHKERRQ(ierr);
ierr = MatMult(Amat,WA,WA2);CHKERRQ(ierr);
ierr = PCApplySymmetricLeft(pc,WA2,ASP);CHKERRQ(ierr);
/* Check for negative curvature */
ierr = VecDotRealPart(P,ASP,&ptasp);CHKERRQ(ierr);
if (ptasp <= dzero) {
/* Scaled negative curvature direction: Compute a step so that
||w + step*p|| = delta and QS(w + step*p) is least */
if (!i) {
ierr = VecCopy(P,X);CHKERRQ(ierr);
ierr = VecNorm(X,NORM_2,&xnorm);CHKERRQ(ierr);
scal = pcgP->delta / xnorm;
ierr = VecScale(X,scal);CHKERRQ(ierr);
} else {
/* Compute roots of quadratic */
ierr = KSPQCGQuadraticRoots(W,P,pcgP->delta,&step1,&step2);CHKERRQ(ierr);
ierr = VecDotRealPart(W,ASP,&wtasp);CHKERRQ(ierr);
ierr = VecDotRealPart(BS,P,&bstp);CHKERRQ(ierr);
ierr = VecCopy(W,X);CHKERRQ(ierr);
q1 = step1*(bstp + wtasp + .5*step1*ptasp);
q2 = step2*(bstp + wtasp + .5*step2*ptasp);
if (q1 <= q2) {
ierr = VecAXPY(X,step1,P);CHKERRQ(ierr);
} else {
ierr = VecAXPY(X,step2,P);CHKERRQ(ierr);
}
}
pcgP->ltsnrm = pcgP->delta; /* convergence in direction of */
ksp->reason = KSP_CONVERGED_CG_NEG_CURVE; /* negative curvature */
if (!i) {
ierr = PetscInfo1(ksp,"negative curvature: delta=%g\n",(double)pcgP->delta);CHKERRQ(ierr);
} else {
ierr = PetscInfo3(ksp,"negative curvature: step1=%g, step2=%g, delta=%g\n",(double)step1,(double)step2,(double)pcgP->delta);CHKERRQ(ierr);
}
} else {
/* Compute step along p */
step = rtr/ptasp;
ierr = VecCopy(W,X);CHKERRQ(ierr); /* x = w */
ierr = VecAXPY(X,step,P);CHKERRQ(ierr); /* x <- step*p + x */
ierr = VecNorm(X,NORM_2,&pcgP->ltsnrm);CHKERRQ(ierr);
if (pcgP->ltsnrm > pcgP->delta) {
/* Since the trial iterate is outside the trust region,
evaluate a constrained step along p so that
||w + step*p|| = delta
The positive step is always better in this case. */
if (!i) {
scal = pcgP->delta / pcgP->ltsnrm;
ierr = VecScale(X,scal);CHKERRQ(ierr);
} else {
/* Compute roots of quadratic */
ierr = KSPQCGQuadraticRoots(W,P,pcgP->delta,&step1,&step2);CHKERRQ(ierr);
ierr = VecCopy(W,X);CHKERRQ(ierr);
ierr = VecAXPY(X,step1,P);CHKERRQ(ierr); /* x <- step1*p + x */
}
pcgP->ltsnrm = pcgP->delta;
ksp->reason = KSP_CONVERGED_CG_CONSTRAINED; /* convergence along constrained step */
if (!i) {
ierr = PetscInfo1(ksp,"constrained step: delta=%g\n",(double)pcgP->delta);CHKERRQ(ierr);
} else {
ierr = PetscInfo3(ksp,"constrained step: step1=%g, step2=%g, delta=%g\n",(double)step1,(double)step2,(double)pcgP->delta);CHKERRQ(ierr);
}
} else {
/* Evaluate the current step */
ierr = VecCopy(X,W);CHKERRQ(ierr); /* update interior iterate */
ierr = VecAXPY(R,-step,ASP);CHKERRQ(ierr); /* r <- -step*asp + r */
ierr = VecNorm(R,NORM_2,&rnrm);CHKERRQ(ierr);
ierr = PetscObjectSAWsTakeAccess((PetscObject)ksp);CHKERRQ(ierr);
ksp->rnorm = rnrm;
ierr = PetscObjectSAWsGrantAccess((PetscObject)ksp);CHKERRQ(ierr);
ierr = KSPLogResidualHistory(ksp,rnrm);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,i+1,rnrm);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,i+1,rnrm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) { /* convergence for */
ierr = PetscInfo3(ksp,"truncated step: step=%g, rnrm=%g, delta=%g\n",(double)PetscRealPart(step),(double)rnrm,(double)pcgP->delta);CHKERRQ(ierr);
}
}
}
if (ksp->reason) break; /* Convergence has been attained */
else { /* Compute a new AS-orthogonal direction */
ierr = VecDot(R,R,&rntrn);CHKERRQ(ierr);
beta = rntrn/rtr;
ierr = VecAYPX(P,beta,R);CHKERRQ(ierr); /* p <- r + beta*p */
rtr = PetscRealPart(rntrn);
}
}
if (!ksp->reason) ksp->reason = KSP_DIVERGED_ITS;
/* Unscale x */
ierr = VecCopy(X,WA2);CHKERRQ(ierr);
ierr = PCApplySymmetricRight(pc,WA2,X);CHKERRQ(ierr);
ierr = MatMult(Amat,X,WA);CHKERRQ(ierr);
ierr = VecDotRealPart(B,X,&btx);CHKERRQ(ierr);
ierr = VecDotRealPart(X,WA,&xtax);CHKERRQ(ierr);
pcgP->quadratic = btx + .5*xtax;
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
Mat A; /* operator matrix */
EPS eps; /* eigenproblem solver context */
EPSType type;
DM da;
Vec v0;
PetscReal error,tol,re,im,*exact;
PetscScalar kr,ki;
PetscInt M,N,P,m,n,p,nev,maxit,i,its,nconv,seed;
PetscLogDouble t1,t2,t3;
PetscBool flg;
PetscRandom rctx;
PetscErrorCode ierr;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n3-D Laplacian Eigenproblem\n\n");CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the operator matrix that defines the eigensystem, Ax=kx
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMDACreate3d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,
DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,-10,-10,-10,
PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE,
1,1,NULL,NULL,NULL,&da);CHKERRQ(ierr);
/* print DM information */
ierr = DMDAGetInfo(da,NULL,&M,&N,&P,&m,&n,&p,NULL,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Grid partitioning: %D %D %D\n",m,n,p);CHKERRQ(ierr);
/* create and fill the matrix */
ierr = DMCreateMatrix(da,&A);CHKERRQ(ierr);
ierr = FillMatrix(da,A);CHKERRQ(ierr);
/* create random initial vector */
seed = 1;
ierr = PetscOptionsGetInt(NULL,"-seed",&seed,NULL);CHKERRQ(ierr);
if (seed<0) SETERRQ(PETSC_COMM_WORLD,1,"Seed must be >=0");
ierr = MatGetVecs(A,&v0,NULL);CHKERRQ(ierr);
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rctx);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr);
for (i=0;i<seed;i++) { /* simulate different seeds in the random generator */
ierr = VecSetRandom(v0,rctx);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the eigensolver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create eigensolver context
*/
ierr = EPSCreate(PETSC_COMM_WORLD,&eps);CHKERRQ(ierr);
/*
Set operators. In this case, it is a standard eigenvalue problem
*/
ierr = EPSSetOperators(eps,A,NULL);CHKERRQ(ierr);
ierr = EPSSetProblemType(eps,EPS_HEP);CHKERRQ(ierr);
/*
Set specific solver options
*/
ierr = EPSSetWhichEigenpairs(eps,EPS_SMALLEST_REAL);CHKERRQ(ierr);
ierr = EPSSetTolerances(eps,1e-8,PETSC_DEFAULT);CHKERRQ(ierr);
ierr = EPSSetInitialSpace(eps,1,&v0);CHKERRQ(ierr);
/*
Set solver parameters at runtime
*/
ierr = EPSSetFromOptions(eps);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the eigensystem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscTime(&t1);CHKERRQ(ierr);
ierr = EPSSetUp(eps);CHKERRQ(ierr);
ierr = PetscTime(&t2);CHKERRQ(ierr);
ierr = EPSSolve(eps);CHKERRQ(ierr);
ierr = PetscTime(&t3);CHKERRQ(ierr);
ierr = EPSGetIterationNumber(eps,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of iterations of the method: %D\n",its);CHKERRQ(ierr);
/*
Optional: Get some information from the solver and display it
*/
ierr = EPSGetType(eps,&type);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Solution method: %s\n\n",type);CHKERRQ(ierr);
ierr = EPSGetDimensions(eps,&nev,NULL,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of requested eigenvalues: %D\n",nev);CHKERRQ(ierr);
ierr = EPSGetTolerances(eps,&tol,&maxit);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Stopping condition: tol=%.4g, maxit=%D\n",(double)tol,maxit);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Get number of converged approximate eigenpairs
*/
ierr = EPSGetConverged(eps,&nconv);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of converged approximate eigenpairs: %D\n\n",nconv);CHKERRQ(ierr);
if (nconv>0) {
ierr = PetscMalloc1(nconv,&exact);CHKERRQ(ierr);
ierr = GetExactEigenvalues(M,N,P,nconv,exact);CHKERRQ(ierr);
/*
Display eigenvalues and relative errors
*/
ierr = PetscPrintf(PETSC_COMM_WORLD,
" k ||Ax-kx||/||kx|| Eigenvalue Error \n"
" ----------------- ------------------ ------------------\n");CHKERRQ(ierr);
for (i=0;i<nconv;i++) {
/*
Get converged eigenpairs: i-th eigenvalue is stored in kr (real part) and
ki (imaginary part)
*/
ierr = EPSGetEigenpair(eps,i,&kr,&ki,NULL,NULL);CHKERRQ(ierr);
/*
Compute the relative error associated to each eigenpair
*/
ierr = EPSComputeRelativeError(eps,i,&error);CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
re = PetscRealPart(kr);
im = PetscImaginaryPart(kr);
#else
re = kr;
im = ki;
#endif
if (im!=0.0) SETERRQ(PETSC_COMM_WORLD,1,"Eigenvalue should be real");
else {
ierr = PetscPrintf(PETSC_COMM_WORLD," %12g %12g %12g\n",(double)re,(double)error,(double)PetscAbsReal(re-exact[i]));CHKERRQ(ierr);
}
}
ierr = PetscFree(exact);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n");CHKERRQ(ierr);
}
/*
Show computing times
*/
ierr = PetscOptionsHasName(NULL,"-showtimes",&flg);CHKERRQ(ierr);
if (flg) {
ierr = PetscPrintf(PETSC_COMM_WORLD," Elapsed time: %g (setup), %g (solve)\n",(double)(t2-t1),(double)(t3-t2));CHKERRQ(ierr);
}
/*
Free work space
*/
ierr = EPSDestroy(&eps);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&v0);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = SlepcFinalize();
return 0;
}
PetscErrorCode KSPSolve_PIPEFCG_cycle(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i,j,k,idx,kdx,mi;
KSP_PIPEFCG *pipefcg;
PetscScalar alpha=0.0,gamma,*betas,*dots;
PetscReal dp=0.0, delta,*eta,*etas;
Vec B,R,Z,X,Qcurr,W,ZETAcurr,M,N,Pcurr,Scurr,*redux;
Mat Amat,Pmat;
PetscFunctionBegin;
/* We have not checked these routines for use with complex numbers. The inner products
are likely not defined correctly for that case */
#if (defined(PETSC_USE_COMPLEX) && !defined(PETSC_SKIP_COMPLEX))
SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"PIPEFGMRES has not been implemented for use with complex scalars");
#endif
#define VecXDot(x,y,a) (((pipefcg->type) == (KSP_CG_HERMITIAN)) ? VecDot (x,y,a) : VecTDot (x,y,a))
#define VecXDotBegin(x,y,a) (((pipefcg->type) == (KSP_CG_HERMITIAN)) ? VecDotBegin (x,y,a) : VecTDotBegin (x,y,a))
#define VecXDotEnd(x,y,a) (((pipefcg->type) == (KSP_CG_HERMITIAN)) ? VecDotEnd (x,y,a) : VecTDotEnd (x,y,a))
#define VecMXDot(x,n,y,a) (((pipefcg->type) == (KSP_CG_HERMITIAN)) ? VecMDot (x,n,y,a) : VecMTDot (x,n,y,a))
#define VecMXDotBegin(x,n,y,a) (((pipefcg->type) == (KSP_CG_HERMITIAN)) ? VecMDotBegin (x,n,y,a) : VecMTDotBegin (x,n,y,a))
#define VecMXDotEnd(x,n,y,a) (((pipefcg->type) == (KSP_CG_HERMITIAN)) ? VecMDotEnd (x,n,y,a) : VecMTDotEnd (x,n,y,a))
pipefcg = (KSP_PIPEFCG*)ksp->data;
X = ksp->vec_sol;
B = ksp->vec_rhs;
R = ksp->work[0];
Z = ksp->work[1];
W = ksp->work[2];
M = ksp->work[3];
N = ksp->work[4];
redux = pipefcg->redux;
dots = pipefcg->dots;
etas = pipefcg->etas;
betas = dots; /* dots takes the result of all dot products of which the betas are a subset */
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat);CHKERRQ(ierr);
/* Compute cycle initial residual */
ierr = KSP_MatMult(ksp,Amat,X,R);CHKERRQ(ierr);
ierr = VecAYPX(R,-1.0,B);CHKERRQ(ierr); /* r <- b - Ax */
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
Pcurr = pipefcg->Pvecs[0];
Scurr = pipefcg->Svecs[0];
Qcurr = pipefcg->Qvecs[0];
ZETAcurr = pipefcg->ZETAvecs[0];
ierr = VecCopy(Z,Pcurr);CHKERRQ(ierr);
ierr = KSP_MatMult(ksp,Amat,Pcurr,Scurr);CHKERRQ(ierr); /* S = Ap */
ierr = VecCopy(Scurr,W);CHKERRQ(ierr); /* w = s = Az */
/* Initial state of pipelining intermediates */
redux[0] = R;
redux[1] = W;
ierr = VecMXDotBegin(Z,2,redux,dots);CHKERRQ(ierr);
ierr = PetscCommSplitReductionBegin(PetscObjectComm((PetscObject)Z));CHKERRQ(ierr); /* perform asynchronous reduction */
ierr = KSP_PCApply(ksp,W,M);CHKERRQ(ierr); /* m = B(w) */
ierr = KSP_MatMult(ksp,Amat,M,N);CHKERRQ(ierr); /* n = Am */
ierr = VecCopy(M,Qcurr);CHKERRQ(ierr); /* q = m */
ierr = VecCopy(N,ZETAcurr);CHKERRQ(ierr); /* zeta = n */
ierr = VecMXDotEnd(Z,2,redux,dots);CHKERRQ(ierr);
gamma = dots[0];
delta = PetscRealPart(dots[1]);
etas[0] = delta;
alpha = gamma/delta;
i = 0;
do {
ksp->its++;
/* Update X, R, Z, W */
ierr = VecAXPY(X,+alpha,Pcurr);CHKERRQ(ierr); /* x <- x + alpha * pi */
ierr = VecAXPY(R,-alpha,Scurr);CHKERRQ(ierr); /* r <- r - alpha * si */
ierr = VecAXPY(Z,-alpha,Qcurr);CHKERRQ(ierr); /* z <- z - alpha * qi */
ierr = VecAXPY(W,-alpha,ZETAcurr);CHKERRQ(ierr); /* w <- w - alpha * zetai */
/* Compute norm for convergence check */
switch (ksp->normtype) {
case KSP_NORM_PRECONDITIONED:
ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- sqrt(z'*z) = sqrt(e'*A'*B'*B*A*e) */
break;
case KSP_NORM_UNPRECONDITIONED:
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- sqrt(r'*r) = sqrt(e'*A'*A*e) */
break;
case KSP_NORM_NATURAL:
dp = PetscSqrtReal(PetscAbsScalar(gamma)); /* dp <- sqrt(r'*z) = sqrt(e'*A'*B*A*e) */
break;
case KSP_NORM_NONE:
dp = 0.0;
break;
default: SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"%s",KSPNormTypes[ksp->normtype]);
}
/* Check for convergence */
ksp->rnorm = dp;
KSPLogResidualHistory(ksp,dp);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,ksp->its,dp);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,ksp->its+1,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) break;
/* Computations of current iteration done */
++i;
/* If needbe, allocate a new chunk of vectors in P and C */
ierr = KSPAllocateVectors_PIPEFCG(ksp,i+1,pipefcg->vecb);CHKERRQ(ierr);
/* Note that we wrap around and start clobbering old vectors */
idx = i % (pipefcg->mmax+1);
Pcurr = pipefcg->Pvecs[idx];
Scurr = pipefcg->Svecs[idx];
Qcurr = pipefcg->Qvecs[idx];
ZETAcurr = pipefcg->ZETAvecs[idx];
eta = pipefcg->etas+idx;
/* number of old directions to orthogonalize against */
switch(pipefcg->truncstrat){
case KSP_FCD_TRUNC_TYPE_STANDARD:
mi = pipefcg->mmax;
break;
case KSP_FCD_TRUNC_TYPE_NOTAY:
mi = ((i-1) % pipefcg->mmax)+1;
break;
default:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Unrecognized Truncation Strategy");
}
/* Pick old p,s,q,zeta in a way suitable for VecMDot */
ierr = VecCopy(Z,Pcurr);CHKERRQ(ierr);
for(k=PetscMax(0,i-mi),j=0;k<i;++j,++k){
kdx = k % (pipefcg->mmax+1);
pipefcg->Pold[j] = pipefcg->Pvecs[kdx];
pipefcg->Sold[j] = pipefcg->Svecs[kdx];
pipefcg->Qold[j] = pipefcg->Qvecs[kdx];
pipefcg->ZETAold[j] = pipefcg->ZETAvecs[kdx];
redux[j] = pipefcg->Svecs[kdx];
}
redux[j] = R; /* If the above loop is not executed redux contains only R => all beta_k = 0, only gamma, delta != 0 */
redux[j+1] = W;
ierr = VecMXDotBegin(Z,j+2,redux,betas);CHKERRQ(ierr); /* Start split reductions for beta_k = (z,s_k), gamma = (z,r), delta = (z,w) */
ierr = PetscCommSplitReductionBegin(PetscObjectComm((PetscObject)Z));CHKERRQ(ierr); /* perform asynchronous reduction */
ierr = VecWAXPY(N,-1.0,R,W);CHKERRQ(ierr); /* m = u + B(w-r): (a) ntmp = w-r */
ierr = KSP_PCApply(ksp,N,M);CHKERRQ(ierr); /* m = u + B(w-r): (b) mtmp = B(ntmp) = B(w-r) */
ierr = VecAXPY(M,1.0,Z);CHKERRQ(ierr); /* m = u + B(w-r): (c) m = z + mtmp */
ierr = KSP_MatMult(ksp,Amat,M,N);CHKERRQ(ierr); /* n = Am */
ierr = VecMXDotEnd(Z,j+2,redux,betas);CHKERRQ(ierr); /* Finish split reductions */
gamma = betas[j];
delta = PetscRealPart(betas[j+1]);
*eta = 0.;
for(k=PetscMax(0,i-mi),j=0;k<i;++j,++k){
kdx = k % (pipefcg->mmax+1);
betas[j] /= -etas[kdx]; /* betak /= etak */
*eta -= ((PetscReal)(PetscAbsScalar(betas[j])*PetscAbsScalar(betas[j]))) * etas[kdx];
/* etaitmp = -betaik^2 * etak */
}
*eta += delta; /* etai = delta -betaik^2 * etak */
if(*eta < 0.) {
pipefcg->norm_breakdown = PETSC_TRUE;
ierr = PetscInfo1(ksp,"Restart due to square root breakdown at it = \n",ksp->its);CHKERRQ(ierr);
break;
} else {
alpha= gamma/(*eta); /* alpha = gamma/etai */
}
/* project out stored search directions using classical G-S */
ierr = VecCopy(Z,Pcurr);CHKERRQ(ierr);
ierr = VecCopy(W,Scurr);CHKERRQ(ierr);
ierr = VecCopy(M,Qcurr);CHKERRQ(ierr);
ierr = VecCopy(N,ZETAcurr);CHKERRQ(ierr);
ierr = VecMAXPY(Pcurr ,j,betas,pipefcg->Pold);CHKERRQ(ierr); /* pi <- ui - sum_k beta_k p_k */
ierr = VecMAXPY(Scurr ,j,betas,pipefcg->Sold);CHKERRQ(ierr); /* si <- wi - sum_k beta_k s_k */
ierr = VecMAXPY(Qcurr ,j,betas,pipefcg->Qold);CHKERRQ(ierr); /* qi <- m - sum_k beta_k q_k */
ierr = VecMAXPY(ZETAcurr,j,betas,pipefcg->ZETAold);CHKERRQ(ierr); /* zetai <- n - sum_k beta_k zeta_k */
} while (ksp->its < ksp->max_it);
PetscFunctionReturn(0);
}
/*@C
SNESComputeJacobianDefault - Computes the Jacobian using finite differences.
Collective on SNES
Input Parameters:
+ x1 - compute Jacobian at this point
- ctx - application's function context, as set with SNESSetFunction()
Output Parameters:
+ J - Jacobian matrix (not altered in this routine)
- B - newly computed Jacobian matrix to use with preconditioner (generally the same as J)
Options Database Key:
+ -snes_fd - Activates SNESComputeJacobianDefault()
. -snes_test_err - Square root of function error tolerance, default square root of machine
epsilon (1.e-8 in double, 3.e-4 in single)
- -mat_fd_type - Either wp or ds (see MATMFFD_WP or MATMFFD_DS)
Notes:
This routine is slow and expensive, and is not currently optimized
to take advantage of sparsity in the problem. Although
SNESComputeJacobianDefault() is not recommended for general use
in large-scale applications, It can be useful in checking the
correctness of a user-provided Jacobian.
An alternative routine that uses coloring to exploit matrix sparsity is
SNESComputeJacobianDefaultColor().
Level: intermediate
.keywords: SNES, finite differences, Jacobian
.seealso: SNESSetJacobian(), SNESComputeJacobianDefaultColor(), MatCreateSNESMF()
@*/
PetscErrorCode SNESComputeJacobianDefault(SNES snes,Vec x1,Mat J,Mat B,void *ctx)
{
Vec j1a,j2a,x2;
PetscErrorCode ierr;
PetscInt i,N,start,end,j,value,root;
PetscScalar dx,*y,wscale;
const PetscScalar *xx;
PetscReal amax,epsilon = PETSC_SQRT_MACHINE_EPSILON;
PetscReal dx_min = 1.e-16,dx_par = 1.e-1,unorm;
MPI_Comm comm;
PetscBool assembled,use_wp = PETSC_TRUE,flg;
const char *list[2] = {"ds","wp"};
PetscMPIInt size;
const PetscInt *ranges;
PetscFunctionBegin;
/* Since this Jacobian will possibly have "extra" nonzero locations just turn off errors for these locations */
ierr = MatSetOption(B,MAT_NEW_NONZERO_ALLOCATION_ERR, PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(((PetscObject)snes)->options,((PetscObject)snes)->prefix,"-snes_test_err",&epsilon,0);CHKERRQ(ierr);
ierr = PetscObjectGetComm((PetscObject)x1,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MatAssembled(B,&assembled);CHKERRQ(ierr);
if (assembled) {
ierr = MatZeroEntries(B);CHKERRQ(ierr);
}
if (!snes->nvwork) {
if (snes->dm) {
ierr = DMGetGlobalVector(snes->dm,&j1a);CHKERRQ(ierr);
ierr = DMGetGlobalVector(snes->dm,&j2a);CHKERRQ(ierr);
ierr = DMGetGlobalVector(snes->dm,&x2);CHKERRQ(ierr);
} else {
snes->nvwork = 3;
ierr = VecDuplicateVecs(x1,snes->nvwork,&snes->vwork);CHKERRQ(ierr);
ierr = PetscLogObjectParents(snes,snes->nvwork,snes->vwork);CHKERRQ(ierr);
j1a = snes->vwork[0]; j2a = snes->vwork[1]; x2 = snes->vwork[2];
}
}
ierr = VecGetSize(x1,&N);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(x1,&start,&end);CHKERRQ(ierr);
ierr = SNESComputeFunction(snes,x1,j1a);CHKERRQ(ierr);
ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)snes),((PetscObject)snes)->prefix,"Differencing options","SNES");CHKERRQ(ierr);
ierr = PetscOptionsEList("-mat_fd_type","Algorithm to compute difference parameter","SNESComputeJacobianDefault",list,2,"wp",&value,&flg);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
if (flg && !value) use_wp = PETSC_FALSE;
if (use_wp) {
ierr = VecNorm(x1,NORM_2,&unorm);CHKERRQ(ierr);
}
/* Compute Jacobian approximation, 1 column at a time.
x1 = current iterate, j1a = F(x1)
x2 = perturbed iterate, j2a = F(x2)
*/
for (i=0; i<N; i++) {
ierr = VecCopy(x1,x2);CHKERRQ(ierr);
if (i>= start && i<end) {
ierr = VecGetArrayRead(x1,&xx);CHKERRQ(ierr);
if (use_wp) dx = PetscSqrtReal(1.0 + unorm);
else dx = xx[i-start];
ierr = VecRestoreArrayRead(x1,&xx);CHKERRQ(ierr);
if (PetscAbsScalar(dx) < dx_min) dx = (PetscRealPart(dx) < 0. ? -1. : 1.) * dx_par;
dx *= epsilon;
wscale = 1.0/dx;
ierr = VecSetValues(x2,1,&i,&dx,ADD_VALUES);CHKERRQ(ierr);
} else {
wscale = 0.0;
}
ierr = VecAssemblyBegin(x2);CHKERRQ(ierr);
ierr = VecAssemblyEnd(x2);CHKERRQ(ierr);
ierr = SNESComputeFunction(snes,x2,j2a);CHKERRQ(ierr);
ierr = VecAXPY(j2a,-1.0,j1a);CHKERRQ(ierr);
/* Communicate scale=1/dx_i to all processors */
ierr = VecGetOwnershipRanges(x1,&ranges);CHKERRQ(ierr);
root = size;
for (j=size-1; j>-1; j--) {
root--;
if (i>=ranges[j]) break;
}
ierr = MPI_Bcast(&wscale,1,MPIU_SCALAR,root,comm);CHKERRQ(ierr);
ierr = VecScale(j2a,wscale);CHKERRQ(ierr);
ierr = VecNorm(j2a,NORM_INFINITY,&amax);CHKERRQ(ierr); amax *= 1.e-14;
ierr = VecGetArray(j2a,&y);CHKERRQ(ierr);
for (j=start; j<end; j++) {
if (PetscAbsScalar(y[j-start]) > amax || j == i) {
ierr = MatSetValues(B,1,&j,1,&i,y+j-start,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = VecRestoreArray(j2a,&y);CHKERRQ(ierr);
}
if (snes->dm) {
ierr = DMRestoreGlobalVector(snes->dm,&j1a);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(snes->dm,&j2a);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(snes->dm,&x2);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (B != J) {
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
Applies some sweeps on nonlinear Gauss-Seidel on each process
*/
PetscErrorCode NonlinearGS(SNES snes,Vec X, Vec B, void *ctx)
{
PetscInt i,j,k,Mx,My,xs,ys,xm,ym,its,tot_its,sweeps,l;
PetscErrorCode ierr;
PetscReal lambda,hx,hy,hxdhy,hydhx,sc;
PetscScalar **x,**b,bij,F,F0=0,J,u,un,us,ue,eu,uw,uxx,uyy,y;
PetscReal atol,rtol,stol;
DM da;
AppCtx *user;
Vec localX,localB;
PetscFunctionBeginUser;
tot_its = 0;
ierr = SNESNGSGetSweeps(snes,&sweeps);CHKERRQ(ierr);
ierr = SNESNGSGetTolerances(snes,&atol,&rtol,&stol,&its);CHKERRQ(ierr);
ierr = SNESGetDM(snes,&da);CHKERRQ(ierr);
ierr = DMGetApplicationContext(da,(void**)&user);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,&My,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
lambda = user->param;
hx = 1.0/(PetscReal)(Mx-1);
hy = 1.0/(PetscReal)(My-1);
sc = hx*hy*lambda;
hxdhy = hx/hy;
hydhx = hy/hx;
ierr = DMGetLocalVector(da,&localX);CHKERRQ(ierr);
if (B) {
ierr = DMGetLocalVector(da,&localB);CHKERRQ(ierr);
}
for (l=0; l<sweeps; l++) {
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
if (B) {
ierr = DMGlobalToLocalBegin(da,B,INSERT_VALUES,localB);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,B,INSERT_VALUES,localB);CHKERRQ(ierr);
}
/*
Get a pointer to vector data.
- For default PETSc vectors, VecGetArray() returns a pointer to
the data array. Otherwise, the routine is implementation dependent.
- You MUST call VecRestoreArray() when you no longer need access to
the array.
*/
ierr = DMDAVecGetArray(da,localX,&x);CHKERRQ(ierr);
if (B) ierr = DMDAVecGetArray(da,localB,&b);CHKERRQ(ierr);
/*
Get local grid boundaries (for 2-dimensional DMDA):
xs, ys - starting grid indices (no ghost points)
xm, ym - widths of local grid (no ghost points)
*/
ierr = DMDAGetCorners(da,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(ierr);
for (j=ys; j<ys+ym; j++) {
for (i=xs; i<xs+xm; i++) {
if (i == 0 || j == 0 || i == Mx-1 || j == My-1) {
/* boundary conditions are all zero Dirichlet */
x[j][i] = 0.0;
} else {
if (B) bij = b[j][i];
else bij = 0.;
u = x[j][i];
un = x[j-1][i];
us = x[j+1][i];
ue = x[j][i-1];
uw = x[j][i+1];
for (k=0; k<its; k++) {
eu = PetscExpScalar(u);
uxx = (2.0*u - ue - uw)*hydhx;
uyy = (2.0*u - un - us)*hxdhy;
F = uxx + uyy - sc*eu - bij;
if (k == 0) F0 = F;
J = 2.0*(hydhx + hxdhy) - sc*eu;
y = F/J;
u -= y;
tot_its++;
if (atol > PetscAbsReal(PetscRealPart(F)) ||
rtol*PetscAbsReal(PetscRealPart(F0)) > PetscAbsReal(PetscRealPart(F)) ||
stol*PetscAbsReal(PetscRealPart(u)) > PetscAbsReal(PetscRealPart(y))) {
break;
}
}
x[j][i] = u;
}
}
}
/*
Restore vector
*/
ierr = DMDAVecRestoreArray(da,localX,&x);CHKERRQ(ierr);
ierr = DMLocalToGlobalBegin(da,localX,INSERT_VALUES,X);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(da,localX,INSERT_VALUES,X);CHKERRQ(ierr);
}
ierr = PetscLogFlops(tot_its*(21.0));CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localX);CHKERRQ(ierr);
if (B) {
ierr = DMDAVecRestoreArray(da,localB,&b);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localB);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
Vec x,b,u; /* approx solution, RHS, exact solution */
Mat A; /* linear system matrix */
KSP ksp; /* linear solver context */
PetscReal norm; /* norm of solution error */
PetscInt dim,i,j,Ii,J,Istart,Iend,n = 6,its,use_random;
PetscErrorCode ierr;
PetscScalar v,none = -1.0,sigma2,pfive = 0.5,*xa;
PetscRandom rctx;
PetscReal h2,sigma1 = 100.0;
PetscBool flg = PETSC_FALSE;
ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr;
#if !defined(PETSC_USE_COMPLEX)
SETERRQ(PETSC_COMM_WORLD,1,"This example requires complex numbers");
#endif
ierr = PetscOptionsGetReal(NULL,NULL,"-sigma1",&sigma1,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,NULL,"-n",&n,NULL);CHKERRQ(ierr);
dim = n*n;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the matrix and right-hand-side vector that define
the linear system, Ax = b.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create parallel matrix, specifying only its global dimensions.
When using MatCreate(), the matrix format can be specified at
runtime. Also, the parallel partitioning of the matrix is
determined by PETSc at runtime.
*/
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,dim,dim);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
/*
Currently, all PETSc parallel matrix formats are partitioned by
contiguous chunks of rows across the processors. Determine which
rows of the matrix are locally owned.
*/
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
/*
Set matrix elements in parallel.
- Each processor needs to insert only elements that it owns
locally (but any non-local elements will be sent to the
appropriate processor during matrix assembly).
- Always specify global rows and columns of matrix entries.
*/
ierr = PetscOptionsGetBool(NULL,NULL,"-norandom",&flg,NULL);CHKERRQ(ierr);
if (flg) use_random = 0;
else use_random = 1;
if (use_random) {
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rctx);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr);
ierr = PetscRandomSetInterval(rctx,0.0,PETSC_i);CHKERRQ(ierr);
} else {
sigma2 = 10.0*PETSC_i;
}
h2 = 1.0/((n+1)*(n+1));
for (Ii=Istart; Ii<Iend; Ii++) {
v = -1.0; i = Ii/n; j = Ii - i*n;
if (i>0) {
J = Ii-n; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);
}
if (i<n-1) {
J = Ii+n; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);
}
if (j>0) {
J = Ii-1; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);
}
if (j<n-1) {
J = Ii+1; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);
}
if (use_random) {ierr = PetscRandomGetValue(rctx,&sigma2);CHKERRQ(ierr);}
v = 4.0 - sigma1*h2 + sigma2*h2;
ierr = MatSetValues(A,1,&Ii,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr);
}
if (use_random) {ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr);}
/*
Assemble matrix, using the 2-step process:
MatAssemblyBegin(), MatAssemblyEnd()
Computations can be done while messages are in transition
by placing code between these two statements.
*/
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/*
Create parallel vectors.
- When using VecCreate(), VecSetSizes() and VecSetFromOptions(),
we specify only the vector's global
dimension; the parallel partitioning is determined at runtime.
- Note: We form 1 vector from scratch and then duplicate as needed.
*/
ierr = VecCreate(PETSC_COMM_WORLD,&u);CHKERRQ(ierr);
ierr = VecSetSizes(u,PETSC_DECIDE,dim);CHKERRQ(ierr);
ierr = VecSetFromOptions(u);CHKERRQ(ierr);
ierr = VecDuplicate(u,&b);CHKERRQ(ierr);
ierr = VecDuplicate(b,&x);CHKERRQ(ierr);
/*
Set exact solution; then compute right-hand-side vector.
*/
if (use_random) {
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rctx);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr);
ierr = VecSetRandom(u,rctx);CHKERRQ(ierr);
} else {
ierr = VecSet(u,pfive);CHKERRQ(ierr);
}
ierr = MatMult(A,u,b);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the linear solver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create linear solver context
*/
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
/*
Set operators. Here the matrix that defines the linear system
also serves as the preconditioning matrix.
*/
ierr = KSPSetOperators(ksp,A,A);CHKERRQ(ierr);
/*
Set runtime options, e.g.,
-ksp_type <type> -pc_type <type> -ksp_monitor -ksp_rtol <rtol>
*/
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the linear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Check solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Print the first 3 entries of x; this demonstrates extraction of the
real and imaginary components of the complex vector, x.
*/
flg = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,NULL,"-print_x3",&flg,NULL);CHKERRQ(ierr);
if (flg) {
ierr = VecGetArray(x,&xa);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"The first three entries of x are:\n");CHKERRQ(ierr);
for (i=0; i<3; i++) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"x[%D] = %g + %g i\n",i,(double)PetscRealPart(xa[i]),(double)PetscImaginaryPart(xa[i]));CHKERRQ(ierr);
}
ierr = VecRestoreArray(x,&xa);CHKERRQ(ierr);
}
/*
Check the error
*/
ierr = VecAXPY(x,none,u);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr);
if (norm < 1.e-12) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error < 1.e-12 iterations %D\n",its);CHKERRQ(ierr);
} else {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %g iterations %D\n",(double)norm,its);CHKERRQ(ierr);
}
/*
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
*/
ierr = KSPDestroy(&ksp);CHKERRQ(ierr);
if (use_random) {ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr);}
ierr = VecDestroy(&u);CHKERRQ(ierr); ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
/* approximately solve the overdetermined system:
2*F(x_i)\cdot F(\x_j)\alpha_i = 0
\alpha_i = 1
Which minimizes the L2 norm of the linearization of:
||F(\sum_i \alpha_i*x_i)||^2
With the constraint that \sum_i\alpha_i = 1
Where x_i is the solution from the ith subsolver.
*/
static PetscErrorCode SNESCompositeApply_AdditiveOptimal(SNES snes,Vec X,Vec B,Vec F,PetscReal *fnorm)
{
PetscErrorCode ierr;
SNES_Composite *jac = (SNES_Composite*)snes->data;
SNES_CompositeLink next = jac->head;
Vec *Xes = jac->Xes,*Fes = jac->Fes;
PetscInt i,j;
PetscScalar tot,total,ftf;
PetscReal min_fnorm;
PetscInt min_i;
SNESConvergedReason reason;
PetscFunctionBegin;
if (!next) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_ARG_WRONGSTATE,"No composite SNESes supplied via SNESCompositeAddSNES() or -snes_composite_sneses");
if (snes->normschedule == SNES_NORM_ALWAYS) {
next = jac->head;
ierr = SNESSetInitialFunction(next->snes,F);CHKERRQ(ierr);
while (next->next) {
next = next->next;
ierr = SNESSetInitialFunction(next->snes,F);CHKERRQ(ierr);
}
}
next = jac->head;
i = 0;
ierr = VecCopy(X,Xes[i]);CHKERRQ(ierr);
ierr = SNESSolve(next->snes,B,Xes[i]);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(next->snes,&reason);CHKERRQ(ierr);
if (reason < 0 && reason != SNES_DIVERGED_MAX_IT) {
jac->innerFailures++;
if (jac->innerFailures >= snes->maxFailures) {
snes->reason = SNES_DIVERGED_INNER;
PetscFunctionReturn(0);
}
}
while (next->next) {
i++;
next = next->next;
ierr = VecCopy(X,Xes[i]);CHKERRQ(ierr);
ierr = SNESSolve(next->snes,B,Xes[i]);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(next->snes,&reason);CHKERRQ(ierr);
if (reason < 0 && reason != SNES_DIVERGED_MAX_IT) {
jac->innerFailures++;
if (jac->innerFailures >= snes->maxFailures) {
snes->reason = SNES_DIVERGED_INNER;
PetscFunctionReturn(0);
}
}
}
/* all the solutions are collected; combine optimally */
for (i=0;i<jac->n;i++) {
for (j=0;j<i+1;j++) {
ierr = VecDotBegin(Fes[i],Fes[j],&jac->h[i + j*jac->n]);CHKERRQ(ierr);
}
ierr = VecDotBegin(Fes[i],F,&jac->g[i]);CHKERRQ(ierr);
}
for (i=0;i<jac->n;i++) {
for (j=0;j<i+1;j++) {
ierr = VecDotEnd(Fes[i],Fes[j],&jac->h[i + j*jac->n]);CHKERRQ(ierr);
if (i == j) jac->fnorms[i] = PetscSqrtReal(PetscRealPart(jac->h[i + j*jac->n]));
}
ierr = VecDotEnd(Fes[i],F,&jac->g[i]);CHKERRQ(ierr);
}
ftf = (*fnorm)*(*fnorm);
for (i=0; i<jac->n; i++) {
for (j=i+1;j<jac->n;j++) {
jac->h[i + j*jac->n] = jac->h[j + i*jac->n];
}
}
for (i=0; i<jac->n; i++) {
for (j=0; j<jac->n; j++) {
jac->h[i + j*jac->n] = jac->h[i + j*jac->n] - jac->g[j] - jac->g[i] + ftf;
}
jac->beta[i] = ftf - jac->g[i];
}
#if defined(PETSC_MISSING_LAPACK_GELSS)
SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_SUP,"SNESCOMPOSITE with ADDITIVEOPTIMAL requires the LAPACK GELSS routine.");
#else
jac->info = 0;
jac->rcond = -1.;
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
PetscStackCall("LAPACKgelss",LAPACKgelss_(&jac->n,&jac->n,&jac->nrhs,jac->h,&jac->lda,jac->beta,&jac->lda,jac->s,&jac->rcond,&jac->rank,jac->work,&jac->lwork,jac->rwork,&jac->info));
#else
PetscStackCall("LAPACKgelss",LAPACKgelss_(&jac->n,&jac->n,&jac->nrhs,jac->h,&jac->lda,jac->beta,&jac->lda,jac->s,&jac->rcond,&jac->rank,jac->work,&jac->lwork,&jac->info));
#endif
ierr = PetscFPTrapPop();CHKERRQ(ierr);
if (jac->info < 0) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_LIB,"Bad argument to GELSS");
if (jac->info > 0) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_LIB,"SVD failed to converge");
#endif
tot = 0.;
total = 0.;
for (i=0; i<jac->n; i++) {
if (snes->errorifnotconverged && PetscIsInfOrNanScalar(jac->beta[i])) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_LIB,"SVD generated inconsistent output");
ierr = PetscInfo2(snes,"%D: %g\n",i,(double)PetscRealPart(jac->beta[i]));CHKERRQ(ierr);
tot += jac->beta[i];
total += PetscAbsScalar(jac->beta[i]);
}
ierr = VecScale(X,(1. - tot));CHKERRQ(ierr);
ierr = VecMAXPY(X,jac->n,jac->beta,Xes);CHKERRQ(ierr);
ierr = SNESComputeFunction(snes,X,F);CHKERRQ(ierr);
if (snes->xl && snes->xu) {
ierr = SNESVIComputeInactiveSetFnorm(snes, F, X, fnorm);CHKERRQ(ierr);
} else {
ierr = VecNorm(F, NORM_2, fnorm);CHKERRQ(ierr);
}
/* take the minimum-normed candidate if it beats the combination by a factor of rtol or the combination has stagnated */
min_fnorm = jac->fnorms[0];
min_i = 0;
for (i=0; i<jac->n; i++) {
if (jac->fnorms[i] < min_fnorm) {
min_fnorm = jac->fnorms[i];
min_i = i;
}
}
/* stagnation or divergence restart to the solution of the solver that failed the least */
if (PetscRealPart(total) < jac->stol || min_fnorm*jac->rtol < *fnorm) {
ierr = VecCopy(jac->Xes[min_i],X);CHKERRQ(ierr);
ierr = VecCopy(jac->Fes[min_i],F);CHKERRQ(ierr);
*fnorm = min_fnorm;
}
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscMPIInt rank,size;
PetscInt nlocal = 6,nghost = 2,ifrom[2],i,rstart,rend;
PetscErrorCode ierr;
PetscBool flg,flg2;
PetscScalar value,*array,*tarray=0;
Vec lx,gx,gxs;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);
if (ierr) return ierr;
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);
CHKERRQ(ierr);
if (size != 2) SETERRQ(PETSC_COMM_SELF,1,"Must run example with two processors\n");
/*
Construct a two dimensional graph connecting nlocal degrees of
freedom per processor. From this we will generate the global
indices of needed ghost values
For simplicity we generate the entire graph on each processor:
in real application the graph would stored in parallel, but this
example is only to demonstrate the management of ghost padding
with VecCreateGhost().
In this example we consider the vector as representing
degrees of freedom in a one dimensional grid with periodic
boundary conditions.
----Processor 1--------- ----Processor 2 --------
0 1 2 3 4 5 6 7 8 9 10 11
|----|
|-------------------------------------------------|
*/
if (!rank) {
ifrom[0] = 11;
ifrom[1] = 6;
} else {
ifrom[0] = 0;
ifrom[1] = 5;
}
/*
Create the vector with two slots for ghost points. Note that both
the local vector (lx) and the global vector (gx) share the same
array for storing vector values.
*/
ierr = PetscOptionsHasName(NULL,NULL,"-allocate",&flg);
CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,NULL,"-vecmpisetghost",&flg2);
CHKERRQ(ierr);
if (flg) {
ierr = PetscMalloc1(nlocal+nghost,&tarray);
CHKERRQ(ierr);
ierr = VecCreateGhostWithArray(PETSC_COMM_WORLD,nlocal,PETSC_DECIDE,nghost,ifrom,tarray,&gxs);
CHKERRQ(ierr);
} else if (flg2) {
ierr = VecCreate(PETSC_COMM_WORLD,&gxs);
CHKERRQ(ierr);
ierr = VecSetType(gxs,VECMPI);
CHKERRQ(ierr);
ierr = VecSetSizes(gxs,nlocal,PETSC_DECIDE);
CHKERRQ(ierr);
ierr = VecMPISetGhost(gxs,nghost,ifrom);
CHKERRQ(ierr);
} else {
ierr = VecCreateGhost(PETSC_COMM_WORLD,nlocal,PETSC_DECIDE,nghost,ifrom,&gxs);
CHKERRQ(ierr);
}
/*
Test VecDuplicate()
*/
ierr = VecDuplicate(gxs,&gx);
CHKERRQ(ierr);
ierr = VecDestroy(&gxs);
CHKERRQ(ierr);
/*
Access the local representation
*/
ierr = VecGhostGetLocalForm(gx,&lx);
CHKERRQ(ierr);
/*
Set the values from 0 to 12 into the "global" vector
*/
ierr = VecGetOwnershipRange(gx,&rstart,&rend);
CHKERRQ(ierr);
for (i=rstart; i<rend; i++) {
value = (PetscScalar) i;
ierr = VecSetValues(gx,1,&i,&value,INSERT_VALUES);
CHKERRQ(ierr);
}
ierr = VecAssemblyBegin(gx);
CHKERRQ(ierr);
ierr = VecAssemblyEnd(gx);
CHKERRQ(ierr);
ierr = VecGhostUpdateBegin(gx,INSERT_VALUES,SCATTER_FORWARD);
CHKERRQ(ierr);
ierr = VecGhostUpdateEnd(gx,INSERT_VALUES,SCATTER_FORWARD);
CHKERRQ(ierr);
/*
Print out each vector, including the ghost padding region.
*/
ierr = VecGetArray(lx,&array);
CHKERRQ(ierr);
for (i=0; i<nlocal+nghost; i++) {
ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD,"%D %g\n",i,(double)PetscRealPart(array[i]));
CHKERRQ(ierr);
}
ierr = VecRestoreArray(lx,&array);
CHKERRQ(ierr);
ierr = PetscSynchronizedFlush(PETSC_COMM_WORLD,PETSC_STDOUT);
CHKERRQ(ierr);
ierr = VecGhostRestoreLocalForm(gx,&lx);
CHKERRQ(ierr);
ierr = VecDestroy(&gx);
CHKERRQ(ierr);
if (flg) {
ierr = PetscFree(tarray);
CHKERRQ(ierr);
}
ierr = PetscFinalize();
return ierr;
}
PETSC_STATIC_INLINE PetscErrorCode DMInterpolate_Hex_Private(DMInterpolationInfo ctx, DM dm, Vec xLocal, Vec v)
{
DM dmCoord;
SNES snes;
KSP ksp;
PC pc;
Vec coordsLocal, r, ref, real;
Mat J;
PetscScalar *a, *coords;
PetscInt p;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = DMGetCoordinatesLocal(dm, &coordsLocal);CHKERRQ(ierr);
ierr = DMGetCoordinateDM(dm, &dmCoord);CHKERRQ(ierr);
ierr = SNESCreate(PETSC_COMM_SELF, &snes);CHKERRQ(ierr);
ierr = SNESSetOptionsPrefix(snes, "hex_interp_");CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_SELF, &r);CHKERRQ(ierr);
ierr = VecSetSizes(r, 3, 3);CHKERRQ(ierr);
ierr = VecSetType(r,dm->vectype);CHKERRQ(ierr);
ierr = VecDuplicate(r, &ref);CHKERRQ(ierr);
ierr = VecDuplicate(r, &real);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_SELF, &J);CHKERRQ(ierr);
ierr = MatSetSizes(J, 3, 3, 3, 3);CHKERRQ(ierr);
ierr = MatSetType(J, MATSEQDENSE);CHKERRQ(ierr);
ierr = MatSetUp(J);CHKERRQ(ierr);
ierr = SNESSetFunction(snes, r, HexMap_Private, NULL);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes, J, J, HexJacobian_Private, NULL);CHKERRQ(ierr);
ierr = SNESGetKSP(snes, &ksp);CHKERRQ(ierr);
ierr = KSPGetPC(ksp, &pc);CHKERRQ(ierr);
ierr = PCSetType(pc, PCLU);CHKERRQ(ierr);
ierr = SNESSetFromOptions(snes);CHKERRQ(ierr);
ierr = VecGetArray(ctx->coords, &coords);CHKERRQ(ierr);
ierr = VecGetArray(v, &a);CHKERRQ(ierr);
for (p = 0; p < ctx->n; ++p) {
PetscScalar *x = NULL, *vertices = NULL;
PetscScalar *xi;
PetscReal xir[3];
PetscInt c = ctx->cells[p], comp, coordSize, xSize;
/* Can make this do all points at once */
ierr = DMPlexVecGetClosure(dmCoord, NULL, coordsLocal, c, &coordSize, &vertices);CHKERRQ(ierr);
if (8*3 != coordSize) SETERRQ2(ctx->comm, PETSC_ERR_ARG_SIZ, "Invalid closure size %d should be %d", coordSize, 8*3);
ierr = DMPlexVecGetClosure(dm, NULL, xLocal, c, &xSize, &x);CHKERRQ(ierr);
if (8*ctx->dof != xSize) SETERRQ2(ctx->comm, PETSC_ERR_ARG_SIZ, "Invalid closure size %d should be %d", xSize, 8*ctx->dof);
ierr = SNESSetFunction(snes, NULL, NULL, (void*) vertices);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes, NULL, NULL, NULL, (void*) vertices);CHKERRQ(ierr);
ierr = VecGetArray(real, &xi);CHKERRQ(ierr);
xi[0] = coords[p*ctx->dim+0];
xi[1] = coords[p*ctx->dim+1];
xi[2] = coords[p*ctx->dim+2];
ierr = VecRestoreArray(real, &xi);CHKERRQ(ierr);
ierr = SNESSolve(snes, real, ref);CHKERRQ(ierr);
ierr = VecGetArray(ref, &xi);CHKERRQ(ierr);
xir[0] = PetscRealPart(xi[0]);
xir[1] = PetscRealPart(xi[1]);
xir[2] = PetscRealPart(xi[2]);
for (comp = 0; comp < ctx->dof; ++comp) {
a[p*ctx->dof+comp] =
x[0*ctx->dof+comp]*(1-xir[0])*(1-xir[1])*(1-xir[2]) +
x[3*ctx->dof+comp]* xir[0]*(1-xir[1])*(1-xir[2]) +
x[2*ctx->dof+comp]* xir[0]* xir[1]*(1-xir[2]) +
x[1*ctx->dof+comp]*(1-xir[0])* xir[1]*(1-xir[2]) +
x[4*ctx->dof+comp]*(1-xir[0])*(1-xir[1])* xir[2] +
x[5*ctx->dof+comp]* xir[0]*(1-xir[1])* xir[2] +
x[6*ctx->dof+comp]* xir[0]* xir[1]* xir[2] +
x[7*ctx->dof+comp]*(1-xir[0])* xir[1]* xir[2];
}
ierr = VecRestoreArray(ref, &xi);CHKERRQ(ierr);
ierr = DMPlexVecRestoreClosure(dmCoord, NULL, coordsLocal, c, &coordSize, &vertices);CHKERRQ(ierr);
ierr = DMPlexVecRestoreClosure(dm, NULL, xLocal, c, &xSize, &x);CHKERRQ(ierr);
}
ierr = VecRestoreArray(v, &a);CHKERRQ(ierr);
ierr = VecRestoreArray(ctx->coords, &coords);CHKERRQ(ierr);
ierr = SNESDestroy(&snes);CHKERRQ(ierr);
ierr = VecDestroy(&r);CHKERRQ(ierr);
ierr = VecDestroy(&ref);CHKERRQ(ierr);
ierr = VecDestroy(&real);CHKERRQ(ierr);
ierr = MatDestroy(&J);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode port_lsd_bfbt(void)
{
Mat A;
Vec x,b;
KSP ksp_A;
PC pc_A;
IS isu,isp;
PetscErrorCode ierr;
PetscFunctionBeginUser;
ierr = LoadTestMatrices(&A,&x,&b,&isu,&isp);CHKERRQ(ierr);
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp_A);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(ksp_A,"fc_");CHKERRQ(ierr);
ierr = KSPSetOperators(ksp_A,A,A);CHKERRQ(ierr);
ierr = KSPGetPC(ksp_A,&pc_A);CHKERRQ(ierr);
ierr = PCSetType(pc_A,PCFIELDSPLIT);CHKERRQ(ierr);
ierr = PCFieldSplitSetBlockSize(pc_A,2);CHKERRQ(ierr);
ierr = PCFieldSplitSetIS(pc_A,"velocity",isu);CHKERRQ(ierr);
ierr = PCFieldSplitSetIS(pc_A,"pressure",isp);CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp_A);CHKERRQ(ierr);
ierr = KSPSolve(ksp_A,b,x);CHKERRQ(ierr);
/* Pull u,p out of x */
{
PetscInt loc;
PetscReal max,norm;
PetscScalar sum;
Vec uvec,pvec;
VecScatter uscat,pscat;
Mat A11,A22;
/* grab matrices and create the compatable u,p vectors */
ierr = MatGetSubMatrix(A,isu,isu,MAT_INITIAL_MATRIX,&A11);CHKERRQ(ierr);
ierr = MatGetSubMatrix(A,isp,isp,MAT_INITIAL_MATRIX,&A22);CHKERRQ(ierr);
ierr = MatCreateVecs(A11,&uvec,NULL);CHKERRQ(ierr);
ierr = MatCreateVecs(A22,&pvec,NULL);CHKERRQ(ierr);
/* perform the scatter from x -> (u,p) */
ierr = VecScatterCreate(x,isu,uvec,NULL,&uscat);CHKERRQ(ierr);
ierr = VecScatterBegin(uscat,x,uvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(uscat,x,uvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterCreate(x,isp,pvec,NULL,&pscat);CHKERRQ(ierr);
ierr = VecScatterBegin(pscat,x,pvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(pscat,x,pvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
PetscPrintf(PETSC_COMM_WORLD,"-- vector vector values --\n");
ierr = VecMin(uvec,&loc,&max);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Min(u) = %1.6f [loc=%D]\n",(double)max,loc);CHKERRQ(ierr);
ierr = VecMax(uvec,&loc,&max);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Max(u) = %1.6f [loc=%D]\n",(double)max,loc);CHKERRQ(ierr);
ierr = VecNorm(uvec,NORM_2,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Norm(u) = %1.6f \n",(double)norm);CHKERRQ(ierr);
ierr = VecSum(uvec,&sum);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Sum(u) = %1.6f \n",(double)PetscRealPart(sum));CHKERRQ(ierr);
PetscPrintf(PETSC_COMM_WORLD,"-- pressure vector values --\n");
ierr = VecMin(pvec,&loc,&max);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Min(p) = %1.6f [loc=%D]\n",(double)max,loc);CHKERRQ(ierr);
ierr = VecMax(pvec,&loc,&max);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Max(p) = %1.6f [loc=%D]\n",(double)max,loc);CHKERRQ(ierr);
ierr = VecNorm(pvec,NORM_2,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Norm(p) = %1.6f \n",(double)norm);CHKERRQ(ierr);
ierr = VecSum(pvec,&sum);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Sum(p) = %1.6f \n",(double)PetscRealPart(sum));CHKERRQ(ierr);
PetscPrintf(PETSC_COMM_WORLD,"-- Full vector values --\n");
ierr = VecMin(x,&loc,&max);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Min(u,p) = %1.6f [loc=%D]\n",(double)max,loc);CHKERRQ(ierr);
ierr = VecMax(x,&loc,&max);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Max(u,p) = %1.6f [loc=%D]\n",(double)max,loc);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Norm(u,p) = %1.6f \n",(double)norm);CHKERRQ(ierr);
ierr = VecSum(x,&sum);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Sum(u,p) = %1.6f \n",(double)PetscRealPart(sum));CHKERRQ(ierr);
ierr = VecScatterDestroy(&uscat);CHKERRQ(ierr);
ierr = VecScatterDestroy(&pscat);CHKERRQ(ierr);
ierr = VecDestroy(&uvec);CHKERRQ(ierr);
ierr = VecDestroy(&pvec);CHKERRQ(ierr);
ierr = MatDestroy(&A11);CHKERRQ(ierr);
ierr = MatDestroy(&A22);CHKERRQ(ierr);
}
ierr = KSPDestroy(&ksp_A);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr);
ierr = ISDestroy(&isu);CHKERRQ(ierr);
ierr = ISDestroy(&isp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
IFunction - Evaluates nonlinear function, F(U).
Input Parameters:
. ts - the TS context
. U - input vector
. ptr - optional user-defined context, as set by SNESSetFunction()
Output Parameter:
. F - function vector
*/
PetscErrorCode IFunction(TS ts,PetscReal ftime,Vec U,Vec Udot,Vec F,void *ptr)
{
AppCtx *appctx = (AppCtx*)ptr;
DM da;
PetscErrorCode ierr;
PetscInt i,Mx,xs,xm;
PetscReal hx,sx;
PetscScalar rho,c,rhoxx,cxx,cx,rhox,kcxrhox;
Field *u,*f,*udot;
Vec localU;
PetscFunctionBegin;
ierr = TSGetDM(ts,&da);CHKERRQ(ierr);
ierr = DMGetLocalVector(da,&localU);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
hx = 1.0/(PetscReal)(Mx-1); sx = 1.0/(hx*hx);
/*
Scatter ghost points to local vector,using the 2-step process
DMGlobalToLocalBegin(),DMGlobalToLocalEnd().
By placing code between these two statements, computations can be
done while messages are in transition.
*/
ierr = DMGlobalToLocalBegin(da,U,INSERT_VALUES,localU);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,U,INSERT_VALUES,localU);CHKERRQ(ierr);
/*
Get pointers to vector data
*/
ierr = DMDAVecGetArrayRead(da,localU,&u);CHKERRQ(ierr);
ierr = DMDAVecGetArrayRead(da,Udot,&udot);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,F,&f);CHKERRQ(ierr);
/*
Get local grid boundaries
*/
ierr = DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);CHKERRQ(ierr);
if (!xs) {
f[0].rho = udot[0].rho; /* u[0].rho - 0.0; */
f[0].c = udot[0].c; /* u[0].c - 1.0; */
xs++;
xm--;
}
if (xs+xm == Mx) {
f[Mx-1].rho = udot[Mx-1].rho; /* u[Mx-1].rho - 1.0; */
f[Mx-1].c = udot[Mx-1].c; /* u[Mx-1].c - 0.0; */
xm--;
}
/*
Compute function over the locally owned part of the grid
*/
for (i=xs; i<xs+xm; i++) {
rho = u[i].rho;
rhoxx = (-2.0*rho + u[i-1].rho + u[i+1].rho)*sx;
c = u[i].c;
cxx = (-2.0*c + u[i-1].c + u[i+1].c)*sx;
if (!appctx->upwind) {
rhox = .5*(u[i+1].rho - u[i-1].rho)/hx;
cx = .5*(u[i+1].c - u[i-1].c)/hx;
kcxrhox = appctx->kappa*(cxx*rho + cx*rhox);
} else {
kcxrhox = appctx->kappa*((u[i+1].c - u[i].c)*u[i+1].rho - (u[i].c - u[i-1].c)*u[i].rho)*sx;
}
f[i].rho = udot[i].rho - appctx->epsilon*rhoxx + kcxrhox - appctx->mu*PetscAbsScalar(rho)*(1.0 - rho)*PetscMax(0,PetscRealPart(c - appctx->cstar)) + appctx->beta*rho;
f[i].c = udot[i].c - appctx->delta*cxx + appctx->lambda*c + appctx->alpha*rho*c/(appctx->gamma + c);
}
/*
Restore vectors
*/
ierr = DMDAVecRestoreArrayRead(da,localU,&u);CHKERRQ(ierr);
ierr = DMDAVecRestoreArrayRead(da,Udot,&udot);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,F,&f);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localU);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PCBDDCSetupFETIDPMatContext(FETIDPMat_ctx fetidpmat_ctx )
{
PetscErrorCode ierr;
PC_IS *pcis=(PC_IS*)fetidpmat_ctx->pc->data;
PC_BDDC *pcbddc=(PC_BDDC*)fetidpmat_ctx->pc->data;
PCBDDCGraph mat_graph=pcbddc->mat_graph;
Mat_IS *matis = (Mat_IS*)fetidpmat_ctx->pc->pmat->data;
MPI_Comm comm;
Mat ScalingMat;
Vec lambda_global;
IS IS_l2g_lambda;
IS subset,subset_mult,subset_n;
PetscBool skip_node,fully_redundant;
PetscInt i,j,k,s,n_boundary_dofs,n_global_lambda,n_vertices,partial_sum;
PetscInt cum,n_local_lambda,n_lambda_for_dof,dual_size,n_neg_values,n_pos_values;
PetscMPIInt rank,size,buf_size,neigh;
PetscScalar scalar_value;
PetscInt *vertex_indices;
PetscInt *dual_dofs_boundary_indices,*aux_local_numbering_1;
const PetscInt *aux_global_numbering;
PetscInt *aux_sums,*cols_B_delta,*l2g_indices;
PetscScalar *array,*scaling_factors,*vals_B_delta;
PetscInt *aux_local_numbering_2;
/* For communication of scaling factors */
PetscInt *ptrs_buffer,neigh_position;
PetscScalar **all_factors,*send_buffer,*recv_buffer;
MPI_Request *send_reqs,*recv_reqs;
/* tests */
Vec test_vec;
PetscBool test_fetidp;
PetscViewer viewer;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)(fetidpmat_ctx->pc),&comm);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
/* Default type of lagrange multipliers is non-redundant */
fully_redundant = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-fetidp_fullyredundant",&fully_redundant,NULL);CHKERRQ(ierr);
/* Evaluate local and global number of lagrange multipliers */
ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
n_local_lambda = 0;
partial_sum = 0;
n_boundary_dofs = 0;
s = 0;
/* Get Vertices used to define the BDDC */
n_vertices = pcbddc->n_vertices;
vertex_indices = pcbddc->local_primal_ref_node;
dual_size = pcis->n_B-n_vertices;
ierr = PetscMalloc1(dual_size,&dual_dofs_boundary_indices);CHKERRQ(ierr);
ierr = PetscMalloc1(dual_size,&aux_local_numbering_1);CHKERRQ(ierr);
ierr = PetscMalloc1(dual_size,&aux_local_numbering_2);CHKERRQ(ierr);
ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
for (i=0;i<pcis->n;i++){
j = mat_graph->count[i]; /* RECALL: mat_graph->count[i] does not count myself */
if ( j > 0 ) {
n_boundary_dofs++;
}
skip_node = PETSC_FALSE;
if ( s < n_vertices && vertex_indices[s]==i) { /* it works for a sorted set of vertices */
skip_node = PETSC_TRUE;
s++;
}
if (j < 1) {
skip_node = PETSC_TRUE;
}
if ( !skip_node ) {
if (fully_redundant) {
/* fully redundant set of lagrange multipliers */
n_lambda_for_dof = (j*(j+1))/2;
} else {
n_lambda_for_dof = j;
}
n_local_lambda += j;
/* needed to evaluate global number of lagrange multipliers */
array[i]=(1.0*n_lambda_for_dof)/(j+1.0); /* already scaled for the next global sum */
/* store some data needed */
dual_dofs_boundary_indices[partial_sum] = n_boundary_dofs-1;
aux_local_numbering_1[partial_sum] = i;
aux_local_numbering_2[partial_sum] = n_lambda_for_dof;
partial_sum++;
}
}
ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecSum(pcis->vec1_global,&scalar_value);CHKERRQ(ierr);
fetidpmat_ctx->n_lambda = (PetscInt)PetscRealPart(scalar_value);
/* compute global ordering of lagrange multipliers and associate l2g map */
ierr = ISCreateGeneral(comm,partial_sum,aux_local_numbering_1,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,partial_sum,aux_local_numbering_2,PETSC_OWN_POINTER,&subset_mult);CHKERRQ(ierr);
ierr = PCBDDCSubsetNumbering(subset,subset_mult,&i,&subset_n);CHKERRQ(ierr);
ierr = ISDestroy(&subset);CHKERRQ(ierr);
if (i != fetidpmat_ctx->n_lambda) {
SETERRQ3(PETSC_COMM_WORLD,PETSC_ERR_PLIB,"Error in %s: global number of multipliers mismatch! (%d!=%d)\n",__FUNCT__,fetidpmat_ctx->n_lambda,i);
}
/* init data for scaling factors exchange */
partial_sum = 0;
j = 0;
ierr = PetscMalloc1(pcis->n_neigh,&ptrs_buffer);CHKERRQ(ierr);
ierr = PetscMalloc1(pcis->n_neigh-1,&send_reqs);CHKERRQ(ierr);
ierr = PetscMalloc1(pcis->n_neigh-1,&recv_reqs);CHKERRQ(ierr);
ierr = PetscMalloc1(pcis->n,&all_factors);CHKERRQ(ierr);
ptrs_buffer[0]=0;
for (i=1;i<pcis->n_neigh;i++) {
partial_sum += pcis->n_shared[i];
ptrs_buffer[i] = ptrs_buffer[i-1]+pcis->n_shared[i];
}
ierr = PetscMalloc1(partial_sum,&send_buffer);CHKERRQ(ierr);
ierr = PetscMalloc1(partial_sum,&recv_buffer);CHKERRQ(ierr);
ierr = PetscMalloc1(partial_sum,&all_factors[0]);CHKERRQ(ierr);
for (i=0;i<pcis->n-1;i++) {
j = mat_graph->count[i];
all_factors[i+1]=all_factors[i]+j;
}
/* scatter B scaling to N vec */
ierr = VecScatterBegin(pcis->N_to_B,pcis->D,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(pcis->N_to_B,pcis->D,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
/* communications */
ierr = VecGetArrayRead(pcis->vec1_N,(const PetscScalar**)&array);CHKERRQ(ierr);
for (i=1;i<pcis->n_neigh;i++) {
for (j=0;j<pcis->n_shared[i];j++) {
send_buffer[ptrs_buffer[i-1]+j]=array[pcis->shared[i][j]];
}
ierr = PetscMPIIntCast(ptrs_buffer[i]-ptrs_buffer[i-1],&buf_size);CHKERRQ(ierr);
ierr = PetscMPIIntCast(pcis->neigh[i],&neigh);CHKERRQ(ierr);
ierr = MPI_Isend(&send_buffer[ptrs_buffer[i-1]],buf_size,MPIU_SCALAR,neigh,0,comm,&send_reqs[i-1]);CHKERRQ(ierr);
ierr = MPI_Irecv(&recv_buffer[ptrs_buffer[i-1]],buf_size,MPIU_SCALAR,neigh,0,comm,&recv_reqs[i-1]);CHKERRQ(ierr);
}
ierr = VecRestoreArrayRead(pcis->vec1_N,(const PetscScalar**)&array);CHKERRQ(ierr);
ierr = MPI_Waitall((pcis->n_neigh-1),recv_reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
/* put values in correct places */
for (i=1;i<pcis->n_neigh;i++) {
for (j=0;j<pcis->n_shared[i];j++) {
k = pcis->shared[i][j];
neigh_position = 0;
while(mat_graph->neighbours_set[k][neigh_position] != pcis->neigh[i]) {neigh_position++;}
all_factors[k][neigh_position]=recv_buffer[ptrs_buffer[i-1]+j];
}
}
ierr = MPI_Waitall((pcis->n_neigh-1),send_reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
ierr = PetscFree(send_reqs);CHKERRQ(ierr);
ierr = PetscFree(recv_reqs);CHKERRQ(ierr);
ierr = PetscFree(send_buffer);CHKERRQ(ierr);
ierr = PetscFree(recv_buffer);CHKERRQ(ierr);
ierr = PetscFree(ptrs_buffer);CHKERRQ(ierr);
/* Compute B and B_delta (local actions) */
ierr = PetscMalloc1(pcis->n_neigh,&aux_sums);CHKERRQ(ierr);
ierr = PetscMalloc1(n_local_lambda,&l2g_indices);CHKERRQ(ierr);
ierr = PetscMalloc1(n_local_lambda,&vals_B_delta);CHKERRQ(ierr);
ierr = PetscMalloc1(n_local_lambda,&cols_B_delta);CHKERRQ(ierr);
ierr = PetscMalloc1(n_local_lambda,&scaling_factors);CHKERRQ(ierr);
ierr = ISGetIndices(subset_n,&aux_global_numbering);CHKERRQ(ierr);
n_global_lambda=0;
partial_sum=0;
cum = 0;
for (i=0;i<dual_size;i++) {
n_global_lambda = aux_global_numbering[cum];
j = mat_graph->count[aux_local_numbering_1[i]];
aux_sums[0]=0;
for (s=1;s<j;s++) {
aux_sums[s]=aux_sums[s-1]+j-s+1;
}
array = all_factors[aux_local_numbering_1[i]];
n_neg_values = 0;
while(n_neg_values < j && mat_graph->neighbours_set[aux_local_numbering_1[i]][n_neg_values] < rank) {n_neg_values++;}
n_pos_values = j - n_neg_values;
if (fully_redundant) {
for (s=0;s<n_neg_values;s++) {
l2g_indices [partial_sum+s]=aux_sums[s]+n_neg_values-s-1+n_global_lambda;
cols_B_delta [partial_sum+s]=dual_dofs_boundary_indices[i];
vals_B_delta [partial_sum+s]=-1.0;
scaling_factors[partial_sum+s]=array[s];
}
for (s=0;s<n_pos_values;s++) {
l2g_indices [partial_sum+s+n_neg_values]=aux_sums[n_neg_values]+s+n_global_lambda;
cols_B_delta [partial_sum+s+n_neg_values]=dual_dofs_boundary_indices[i];
vals_B_delta [partial_sum+s+n_neg_values]=1.0;
scaling_factors[partial_sum+s+n_neg_values]=array[s+n_neg_values];
}
partial_sum += j;
} else {
/* l2g_indices and default cols and vals of B_delta */
for (s=0;s<j;s++) {
l2g_indices [partial_sum+s]=n_global_lambda+s;
cols_B_delta [partial_sum+s]=dual_dofs_boundary_indices[i];
vals_B_delta [partial_sum+s]=0.0;
}
/* B_delta */
if ( n_neg_values > 0 ) { /* there's a rank next to me to the left */
vals_B_delta [partial_sum+n_neg_values-1]=-1.0;
}
if ( n_neg_values < j ) { /* there's a rank next to me to the right */
vals_B_delta [partial_sum+n_neg_values]=1.0;
}
/* scaling as in Klawonn-Widlund 1999*/
for (s=0;s<n_neg_values;s++) {
scalar_value = 0.0;
for (k=0;k<s+1;k++) {
scalar_value += array[k];
}
scaling_factors[partial_sum+s] = -scalar_value;
}
for (s=0;s<n_pos_values;s++) {
scalar_value = 0.0;
for (k=s+n_neg_values;k<j;k++) {
scalar_value += array[k];
}
scaling_factors[partial_sum+s+n_neg_values] = scalar_value;
}
partial_sum += j;
}
cum += aux_local_numbering_2[i];
}
ierr = ISRestoreIndices(subset_n,&aux_global_numbering);CHKERRQ(ierr);
ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
ierr = PetscFree(aux_sums);CHKERRQ(ierr);
ierr = PetscFree(aux_local_numbering_1);CHKERRQ(ierr);
ierr = PetscFree(dual_dofs_boundary_indices);CHKERRQ(ierr);
ierr = PetscFree(all_factors[0]);CHKERRQ(ierr);
ierr = PetscFree(all_factors);CHKERRQ(ierr);
/* Local to global mapping of fetidpmat */
ierr = VecCreate(PETSC_COMM_SELF,&fetidpmat_ctx->lambda_local);CHKERRQ(ierr);
ierr = VecSetSizes(fetidpmat_ctx->lambda_local,n_local_lambda,n_local_lambda);CHKERRQ(ierr);
ierr = VecSetType(fetidpmat_ctx->lambda_local,VECSEQ);CHKERRQ(ierr);
ierr = VecCreate(comm,&lambda_global);CHKERRQ(ierr);
ierr = VecSetSizes(lambda_global,PETSC_DECIDE,fetidpmat_ctx->n_lambda);CHKERRQ(ierr);
ierr = VecSetType(lambda_global,VECMPI);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,n_local_lambda,l2g_indices,PETSC_OWN_POINTER,&IS_l2g_lambda);CHKERRQ(ierr);
ierr = VecScatterCreate(fetidpmat_ctx->lambda_local,(IS)0,lambda_global,IS_l2g_lambda,&fetidpmat_ctx->l2g_lambda);CHKERRQ(ierr);
ierr = ISDestroy(&IS_l2g_lambda);CHKERRQ(ierr);
/* Create local part of B_delta */
ierr = MatCreate(PETSC_COMM_SELF,&fetidpmat_ctx->B_delta);CHKERRQ(ierr);
ierr = MatSetSizes(fetidpmat_ctx->B_delta,n_local_lambda,pcis->n_B,n_local_lambda,pcis->n_B);CHKERRQ(ierr);
ierr = MatSetType(fetidpmat_ctx->B_delta,MATSEQAIJ);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(fetidpmat_ctx->B_delta,1,NULL);CHKERRQ(ierr);
ierr = MatSetOption(fetidpmat_ctx->B_delta,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
for (i=0;i<n_local_lambda;i++) {
ierr = MatSetValue(fetidpmat_ctx->B_delta,i,cols_B_delta[i],vals_B_delta[i],INSERT_VALUES);CHKERRQ(ierr);
}
ierr = PetscFree(vals_B_delta);CHKERRQ(ierr);
ierr = MatAssemblyBegin(fetidpmat_ctx->B_delta,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd (fetidpmat_ctx->B_delta,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (fully_redundant) {
ierr = MatCreate(PETSC_COMM_SELF,&ScalingMat);CHKERRQ(ierr);
ierr = MatSetSizes(ScalingMat,n_local_lambda,n_local_lambda,n_local_lambda,n_local_lambda);CHKERRQ(ierr);
ierr = MatSetType(ScalingMat,MATSEQAIJ);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(ScalingMat,1,NULL);CHKERRQ(ierr);
for (i=0;i<n_local_lambda;i++) {
ierr = MatSetValue(ScalingMat,i,i,scaling_factors[i],INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(ScalingMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd (ScalingMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatMatMult(ScalingMat,fetidpmat_ctx->B_delta,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&fetidpmat_ctx->B_Ddelta);CHKERRQ(ierr);
ierr = MatDestroy(&ScalingMat);CHKERRQ(ierr);
} else {
ierr = MatCreate(PETSC_COMM_SELF,&fetidpmat_ctx->B_Ddelta);CHKERRQ(ierr);
ierr = MatSetSizes(fetidpmat_ctx->B_Ddelta,n_local_lambda,pcis->n_B,n_local_lambda,pcis->n_B);CHKERRQ(ierr);
ierr = MatSetType(fetidpmat_ctx->B_Ddelta,MATSEQAIJ);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(fetidpmat_ctx->B_Ddelta,1,NULL);CHKERRQ(ierr);
for (i=0;i<n_local_lambda;i++) {
ierr = MatSetValue(fetidpmat_ctx->B_Ddelta,i,cols_B_delta[i],scaling_factors[i],INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(fetidpmat_ctx->B_Ddelta,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd (fetidpmat_ctx->B_Ddelta,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
ierr = PetscFree(scaling_factors);CHKERRQ(ierr);
ierr = PetscFree(cols_B_delta);CHKERRQ(ierr);
/* Create some vectors needed by fetidp */
ierr = VecDuplicate(pcis->vec1_B,&fetidpmat_ctx->temp_solution_B);CHKERRQ(ierr);
ierr = VecDuplicate(pcis->vec1_D,&fetidpmat_ctx->temp_solution_D);CHKERRQ(ierr);
test_fetidp = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,"-fetidp_check",&test_fetidp,NULL);CHKERRQ(ierr);
if (test_fetidp && !pcbddc->use_deluxe_scaling) {
PetscReal real_value;
ierr = PetscViewerASCIIGetStdout(comm,&viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPushSynchronized(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"----------FETI_DP TESTS--------------\n");CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"All tests should return zero!\n");CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"FETIDP MAT context in the ");CHKERRQ(ierr);
if (fully_redundant) {
ierr = PetscViewerASCIIPrintf(viewer,"fully redundant case for lagrange multipliers.\n");CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer,"Non-fully redundant case for lagrange multiplier.\n");CHKERRQ(ierr);
}
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
/******************************************************************/
/* TEST A/B: Test numbering of global lambda dofs */
/******************************************************************/
ierr = VecDuplicate(fetidpmat_ctx->lambda_local,&test_vec);CHKERRQ(ierr);
ierr = VecSet(lambda_global,1.0);CHKERRQ(ierr);
ierr = VecSet(test_vec,1.0);CHKERRQ(ierr);
ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
scalar_value = -1.0;
ierr = VecAXPY(test_vec,scalar_value,fetidpmat_ctx->lambda_local);CHKERRQ(ierr);
ierr = VecNorm(test_vec,NORM_INFINITY,&real_value);CHKERRQ(ierr);
ierr = VecDestroy(&test_vec);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(viewer,"A[%04d]: CHECK glob to loc: % 1.14e\n",rank,real_value);CHKERRQ(ierr);
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
if (fully_redundant) {
ierr = VecSet(lambda_global,0.0);CHKERRQ(ierr);
ierr = VecSet(fetidpmat_ctx->lambda_local,0.5);CHKERRQ(ierr);
ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecSum(lambda_global,&scalar_value);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(viewer,"B[%04d]: CHECK loc to glob: % 1.14e\n",rank,PetscRealPart(scalar_value)-fetidpmat_ctx->n_lambda);CHKERRQ(ierr);
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
}
/******************************************************************/
/* TEST C: It should holds B_delta*w=0, w\in\widehat{W} */
/* This is the meaning of the B matrix */
/******************************************************************/
ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* Action of B_delta */
ierr = MatMult(fetidpmat_ctx->B_delta,pcis->vec1_B,fetidpmat_ctx->lambda_local);CHKERRQ(ierr);
ierr = VecSet(lambda_global,0.0);CHKERRQ(ierr);
ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecNorm(lambda_global,NORM_INFINITY,&real_value);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"C[coll]: CHECK infty norm of B_delta*w (w continuous): % 1.14e\n",real_value);CHKERRQ(ierr);
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
/******************************************************************/
/* TEST D: It should holds E_Dw = w - P_Dw w\in\widetilde{W} */
/* E_D = R_D^TR */
/* P_D = B_{D,delta}^T B_{delta} */
/* eq.44 Mandel Tezaur and Dohrmann 2005 */
/******************************************************************/
/* compute a random vector in \widetilde{W} */
ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
scalar_value = 0.0; /* set zero at vertices */
ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
for (i=0;i<n_vertices;i++) { array[vertex_indices[i]]=scalar_value; }
ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
/* store w for final comparison */
ierr = VecDuplicate(pcis->vec1_B,&test_vec);CHKERRQ(ierr);
ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,test_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,test_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* Jump operator P_D : results stored in pcis->vec1_B */
ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* Action of B_delta */
ierr = MatMult(fetidpmat_ctx->B_delta,pcis->vec1_B,fetidpmat_ctx->lambda_local);CHKERRQ(ierr);
ierr = VecSet(lambda_global,0.0);CHKERRQ(ierr);
ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* Action of B_Ddelta^T */
ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = MatMultTranspose(fetidpmat_ctx->B_Ddelta,fetidpmat_ctx->lambda_local,pcis->vec1_B);CHKERRQ(ierr);
/* Average operator E_D : results stored in pcis->vec2_B */
ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = PCBDDCScalingExtension(fetidpmat_ctx->pc,pcis->vec2_B,pcis->vec1_global);CHKERRQ(ierr);
ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_global,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (pcis->global_to_B,pcis->vec1_global,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* test E_D=I-P_D */
scalar_value = 1.0;
ierr = VecAXPY(pcis->vec1_B,scalar_value,pcis->vec2_B);CHKERRQ(ierr);
scalar_value = -1.0;
ierr = VecAXPY(pcis->vec1_B,scalar_value,test_vec);CHKERRQ(ierr);
ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&real_value);CHKERRQ(ierr);
ierr = VecDestroy(&test_vec);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(viewer,"D[%04d] CHECK infty norm of E_D + P_D - I: % 1.14e\n",rank,real_value);CHKERRQ(ierr);
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
/******************************************************************/
/* TEST E: It should holds R_D^TP_Dw=0 w\in\widetilde{W} */
/* eq.48 Mandel Tezaur and Dohrmann 2005 */
/******************************************************************/
ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
scalar_value = 0.0; /* set zero at vertices */
for (i=0;i<n_vertices;i++) { array[vertex_indices[i]]=scalar_value; }
ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
/* Jump operator P_D : results stored in pcis->vec1_B */
ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* Action of B_delta */
ierr = MatMult(fetidpmat_ctx->B_delta,pcis->vec1_B,fetidpmat_ctx->lambda_local);CHKERRQ(ierr);
ierr = VecSet(lambda_global,0.0);CHKERRQ(ierr);
ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,lambda_global,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* Action of B_Ddelta^T */
ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = MatMultTranspose(fetidpmat_ctx->B_Ddelta,fetidpmat_ctx->lambda_local,pcis->vec1_B);CHKERRQ(ierr);
/* scaling */
ierr = PCBDDCScalingExtension(fetidpmat_ctx->pc,pcis->vec1_B,pcis->vec1_global);CHKERRQ(ierr);
ierr = VecNorm(pcis->vec1_global,NORM_INFINITY,&real_value);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"E[coll]: CHECK infty norm of R^T_D P_D: % 1.14e\n",real_value);CHKERRQ(ierr);
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
if (!fully_redundant) {
/******************************************************************/
/* TEST F: It should holds B_{delta}B^T_{D,delta}=I */
/* Corollary thm 14 Mandel Tezaur and Dohrmann 2005 */
/******************************************************************/
ierr = VecDuplicate(lambda_global,&test_vec);CHKERRQ(ierr);
ierr = VecSetRandom(lambda_global,NULL);CHKERRQ(ierr);
/* Action of B_Ddelta^T */
ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,lambda_global,fetidpmat_ctx->lambda_local,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = MatMultTranspose(fetidpmat_ctx->B_Ddelta,fetidpmat_ctx->lambda_local,pcis->vec1_B);CHKERRQ(ierr);
/* Action of B_delta */
ierr = MatMult(fetidpmat_ctx->B_delta,pcis->vec1_B,fetidpmat_ctx->lambda_local);CHKERRQ(ierr);
ierr = VecSet(test_vec,0.0);CHKERRQ(ierr);
ierr = VecScatterBegin(fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,test_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd (fetidpmat_ctx->l2g_lambda,fetidpmat_ctx->lambda_local,test_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
scalar_value = -1.0;
ierr = VecAXPY(lambda_global,scalar_value,test_vec);CHKERRQ(ierr);
ierr = VecNorm(lambda_global,NORM_INFINITY,&real_value);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"E[coll]: CHECK infty norm of P^T_D - I: % 1.14e\n",real_value);CHKERRQ(ierr);
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
ierr = VecDestroy(&test_vec);CHKERRQ(ierr);
}
}
/* final cleanup */
ierr = VecDestroy(&lambda_global);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode NonlinearGS(SNES snes, Vec X, Vec B, void *ctx)
{
DMDALocalInfo info;
Field **x,**b;
PetscErrorCode ierr;
Vec localX, localB;
DM da;
PetscInt xints,xinte,yints,yinte,i,j,k,l;
PetscInt max_its,tot_its;
PetscInt sweeps;
PetscReal rtol,atol,stol;
PetscReal hx,hy,dhx,dhy,hxdhy,hydhx;
PetscReal grashof,prandtl,lid;
PetscScalar u,uxx,uyy,vx,vy,avx,avy,vxp,vxm,vyp,vym;
PetscScalar fu, fv, fomega, ftemp;
PetscScalar dfudu;
PetscScalar dfvdv;
PetscScalar dfodu, dfodv, dfodo;
PetscScalar dftdu, dftdv, dftdt;
PetscScalar yu=0, yv=0, yo=0, yt=0;
PetscScalar bjiu, bjiv, bjiomega, bjitemp;
PetscBool ptconverged;
PetscReal pfnorm,pfnorm0,pynorm,pxnorm;
AppCtx *user = (AppCtx*)ctx;
PetscFunctionBeginUser;
grashof = user->grashof;
prandtl = user->prandtl;
lid = user->lidvelocity;
tot_its = 0;
ierr = SNESNGSGetTolerances(snes,&rtol,&atol,&stol,&max_its);CHKERRQ(ierr);
ierr = SNESNGSGetSweeps(snes,&sweeps);CHKERRQ(ierr);
ierr = SNESGetDM(snes,(DM*)&da);CHKERRQ(ierr);
ierr = DMGetLocalVector(da,&localX);CHKERRQ(ierr);
if (B) {
ierr = DMGetLocalVector(da,&localB);CHKERRQ(ierr);
}
/*
Scatter ghost points to local vector, using the 2-step process
DMGlobalToLocalBegin(), DMGlobalToLocalEnd().
*/
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
if (B) {
ierr = DMGlobalToLocalBegin(da,B,INSERT_VALUES,localB);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,B,INSERT_VALUES,localB);CHKERRQ(ierr);
}
ierr = DMDAGetLocalInfo(da,&info);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,localX,&x);CHKERRQ(ierr);
if (B) {
ierr = DMDAVecGetArrayRead(da,localB,&b);CHKERRQ(ierr);
}
/* looks like a combination of the formfunction / formjacobian routines */
dhx = (PetscReal)(info.mx-1);dhy = (PetscReal)(info.my-1);
hx = 1.0/dhx; hy = 1.0/dhy;
hxdhy = hx*dhy; hydhx = hy*dhx;
xints = info.xs; xinte = info.xs+info.xm; yints = info.ys; yinte = info.ys+info.ym;
/* Set the boundary conditions on the momentum equations */
/* Test whether we are on the bottom edge of the global array */
if (yints == 0) {
j = 0;
/* bottom edge */
for (i=info.xs; i<info.xs+info.xm; i++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
} else {
bjiu = 0.0;
bjiv = 0.0;
}
x[j][i].u = 0.0 + bjiu;
x[j][i].v = 0.0 + bjiv;
}
}
/* Test whether we are on the top edge of the global array */
if (yinte == info.my) {
j = info.my - 1;
/* top edge */
for (i=info.xs; i<info.xs+info.xm; i++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
} else {
bjiu = 0.0;
bjiv = 0.0;
}
x[j][i].u = lid + bjiu;
x[j][i].v = bjiv;
}
}
/* Test whether we are on the left edge of the global array */
if (xints == 0) {
i = 0;
/* left edge */
for (j=info.ys; j<info.ys+info.ym; j++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
} else {
bjiu = 0.0;
bjiv = 0.0;
}
x[j][i].u = 0.0 + bjiu;
x[j][i].v = 0.0 + bjiv;
}
}
/* Test whether we are on the right edge of the global array */
if (xinte == info.mx) {
i = info.mx - 1;
/* right edge */
for (j=info.ys; j<info.ys+info.ym; j++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
} else {
bjiu = 0.0;
bjiv = 0.0;
}
x[j][i].u = 0.0 + bjiu;
x[j][i].v = 0.0 + bjiv;
}
}
for (k=0; k < sweeps; k++) {
for (j=info.ys; j<info.ys + info.ym; j++) {
for (i=info.xs; i<info.xs + info.xm; i++) {
ptconverged = PETSC_FALSE;
pfnorm0 = 0.0;
fu = 0.0;
fv = 0.0;
fomega = 0.0;
ftemp = 0.0;
for (l = 0; l < max_its && !ptconverged; l++) {
if (B) {
bjiu = b[j][i].u;
bjiv = b[j][i].v;
bjiomega = b[j][i].omega;
bjitemp = b[j][i].temp;
} else {
bjiu = 0.0;
bjiv = 0.0;
bjiomega = 0.0;
bjitemp = 0.0;
}
if (i != 0 && i != info.mx - 1 && j != 0 && j != info.my-1) {
/* U velocity */
u = x[j][i].u;
uxx = (2.0*u - x[j][i-1].u - x[j][i+1].u)*hydhx;
uyy = (2.0*u - x[j-1][i].u - x[j+1][i].u)*hxdhy;
fu = uxx + uyy - .5*(x[j+1][i].omega-x[j-1][i].omega)*hx - bjiu;
dfudu = 2.0*(hydhx + hxdhy);
/* V velocity */
u = x[j][i].v;
uxx = (2.0*u - x[j][i-1].v - x[j][i+1].v)*hydhx;
uyy = (2.0*u - x[j-1][i].v - x[j+1][i].v)*hxdhy;
fv = uxx + uyy + .5*(x[j][i+1].omega-x[j][i-1].omega)*hy - bjiv;
dfvdv = 2.0*(hydhx + hxdhy);
/*
convective coefficients for upwinding
*/
vx = x[j][i].u; avx = PetscAbsScalar(vx);
vxp = .5*(vx+avx); vxm = .5*(vx-avx);
vy = x[j][i].v; avy = PetscAbsScalar(vy);
vyp = .5*(vy+avy); vym = .5*(vy-avy);
/* Omega */
u = x[j][i].omega;
uxx = (2.0*u - x[j][i-1].omega - x[j][i+1].omega)*hydhx;
uyy = (2.0*u - x[j-1][i].omega - x[j+1][i].omega)*hxdhy;
fomega = uxx + uyy + (vxp*(u - x[j][i-1].omega) + vxm*(x[j][i+1].omega - u))*hy +
(vyp*(u - x[j-1][i].omega) + vym*(x[j+1][i].omega - u))*hx -
.5*grashof*(x[j][i+1].temp - x[j][i-1].temp)*hy - bjiomega;
/* convective coefficient derivatives */
dfodo = 2.0*(hydhx + hxdhy) + ((vxp - vxm)*hy + (vyp - vym)*hx);
if (PetscRealPart(vx) > 0.0) dfodu = (u - x[j][i-1].omega)*hy;
else dfodu = (x[j][i+1].omega - u)*hy;
if (PetscRealPart(vy) > 0.0) dfodv = (u - x[j-1][i].omega)*hx;
else dfodv = (x[j+1][i].omega - u)*hx;
/* Temperature */
u = x[j][i].temp;
uxx = (2.0*u - x[j][i-1].temp - x[j][i+1].temp)*hydhx;
uyy = (2.0*u - x[j-1][i].temp - x[j+1][i].temp)*hxdhy;
ftemp = uxx + uyy + prandtl*((vxp*(u - x[j][i-1].temp) + vxm*(x[j][i+1].temp - u))*hy + (vyp*(u - x[j-1][i].temp) + vym*(x[j+1][i].temp - u))*hx) - bjitemp;
dftdt = 2.0*(hydhx + hxdhy) + prandtl*((vxp - vxm)*hy + (vyp - vym)*hx);
if (PetscRealPart(vx) > 0.0) dftdu = prandtl*(u - x[j][i-1].temp)*hy;
else dftdu = prandtl*(x[j][i+1].temp - u)*hy;
if (PetscRealPart(vy) > 0.0) dftdv = prandtl*(u - x[j-1][i].temp)*hx;
else dftdv = prandtl*(x[j+1][i].temp - u)*hx;
/* invert the system:
[ dfu / du 0 0 0 ][yu] = [fu]
[ 0 dfv / dv 0 0 ][yv] [fv]
[ dfo / du dfo / dv dfo / do 0 ][yo] [fo]
[ dft / du dft / dv 0 dft / dt ][yt] [ft]
by simple back-substitution
*/
yu = fu / dfudu;
yv = fv / dfvdv;
yo = (fomega - (dfodu*yu + dfodv*yv)) / dfodo;
yt = (ftemp - (dftdu*yu + dftdv*yv)) / dftdt;
x[j][i].u = x[j][i].u - yu;
x[j][i].v = x[j][i].v - yv;
x[j][i].temp = x[j][i].temp - yt;
x[j][i].omega = x[j][i].omega - yo;
}
if (i == 0) {
fomega = x[j][i].omega - (x[j][i+1].v - x[j][i].v)*dhx - bjiomega;
ftemp = x[j][i].temp - bjitemp;
yo = fomega;
yt = ftemp;
x[j][i].omega = x[j][i].omega - fomega;
x[j][i].temp = x[j][i].temp - ftemp;
}
if (i == info.mx - 1) {
fomega = x[j][i].omega - (x[j][i].v - x[j][i-1].v)*dhx - bjiomega;
ftemp = x[j][i].temp - (PetscReal)(grashof>0) - bjitemp;
yo = fomega;
yt = ftemp;
x[j][i].omega = x[j][i].omega - fomega;
x[j][i].temp = x[j][i].temp - ftemp;
}
if (j == 0) {
fomega = x[j][i].omega + (x[j+1][i].u - x[j][i].u)*dhy - bjiomega;
ftemp = x[j][i].temp-x[j+1][i].temp - bjitemp;
yo = fomega;
yt = ftemp;
x[j][i].omega = x[j][i].omega - fomega;
x[j][i].temp = x[j][i].temp - ftemp;
}
if (j == info.my - 1) {
fomega = x[j][i].omega + (x[j][i].u - x[j-1][i].u)*dhy - bjiomega;
ftemp = x[j][i].temp-x[j-1][i].temp - bjitemp;
yo = fomega;
yt = ftemp;
x[j][i].omega = x[j][i].omega - fomega;
x[j][i].temp = x[j][i].temp - ftemp;
}
tot_its++;
pfnorm = PetscRealPart(fu*fu + fv*fv + fomega*fomega + ftemp*ftemp);
pfnorm = PetscSqrtReal(pfnorm);
pynorm = PetscRealPart(yu*yu + yv*yv + yo*yo + yt*yt);
pynorm = PetscSqrtReal(pynorm);
pxnorm = PetscRealPart(x[j][i].u*x[j][i].u + x[j][i].v*x[j][i].v + x[j][i].omega*x[j][i].omega + x[j][i].temp*x[j][i].temp);
pxnorm = PetscSqrtReal(pxnorm);
if (l == 0) pfnorm0 = pfnorm;
if (rtol*pfnorm0 >pfnorm ||
atol > pfnorm ||
pxnorm*stol > pynorm) ptconverged = PETSC_TRUE;
}
}
}
}
ierr = DMDAVecRestoreArray(da,localX,&x);CHKERRQ(ierr);
if (B) {
ierr = DMDAVecRestoreArrayRead(da,localB,&b);CHKERRQ(ierr);
}
ierr = DMLocalToGlobalBegin(da,localX,INSERT_VALUES,X);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(da,localX,INSERT_VALUES,X);CHKERRQ(ierr);
ierr = PetscLogFlops(tot_its*(84.0 + 41.0 + 26.0));CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localX);CHKERRQ(ierr);
if (B) {
ierr = DMRestoreLocalVector(da,&localB);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}