/* collective on KSP */ PetscErrorCode KSPPlotEigenContours_Private(KSP ksp,PetscInt neig,const PetscReal *r,const PetscReal *c) { PetscErrorCode ierr; PetscReal xmin,xmax,ymin,ymax,*xloc,*yloc,*value,px0,py0,rscale,iscale; PetscInt M,N,i,j; PetscMPIInt rank; PetscViewer viewer; PetscDraw draw; PetscDrawAxis drawaxis; PetscFunctionBegin; ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)ksp),&rank);CHKERRQ(ierr); if (rank) PetscFunctionReturn(0); M = 80; N = 80; xmin = r[0]; xmax = r[0]; ymin = c[0]; ymax = c[0]; for (i=1; i<neig; i++) { xmin = PetscMin(xmin,r[i]); xmax = PetscMax(xmax,r[i]); ymin = PetscMin(ymin,c[i]); ymax = PetscMax(ymax,c[i]); } ierr = PetscMalloc3(M,&xloc,N,&yloc,M*N,&value);CHKERRQ(ierr); for (i=0; i<M; i++) xloc[i] = xmin - 0.1*(xmax-xmin) + 1.2*(xmax-xmin)*i/(M-1); for (i=0; i<N; i++) yloc[i] = ymin - 0.1*(ymax-ymin) + 1.2*(ymax-ymin)*i/(N-1); ierr = PolyEval(neig,r,c,0,0,&px0,&py0);CHKERRQ(ierr); rscale = px0/(PetscSqr(px0)+PetscSqr(py0)); iscale = -py0/(PetscSqr(px0)+PetscSqr(py0)); for (j=0; j<N; j++) { for (i=0; i<M; i++) { PetscReal px,py,tx,ty,tmod; ierr = PolyEval(neig,r,c,xloc[i],yloc[j],&px,&py);CHKERRQ(ierr); tx = px*rscale - py*iscale; ty = py*rscale + px*iscale; tmod = PetscSqr(tx) + PetscSqr(ty); /* modulus of the complex polynomial */ if (tmod > 1) tmod = 1.0; if (tmod > 0.5 && tmod < 1) tmod = 0.5; if (tmod > 0.2 && tmod < 0.5) tmod = 0.2; if (tmod > 0.05 && tmod < 0.2) tmod = 0.05; if (tmod < 1e-3) tmod = 1e-3; value[i+j*M] = PetscLogReal(tmod) / PetscLogReal(10.0); } } ierr = PetscViewerDrawOpen(PETSC_COMM_SELF,0,"Iteratively Computed Eigen-contours",PETSC_DECIDE,PETSC_DECIDE,450,450,&viewer);CHKERRQ(ierr); ierr = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr); ierr = PetscDrawTensorContour(draw,M,N,NULL,NULL,value);CHKERRQ(ierr); if (0) { ierr = PetscDrawAxisCreate(draw,&drawaxis);CHKERRQ(ierr); ierr = PetscDrawAxisSetLimits(drawaxis,xmin,xmax,ymin,ymax);CHKERRQ(ierr); ierr = PetscDrawAxisSetLabels(drawaxis,"Eigen-counters","real","imag");CHKERRQ(ierr); ierr = PetscDrawAxisDraw(drawaxis);CHKERRQ(ierr); ierr = PetscDrawAxisDestroy(&drawaxis);CHKERRQ(ierr); } ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); ierr = PetscFree3(xloc,yloc,value);CHKERRQ(ierr); PetscFunctionReturn(0); }
int main(int argc, char **argv) { PetscErrorCode ierr; /* Error code */ char ptype[256] = "hull1972a1"; /* Problem specification */ PetscInt n_refine = 1; /* Number of refinement levels for convergence analysis */ PetscReal refine_fac = 2.0; /* Refinement factor for dt */ PetscReal dt_initial = 0.01; /* Initial default value of dt */ PetscReal dt; PetscReal tfinal = 20.0; /* Final time for the time-integration */ PetscInt maxiter = 100000; /* Maximum number of time-integration iterations */ PetscReal *error; /* Array to store the errors for convergence analysis */ PetscMPIInt size; /* No of processors */ PetscBool flag; /* Flag denoting availability of exact solution */ PetscInt r; /* Initialize program */ PetscInitialize(&argc,&argv,(char*)0,help); /* Check if running with only 1 proc */ ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); if (size>1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Only for sequential runs"); ierr = PetscOptionsString("-problem","Problem specification","<hull1972a1>", ptype,ptype,sizeof(ptype),NULL);CHKERRQ(ierr); ierr = PetscOptionsInt("-refinement_levels","Number of refinement levels for convergence analysis", "<1>",n_refine,&n_refine,NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-refinement_factor","Refinement factor for dt","<2.0>", refine_fac,&refine_fac,NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-dt","Time step size (for convergence analysis, initial time step)", "<0.01>",dt_initial,&dt_initial,NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-final_time","Final time for the time-integration","<20.0>", tfinal,&tfinal,NULL);CHKERRQ(ierr); ierr = PetscMalloc1(n_refine,&error);CHKERRQ(ierr); for (r = 0,dt = dt_initial; r < n_refine; r++) { error[r] = 0; if (r > 0) dt /= refine_fac; ierr = PetscPrintf(PETSC_COMM_WORLD,"Solving ODE \"%s\" with dt %f, final time %f and system size %D.\n",ptype,(double)dt,(double)tfinal,GetSize(&ptype[0])); ierr = SolveODE(&ptype[0],dt,tfinal,maxiter,&error[r],&flag); if (flag) { /* If exact solution available for the specified ODE */ if (r > 0) { PetscReal conv_rate = (PetscLogReal(error[r]) - PetscLogReal(error[r-1])) / (-PetscLogReal(refine_fac)); ierr = PetscPrintf(PETSC_COMM_WORLD,"Error = %E,\tConvergence rate = %f\n.",(double)error[r],(double)conv_rate);CHKERRQ(ierr); } else { ierr = PetscPrintf(PETSC_COMM_WORLD,"Error = %E.\n",error[r]);CHKERRQ(ierr); } } } ierr = PetscFree(error);CHKERRQ(ierr); /* Exit */ PetscFinalize(); return(0); }
static PetscErrorCode KSPSolve_AGMRES(KSP ksp) { PetscErrorCode ierr; PetscInt its; KSP_AGMRES *agmres = (KSP_AGMRES*)ksp->data; PetscBool guess_zero = ksp->guess_zero; PetscReal res_old, res; PetscInt test; PetscFunctionBegin; ierr = PetscObjectSAWsTakeAccess((PetscObject)ksp);CHKERRQ(ierr); ksp->its = 0; ierr = PetscObjectSAWsGrantAccess((PetscObject)ksp);CHKERRQ(ierr); ksp->reason = KSP_CONVERGED_ITERATING; if (!agmres->HasShifts) { /* Compute Shifts for the Newton basis */ ierr = KSPComputeShifts_DGMRES(ksp);CHKERRQ(ierr); } /* NOTE: At this step, the initial guess is not equal to zero since one cycle of the classical GMRES is performed to compute the shifts */ ierr = (*ksp->converged)(ksp,0,ksp->rnorm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr); while (!ksp->reason) { ierr = KSPInitialResidual(ksp,ksp->vec_sol,VEC_TMP,VEC_TMP_MATOP,VEC_V(0),ksp->vec_rhs);CHKERRQ(ierr); if ((ksp->pc_side == PC_LEFT) && agmres->r && agmres->DeflPrecond) { ierr = KSPDGMRESApplyDeflation_DGMRES(ksp, VEC_V(0), VEC_TMP);CHKERRQ(ierr); ierr = VecCopy(VEC_TMP, VEC_V(0));CHKERRQ(ierr); agmres->matvecs += 1; } ierr = VecNormalize(VEC_V(0),&(ksp->rnorm));CHKERRQ(ierr); KSPCheckNorm(ksp,ksp->rnorm); res_old = ksp->rnorm; /* Record the residual norm to test if deflation is needed */ ksp->ops->buildsolution = KSPBuildSolution_AGMRES; ierr = KSPAGMRESCycle(&its,ksp);CHKERRQ(ierr); if (ksp->its >= ksp->max_it) { if (!ksp->reason) ksp->reason = KSP_DIVERGED_ITS; break; } /* compute the eigenvectors to augment the subspace : use an adaptive strategy */ res = ksp->rnorm; if (!ksp->reason && agmres->neig > 0) { test = agmres->max_k * PetscLogReal(ksp->rtol/res) / PetscLogReal(res/res_old); /* estimate the remaining number of steps */ if ((test > agmres->smv*(ksp->max_it-ksp->its)) || agmres->force) { if (!agmres->force && ((test > agmres->bgv*(ksp->max_it-ksp->its)) && ((agmres->r + 1) < agmres->max_neig))) { agmres->neig += 1; /* Augment the number of eigenvalues to deflate if the convergence is too slow */ } ierr = KSPDGMRESComputeDeflationData_DGMRES(ksp,&agmres->neig);CHKERRQ(ierr); } } ksp->guess_zero = PETSC_FALSE; /* every future call to KSPInitialResidual() will have nonzero guess */ } ksp->guess_zero = guess_zero; /* restore if user has provided nonzero initial guess */ PetscFunctionReturn(0); }
PetscErrorCode FormPsiAndExactSoln(DM da) { ObsCtx *user; PetscErrorCode ierr; DMDALocalInfo info; PetscInt i,j; DM coordDA; Vec coordinates; DMDACoor2d **coords; PetscReal **psi, **uexact, r; const PetscReal afree = 0.69797, A = 0.68026, B = 0.47152; PetscFunctionBeginUser; ierr = DMGetApplicationContext(da,&user);CHKERRQ(ierr); ierr = DMDAGetLocalInfo(da,&info); CHKERRQ(ierr); ierr = DMGetCoordinateDM(da, &coordDA);CHKERRQ(ierr); ierr = DMGetCoordinates(da, &coordinates);CHKERRQ(ierr); ierr = DMDAVecGetArray(coordDA, coordinates, &coords);CHKERRQ(ierr); ierr = DMDAVecGetArray(da, user->psi, &psi);CHKERRQ(ierr); ierr = DMDAVecGetArray(da, user->uexact, &uexact);CHKERRQ(ierr); for (j=info.ys; j<info.ys+info.ym; j++) { for (i=info.xs; i<info.xs+info.xm; i++) { r = PetscSqrtReal(pow(coords[j][i].x,2) + pow(coords[j][i].y,2)); if (r <= 1.0) psi[j][i] = PetscSqrtReal(1.0 - r * r); else psi[j][i] = -1.0; if (r <= afree) uexact[j][i] = psi[j][i]; /* on the obstacle */ else uexact[j][i] = - A * PetscLogReal(r) + B; /* solves the laplace eqn */ } } ierr = DMDAVecRestoreArray(da, user->psi, &psi);CHKERRQ(ierr); ierr = DMDAVecRestoreArray(da, user->uexact, &uexact);CHKERRQ(ierr); ierr = DMDAVecRestoreArray(coordDA, coordinates, &coords);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode stdNormalArray(PetscReal *eps, PetscInt numdim, PetscRandom ran) { PetscInt i; PetscScalar u1,u2; PetscReal t; PetscErrorCode ierr; PetscFunctionBegin; for (i=0; i<numdim; i+=2) { ierr = PetscRandomGetValue(ran,&u1);CHKERRQ(ierr); ierr = PetscRandomGetValue(ran,&u2);CHKERRQ(ierr); t = PetscSqrtReal(-2*PetscLogReal(PetscRealPart(u1))); eps[i] = t * PetscCosReal(2*PETSC_PI*PetscRealPart(u2)); eps[i+1] = t * PetscSinReal(2*PETSC_PI*PetscRealPart(u2)); } PetscFunctionReturn(0); }
//FORMPSI PetscErrorCode FormPsiAndInitialGuess(DM da,Vec U0,PetscBool feasible, ObsCtx *user) { PetscErrorCode ierr; PetscInt i,j; PetscReal **psi, **u0, **uexact, x, y, r, pi = PETSC_PI, afree = 0.69797, A = 0.68026, B = 0.47152; DMDALocalInfo info; PetscFunctionBeginUser; ierr = DMDAGetLocalInfo(da,&info); CHKERRQ(ierr); ierr = DMDAVecGetArray(da, user->psi, &psi);CHKERRQ(ierr); ierr = DMDAVecGetArray(da, U0, &u0);CHKERRQ(ierr); ierr = DMDAVecGetArray(da, user->g, &uexact);CHKERRQ(ierr); for (j=info.ys; j<info.ys+info.ym; j++) { y = -2.0 + j * user->dy; for (i=info.xs; i<info.xs+info.xm; i++) { x = -2.0 + i * user->dx; r = PetscSqrtReal(x * x + y * y); if (r <= 1.0) psi[j][i] = PetscSqrtReal(1.0 - r * r); else psi[j][i] = -1.0; if (r <= afree) uexact[j][i] = psi[j][i]; /* on the obstacle */ else uexact[j][i] = - A * PetscLogReal(r) + B; /* solves the laplace eqn */ if (feasible) { if (i == 0 || j == 0 || i == info.mx-1 || j == info.my-1) u0[j][i] = uexact[j][i]; else u0[j][i] = uexact[j][i] + PetscCosReal(pi*x/4.0)*PetscCosReal(pi*y/4.0); } else u0[j][i] = 0.; } } ierr = DMDAVecRestoreArray(da, user->psi, &psi);CHKERRQ(ierr); ierr = DMDAVecRestoreArray(da, U0, &u0);CHKERRQ(ierr); ierr = DMDAVecRestoreArray(da, user->g, &uexact);CHKERRQ(ierr); PetscFunctionReturn(0); }
/* PEPBuildDiagonalScaling - compute two diagonal matrices to be applied for balancing in polynomial eigenproblems. */ PetscErrorCode PEPBuildDiagonalScaling(PEP pep) { PetscErrorCode ierr; PetscInt it,i,j,k,nmat,nr,e,nz,lst,lend,nc=0,*cols,emax,emin,emaxl,eminl; const PetscInt *cidx,*ridx; Mat M,*T,A; PetscMPIInt n; PetscBool cont=PETSC_TRUE,flg=PETSC_FALSE; PetscScalar *array,*Dr,*Dl,t; PetscReal l2,d,*rsum,*aux,*csum,w=1.0; MatStructure str; MatInfo info; PetscFunctionBegin; l2 = 2*PetscLogReal(2.0); nmat = pep->nmat; ierr = PetscMPIIntCast(pep->n,&n); ierr = STGetMatStructure(pep->st,&str);CHKERRQ(ierr); ierr = PetscMalloc1(nmat,&T);CHKERRQ(ierr); for (k=0;k<nmat;k++) { ierr = STGetTOperators(pep->st,k,&T[k]);CHKERRQ(ierr); } /* Form local auxiliar matrix M */ ierr = PetscObjectTypeCompareAny((PetscObject)T[0],&cont,MATMPIAIJ,MATSEQAIJ);CHKERRQ(ierr); if (!cont) SETERRQ(PetscObjectComm((PetscObject)T[0]),PETSC_ERR_SUP,"Only for MPIAIJ or SEQAIJ matrix types"); ierr = PetscObjectTypeCompare((PetscObject)T[0],MATMPIAIJ,&cont);CHKERRQ(ierr); if (cont) { ierr = MatMPIAIJGetLocalMat(T[0],MAT_INITIAL_MATRIX,&M);CHKERRQ(ierr); flg = PETSC_TRUE; } else { ierr = MatDuplicate(T[0],MAT_COPY_VALUES,&M);CHKERRQ(ierr); } ierr = MatGetInfo(M,MAT_LOCAL,&info);CHKERRQ(ierr); nz = info.nz_used; ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr); for (i=0;i<nz;i++) { t = PetscAbsScalar(array[i]); array[i] = t*t; } ierr = MatSeqAIJRestoreArray(M,&array);CHKERRQ(ierr); for (k=1;k<nmat;k++) { if (flg) { ierr = MatMPIAIJGetLocalMat(T[k],MAT_INITIAL_MATRIX,&A);CHKERRQ(ierr); } else { if (str==SAME_NONZERO_PATTERN) { ierr = MatCopy(T[k],A,SAME_NONZERO_PATTERN);CHKERRQ(ierr); } else { ierr = MatDuplicate(T[k],MAT_COPY_VALUES,&A);CHKERRQ(ierr); } } ierr = MatGetInfo(A,MAT_LOCAL,&info);CHKERRQ(ierr); nz = info.nz_used; ierr = MatSeqAIJGetArray(A,&array);CHKERRQ(ierr); for (i=0;i<nz;i++) { t = PetscAbsScalar(array[i]); array[i] = t*t; } ierr = MatSeqAIJRestoreArray(A,&array);CHKERRQ(ierr); w *= pep->slambda*pep->slambda*pep->sfactor; ierr = MatAXPY(M,w,A,str);CHKERRQ(ierr); if (flg || str!=SAME_NONZERO_PATTERN || k==nmat-2) { ierr = MatDestroy(&A);CHKERRQ(ierr); } } ierr = MatGetRowIJ(M,0,PETSC_FALSE,PETSC_FALSE,&nr,&ridx,&cidx,&cont);CHKERRQ(ierr); if (!cont) SETERRQ(PetscObjectComm((PetscObject)T[0]), PETSC_ERR_SUP,"It is not possible to compute scaling diagonals for these PEP matrices"); ierr = MatGetInfo(M,MAT_LOCAL,&info);CHKERRQ(ierr); nz = info.nz_used; ierr = VecGetOwnershipRange(pep->Dl,&lst,&lend);CHKERRQ(ierr); ierr = PetscMalloc4(nr,&rsum,pep->n,&csum,pep->n,&aux,PetscMin(pep->n-lend+lst,nz),&cols);CHKERRQ(ierr); ierr = VecSet(pep->Dr,1.0);CHKERRQ(ierr); ierr = VecSet(pep->Dl,1.0);CHKERRQ(ierr); ierr = VecGetArray(pep->Dl,&Dl);CHKERRQ(ierr); ierr = VecGetArray(pep->Dr,&Dr);CHKERRQ(ierr); ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr); ierr = PetscMemzero(aux,pep->n*sizeof(PetscReal));CHKERRQ(ierr); for (j=0;j<nz;j++) { /* Search non-zero columns outsize lst-lend */ if (aux[cidx[j]]==0 && (cidx[j]<lst || lend<=cidx[j])) cols[nc++] = cidx[j]; /* Local column sums */ aux[cidx[j]] += PetscAbsScalar(array[j]); } for (it=0;it<pep->sits && cont;it++) { emaxl = 0; eminl = 0; /* Column sum */ if (it>0) { /* it=0 has been already done*/ ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr); ierr = PetscMemzero(aux,pep->n*sizeof(PetscReal));CHKERRQ(ierr); for (j=0;j<nz;j++) aux[cidx[j]] += PetscAbsScalar(array[j]); ierr = MatSeqAIJRestoreArray(M,&array);CHKERRQ(ierr); } ierr = MPI_Allreduce(aux,csum,n,MPIU_REAL,MPIU_SUM,PetscObjectComm((PetscObject)pep->Dr)); /* Update Dr */ for (j=lst;j<lend;j++) { d = PetscLogReal(csum[j])/l2; e = -(PetscInt)((d < 0)?(d-0.5):(d+0.5)); d = PetscPowReal(2.0,e); Dr[j-lst] *= d; aux[j] = d*d; emaxl = PetscMax(emaxl,e); eminl = PetscMin(eminl,e); } for (j=0;j<nc;j++) { d = PetscLogReal(csum[cols[j]])/l2; e = -(PetscInt)((d < 0)?(d-0.5):(d+0.5)); d = PetscPowReal(2.0,e); aux[cols[j]] = d*d; emaxl = PetscMax(emaxl,e); eminl = PetscMin(eminl,e); } /* Scale M */ ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr); for (j=0;j<nz;j++) { array[j] *= aux[cidx[j]]; } ierr = MatSeqAIJRestoreArray(M,&array);CHKERRQ(ierr); /* Row sum */ ierr = PetscMemzero(rsum,nr*sizeof(PetscReal));CHKERRQ(ierr); ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr); for (i=0;i<nr;i++) { for (j=ridx[i];j<ridx[i+1];j++) rsum[i] += PetscAbsScalar(array[j]); /* Update Dl */ d = PetscLogReal(rsum[i])/l2; e = -(PetscInt)((d < 0)?(d-0.5):(d+0.5)); d = PetscPowReal(2.0,e); Dl[i] *= d; /* Scale M */ for (j=ridx[i];j<ridx[i+1];j++) array[j] *= d*d; emaxl = PetscMax(emaxl,e); eminl = PetscMin(eminl,e); } ierr = MatSeqAIJRestoreArray(M,&array);CHKERRQ(ierr); /* Compute global max and min */ ierr = MPI_Allreduce(&emaxl,&emax,1,MPIU_INT,MPIU_MAX,PetscObjectComm((PetscObject)pep->Dl)); ierr = MPI_Allreduce(&eminl,&emin,1,MPIU_INT,MPIU_MIN,PetscObjectComm((PetscObject)pep->Dl)); if (emax<=emin+2) cont = PETSC_FALSE; } ierr = VecRestoreArray(pep->Dr,&Dr);CHKERRQ(ierr); ierr = VecRestoreArray(pep->Dl,&Dl);CHKERRQ(ierr); /* Free memory*/ ierr = MatDestroy(&M);CHKERRQ(ierr); ierr = PetscFree4(rsum,csum,aux,cols);CHKERRQ(ierr); ierr = PetscFree(T);CHKERRQ(ierr); PetscFunctionReturn(0); }
int main(int Argc,char **Args) { PetscBool flg; PetscInt n = -6; PetscScalar rho = 1.0; PetscReal h; PetscReal beta = 1.0; DM da; PetscRandom rctx; PetscMPIInt comm_size; Mat H,HtH; PetscInt x, y, xs, ys, xm, ym; PetscReal r1, r2; PetscScalar uxy1, uxy2; MatStencil sxy, sxy_m; PetscScalar val, valconj; Vec b, Htb,xvec; KSP kspmg; PC pcmg; PetscErrorCode ierr; PetscInt ix[1] = {0}; PetscScalar vals[1] = {1.0}; PetscInitialize(&Argc,&Args,(char*)0,help); ierr = PetscOptionsGetInt(NULL,"-size",&n,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetReal(NULL,"-beta",&beta,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-rho",&rho,&flg);CHKERRQ(ierr); /* Set the fudge parameters, we scale the whole thing by 1/(2*h) later */ h = 1.; rho *= 1./(2.*h); /* Geometry info */ ierr = DMDACreate2d(PETSC_COMM_WORLD, DMDA_BOUNDARY_PERIODIC,DMDA_BOUNDARY_PERIODIC, DMDA_STENCIL_STAR, n, n, PETSC_DECIDE, PETSC_DECIDE, 2 /* this is the # of dof's */, 1, NULL, NULL, &da);CHKERRQ(ierr); /* Random numbers */ ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rctx);CHKERRQ(ierr); ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr); /* Single or multi processor ? */ ierr = MPI_Comm_size(PETSC_COMM_WORLD,&comm_size);CHKERRQ(ierr); /* construct matrix */ ierr = DMSetMatType(da,MATAIJ);CHKERRQ(ierr); ierr = DMCreateMatrix(da, &H);CHKERRQ(ierr); /* get local corners for this processor */ ierr = DMDAGetCorners(da,&xs,&ys,0,&xm,&ym,0);CHKERRQ(ierr); /* Assemble the matrix */ for (x=xs; x<xs+xm; x++) { for (y=ys; y<ys+ym; y++) { /* each lattice point sets only the *forward* pointing parameters (right, down), i.e. Nabla_1^+ and Nabla_2^+. In this way we can use only local random number creation. That means we also have to set the corresponding backward pointing entries. */ /* Compute some normally distributed random numbers via Box-Muller */ ierr = PetscRandomGetValueReal(rctx, &r1);CHKERRQ(ierr); r1 = 1.-r1; /* to change from [0,1) to (0,1], which we need for the log */ ierr = PetscRandomGetValueReal(rctx, &r2);CHKERRQ(ierr); PetscReal R = PetscSqrtReal(-2.*PetscLogReal(r1)); PetscReal c = PetscCosReal(2.*PETSC_PI*r2); PetscReal s = PetscSinReal(2.*PETSC_PI*r2); /* use those to set the field */ uxy1 = PetscExpScalar(((PetscScalar) (R*c/beta))*PETSC_i); uxy2 = PetscExpScalar(((PetscScalar) (R*s/beta))*PETSC_i); sxy.i = x; sxy.j = y; /* the point where we are */ /* center action */ sxy.c = 0; /* spin 0, 0 */ ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy, &rho, ADD_VALUES);CHKERRQ(ierr); sxy.c = 1; /* spin 1, 1 */ val = -rho; ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy, &val, ADD_VALUES);CHKERRQ(ierr); sxy_m.i = x+1; sxy_m.j = y; /* right action */ sxy.c = 0; sxy_m.c = 0; /* spin 0, 0 */ val = -uxy1; valconj = PetscConj(val); ierr = MatSetValuesStencil(H, 1, &sxy_m, 1, &sxy, &val, ADD_VALUES);CHKERRQ(ierr); ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy_m, &valconj, ADD_VALUES);CHKERRQ(ierr); sxy.c = 0; sxy_m.c = 1; /* spin 0, 1 */ val = -uxy1; valconj = PetscConj(val); ierr = MatSetValuesStencil(H, 1, &sxy_m, 1, &sxy, &val, ADD_VALUES);CHKERRQ(ierr); ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy_m, &valconj, ADD_VALUES);CHKERRQ(ierr); sxy.c = 1; sxy_m.c = 0; /* spin 1, 0 */ val = uxy1; valconj = PetscConj(val); ierr = MatSetValuesStencil(H, 1, &sxy_m, 1, &sxy, &val, ADD_VALUES);CHKERRQ(ierr); ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy_m, &valconj, ADD_VALUES);CHKERRQ(ierr); sxy.c = 1; sxy_m.c = 1; /* spin 1, 1 */ val = uxy1; valconj = PetscConj(val); ierr = MatSetValuesStencil(H, 1, &sxy_m, 1, &sxy, &val, ADD_VALUES);CHKERRQ(ierr); ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy_m, &valconj, ADD_VALUES);CHKERRQ(ierr); sxy_m.i = x; sxy_m.j = y+1; /* down action */ sxy.c = 0; sxy_m.c = 0; /* spin 0, 0 */ val = -uxy2; valconj = PetscConj(val); ierr = MatSetValuesStencil(H, 1, &sxy_m, 1, &sxy, &val, ADD_VALUES);CHKERRQ(ierr); ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy_m, &valconj, ADD_VALUES);CHKERRQ(ierr); sxy.c = 0; sxy_m.c = 1; /* spin 0, 1 */ val = -PETSC_i*uxy2; valconj = PetscConj(val); ierr = MatSetValuesStencil(H, 1, &sxy_m, 1, &sxy, &val, ADD_VALUES);CHKERRQ(ierr); ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy_m, &valconj, ADD_VALUES);CHKERRQ(ierr); sxy.c = 1; sxy_m.c = 0; /* spin 1, 0 */ val = -PETSC_i*uxy2; valconj = PetscConj(val); ierr = MatSetValuesStencil(H, 1, &sxy_m, 1, &sxy, &val, ADD_VALUES);CHKERRQ(ierr); ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy_m, &valconj, ADD_VALUES);CHKERRQ(ierr); sxy.c = 1; sxy_m.c = 1; /* spin 1, 1 */ val = PetscConj(uxy2); valconj = PetscConj(val); ierr = MatSetValuesStencil(H, 1, &sxy_m, 1, &sxy, &val, ADD_VALUES);CHKERRQ(ierr); ierr = MatSetValuesStencil(H, 1, &sxy, 1, &sxy_m, &valconj, ADD_VALUES);CHKERRQ(ierr); } } ierr = MatAssemblyBegin(H, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(H, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); /* scale H */ ierr = MatScale(H, 1./(2.*h));CHKERRQ(ierr); /* it looks like H is Hermetian */ /* construct normal equations */ ierr = MatMatMult(H, H, MAT_INITIAL_MATRIX, 1., &HtH);CHKERRQ(ierr); /* permutation matrix to check whether H and HtH are identical to the ones in the paper */ /* Mat perm; */ /* ierr = DMCreateMatrix(da, &perm);CHKERRQ(ierr); */ /* PetscInt row, col; */ /* PetscScalar one = 1.0; */ /* for (PetscInt i=0; i<n; i++) { */ /* for (PetscInt j=0; j<n; j++) { */ /* row = (i*n+j)*2; col = i*n+j; */ /* ierr = MatSetValues(perm, 1, &row, 1, &col, &one, INSERT_VALUES);CHKERRQ(ierr); */ /* row = (i*n+j)*2+1; col = i*n+j + n*n; */ /* ierr = MatSetValues(perm, 1, &row, 1, &col, &one, INSERT_VALUES);CHKERRQ(ierr); */ /* } */ /* } */ /* ierr = MatAssemblyBegin(perm, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); */ /* ierr = MatAssemblyEnd(perm, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); */ /* Mat Hperm; */ /* ierr = MatPtAP(H, perm, MAT_INITIAL_MATRIX, 1.0, &Hperm);CHKERRQ(ierr); */ /* ierr = PetscPrintf(PETSC_COMM_WORLD, "Matrix H after construction\n");CHKERRQ(ierr); */ /* ierr = MatView(Hperm, PETSC_VIEWER_STDOUT_(PETSC_COMM_WORLD));CHKERRQ(ierr); */ /* Mat HtHperm; */ /* ierr = MatPtAP(HtH, perm, MAT_INITIAL_MATRIX, 1.0, &HtHperm);CHKERRQ(ierr); */ /* ierr = PetscPrintf(PETSC_COMM_WORLD, "Matrix HtH:\n");CHKERRQ(ierr); */ /* ierr = MatView(HtHperm, PETSC_VIEWER_STDOUT_(PETSC_COMM_WORLD));CHKERRQ(ierr); */ /* right hand side */ ierr = DMCreateGlobalVector(da, &b);CHKERRQ(ierr); ierr = VecSet(b,0.0);CHKERRQ(ierr); ierr = VecSetValues(b, 1, ix, vals, INSERT_VALUES);CHKERRQ(ierr); ierr = VecAssemblyBegin(b);CHKERRQ(ierr); ierr = VecAssemblyEnd(b);CHKERRQ(ierr); /* ierr = VecSetRandom(b, rctx);CHKERRQ(ierr); */ ierr = VecDuplicate(b, &Htb);CHKERRQ(ierr); ierr = MatMultTranspose(H, b, Htb);CHKERRQ(ierr); /* construct solver */ ierr = KSPCreate(PETSC_COMM_WORLD,&kspmg);CHKERRQ(ierr); ierr = KSPSetType(kspmg, KSPCG);CHKERRQ(ierr); ierr = KSPGetPC(kspmg,&pcmg);CHKERRQ(ierr); ierr = PCSetType(pcmg,PCASA);CHKERRQ(ierr); /* maybe user wants to override some of the choices */ ierr = KSPSetFromOptions(kspmg);CHKERRQ(ierr); ierr = KSPSetOperators(kspmg, HtH, HtH, DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); ierr = DMDASetRefinementFactor(da, 3, 3, 3);CHKERRQ(ierr); ierr = PCSetDM(pcmg,da);CHKERRQ(ierr); ierr = PCASASetTolerances(pcmg, 1.e-6, 1.e-10,PETSC_DEFAULT,PETSC_DEFAULT);CHKERRQ(ierr); ierr = VecDuplicate(b, &xvec);CHKERRQ(ierr); ierr = VecSet(xvec, 0.0);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Solve the linear system - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = KSPSolve(kspmg, Htb, xvec);CHKERRQ(ierr); /* ierr = VecView(xvec, PETSC_VIEWER_STDOUT_(PETSC_COMM_WORLD));CHKERRQ(ierr); */ ierr = KSPDestroy(&kspmg);CHKERRQ(ierr); ierr = VecDestroy(&xvec);CHKERRQ(ierr); /* seems to be destroyed by KSPDestroy */ ierr = VecDestroy(&b);CHKERRQ(ierr); ierr = VecDestroy(&Htb);CHKERRQ(ierr); ierr = MatDestroy(&HtH);CHKERRQ(ierr); ierr = MatDestroy(&H);CHKERRQ(ierr); ierr = DMDestroy(&da);CHKERRQ(ierr); ierr = PetscRandomDestroy(&rctx);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }
int main(int argc,char **argv) { PetscDrawLG lg; PetscErrorCode ierr; PetscInt Mx = 100,i; PetscReal x,hx = .1/Mx,pause,xx[3],yy[3]; PetscDraw draw; const char *const legend[] = {"(1 - u^2)^2","1 - u^2","-(1 - u)log(1 - u)"}; PetscDrawAxis axis; PetscDrawViewPorts *ports; PetscFunctionBegin; ierr = PetscInitialize(&argc,&argv,0,help);if (ierr) return ierr; ierr = PetscViewerDrawResize(PETSC_VIEWER_DRAW_(PETSC_COMM_WORLD),1200,800);CHKERRQ(ierr); ierr = PetscViewerDrawGetDrawLG(PETSC_VIEWER_DRAW_(PETSC_COMM_WORLD),0,&lg);CHKERRQ(ierr); ierr = PetscDrawLGGetDraw(lg,&draw);CHKERRQ(ierr); ierr = PetscDrawCheckResizedWindow(draw);CHKERRQ(ierr); ierr = PetscDrawViewPortsCreateRect(draw,1,2,&ports);CHKERRQ(ierr); ierr = PetscDrawLGGetAxis(lg,&axis);CHKERRQ(ierr); ierr = PetscDrawLGReset(lg);CHKERRQ(ierr); /* Plot the energies */ ierr = PetscDrawLGSetDimension(lg,3);CHKERRQ(ierr); ierr = PetscDrawViewPortsSet(ports,1);CHKERRQ(ierr); x = .9; for (i=0; i<Mx; i++) { xx[0] = xx[1] = xx[2] = x; yy[0] = (1.-x*x)*(1. - x*x); yy[1] = (1. - x*x); yy[2] = -(1.-x)*PetscLogReal(1.-x); ierr = PetscDrawLGAddPoint(lg,xx,yy);CHKERRQ(ierr); x += hx; } ierr = PetscDrawGetPause(draw,&pause);CHKERRQ(ierr); ierr = PetscDrawSetPause(draw,0.0);CHKERRQ(ierr); ierr = PetscDrawAxisSetLabels(axis,"Energy","","");CHKERRQ(ierr); ierr = PetscDrawLGSetLegend(lg,legend);CHKERRQ(ierr); ierr = PetscDrawLGDraw(lg);CHKERRQ(ierr); /* Plot the forces */ ierr = PetscDrawViewPortsSet(ports,0);CHKERRQ(ierr); ierr = PetscDrawLGReset(lg);CHKERRQ(ierr); x = .9; for (i=0; i<Mx; i++) { xx[0] = xx[1] = xx[2] = x; yy[0] = x*x*x - x; yy[1] = -x; yy[2] = 1.0 + PetscLogReal(1. - x); ierr = PetscDrawLGAddPoint(lg,xx,yy);CHKERRQ(ierr); x += hx; } ierr = PetscDrawAxisSetLabels(axis,"Derivative","","");CHKERRQ(ierr); ierr = PetscDrawLGSetLegend(lg,NULL);CHKERRQ(ierr); ierr = PetscDrawLGDraw(lg);CHKERRQ(ierr); ierr = PetscDrawSetPause(draw,pause);CHKERRQ(ierr); ierr = PetscDrawPause(draw);CHKERRQ(ierr); ierr = PetscDrawViewPortsDestroy(ports);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }
static void func9(PetscReal x, PetscReal *val) { *val = PetscLogReal(PetscCosReal(x)); }
static void func8(PetscReal x, PetscReal *val) { *val = PetscLogReal(x)*PetscLogReal(x); }
PetscErrorCode DSFunction_EXP_NHEP_PADE(DS ds) { #if defined(PETSC_MISSING_LAPACK_GESV) || defined(SLEPC_MISSING_LAPACK_LANGE) PetscFunctionBegin; SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GESV/LANGE - Lapack routines are unavailable"); #else PetscErrorCode ierr; PetscBLASInt n,ld,ld2,*ipiv,info,inc=1; PetscInt j,k,odd; const PetscInt p=MAX_PADE; PetscReal c[MAX_PADE+1],s; PetscScalar scale,mone=-1.0,one=1.0,two=2.0,zero=0.0; PetscScalar *A,*A2,*Q,*P,*W,*aux; PetscFunctionBegin; ierr = PetscBLASIntCast(ds->n,&n);CHKERRQ(ierr); ierr = PetscBLASIntCast(ds->ld,&ld);CHKERRQ(ierr); ld2 = ld*ld; ierr = DSAllocateWork_Private(ds,0,ld,ld);CHKERRQ(ierr); ipiv = ds->iwork; if (!ds->mat[DS_MAT_W]) { ierr = DSAllocateMat_Private(ds,DS_MAT_W);CHKERRQ(ierr); } if (!ds->mat[DS_MAT_Z]) { ierr = DSAllocateMat_Private(ds,DS_MAT_Z);CHKERRQ(ierr); } A = ds->mat[DS_MAT_A]; A2 = ds->mat[DS_MAT_Z]; Q = ds->mat[DS_MAT_Q]; P = ds->mat[DS_MAT_F]; W = ds->mat[DS_MAT_W]; /* Pade' coefficients */ c[0] = 1.0; for (k=1;k<=p;k++) { c[k] = c[k-1]*(p+1-k)/(k*(2*p+1-k)); } /* Scaling */ s = LAPACKlange_("I",&n,&n,A,&ld,ds->rwork); if (s>0.5) { s = PetscMax(0,(int)(PetscLogReal(s)/PetscLogReal(2.0)) + 2); scale = PetscPowReal(2.0,(-1)*s); PetscStackCallBLAS("BLASscal",BLASscal_(&ld2,&scale,A,&inc)); } /* Horner evaluation */ PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n,&n,&n,&one,A,&ld,A,&ld,&zero,A2,&ld)); ierr = PetscMemzero(Q,ld*ld*sizeof(PetscScalar));CHKERRQ(ierr); ierr = PetscMemzero(P,ld*ld*sizeof(PetscScalar));CHKERRQ(ierr); for (j=0;j<n;j++) { Q[j+j*ld] = c[p]; P[j+j*ld] = c[p-1]; } odd = 1; for (k=p-1;k>0;k--) { if (odd==1) { PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n,&n,&n,&one,Q,&ld,A2,&ld,&zero,W,&ld)); aux = Q; Q = W; W = aux; for (j=0;j<n;j++) Q[j+j*ld] = Q[j+j*ld] + c[k-1]; } else { PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n,&n,&n,&one,P,&ld,A2,&ld,&zero,W,&ld)); aux = P; P = W; W = aux; for (j=0;j<n;j++) P[j+j*ld] = P[j+j*ld] + c[k-1]; } odd = 1-odd; } if (odd==1) { PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n,&n,&n,&one,Q,&ld,A,&ld,&zero,W,&ld)); aux = Q; Q = W; W = aux; PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&ld2,&mone,P,&inc,Q,&inc)); PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&n,&n,Q,&ld,ipiv,P,&ld,&info)); PetscStackCallBLAS("BLASscal",BLASscal_(&ld2,&two,P,&inc)); for (j=0;j<n;j++) P[j+j*ld] = P[j+j*ld] + 1.0; PetscStackCallBLAS("BLASscal",BLASscal_(&ld2,&mone,P,&inc)); } else { PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n,&n,&n,&one,P,&ld,A,&ld,&zero,W,&ld)); aux = P; P = W; W = aux; PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&ld2,&mone,P,&inc,Q,&inc)); PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&n,&n,Q,&ld,ipiv,P,&ld,&info)); PetscStackCallBLAS("BLASscal",BLASscal_(&ld2,&two,P,&inc)); for (j=0;j<n;j++) P[j+j*ld] = P[j+j*ld] + 1.0; } for (k=1;k<=s;k++) { PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&n,&n,&n,&one,P,&ld,P,&ld,&zero,W,&ld)); ierr = PetscMemcpy(P,W,ld2*sizeof(PetscScalar));CHKERRQ(ierr); } if (P!=ds->mat[DS_MAT_F]) { ierr = PetscMemcpy(ds->mat[DS_MAT_F],P,ld2*sizeof(PetscScalar));CHKERRQ(ierr); } PetscFunctionReturn(0); #endif }
static void func8(PetscReal x, PetscReal *val) { if (x == 0.0) *val = PETSC_INFINITY; else *val = PetscLogReal(x)*PetscLogReal(x); }
static void func5(PetscReal x, PetscReal *val) { if (x == 0.0) *val = 0.0; else *val = PetscSqrtReal(x)*PetscLogReal(x); }
/* FormFunction - Evaluates nonlinear function, F(x). Input Parameters: . ts - the TS context . X - input vector . ptr - optional user-defined context, as set by SNESSetFunction() Output Parameter: . F - function vector */ PetscErrorCode FormFunction(TS ts,PetscReal ftime,Vec X,Vec Xdot,Vec F,void *ptr) { DM da; PetscErrorCode ierr; PetscInt i,Mx,xs,xm; PetscReal hx,sx; Field *x,*xdot,*f; Vec localX,localXdot; UserCtx *ctx = (UserCtx*)ptr; PetscFunctionBegin; ierr = TSGetDM(ts,&da);CHKERRQ(ierr); ierr = DMGetLocalVector(da,&localX);CHKERRQ(ierr); ierr = DMGetLocalVector(da,&localXdot);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); hx = 1.0/(PetscReal)Mx; 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,X,INSERT_VALUES,localX);CHKERRQ(ierr); ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,localX);CHKERRQ(ierr); ierr = DMGlobalToLocalBegin(da,Xdot,INSERT_VALUES,localXdot);CHKERRQ(ierr); ierr = DMGlobalToLocalEnd(da,Xdot,INSERT_VALUES,localXdot);CHKERRQ(ierr); /* Get pointers to vector data */ ierr = DMDAVecGetArrayRead(da,localX,&x);CHKERRQ(ierr); ierr = DMDAVecGetArrayRead(da,localXdot,&xdot);CHKERRQ(ierr); ierr = DMDAVecGetArray(da,F,&f);CHKERRQ(ierr); /* Get local grid boundaries */ ierr = DMDAGetCorners(da,&xs,NULL,NULL,&xm,NULL,NULL);CHKERRQ(ierr); /* Compute function over the locally owned part of the grid */ for (i=xs; i<xs+xm; i++) { f[i].w = x[i].w + ctx->kappa*(x[i-1].u + x[i+1].u - 2.0*x[i].u)*sx; if (ctx->cahnhillard) { switch (ctx->energy) { case 1: /* double well */ f[i].w += -x[i].u*x[i].u*x[i].u + x[i].u; break; case 2: /* double obstacle */ f[i].w += x[i].u; break; case 3: /* logarithmic */ if (PetscRealPart(x[i].u) < -1.0 + 2.0*ctx->tol) f[i].w += .5*ctx->theta*(-PetscLogReal(ctx->tol) + PetscLogScalar((1.0-x[i].u)/2.0)) + ctx->theta_c*x[i].u; else if (PetscRealPart(x[i].u) > 1.0 - 2.0*ctx->tol) f[i].w += .5*ctx->theta*(-PetscLogScalar((1.0+x[i].u)/2.0) + PetscLogReal(ctx->tol)) + ctx->theta_c*x[i].u; else f[i].w += .5*ctx->theta*(-PetscLogScalar((1.0+x[i].u)/2.0) + PetscLogScalar((1.0-x[i].u)/2.0)) + ctx->theta_c*x[i].u; break; } } f[i].u = xdot[i].u - (x[i-1].w + x[i+1].w - 2.0*x[i].w)*sx; } /* Restore vectors */ ierr = DMDAVecRestoreArrayRead(da,localXdot,&xdot);CHKERRQ(ierr); ierr = DMDAVecRestoreArrayRead(da,localX,&x);CHKERRQ(ierr); ierr = DMDAVecRestoreArray(da,F,&f);CHKERRQ(ierr); ierr = DMRestoreLocalVector(da,&localX);CHKERRQ(ierr); ierr = DMRestoreLocalVector(da,&localXdot);CHKERRQ(ierr); PetscFunctionReturn(0); }