PetscErrorCode BSSCR_PCScGtKGUseStandardScaling( PC pc )
{
PC_SC_GtKG ctx = (PC_SC_GtKG)pc->data;
Mat K,G,D,C;
Vec rG;
PetscScalar rg2, rg, ra;
PetscInt N;
Vec rA, rC;
Vec L1,L2, R1,R2;
BSSCR_BSSCR_pc_error_ScGtKG( pc, __func__ );
L1 = ctx->X1;
L2 = ctx->X2;
R1 = ctx->Y1;
R2 = ctx->Y2;
rA = L1;
rC = L2;
K = ctx->F;
G = ctx->Bt;
D = ctx->B;
C = ctx->C;
VecDuplicate( rA, &rG );
/* Get magnitude of K */
MatGetRowMax( K, rA, PETSC_NULL );
VecSqrt( rA );
VecReciprocal( rA );
VecDot( rA,rA, &ra );
VecGetSize( rA, &N );
ra = PetscSqrtScalar( ra/N );
/* Get magnitude of G */
MatGetRowMax( G, rG, PETSC_NULL );
VecDot( rG, rG, &rg2 );
VecGetSize( rG, &N );
rg = PetscSqrtScalar(rg2/N);
// printf("rg = %f \n", rg );
VecSet( rC, 1.0/(rg*ra) );
Stg_VecDestroy(&rG );
VecCopy( L1, R1 );
VecCopy( L2, R2 );
PetscFunctionReturn(0);
}
static PetscErrorCode sol_true(PetscReal t,Vec U)
{
PetscErrorCode ierr;
PetscScalar *u;
PetscFunctionBegin;
ierr = VecGetArray(U,&u);CHKERRQ(ierr);
u[0] = PetscSqrtScalar(1.0+PetscCosScalar(t));
u[1] = PetscSqrtScalar(2.0+PetscCosScalar(5.0*t));
ierr = VecRestoreArray(U,&u);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode RHSFunction_Hull1972B4(TS ts, PetscReal t, Vec Y, Vec F, void *s)
{
PetscErrorCode ierr;
PetscScalar *y,*f;
PetscFunctionBegin;
ierr = VecGetArray(Y,&y);CHKERRQ(ierr);
ierr = VecGetArray(F,&f);CHKERRQ(ierr);
f[0] = -y[1] - y[0]*y[2]/PetscSqrtScalar(y[0]*y[0]+y[1]*y[1]);
f[1] = y[0] - y[1]*y[2]/PetscSqrtScalar(y[0]*y[0]+y[1]*y[1]);
f[2] = y[0]/PetscSqrtScalar(y[0]*y[0]+y[1]*y[1]);
ierr = VecRestoreArray(Y,&y);CHKERRQ(ierr);
ierr = VecRestoreArray(F,&f);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
// http://mathworld.wolfram.com/SpherePointPicking.html
PetscErrorCode SphericalDistribution(PetscRandom rnd, PetscReal a, Coor *d)
{
PetscReal u,q;
PetscRandomGetValue(rnd,&u); // [0,1]
u = (1-a) * u + a; // [a,1]
PetscRandomGetValue(rnd,&q); // [0,1]
q = 2 * PETSC_PI * q; // [0, 2pi]
d->x = PetscSqrtScalar( 1 - u*u ) * cos(q);
d->y = PetscSqrtScalar( 1 - u*u ) * sin(q);
d->z = u;
return 0;
}
static PetscErrorCode KSPSolve_SpecEst(KSP ksp)
{
PetscErrorCode ierr;
KSP_SpecEst *spec = (KSP_SpecEst*)ksp->data;
PetscFunctionBegin;
if (spec->current) {
ierr = KSPSolve(spec->kspcheap,ksp->vec_rhs,ksp->vec_sol);CHKERRQ(ierr);
ierr = KSPSpecEstPropagateUp(ksp,spec->kspcheap);CHKERRQ(ierr);
} else {
PetscInt i,its,neig;
PetscReal *real,*imag,rad = 0;
ierr = KSPSolve(spec->kspest,ksp->vec_rhs,ksp->vec_sol);CHKERRQ(ierr);
ierr = KSPSpecEstPropagateUp(ksp,spec->kspest);CHKERRQ(ierr);
ierr = KSPComputeExtremeSingularValues(spec->kspest,&spec->max,&spec->min);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(spec->kspest,&its);CHKERRQ(ierr);
ierr = PetscMalloc2(its,PetscReal,&real,its,PetscReal,&imag);CHKERRQ(ierr);
ierr = KSPComputeEigenvalues(spec->kspest,its,real,imag,&neig);CHKERRQ(ierr);
for (i=0; i<neig; i++) {
/* We would really like to compute w (nominally 1/radius) to minimize |1-wB|. Empirically it
is better to compute rad = |1-B| than rad = |B|. There must be a cheap way to do better. */
rad = PetscMax(rad,PetscRealPart(PetscSqrtScalar((PetscScalar)(PetscSqr(real[i]-1.) + PetscSqr(imag[i])))));
}
ierr = PetscFree2(real,imag);CHKERRQ(ierr);
spec->radius = rad;
ierr = KSPChebyshevSetEigenvalues(spec->kspcheap,spec->max*spec->maxfactor,spec->min*spec->minfactor);CHKERRQ(ierr);
ierr = KSPRichardsonSetScale(spec->kspcheap,spec->richfactor/spec->radius);
ierr = PetscInfo3(ksp,"Estimated singular value min=%G max=%G, spectral radius=%G",spec->min,spec->max,spec->radius);CHKERRQ(ierr);
spec->current = PETSC_TRUE;
}
PetscFunctionReturn(0);
}
static PetscErrorCode VecNorm_Nest(Vec xin,NormType type,PetscReal *z)
{
Vec_Nest *bx = (Vec_Nest*)xin->data;
PetscInt i,nr;
PetscReal z_i;
PetscReal _z;
PetscErrorCode ierr;
PetscFunctionBegin;
nr = bx->nb;
_z = 0.0;
if (type == NORM_2) {
PetscScalar dot;
ierr = VecDot(xin,xin,&dot);CHKERRQ(ierr);
_z = PetscAbsScalar(PetscSqrtScalar(dot));
} else if (type == NORM_1) {
for (i=0; i<nr; i++) {
ierr = VecNorm(bx->v[i],type,&z_i);CHKERRQ(ierr);
_z = _z + z_i;
}
} else if (type == NORM_INFINITY) {
for (i=0; i<nr; i++) {
ierr = VecNorm(bx->v[i],type,&z_i);CHKERRQ(ierr);
if (z_i > _z) _z = z_i;
}
}
*z = _z;
PetscFunctionReturn(0);
}
PetscErrorCode QPIPComputeNormFromCentralPath(TAO_BQPIP *qp, PetscReal *norm)
{
PetscErrorCode ierr;
PetscReal gap[2],mu[2], nmu;
PetscFunctionBegin;
ierr = VecPointwiseMult(qp->GZwork, qp->G, qp->Z);CHKERRQ(ierr);
ierr = VecPointwiseMult(qp->TSwork, qp->T, qp->S);CHKERRQ(ierr);
ierr = VecNorm(qp->TSwork, NORM_1, &mu[0]);CHKERRQ(ierr);
ierr = VecNorm(qp->GZwork, NORM_1, &mu[1]);CHKERRQ(ierr);
nmu=-(mu[0]+mu[1])/qp->m;
ierr = VecShift(qp->GZwork,nmu);CHKERRQ(ierr);
ierr = VecShift(qp->TSwork,nmu);CHKERRQ(ierr);
ierr = VecNorm(qp->GZwork,NORM_2,&gap[0]);CHKERRQ(ierr);
ierr = VecNorm(qp->TSwork,NORM_2,&gap[1]);CHKERRQ(ierr);
gap[0]*=gap[0];
gap[1]*=gap[1];
qp->pathnorm=PetscSqrtScalar( (gap[0]+gap[1]) );
*norm=qp->pathnorm;
PetscFunctionReturn(0);
}
PetscErrorCode StokesCalcError(Stokes *s)
{
PetscScalar scale = PetscSqrtScalar(s->nx*s->ny);
PetscReal val;
Vec y0, y1;
PetscErrorCode ierr;
PetscFunctionBeginUser;
/* error y-x */
ierr = VecAXPY(s->y, -1.0, s->x);CHKERRQ(ierr);
/* ierr = VecView(s->y, (PetscViewer)PETSC_VIEWER_DEFAULT);CHKERRQ(ierr); */
/* error in velocity */
ierr = VecGetSubVector(s->y, s->isg[0], &y0);CHKERRQ(ierr);
ierr = VecNorm(y0, NORM_2, &val);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," discretization error u = %g\n",(double)(PetscRealPart(val/scale)));CHKERRQ(ierr);
ierr = VecRestoreSubVector(s->y, s->isg[0], &y0);CHKERRQ(ierr);
/* error in pressure */
ierr = VecGetSubVector(s->y, s->isg[1], &y1);CHKERRQ(ierr);
ierr = VecNorm(y1, NORM_2, &val);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," discretization error p = %g\n",(double)(PetscRealPart(val/scale)));CHKERRQ(ierr);
ierr = VecRestoreSubVector(s->y, s->isg[1], &y1);CHKERRQ(ierr);
/* total error */
ierr = VecNorm(s->y, NORM_2, &val);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," discretization error [u,p] = %g\n", (double)PetscRealPart((val/scale)));CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void InitialCondition(TS ts, Vec X)
{
PetscScalar *x;
VecGetArray(X, &x);
for (PetscInt j=0; j<N2; j++) {
for (PetscInt i=0; i<N1; i++) {
for (PetscInt var=0; var<DOF; var++) {
PetscScalar X1Coord = X1_MIN + DX1/2. + i*DX1;
PetscScalar X2Coord = X2_MIN + DX2/2. + j*DX2;
PetscScalar X1Center = (X1_MIN + X1_MAX)/2.;
PetscScalar X2Center = (X2_MIN + X2_MAX)/2.;
PetscScalar r = PetscSqrtScalar(
PetscPowScalar(X1Coord-X1Center, 2.0) +
PetscPowScalar(X2Coord-X2Center, 2.0));
x[INDEX_GLOBAL(i,j,var)] = exp(-r*r/.01);
}
}
}
VecRestoreArray(X, &x);
}
PetscErrorCode IFunction_Hull1972B4(TS ts, PetscReal t, Vec Y, Vec Ydot, Vec F, void *s)
{
PetscErrorCode ierr;
PetscScalar *y,*f;
PetscFunctionBegin;
ierr = VecGetArray(Y,&y);CHKERRQ(ierr);
ierr = VecGetArray(F,&f);CHKERRQ(ierr);
f[0] = -y[1] - y[0]*y[2]/PetscSqrtScalar(y[0]*y[0]+y[1]*y[1]);
f[1] = y[0] - y[1]*y[2]/PetscSqrtScalar(y[0]*y[0]+y[1]*y[1]);
f[2] = y[0]/PetscSqrtScalar(y[0]*y[0]+y[1]*y[1]);
ierr = VecRestoreArray(Y,&y);CHKERRQ(ierr);
ierr = VecRestoreArray(F,&f);CHKERRQ(ierr);
/* Left hand side = ydot - f(y) */
ierr = VecAYPX(F,-1.0,Ydot);
PetscFunctionReturn(0);
}
PetscErrorCode ini_bou(Vec X,AppCtx* user)
{
PetscErrorCode ierr;
DM cda;
DMDACoor2d **coors;
PetscScalar **p;
Vec gc;
PetscInt i,j;
PetscInt xs,ys,xm,ym,M,N;
PetscScalar xi,yi;
PetscScalar sigmax=user->sigmax,sigmay=user->sigmay;
PetscScalar rho =user->rho;
PetscScalar mux =user->mux,muy=user->muy;
PetscMPIInt rank;
PetscScalar sum;
PetscFunctionBeginUser;
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = DMDAGetInfo(user->da,NULL,&M,&N,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);
user->dx = (user->xmax - user->xmin)/(M-1); user->dy = (user->ymax - user->ymin)/(N-1);
ierr = DMGetCoordinateDM(user->da,&cda);CHKERRQ(ierr);
ierr = DMGetCoordinates(user->da,&gc);CHKERRQ(ierr);
ierr = DMDAVecGetArray(cda,gc,&coors);CHKERRQ(ierr);
ierr = DMDAVecGetArray(user->da,X,&p);CHKERRQ(ierr);
ierr = DMDAGetCorners(cda,&xs,&ys,0,&xm,&ym,0);CHKERRQ(ierr);
/* mux and muy need to be grid points in the x and y-direction otherwise the solution goes unstable
muy is set by choosing the y domain, no. of grid points along y-direction so that muy is a grid point
in the y-direction. We only modify mux here
*/
mux = user->mux = coors[0][M/2+10].x; /* For -pi < x < pi, this should be some angle between 0 and pi/2 */
if (user->nonoiseinitial) {
for (i=xs; i < xs+xm; i++) {
for (j=ys; j < ys+ym; j++) {
xi = coors[j][i].x; yi = coors[j][i].y;
if ((xi == mux) && (yi == muy)) {
p[j][i] = 1.0;
}
}
}
} else {
/* Change PM_min accordingly */
user->PM_min = user->Pmax*sin(mux);
for (i=xs; i < xs+xm; i++) {
for (j=ys; j < ys+ym; j++) {
xi = coors[j][i].x; yi = coors[j][i].y;
p[j][i] = (0.5/(PETSC_PI*sigmax*sigmay*PetscSqrtScalar(1.0-rho*rho)))*PetscExpScalar(-0.5/(1-rho*rho)*(PetscPowScalar((xi-mux)/sigmax,2) + PetscPowScalar((yi-muy)/sigmay,2) - 2*rho*(xi-mux)*(yi-muy)/(sigmax*sigmay)));
}
}
}
ierr = DMDAVecRestoreArray(cda,gc,&coors);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(user->da,X,&p);CHKERRQ(ierr);
ierr = VecSum(X,&sum);CHKERRQ(ierr);
ierr = VecScale(X,1.0/sum);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode TSAlphaAdaptDefault(TS ts,PetscReal t,Vec X,Vec Xdot, PetscReal *nextdt,PetscBool *ok,void *ctx)
{
TS_Alpha *th;
SNESConvergedReason snesreason;
PetscReal dt,normX,normE,Emax,scale;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(ts,TS_CLASSID,1);
#if PETSC_USE_DEBUG
{
PetscBool match;
ierr = PetscObjectTypeCompare((PetscObject)ts,TSALPHA,&match);CHKERRQ(ierr);
if (!match) SETERRQ(((PetscObject)ts)->comm,1,"Only for TSALPHA");
}
#endif
th = (TS_Alpha*)ts->data;
ierr = SNESGetConvergedReason(ts->snes,&snesreason);CHKERRQ(ierr);
if (snesreason < 0) {
*ok = PETSC_FALSE;
*nextdt *= th->scale_min;
goto finally;
}
/* first-order aproximation to the local error */
/* E = (X0 + dt*Xdot) - X */
ierr = TSGetTimeStep(ts,&dt);CHKERRQ(ierr);
if (!th->E) {ierr = VecDuplicate(th->X0,&th->E);CHKERRQ(ierr);}
ierr = VecWAXPY(th->E,dt,Xdot,th->X0);CHKERRQ(ierr);
ierr = VecAXPY(th->E,-1,X);CHKERRQ(ierr);
ierr = VecNorm(th->E,NORM_2,&normE);CHKERRQ(ierr);
/* compute maximum allowable error */
ierr = VecNorm(X,NORM_2,&normX);CHKERRQ(ierr);
if (normX == 0) {ierr = VecNorm(th->X0,NORM_2,&normX);CHKERRQ(ierr);}
Emax = th->rtol * normX + th->atol;
/* compute next time step */
if (normE > 0) {
scale = th->rho * PetscRealPart(PetscSqrtScalar((PetscScalar)(Emax/normE)));
scale = PetscMax(scale,th->scale_min);
scale = PetscMin(scale,th->scale_max);
if (!(*ok))
scale = PetscMin(1.0,scale);
*nextdt *= scale;
}
/* accept or reject step */
if (normE <= Emax)
*ok = PETSC_TRUE;
else
*ok = PETSC_FALSE;
finally:
*nextdt = PetscMax(*nextdt,th->dt_min);
*nextdt = PetscMin(*nextdt,th->dt_max);
PetscFunctionReturn(0);
}
PetscErrorCode FormFunctionLocal(DMDALocalInfo *info,PetscScalar **t,PetscScalar **f,void *ptr)
{
PetscInt i,j;
PetscScalar hx,hy;
PetscScalar gradup,graddown,gradleft,gradright,gradx,grady;
PetscScalar coeffup,coeffdown,coeffleft,coeffright;
PetscFunctionBeginUser;
hx = 1.0/(PetscReal)(info->mx-1); hy = 1.0/(PetscReal)(info->my-1);
/* Evaluate function */
for (j=info->ys; j<info->ys+info->ym; j++) {
for (i=info->xs; i<info->xs+info->xm; i++) {
if (i == 0 || i == info->mx-1 || j == 0 || j == info->my-1) {
f[j][i] = t[j][i] - (1.0 - (2.0*hx*(PetscReal)i - 1.0)*(2.0*hx*(PetscReal)i - 1.0));
} else {
gradup = (t[j+1][i] - t[j][i])/hy;
graddown = (t[j][i] - t[j-1][i])/hy;
gradright = (t[j][i+1] - t[j][i])/hx;
gradleft = (t[j][i] - t[j][i-1])/hx;
gradx = .5*(t[j][i+1] - t[j][i-1])/hx;
grady = .5*(t[j+1][i] - t[j-1][i])/hy;
coeffup = 1.0/PetscSqrtScalar(1.0 + gradup*gradup + gradx*gradx);
coeffdown = 1.0/PetscSqrtScalar(1.0 + graddown*graddown + gradx*gradx);
coeffleft = 1.0/PetscSqrtScalar(1.0 + gradleft*gradleft + grady*grady);
coeffright = 1.0/PetscSqrtScalar(1.0 + gradright*gradright + grady*grady);
f[j][i] = (coeffup*gradup - coeffdown*graddown)*hx + (coeffright*gradright - coeffleft*gradleft)*hy;
}
}
}
PetscFunctionReturn(0);
}
PetscErrorCode Rotation(Coor x0, Coor x1, Coor *n, Coor *r, Coor *s)
{
PetscReal mag;
n->x = x1.x - x0.x;
n->y = x1.y - x0.y;
n->z = x1.z - x0.z;
mag = PetscSqrtScalar(n->x*n->x + n->y*n->y + n->z*n->z);
n->x /= mag;
n->y /= mag;
n->z /= mag;
PetscReal nx2 = n->x*n->x,
ny2 = n->y*n->y,
nz2 = n->z*n->z;
if( nx2+ ny2 > nx2 + nz2 ) {
mag = PetscSqrtScalar(nx2 + ny2);
r->x = n->y / mag;
r->y = -n->x / mag;
r->z = 0;
s->x = n->x * n->z;
s->y = n->y * n->z;
s->z = -nx2-ny2;
} else {
mag = PetscSqrtScalar(nx2 + nz2);
r->x = n->z / mag;
r->y = 0;
r->z = -n->x / mag;
s->x = -n->x * n->y;
s->y = nx2 + nz2;
s->z = -n->y * n->z;
}
mag = PetscSqrtScalar(s->x*s->x + s->y*s->y + s->z*s->z);
s->x /= mag;
s->y /= mag;
s->z /= mag;
return 0;
}
static PetscErrorCode IPMComputeKKT(Tao tao)
{
TAO_IPM *ipmP = (TAO_IPM *)tao->data;
PetscScalar norm;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecCopy(tao->gradient,ipmP->rd);CHKERRQ(ierr);
if (ipmP->me > 0) {
/* rd = gradient + Ae'*lamdae */
ierr = MatMultTranspose(tao->jacobian_equality,ipmP->lamdae,ipmP->work);CHKERRQ(ierr);
ierr = VecAXPY(ipmP->rd, 1.0, ipmP->work);CHKERRQ(ierr);
/* rpe = ce(x) */
ierr = VecCopy(tao->constraints_equality,ipmP->rpe);CHKERRQ(ierr);
}
if (ipmP->nb > 0) {
/* rd = rd - Ai'*lamdai */
ierr = MatMultTranspose(ipmP->Ai,ipmP->lamdai,ipmP->work);CHKERRQ(ierr);
ierr = VecAXPY(ipmP->rd, -1.0, ipmP->work);CHKERRQ(ierr);
/* rpi = cin - s */
ierr = VecCopy(ipmP->ci,ipmP->rpi);CHKERRQ(ierr);
ierr = VecAXPY(ipmP->rpi, -1.0, ipmP->s);CHKERRQ(ierr);
/* com = s .* lami */
ierr = VecPointwiseMult(ipmP->complementarity, ipmP->s,ipmP->lamdai);CHKERRQ(ierr);
}
/* phi = ||rd; rpe; rpi; com|| */
ierr = VecDot(ipmP->rd,ipmP->rd,&norm);CHKERRQ(ierr);
ipmP->phi = norm;
if (ipmP->me > 0 ) {
ierr = VecDot(ipmP->rpe,ipmP->rpe,&norm);CHKERRQ(ierr);
ipmP->phi += norm;
}
if (ipmP->nb > 0) {
ierr = VecDot(ipmP->rpi,ipmP->rpi,&norm);CHKERRQ(ierr);
ipmP->phi += norm;
ierr = VecDot(ipmP->complementarity,ipmP->complementarity,&norm);CHKERRQ(ierr);
ipmP->phi += norm;
/* mu = s'*lami/nb */
ierr = VecDot(ipmP->s,ipmP->lamdai,&ipmP->mu);CHKERRQ(ierr);
ipmP->mu /= ipmP->nb;
} else {
ipmP->mu = 1.0;
}
ipmP->phi = PetscSqrtScalar(ipmP->phi);
PetscFunctionReturn(0);
}
static PetscErrorCode KSPGMRESUpdateHessenberg(KSP ksp,PetscInt it,PetscBool hapend,PetscReal *res)
{
PetscScalar *hh,*cc,*ss,tt;
PetscInt j;
KSP_GMRES *gmres = (KSP_GMRES*)(ksp->data);
PetscFunctionBegin;
hh = HH(0,it);
cc = CC(0);
ss = SS(0);
/* Apply all the previously computed plane rotations to the new column
of the Hessenberg matrix */
for (j=1; j<=it; j++) {
tt = *hh;
*hh = PetscConj(*cc) * tt + *ss * *(hh+1);
hh++;
*hh = *cc++ * *hh - (*ss++ * tt);
}
/*
compute the new plane rotation, and apply it to:
1) the right-hand-side of the Hessenberg system
2) the new column of the Hessenberg matrix
thus obtaining the updated value of the residual
*/
if (!hapend) {
tt = PetscSqrtScalar(PetscConj(*hh) * *hh + PetscConj(*(hh+1)) * *(hh+1));
if (tt == 0.0) {
ksp->reason = KSP_DIVERGED_NULL;
PetscFunctionReturn(0);
}
*cc = *hh / tt;
*ss = *(hh+1) / tt;
*GRS(it+1) = -(*ss * *GRS(it));
*GRS(it) = PetscConj(*cc) * *GRS(it);
*hh = PetscConj(*cc) * *hh + *ss * *(hh+1);
*res = PetscAbsScalar(*GRS(it+1));
} else {
/* happy breakdown: HH(it+1, it) = 0, therfore we don't need to apply
another rotation matrix (so RH doesn't change). The new residual is
always the new sine term times the residual from last time (GRS(it)),
but now the new sine rotation would be zero...so the residual should
be zero...so we will multiply "zero" by the last residual. This might
not be exactly what we want to do here -could just return "zero". */
*res = 0.0;
}
PetscFunctionReturn(0);
}
PetscErrorCode KSPFischerGuessUpdate_Method2(KSPFischerGuess_Method2 *itg,Vec x)
{
PetscScalar norm;
PetscErrorCode ierr;
int curl = itg->curl,i;
PetscFunctionBegin;
PetscValidHeaderSpecific(x,VEC_CLASSID,2);
PetscValidPointer(itg,3);
if (curl == itg->maxl) {
ierr = KSP_MatMult(itg->ksp,itg->mat,x,itg->Ax);CHKERRQ(ierr); /* norm = sqrt(x'Ax) */
ierr = VecDot(x,itg->Ax,&norm);CHKERRQ(ierr);
ierr = VecCopy(x,itg->xtilde[0]);CHKERRQ(ierr);
ierr = VecScale(itg->xtilde[0],1.0/PetscSqrtScalar(norm));CHKERRQ(ierr);
itg->curl = 1;
} else {
if (!curl) {
ierr = VecCopy(x,itg->xtilde[curl]);CHKERRQ(ierr);
} else {
ierr = VecWAXPY(itg->xtilde[curl],-1.0,itg->guess,x);CHKERRQ(ierr);
}
ierr = KSP_MatMult(itg->ksp,itg->mat,itg->xtilde[curl],itg->Ax);CHKERRQ(ierr);
ierr = VecMDot(itg->Ax,curl,itg->xtilde,itg->alpha);CHKERRQ(ierr);
for (i=0; i<curl; i++) itg->alpha[i] = -itg->alpha[i];
ierr = VecMAXPY(itg->xtilde[curl],curl,itg->alpha,itg->xtilde);CHKERRQ(ierr);
ierr = KSP_MatMult(itg->ksp,itg->mat,itg->xtilde[curl],itg->Ax);CHKERRQ(ierr); /* norm = sqrt(xtilde[curl]'Axtilde[curl]) */
ierr = VecDot(itg->xtilde[curl],itg->Ax,&norm);CHKERRQ(ierr);
if (PetscAbsScalar(norm) != 0.0) {
ierr = VecScale(itg->xtilde[curl],1.0/PetscSqrtScalar(norm));CHKERRQ(ierr);
itg->curl++;
} else {
ierr = PetscInfo(itg->ksp,"Not increasing dimension of Fischer space because new direction is identical to previous\n");CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
PetscErrorCode ComputeSensiP(Vec lambda,Vec mu,AppCtx *ctx)
{
PetscErrorCode ierr;
PetscScalar sensip;
const PetscScalar *x,*y;
PetscFunctionBegin;
ierr = VecGetArrayRead(lambda,&x);CHKERRQ(ierr);
ierr = VecGetArrayRead(mu,&y);CHKERRQ(ierr);
sensip = 1./PetscSqrtScalar(1.-(ctx->Pm/ctx->Pmax)*(ctx->Pm/ctx->Pmax))/ctx->Pmax*x[0]+y[0];
ierr = PetscPrintf(PETSC_COMM_WORLD,"\n sensitivity wrt parameter pm: %.7f \n",(double)sensip);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(lambda,&x);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(mu,&y);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
For the ideal gas, the relationship of the speed of the sound "c",
density "\rho" and the pressure "p" is:
p = c^2 \rho
*/
PetscErrorCode SpeedOfSound_PG(User user,const Node *x,PetscScalar *c)
{
PetscErrorCode ierr;
PetscScalar p;
PetscFunctionBeginUser;
if (user->includeenergy){
ierr = Pressure_Full(user,x,&p);CHKERRQ(ierr);
}else{
ierr = Pressure_Partial(user,x,&p);CHKERRQ(ierr);
}
(*c)=PetscSqrtScalar(user->adiabatic*PetscAbsScalar(p)/x->r);
PetscFunctionReturn(0);
}
PetscErrorCode ini_bou(Vec X,AppCtx* user)
{
PetscErrorCode ierr;
DM cda;
DMDACoor2d **coors;
PetscScalar **p;
Vec gc;
PetscInt i,j;
PetscInt xs,ys,xm,ym,M,N;
PetscScalar xi,yi;
PetscScalar sigmax=user->sigmax,sigmay=user->sigmay;
PetscScalar rho =user->rho;
PetscScalar mux =user->mux,muy=user->muy;
PetscMPIInt rank;
PetscFunctionBeginUser;
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
CHKERRQ(ierr);
ierr = DMDAGetInfo(user->da,NULL,&M,&N,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);
user->dx = (user->xmax - user->xmin)/(M-1);
user->dy = (user->ymax - user->ymin)/(N-1);
ierr = DMGetCoordinateDM(user->da,&cda);
CHKERRQ(ierr);
ierr = DMGetCoordinates(user->da,&gc);
CHKERRQ(ierr);
ierr = DMDAVecGetArray(cda,gc,&coors);
CHKERRQ(ierr);
ierr = DMDAVecGetArray(user->da,X,&p);
CHKERRQ(ierr);
ierr = DMDAGetCorners(cda,&xs,&ys,0,&xm,&ym,0);
CHKERRQ(ierr);
for (i=xs; i < xs+xm; i++) {
for (j=ys; j < ys+ym; j++) {
xi = coors[j][i].x;
yi = coors[j][i].y;
if (i == 0 || j == 0 || i == M-1 || j == N-1) p[j][i] = 0.0;
else p[j][i] = (0.5/(PETSC_PI*sigmax*sigmay*PetscSqrtScalar(1.0-rho*rho)))*PetscExpScalar(-0.5/(1-rho*rho)*(PetscPowScalar((xi-mux)/sigmax,2) + PetscPowScalar((yi-muy)/sigmay,2) - 2*rho*(xi-mux)*(yi-muy)/(sigmax*sigmay)));
}
}
/* p[N/2+N%2][M/2+M%2] = 1/(user->dx*user->dy); */
ierr = DMDAVecRestoreArray(cda,gc,&coors);
CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(user->da,X,&p);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/* ------------------------------------------------------------------- */
PetscErrorCode FormInitialSolution(DM da,Vec X,PetscReal kappa)
{
PetscErrorCode ierr;
PetscInt i,xs,xm,Mx;
Field *x;
PetscReal hx,xx,r,sx;
PetscFunctionBegin;
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);
/*
Get pointers to vector data
*/
ierr = DMDAVecGetArray(da,X,&x);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++) {
xx = i*hx;
r = PetscSqrtScalar((xx-.5)*(xx-.5));
if (r < .125) x[i].u = 1.0;
else x[i].u = -.50;
/* u[i] = PetscPowScalar(x - .5,4.0); */
}
for (i=xs; i<xs+xm; i++) x[i].w = -kappa*(x[i-1].u + x[i+1].u - 2.0*x[i].u)*sx;
/*
Restore vectors
*/
ierr = DMDAVecRestoreArray(da,X,&x);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode FormInitialSolution(Vec U,void* ptr)
{
AppCtx *user=(AppCtx*)ptr;
DM da=user->da;
PetscReal c=user->c;
PetscErrorCode ierr;
PetscInt i,j,xs,ys,xm,ym,Mx,My;
PetscScalar **u;
PetscReal hx,hy,x,y,r;
PetscFunctionBeginUser;
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);
hx = 1.0/(PetscReal)(Mx-1);
hy = 1.0/(PetscReal)(My-1);
/* Get pointers to vector data */
ierr = DMDAVecGetArray(da,U,&u);CHKERRQ(ierr);
/* Get local grid boundaries */
ierr = DMDAGetCorners(da,&xs,&ys,PETSC_NULL,&xm,&ym,PETSC_NULL);CHKERRQ(ierr);
/* Compute function over the locally owned part of the grid */
for (j=ys; j<ys+ym; j++) {
y = j*hy;
for (i=xs; i<xs+xm; i++) {
x = i*hx;
r = PetscSqrtScalar((x-.5)*(x-.5) + (y-.5)*(y-.5));
if (r < .125) {
u[j][i] = PetscExpScalar(c*r*r*r);
} else {
u[j][i] = 0.0;
}
}
}
/* Restore vectors */
ierr = DMDAVecRestoreArray(da,U,&u);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
FormFunctionLocal - Evaluates nonlinear function, F(x).
*/
PetscErrorCode FormFunctionLocal(DMDALocalInfo *info,PetscScalar **x,PetscScalar **f,AppCtx *user)
{
DM coordDA;
Vec coordinates;
DMDACoor2d **coords;
PetscScalar u, ux, uy, uxx, uyy;
PetscReal D, K, hx, hy, hxdhy, hydhx;
PetscInt i,j;
PetscErrorCode ierr;
PetscFunctionBeginUser;
D = user->D;
K = user->K;
hx = 1.0/(PetscReal)(info->mx-1);
hy = 1.0/(PetscReal)(info->my-1);
hxdhy = hx/hy;
hydhx = hy/hx;
/*
Compute function over the locally owned part of the grid
*/
ierr = DMGetCoordinateDM(info->da, &coordDA);CHKERRQ(ierr);
ierr = DMGetCoordinates(info->da, &coordinates);CHKERRQ(ierr);
ierr = DMDAVecGetArray(coordDA, coordinates, &coords);CHKERRQ(ierr);
for (j=info->ys; j<info->ys+info->ym; j++) {
for (i=info->xs; i<info->xs+info->xm; i++) {
if (i == 0 || j == 0 || i == info->mx-1 || j == info->my-1) f[j][i] = x[j][i];
else {
u = x[j][i];
ux = (x[j][i+1] - x[j][i])/hx;
uy = (x[j+1][i] - x[j][i])/hy;
uxx = (2.0*u - x[j][i-1] - x[j][i+1])*hydhx;
uyy = (2.0*u - x[j-1][i] - x[j+1][i])*hxdhy;
f[j][i] = D*(uxx + uyy) - (K*funcA(x[j][i], user)*PetscSqrtScalar(ux*ux + uy*uy) + funcU(&coords[j][i]))*hx*hy;
if (PetscIsInfOrNanScalar(f[j][i])) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FP, "Invalid residual: %g", PetscRealPart(f[j][i]));
}
}
}
ierr = DMDAVecRestoreArray(coordDA, coordinates, &coords);CHKERRQ(ierr);
ierr = PetscLogFlops(11*info->ym*info->xm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode FormInitialSolution(TS ts,Vec U,void *ptr)
{
AppCtx *user=(AppCtx*)ptr;
PetscReal c =user->c;
DM da;
PetscErrorCode ierr;
PetscInt i,xs,xm,Mx;
PetscScalar *u;
PetscReal hx,x,r;
PetscFunctionBeginUser;
ierr = TSGetDM(ts,&da);
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-1);
/* Get pointers to vector data */
ierr = DMDAVecGetArray(da,U,&u);
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++) {
x = i*hx;
r = PetscSqrtScalar((x-.5)*(x-.5));
if (r < .125) u[i] = PetscExpScalar(c*r*r*r);
else u[i] = 0.0;
}
/* Restore vectors */
ierr = DMDAVecRestoreArray(da,U,&u);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode Tao_mcstep(TaoLineSearch ls,PetscReal *stx,PetscReal *fx,PetscReal *dx,PetscReal *sty,PetscReal *fy,PetscReal *dy,PetscReal *stp,PetscReal *fp,PetscReal *dp)
{
TaoLineSearch_MT *mtP = (TaoLineSearch_MT *) ls->data;
PetscReal gamma1, p, q, r, s, sgnd, stpc, stpf, stpq, theta;
PetscInt bound;
PetscFunctionBegin;
/* Check the input parameters for errors */
mtP->infoc = 0;
if (mtP->bracket && (*stp <= PetscMin(*stx,*sty) || (*stp >= PetscMax(*stx,*sty)))) SETERRQ(PETSC_COMM_SELF,1,"bad stp in bracket");
if (*dx * (*stp-*stx) >= 0.0) SETERRQ(PETSC_COMM_SELF,1,"dx * (stp-stx) >= 0.0");
if (ls->stepmax < ls->stepmin) SETERRQ(PETSC_COMM_SELF,1,"stepmax > stepmin");
/* Determine if the derivatives have opposite sign */
sgnd = *dp * (*dx / PetscAbsReal(*dx));
if (*fp > *fx) {
/* Case 1: a higher function value.
The minimum is bracketed. If the cubic step is closer
to stx than the quadratic step, the cubic step is taken,
else the average of the cubic and quadratic steps is taken. */
mtP->infoc = 1;
bound = 1;
theta = 3 * (*fx - *fp) / (*stp - *stx) + *dx + *dp;
s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dx));
s = PetscMax(s,PetscAbsReal(*dp));
gamma1 = s*PetscSqrtScalar(PetscPowScalar(theta/s,2.0) - (*dx/s)*(*dp/s));
if (*stp < *stx) gamma1 = -gamma1;
/* Can p be 0? Check */
p = (gamma1 - *dx) + theta;
q = ((gamma1 - *dx) + gamma1) + *dp;
r = p/q;
stpc = *stx + r*(*stp - *stx);
stpq = *stx + ((*dx/((*fx-*fp)/(*stp-*stx)+*dx))*0.5) * (*stp - *stx);
if (PetscAbsReal(stpc-*stx) < PetscAbsReal(stpq-*stx)) {
stpf = stpc;
} else {
stpf = stpc + 0.5*(stpq - stpc);
}
mtP->bracket = 1;
} else if (sgnd < 0.0) {
/* Case 2: A lower function value and derivatives of
opposite sign. The minimum is bracketed. If the cubic
step is closer to stx than the quadratic (secant) step,
the cubic step is taken, else the quadratic step is taken. */
mtP->infoc = 2;
bound = 0;
theta = 3*(*fx - *fp)/(*stp - *stx) + *dx + *dp;
s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dx));
s = PetscMax(s,PetscAbsReal(*dp));
gamma1 = s*PetscSqrtScalar(PetscPowScalar(theta/s,2.0) - (*dx/s)*(*dp/s));
if (*stp > *stx) gamma1 = -gamma1;
p = (gamma1 - *dp) + theta;
q = ((gamma1 - *dp) + gamma1) + *dx;
r = p/q;
stpc = *stp + r*(*stx - *stp);
stpq = *stp + (*dp/(*dp-*dx))*(*stx - *stp);
if (PetscAbsReal(stpc-*stp) > PetscAbsReal(stpq-*stp)) {
stpf = stpc;
} else {
stpf = stpq;
}
mtP->bracket = 1;
} else if (PetscAbsReal(*dp) < PetscAbsReal(*dx)) {
/* Case 3: A lower function value, derivatives of the
same sign, and the magnitude of the derivative decreases.
The cubic step is only used if the cubic tends to infinity
in the direction of the step or if the minimum of the cubic
is beyond stp. Otherwise the cubic step is defined to be
either stepmin or stepmax. The quadratic (secant) step is also
computed and if the minimum is bracketed then the step
closest to stx is taken, else the step farthest away is taken. */
mtP->infoc = 3;
bound = 1;
theta = 3*(*fx - *fp)/(*stp - *stx) + *dx + *dp;
s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dx));
s = PetscMax(s,PetscAbsReal(*dp));
/* The case gamma1 = 0 only arises if the cubic does not tend
to infinity in the direction of the step. */
gamma1 = s*PetscSqrtScalar(PetscMax(0.0,PetscPowScalar(theta/s,2.0) - (*dx/s)*(*dp/s)));
if (*stp > *stx) gamma1 = -gamma1;
p = (gamma1 - *dp) + theta;
q = (gamma1 + (*dx - *dp)) + gamma1;
r = p/q;
if (r < 0.0 && gamma1 != 0.0) stpc = *stp + r*(*stx - *stp);
else if (*stp > *stx) stpc = ls->stepmax;
else stpc = ls->stepmin;
stpq = *stp + (*dp/(*dp-*dx)) * (*stx - *stp);
if (mtP->bracket) {
if (PetscAbsReal(*stp-stpc) < PetscAbsReal(*stp-stpq)) {
stpf = stpc;
} else {
stpf = stpq;
}
} else {
if (PetscAbsReal(*stp-stpc) > PetscAbsReal(*stp-stpq)) {
stpf = stpc;
} else {
stpf = stpq;
}
}
} else {
/* Case 4: A lower function value, derivatives of the
same sign, and the magnitude of the derivative does
not decrease. If the minimum is not bracketed, the step
is either stpmin or stpmax, else the cubic step is taken. */
mtP->infoc = 4;
bound = 0;
if (mtP->bracket) {
theta = 3*(*fp - *fy)/(*sty - *stp) + *dy + *dp;
s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dy));
s = PetscMax(s,PetscAbsReal(*dp));
gamma1 = s*PetscSqrtScalar(PetscPowScalar(theta/s,2.0) - (*dy/s)*(*dp/s));
if (*stp > *sty) gamma1 = -gamma1;
p = (gamma1 - *dp) + theta;
q = ((gamma1 - *dp) + gamma1) + *dy;
r = p/q;
stpc = *stp + r*(*sty - *stp);
stpf = stpc;
} else if (*stp > *stx) {
stpf = ls->stepmax;
} else {
stpf = ls->stepmin;
}
}
/* Update the interval of uncertainty. This update does not
depend on the new step or the case analysis above. */
if (*fp > *fx) {
*sty = *stp;
*fy = *fp;
*dy = *dp;
} else {
if (sgnd < 0.0) {
*sty = *stx;
*fy = *fx;
*dy = *dx;
}
*stx = *stp;
*fx = *fp;
*dx = *dp;
}
/* Compute the new step and safeguard it. */
stpf = PetscMin(ls->stepmax,stpf);
stpf = PetscMax(ls->stepmin,stpf);
*stp = stpf;
if (mtP->bracket && bound) {
if (*sty > *stx) {
*stp = PetscMin(*stx+0.66*(*sty-*stx),*stp);
} else {
*stp = PetscMax(*stx+0.66*(*sty-*stx),*stp);
}
}
PetscFunctionReturn(0);
}
static PetscErrorCode KSPFGMRESUpdateHessenberg(KSP ksp,PetscInt it,PetscBool hapend,PetscReal *res)
{
PetscScalar *hh,*cc,*ss,tt;
PetscInt j;
KSP_FGMRES *fgmres = (KSP_FGMRES*)(ksp->data);
PetscFunctionBegin;
hh = HH(0,it); /* pointer to beginning of column to update - so
incrementing hh "steps down" the (it+1)th col of HH*/
cc = CC(0); /* beginning of cosine rotations */
ss = SS(0); /* beginning of sine rotations */
/* Apply all the previously computed plane rotations to the new column
of the Hessenberg matrix */
/* Note: this uses the rotation [conj(c) s ; -s c], c= cos(theta), s= sin(theta),
and some refs have [c s ; -conj(s) c] (don't be confused!) */
for (j=1; j<=it; j++) {
tt = *hh;
*hh = PetscConj(*cc) * tt + *ss * *(hh+1);
hh++;
*hh = *cc++ * *hh - (*ss++ * tt);
/* hh, cc, and ss have all been incremented one by end of loop */
}
/*
compute the new plane rotation, and apply it to:
1) the right-hand-side of the Hessenberg system (RS)
note: it affects RS(it) and RS(it+1)
2) the new column of the Hessenberg matrix
note: it affects HH(it,it) which is currently pointed to
by hh and HH(it+1, it) (*(hh+1))
thus obtaining the updated value of the residual...
*/
/* compute new plane rotation */
if (!hapend) {
tt = PetscSqrtScalar(PetscConj(*hh) * *hh + PetscConj(*(hh+1)) * *(hh+1));
if (tt == 0.0) {
ksp->reason = KSP_DIVERGED_NULL;
PetscFunctionReturn(0);
}
*cc = *hh / tt; /* new cosine value */
*ss = *(hh+1) / tt; /* new sine value */
/* apply to 1) and 2) */
*RS(it+1) = -(*ss * *RS(it));
*RS(it) = PetscConj(*cc) * *RS(it);
*hh = PetscConj(*cc) * *hh + *ss * *(hh+1);
/* residual is the last element (it+1) of right-hand side! */
*res = PetscAbsScalar(*RS(it+1));
} else { /* happy breakdown: HH(it+1, it) = 0, therfore we don't need to apply
another rotation matrix (so RH doesn't change). The new residual is
always the new sine term times the residual from last time (RS(it)),
but now the new sine rotation would be zero...so the residual should
be zero...so we will multiply "zero" by the last residual. This might
not be exactly what we want to do here -could just return "zero". */
*res = 0.0;
}
PetscFunctionReturn(0);
}
/*
MSA_BoundaryConditions - Calculates the boundary conditions for
the region.
Input Parameter:
. user - user-defined application context
Output Parameter:
. user - user-defined application context
*/
static PetscErrorCode MSA_BoundaryConditions(AppCtx * user)
{
PetscErrorCode ierr;
PetscInt i,j,k,limit=0;
PetscInt maxits=5;
PetscInt mx=user->mx,my=user->my;
PetscInt bsize=0, lsize=0, tsize=0, rsize=0;
PetscReal one=1.0, two=2.0, three=3.0, tol=1e-10;
PetscReal fnorm,det,hx,hy,xt=0,yt=0;
PetscReal u1,u2,nf1,nf2,njac11,njac12,njac21,njac22;
PetscReal b=-0.5, t=0.5, l=-0.5, r=0.5;
PetscReal *boundary;
bsize=mx+2; lsize=my+2; rsize=my+2; tsize=mx+2;
ierr = PetscMalloc1(bsize,&user->bottom);CHKERRQ(ierr);
ierr = PetscMalloc1(tsize,&user->top);CHKERRQ(ierr);
ierr = PetscMalloc1(lsize,&user->left);CHKERRQ(ierr);
ierr = PetscMalloc1(rsize,&user->right);CHKERRQ(ierr);
hx= (r-l)/(mx+1); hy=(t-b)/(my+1);
for (j=0; j<4; j++){
if (j==0){
yt=b;
xt=l;
limit=bsize;
boundary=user->bottom;
} else if (j==1){
yt=t;
xt=l;
limit=tsize;
boundary=user->top;
} else if (j==2){
yt=b;
xt=l;
limit=lsize;
boundary=user->left;
} else { /* if (j==3) */
yt=b;
xt=r;
limit=rsize;
boundary=user->right;
}
for (i=0; i<limit; i++){
u1=xt;
u2=-yt;
for (k=0; k<maxits; k++){
nf1=u1 + u1*u2*u2 - u1*u1*u1/three-xt;
nf2=-u2 - u1*u1*u2 + u2*u2*u2/three-yt;
fnorm=PetscSqrtScalar(nf1*nf1+nf2*nf2);
if (fnorm <= tol) break;
njac11=one+u2*u2-u1*u1;
njac12=two*u1*u2;
njac21=-two*u1*u2;
njac22=-one - u1*u1 + u2*u2;
det = njac11*njac22-njac21*njac12;
u1 = u1-(njac22*nf1-njac12*nf2)/det;
u2 = u2-(njac11*nf2-njac21*nf1)/det;
}
boundary[i]=u1*u1-u2*u2;
if (j==0 || j==1) {
xt=xt+hx;
} else { /* if (j==2 || j==3) */
yt=yt+hy;
}
}
}
return 0;
}
/*
QuadraticH - Evaluates the Hessian matrix.
Input Parameters:
. user - user-defined context, as set by TaoSetHessian()
. X - input vector
Output Parameter:
. H - Hessian matrix
*/
PetscErrorCode QuadraticH(AppCtx *user, Vec X, Mat Hessian)
{
PetscErrorCode ierr;
PetscInt i,j,k,row;
PetscInt mx=user->mx, my=user->my;
PetscInt col[7];
PetscReal hx=1.0/(mx+1), hy=1.0/(my+1), hydhx=hy/hx, hxdhy=hx/hy;
PetscReal rhx=mx+1, rhy=my+1;
PetscReal f1,f2,f3,f4,f5,f6,d1,d2,d3,d4,d5,d6,d7,d8,xc,xl,xr,xt,xb,xlt,xrb;
PetscReal hl,hr,ht,hb,hc,htl,hbr;
PetscReal *x, v[7];
/* Get pointers to vector data */
ierr = VecGetArray(X,&x);CHKERRQ(ierr);
/* Initialize matrix entries to zero */
ierr = MatZeroEntries(Hessian); CHKERRQ(ierr);
/* Set various matrix options */
ierr = MatSetOption(Hessian,MAT_IGNORE_OFF_PROC_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
/* Compute Hessian over the locally owned part of the mesh */
for (i=0; i< mx; i++){
for (j=0; j<my; j++){
row=(j)*mx + (i);
xc = x[row];
xlt=xrb=xl=xr=xb=xt=xc;
/* Left side */
if (i==0){
xl= user->left[j+1];
xlt = user->left[j+2];
} else {
xl = x[row-1];
}
if (j==0){
xb=user->bottom[i+1];
xrb = user->bottom[i+2];
} else {
xb = x[row-mx];
}
if (i+1 == mx){
xr=user->right[j+1];
xrb = user->right[j];
} else {
xr = x[row+1];
}
if (j+1==my){
xt=user->top[i+1];
xlt = user->top[i];
}else {
xt = x[row+mx];
}
if (i>0 && j+1<my){
xlt = x[row-1+mx];
}
if (j>0 && i+1<mx){
xrb = x[row+1-mx];
}
d1 = (xc-xl)*rhx;
d2 = (xc-xr)*rhx;
d3 = (xc-xt)*rhy;
d4 = (xc-xb)*rhy;
d5 = (xrb-xr)*rhy;
d6 = (xrb-xb)*rhx;
d7 = (xlt-xl)*rhy;
d8 = (xlt-xt)*rhx;
f1 = PetscSqrtScalar( 1.0 + d1*d1 + d7*d7);
f2 = PetscSqrtScalar( 1.0 + d1*d1 + d4*d4);
f3 = PetscSqrtScalar( 1.0 + d3*d3 + d8*d8);
f4 = PetscSqrtScalar( 1.0 + d3*d3 + d2*d2);
f5 = PetscSqrtScalar( 1.0 + d2*d2 + d5*d5);
f6 = PetscSqrtScalar( 1.0 + d4*d4 + d6*d6);
hl = (-hydhx*(1.0+d7*d7)+d1*d7)/(f1*f1*f1)+(-hydhx*(1.0+d4*d4)+d1*d4)/(f2*f2*f2);
hr = (-hydhx*(1.0+d5*d5)+d2*d5)/(f5*f5*f5)+(-hydhx*(1.0+d3*d3)+d2*d3)/(f4*f4*f4);
ht = (-hxdhy*(1.0+d8*d8)+d3*d8)/(f3*f3*f3)+(-hxdhy*(1.0+d2*d2)+d2*d3)/(f4*f4*f4);
hb = (-hxdhy*(1.0+d6*d6)+d4*d6)/(f6*f6*f6)+(-hxdhy*(1.0+d1*d1)+d1*d4)/(f2*f2*f2);
hbr = -d2*d5/(f5*f5*f5) - d4*d6/(f6*f6*f6);
htl = -d1*d7/(f1*f1*f1) - d3*d8/(f3*f3*f3);
hc = hydhx*(1.0+d7*d7)/(f1*f1*f1) + hxdhy*(1.0+d8*d8)/(f3*f3*f3) + hydhx*(1.0+d5*d5)/(f5*f5*f5) + hxdhy*(1.0+d6*d6)/(f6*f6*f6) +
(hxdhy*(1.0+d1*d1)+hydhx*(1.0+d4*d4)-2*d1*d4)/(f2*f2*f2) + (hxdhy*(1.0+d2*d2)+hydhx*(1.0+d3*d3)-2*d2*d3)/(f4*f4*f4);
hl*=0.5; hr*=0.5; ht*=0.5; hb*=0.5; hbr*=0.5; htl*=0.5; hc*=0.5;
k=0;
if (j>0){
v[k]=hb; col[k]=row - mx; k++;
}
if (j>0 && i < mx -1){
v[k]=hbr; col[k]=row - mx+1; k++;
}
if (i>0){
v[k]= hl; col[k]=row - 1; k++;
}
v[k]= hc; col[k]=row; k++;
if (i < mx-1 ){
v[k]= hr; col[k]=row+1; k++;
}
if (i>0 && j < my-1 ){
v[k]= htl; col[k] = row+mx-1; k++;
}
if (j < my-1 ){
v[k]= ht; col[k] = row+mx; k++;
}
/*
Set matrix values using local numbering, which was defined
earlier, in the main routine.
*/
ierr = MatSetValues(Hessian,1,&row,k,col,v,INSERT_VALUES);CHKERRQ(ierr);
}
}
/* Restore vectors */
ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
/* Assemble the matrix */
ierr = MatAssemblyBegin(Hessian,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(Hessian,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscLogFlops(199*mx*my);CHKERRQ(ierr);
return 0;
}
/* FormFunctionGradient - Evaluates function and corresponding gradient.
Input Parameters:
. tao - the Tao context
. X - input vector
. userCtx - optional user-defined context, as set by TaoSetFunctionGradient()
Output Parameters:
. fcn - the newly evaluated function
. G - vector containing the newly evaluated gradient
*/
PetscErrorCode FormFunctionGradient(Tao tao,Vec X,PetscReal *fcn,Vec G,void *userCtx)
{
AppCtx *user = (AppCtx *) userCtx;
PetscErrorCode ierr;
PetscInt i,j,row;
PetscInt mx=user->mx, my=user->my;
PetscReal rhx=mx+1, rhy=my+1;
PetscReal hx=1.0/(mx+1),hy=1.0/(my+1), hydhx=hy/hx, hxdhy=hx/hy, area=0.5*hx*hy, ft=0;
PetscReal f1,f2,f3,f4,f5,f6,d1,d2,d3,d4,d5,d6,d7,d8,xc,xl,xr,xt,xb,xlt,xrb;
PetscReal df1dxc,df2dxc,df3dxc,df4dxc,df5dxc,df6dxc;
PetscReal zero=0.0;
PetscReal *g, *x;
ierr = VecSet(G, zero);CHKERRQ(ierr);
ierr = VecGetArray(X,&x);CHKERRQ(ierr);
ierr = VecGetArray(G,&g);CHKERRQ(ierr);
/* Compute function over the locally owned part of the mesh */
for (j=0; j<my; j++){
for (i=0; i< mx; i++){
row=(j)*mx + (i);
xc = x[row];
xlt=xrb=xl=xr=xb=xt=xc;
if (i==0){ /* left side */
xl= user->left[j+1];
xlt = user->left[j+2];
} else {
xl = x[row-1];
}
if (j==0){ /* bottom side */
xb=user->bottom[i+1];
xrb = user->bottom[i+2];
} else {
xb = x[row-mx];
}
if (i+1 == mx){ /* right side */
xr=user->right[j+1];
xrb = user->right[j];
} else {
xr = x[row+1];
}
if (j+1==0+my){ /* top side */
xt=user->top[i+1];
xlt = user->top[i];
}else {
xt = x[row+mx];
}
if (i>0 && j+1<my){
xlt = x[row-1+mx];
}
if (j>0 && i+1<mx){
xrb = x[row+1-mx];
}
d1 = (xc-xl);
d2 = (xc-xr);
d3 = (xc-xt);
d4 = (xc-xb);
d5 = (xr-xrb);
d6 = (xrb-xb);
d7 = (xlt-xl);
d8 = (xt-xlt);
df1dxc = d1*hydhx;
df2dxc = ( d1*hydhx + d4*hxdhy );
df3dxc = d3*hxdhy;
df4dxc = ( d2*hydhx + d3*hxdhy );
df5dxc = d2*hydhx;
df6dxc = d4*hxdhy;
d1 *= rhx;
d2 *= rhx;
d3 *= rhy;
d4 *= rhy;
d5 *= rhy;
d6 *= rhx;
d7 *= rhy;
d8 *= rhx;
f1 = PetscSqrtScalar( 1.0 + d1*d1 + d7*d7);
f2 = PetscSqrtScalar( 1.0 + d1*d1 + d4*d4);
f3 = PetscSqrtScalar( 1.0 + d3*d3 + d8*d8);
f4 = PetscSqrtScalar( 1.0 + d3*d3 + d2*d2);
f5 = PetscSqrtScalar( 1.0 + d2*d2 + d5*d5);
f6 = PetscSqrtScalar( 1.0 + d4*d4 + d6*d6);
ft = ft + (f2 + f4);
df1dxc /= f1;
df2dxc /= f2;
df3dxc /= f3;
df4dxc /= f4;
df5dxc /= f5;
df6dxc /= f6;
g[row] = (df1dxc+df2dxc+df3dxc+df4dxc+df5dxc+df6dxc )/2.0;
}
}
for (j=0; j<my; j++){ /* left side */
d3=(user->left[j+1] - user->left[j+2])*rhy;
d2=(user->left[j+1] - x[j*mx])*rhx;
ft = ft+PetscSqrtScalar( 1.0 + d3*d3 + d2*d2);
}
for (i=0; i<mx; i++){ /* bottom */
d2=(user->bottom[i+1]-user->bottom[i+2])*rhx;
d3=(user->bottom[i+1]-x[i])*rhy;
ft = ft+PetscSqrtScalar( 1.0 + d3*d3 + d2*d2);
}
for (j=0; j< my; j++){ /* right side */
d1=(x[(j+1)*mx-1]-user->right[j+1])*rhx;
d4=(user->right[j]-user->right[j+1])*rhy;
ft = ft+PetscSqrtScalar( 1.0 + d1*d1 + d4*d4);
}
for (i=0; i<mx; i++){ /* top side */
d1=(x[(my-1)*mx + i] - user->top[i+1])*rhy;
d4=(user->top[i+1] - user->top[i])*rhx;
ft = ft+PetscSqrtScalar( 1.0 + d1*d1 + d4*d4);
}
/* Bottom left corner */
d1=(user->left[0]-user->left[1])*rhy;
d2=(user->bottom[0]-user->bottom[1])*rhx;
ft +=PetscSqrtScalar( 1.0 + d1*d1 + d2*d2);
/* Top right corner */
d1=(user->right[my+1] - user->right[my])*rhy;
d2=(user->top[mx+1] - user->top[mx])*rhx;
ft +=PetscSqrtScalar( 1.0 + d1*d1 + d2*d2);
(*fcn)=ft*area;
/* Restore vectors */
ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
ierr = VecRestoreArray(G,&g);CHKERRQ(ierr);
ierr = PetscLogFlops(67*mx*my);CHKERRQ(ierr);
return 0;
}
static PetscErrorCode KSPSolve_TCQMR(KSP ksp)
{
PetscReal rnorm0,rnorm,dp1,Gamma;
PetscScalar theta,ep,cl1,sl1,cl,sl,sprod,tau_n1,f;
PetscScalar deltmp,rho,beta,eptmp,ta,s,c,tau_n,delta;
PetscScalar dp11,dp2,rhom1,alpha,tmp;
PetscErrorCode ierr;
PetscFunctionBegin;
ksp->its = 0;
ierr = KSPInitialResidual(ksp,x,u,v,r,b);CHKERRQ(ierr);
ierr = VecNorm(r,NORM_2,&rnorm0);CHKERRQ(ierr); /* rnorm0 = ||r|| */
KSPCheckNorm(ksp,rnorm0);
ierr = (*ksp->converged)(ksp,0,rnorm0,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) PetscFunctionReturn(0);
ierr = VecSet(um1,0.0);CHKERRQ(ierr);
ierr = VecCopy(r,u);CHKERRQ(ierr);
rnorm = rnorm0;
tmp = 1.0/rnorm; ierr = VecScale(u,tmp);CHKERRQ(ierr);
ierr = VecSet(vm1,0.0);CHKERRQ(ierr);
ierr = VecCopy(u,v);CHKERRQ(ierr);
ierr = VecCopy(u,v0);CHKERRQ(ierr);
ierr = VecSet(pvec1,0.0);CHKERRQ(ierr);
ierr = VecSet(pvec2,0.0);CHKERRQ(ierr);
ierr = VecSet(p,0.0);CHKERRQ(ierr);
theta = 0.0;
ep = 0.0;
cl1 = 0.0;
sl1 = 0.0;
cl = 0.0;
sl = 0.0;
sprod = 1.0;
tau_n1= rnorm0;
f = 1.0;
Gamma = 1.0;
rhom1 = 1.0;
/*
CALCULATE SQUARED LANCZOS vectors
*/
ierr = (*ksp->converged)(ksp,ksp->its,rnorm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
while (!ksp->reason) {
ierr = KSPMonitor(ksp,ksp->its,rnorm);CHKERRQ(ierr);
ksp->its++;
ierr = KSP_PCApplyBAorAB(ksp,u,y,vtmp);CHKERRQ(ierr); /* y = A*u */
ierr = VecDot(y,v0,&dp11);CHKERRQ(ierr);
KSPCheckDot(ksp,dp11);
ierr = VecDot(u,v0,&dp2);CHKERRQ(ierr);
alpha = dp11 / dp2; /* alpha = v0'*y/v0'*u */
deltmp = alpha;
ierr = VecCopy(y,z);CHKERRQ(ierr);
ierr = VecAXPY(z,-alpha,u);CHKERRQ(ierr); /* z = y - alpha u */
ierr = VecDot(u,v0,&rho);CHKERRQ(ierr);
beta = rho / (f*rhom1);
rhom1 = rho;
ierr = VecCopy(z,utmp);CHKERRQ(ierr); /* up1 = (A-alpha*I)*
(z-2*beta*p) + f*beta*
beta*um1 */
ierr = VecAXPY(utmp,-2.0*beta,p);CHKERRQ(ierr);
ierr = KSP_PCApplyBAorAB(ksp,utmp,up1,vtmp);CHKERRQ(ierr);
ierr = VecAXPY(up1,-alpha,utmp);CHKERRQ(ierr);
ierr = VecAXPY(up1,f*beta*beta,um1);CHKERRQ(ierr);
ierr = VecNorm(up1,NORM_2,&dp1);CHKERRQ(ierr);
KSPCheckNorm(ksp,dp1);
f = 1.0 / dp1;
ierr = VecScale(up1,f);CHKERRQ(ierr);
ierr = VecAYPX(p,-beta,z);CHKERRQ(ierr); /* p = f*(z-beta*p) */
ierr = VecScale(p,f);CHKERRQ(ierr);
ierr = VecCopy(u,um1);CHKERRQ(ierr);
ierr = VecCopy(up1,u);CHKERRQ(ierr);
beta = beta/Gamma;
eptmp = beta;
ierr = KSP_PCApplyBAorAB(ksp,v,vp1,vtmp);CHKERRQ(ierr);
ierr = VecAXPY(vp1,-alpha,v);CHKERRQ(ierr);
ierr = VecAXPY(vp1,-beta,vm1);CHKERRQ(ierr);
ierr = VecNorm(vp1,NORM_2,&Gamma);CHKERRQ(ierr);
KSPCheckNorm(ksp,Gamma);
ierr = VecScale(vp1,1.0/Gamma);CHKERRQ(ierr);
ierr = VecCopy(v,vm1);CHKERRQ(ierr);
ierr = VecCopy(vp1,v);CHKERRQ(ierr);
/*
SOLVE Ax = b
*/
/* Apply last two Given's (Gl-1 and Gl) rotations to (beta,alpha,Gamma) */
if (ksp->its > 2) {
theta = sl1*beta;
eptmp = -cl1*beta;
}
if (ksp->its > 1) {
ep = -cl*eptmp + sl*alpha;
deltmp = -sl*eptmp - cl*alpha;
}
if (PetscAbsReal(Gamma) > PetscAbsScalar(deltmp)) {
ta = -deltmp / Gamma;
s = 1.0 / PetscSqrtScalar(1.0 + ta*ta);
c = s*ta;
} else {
ta = -Gamma/deltmp;
c = 1.0 / PetscSqrtScalar(1.0 + ta*ta);
s = c*ta;
}
delta = -c*deltmp + s*Gamma;
tau_n = -c*tau_n1; tau_n1 = -s*tau_n1;
ierr = VecCopy(vm1,pvec);CHKERRQ(ierr);
ierr = VecAXPY(pvec,-theta,pvec2);CHKERRQ(ierr);
ierr = VecAXPY(pvec,-ep,pvec1);CHKERRQ(ierr);
ierr = VecScale(pvec,1.0/delta);CHKERRQ(ierr);
ierr = VecAXPY(x,tau_n,pvec);CHKERRQ(ierr);
cl1 = cl; sl1 = sl; cl = c; sl = s;
ierr = VecCopy(pvec1,pvec2);CHKERRQ(ierr);
ierr = VecCopy(pvec,pvec1);CHKERRQ(ierr);
/* Compute the upper bound on the residual norm r (See QMR paper p. 13) */
sprod = sprod*PetscAbsScalar(s);
rnorm = rnorm0 * PetscSqrtReal((PetscReal)ksp->its+2.0) * PetscRealPart(sprod);
ierr = (*ksp->converged)(ksp,ksp->its,rnorm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->its >= ksp->max_it) {
if (!ksp->reason) ksp->reason = KSP_DIVERGED_ITS;
break;
}
}
ierr = KSPMonitor(ksp,ksp->its,rnorm);CHKERRQ(ierr);
ierr = KSPUnwindPreconditioner(ksp,x,vtmp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
