PetscErrorCode FormFunction(SNES snes, Vec x, Vec F, void *ctx) {
PetscErrorCode ierr;
const PetscReal *ax;
PetscReal *aF;
ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
ierr = VecGetArray(F,&aF);CHKERRQ(ierr);
aF[0] = atan(ax[0]);
ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
ierr = VecRestoreArray(F,&aF);CHKERRQ(ierr);
return 0;
}
/*@
STComputeExplicitOperator - Computes the explicit operator associated
to the eigenvalue problem with the specified spectral transformation.
Collective on ST
Input Parameter:
. st - the spectral transform context
Output Parameter:
. mat - the explicit operator
Notes:
This routine builds a matrix containing the explicit operator. For
example, in generalized problems with shift-and-invert spectral
transformation the result would be matrix (A - s B)^-1 B.
This computation is done by applying the operator to columns of the
identity matrix. This is analogous to MatComputeExplicitOperator().
Level: advanced
.seealso: STApply()
@*/
PetscErrorCode STComputeExplicitOperator(ST st,Mat *mat)
{
PetscErrorCode ierr;
Vec in,out;
PetscInt i,M,m,*rows,start,end;
const PetscScalar *array;
PetscScalar one = 1.0;
PetscMPIInt size;
PetscFunctionBegin;
PetscValidHeaderSpecific(st,ST_CLASSID,1);
PetscValidPointer(mat,2);
STCheckMatrices(st,1);
if (st->nmat>2) SETERRQ(PetscObjectComm((PetscObject)st),PETSC_ERR_ARG_WRONGSTATE,"Can only be used with 1 or 2 matrices");
ierr = MPI_Comm_size(PetscObjectComm((PetscObject)st),&size);CHKERRQ(ierr);
ierr = MatGetVecs(st->A[0],&in,&out);CHKERRQ(ierr);
ierr = VecGetSize(out,&M);CHKERRQ(ierr);
ierr = VecGetLocalSize(out,&m);CHKERRQ(ierr);
ierr = VecSetOption(in,VEC_IGNORE_OFF_PROC_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(out,&start,&end);CHKERRQ(ierr);
ierr = PetscMalloc1(m,&rows);CHKERRQ(ierr);
for (i=0;i<m;i++) rows[i] = start + i;
ierr = MatCreate(PetscObjectComm((PetscObject)st),mat);CHKERRQ(ierr);
ierr = MatSetSizes(*mat,m,m,M,M);CHKERRQ(ierr);
if (size == 1) {
ierr = MatSetType(*mat,MATSEQDENSE);CHKERRQ(ierr);
ierr = MatSeqDenseSetPreallocation(*mat,NULL);CHKERRQ(ierr);
} else {
ierr = MatSetType(*mat,MATMPIAIJ);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(*mat,m,NULL,M-m,NULL);CHKERRQ(ierr);
}
for (i=0;i<M;i++) {
ierr = VecSet(in,0.0);CHKERRQ(ierr);
ierr = VecSetValues(in,1,&i,&one,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(in);CHKERRQ(ierr);
ierr = VecAssemblyEnd(in);CHKERRQ(ierr);
ierr = STApply(st,in,out);CHKERRQ(ierr);
ierr = VecGetArrayRead(out,&array);CHKERRQ(ierr);
ierr = MatSetValues(*mat,m,rows,1,&i,array,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(out,&array);CHKERRQ(ierr);
}
ierr = PetscFree(rows);CHKERRQ(ierr);
ierr = VecDestroy(&in);CHKERRQ(ierr);
ierr = VecDestroy(&out);CHKERRQ(ierr);
ierr = MatAssemblyBegin(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode I2Function(TS ts,PetscReal t,Vec U,Vec V,Vec A,Vec F,void *ctx)
{
AppCtx *app = (AppCtx*)ctx;
const PetscScalar *u,*v,*a;
PetscScalar Res,*f;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecGetArrayRead(U,&u);CHKERRQ(ierr);
ierr = VecGetArrayRead(V,&v);CHKERRQ(ierr);
ierr = VecGetArrayRead(A,&a);CHKERRQ(ierr);
Res = a[0] + 9.8 + 0.5 * app->Cd * v[0]*v[0] * PetscSignReal(PetscRealPart(v[0]));
ierr = VecRestoreArrayRead(U,&u);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(V,&v);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(A,&a);CHKERRQ(ierr);
ierr = VecGetArray(F,&f);CHKERRQ(ierr);
f[0] = Res;
ierr = VecRestoreArray(F,&f);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatMult_myMat(Mat A,Vec x,Vec y)
{
PetscFunctionBeginUser;
PetscErrorCode ierr;
model *m;
ierr = MatShellGetContext(A, &m); CHKERRQ(ierr);
PetscInt len_x, len_y;
ierr = VecGetLocalSize(x, &len_x); CHKERRQ(ierr);
ierr = VecGetLocalSize(y, &len_y); CHKERRQ(ierr);
//std::cout << "len_x=" << len_x << "len_y=" << len_y << std::endl;
const PetscScalar *px;
PetscScalar *py, *pgx;
VecScatter ctx;
Vec vout;
VecScatterCreateToAll(x,&ctx,&vout);
// scatter as many times as you need
VecScatterBegin(ctx,x,vout,INSERT_VALUES,SCATTER_FORWARD);
VecScatterEnd(ctx,x,vout,INSERT_VALUES,SCATTER_FORWARD);
ierr = VecGetArray(vout, &pgx); CHKERRQ(ierr);
ierr = VecGetArrayRead(x, &px); CHKERRQ(ierr);
ierr = VecGetArray(y, &py); CHKERRQ(ierr);
PetscInt Istart, Iend;
ierr = MatGetOwnershipRange(A, &Istart, &Iend); CHKERRQ(ierr);
PetscInt A_m, n;
ierr = MatGetSize(A, &A_m, &n); CHKERRQ(ierr);
PetscScalar* pgy = new PetscScalar[n];
rokko::heisenberg_hamiltonian::multiply(m->L, m->lattice, pgx, pgy);
for(int j = 0; j < len_y; ++j) {
py[j] = 0.;
}
int k=0;
for(int i = Istart; i < Iend; ++i) {
py[k] = pgy[i];
++k;
}
// destroy scatter context and local vector when no longer needed
VecScatterDestroy(&ctx);
//VecView(vout, PETSC_VIEWER_STDOUT_WORLD);
VecDestroy(&vout);
ierr = VecRestoreArrayRead(x,&px); CHKERRQ(ierr);
ierr = VecRestoreArray(y,&py); CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Special case where the matrix was ILU(0) factored in the natural
ordering. This eliminates the need for the column and row permutation.
*/
PetscErrorCode MatSolve_SeqBAIJ_1_NaturalOrdering_inplace(Mat A,Vec bb,Vec xx)
{
Mat_SeqBAIJ *a = (Mat_SeqBAIJ*)A->data;
const PetscInt n = a->mbs,*vi,*ai=a->i,*aj=a->j,*diag=a->diag;
PetscErrorCode ierr;
const MatScalar *aa=a->a,*v;
PetscScalar *x;
const PetscScalar *b;
PetscScalar s1,x1;
PetscInt jdx,idt,idx,nz,i;
PetscFunctionBegin;
ierr = VecGetArrayRead(bb,&b);CHKERRQ(ierr);
ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
/* forward solve the lower triangular */
idx = 0;
x[0] = b[0];
for (i=1; i<n; i++) {
v = aa + ai[i];
vi = aj + ai[i];
nz = diag[i] - ai[i];
idx += 1;
s1 = b[idx];
while (nz--) {
jdx = *vi++;
x1 = x[jdx];
s1 -= v[0]*x1;
v += 1;
}
x[idx] = s1;
}
/* backward solve the upper triangular */
for (i=n-1; i>=0; i--) {
v = aa + diag[i] + 1;
vi = aj + diag[i] + 1;
nz = ai[i+1] - diag[i] - 1;
idt = i;
s1 = x[idt];
while (nz--) {
idx = *vi++;
x1 = x[idx];
s1 -= v[0]*x1;
v += 1;
}
v = aa + diag[i];
x[idt] = v[0]*s1;
}
ierr = VecRestoreArrayRead(bb,&b);CHKERRQ(ierr);
ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
ierr = PetscLogFlops(2.0*(a->nz) - A->cmap->n);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode EventFunction(TS ts,PetscReal t,Vec U,PetscScalar *fvalue,void *ctx)
{
PetscErrorCode ierr;
const PetscScalar *u;
PetscFunctionBegin;
/* Event for ball height */
ierr = VecGetArrayRead(U,&u);CHKERRQ(ierr);
fvalue[0] = u[0];
ierr = VecRestoreArrayRead(U,&u);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode PCBDDCScalingExtension_Deluxe(PC pc, Vec x, Vec y)
{
PC_IS* pcis=(PC_IS*)pc->data;
PC_BDDC* pcbddc=(PC_BDDC*)pc->data;
PCBDDCDeluxeScaling deluxe_ctx = pcbddc->deluxe_ctx;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecSet(pcbddc->work_scaling,0.0);CHKERRQ(ierr);
ierr = VecSet(y,0.0);CHKERRQ(ierr);
if (deluxe_ctx->n_simple) { /* scale deluxe vertices using diagonal scaling */
PetscInt i;
const PetscScalar *array_x,*array_D;
PetscScalar *array;
ierr = VecGetArrayRead(x,&array_x);CHKERRQ(ierr);
ierr = VecGetArrayRead(pcis->D,&array_D);CHKERRQ(ierr);
ierr = VecGetArray(pcbddc->work_scaling,&array);CHKERRQ(ierr);
for (i=0;i<deluxe_ctx->n_simple;i++) {
array[deluxe_ctx->idx_simple_B[i]] = array_x[deluxe_ctx->idx_simple_B[i]]*array_D[deluxe_ctx->idx_simple_B[i]];
}
ierr = VecRestoreArray(pcbddc->work_scaling,&array);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(pcis->D,&array_D);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(x,&array_x);CHKERRQ(ierr);
}
/* sequential part : all problems and Schur applications collapsed into a single matrix vector multiplication or a matvec and a solve */
if (deluxe_ctx->seq_mat) {
ierr = VecScatterBegin(deluxe_ctx->seq_scctx,x,deluxe_ctx->seq_work1,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(deluxe_ctx->seq_scctx,x,deluxe_ctx->seq_work1,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = MatMultTranspose(deluxe_ctx->seq_mat,deluxe_ctx->seq_work1,deluxe_ctx->seq_work2);CHKERRQ(ierr);
if (deluxe_ctx->seq_ksp) {
ierr = KSPSolveTranspose(deluxe_ctx->seq_ksp,deluxe_ctx->seq_work2,deluxe_ctx->seq_work2);CHKERRQ(ierr);
}
ierr = VecScatterBegin(deluxe_ctx->seq_scctx,deluxe_ctx->seq_work2,pcbddc->work_scaling,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(deluxe_ctx->seq_scctx,deluxe_ctx->seq_work2,pcbddc->work_scaling,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
}
/* put local boundary part in global vector */
ierr = VecScatterBegin(pcis->global_to_B,pcbddc->work_scaling,y,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(pcis->global_to_B,pcbddc->work_scaling,y,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
FormIJacobian - Evaluates Jacobian matrix.
Input Parameters:
+ ts - the TS context
. t - pseudo-time
. X - input vector
. Xdot - time derivative
. shift - multiplier for mass matrix
. dummy - user-defined context
Output Parameters:
. J - Jacobian matrix
. B - optionally different preconditioning matrix
. flag - flag indicating matrix structure
*/
static PetscErrorCode FormIJacobian(TS ts,PetscReal t,Vec X,Vec Xdot,PetscReal shift,Mat J,Mat B,void *ictx)
{
const PetscScalar *x;
PetscErrorCode ierr;
PetscInt i;
Ctx *ctx = (Ctx*)ictx;
PetscFunctionBeginUser;
ierr = MatZeroEntries(B);CHKERRQ(ierr);
/*
Get pointer to vector data
*/
ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
/*
Compute Jacobian entries and insert into matrix.
*/
for (i=0; i<ctx->n-1; i++) {
PetscInt rowcol[2];
PetscScalar v[2][2],a,a0,a1,a00,a01,a10,a11;
rowcol[0] = i;
rowcol[1] = i+1;
a = x[i+1] - PetscSqr(x[i]);
a0 = -2.*x[i];
a00 = -2.;
a01 = 0.;
a1 = 1.;
a10 = 0.;
a11 = 0.;
v[0][0] = 2. + 200.*(a*a00 + a0*a0);
v[0][1] = 200.*(a*a01 + a1*a0);
v[1][0] = 200.*(a*a10 + a0*a1);
v[1][1] = 200.*(a*a11 + a1*a1);
ierr = MatSetValues(B,2,rowcol,2,rowcol,&v[0][0],ADD_VALUES);CHKERRQ(ierr);
}
for (i=0; i<ctx->n; i++) {
ierr = MatSetValue(B,i,i,(PetscScalar)shift,ADD_VALUES);CHKERRQ(ierr);
}
ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr);
/*
Assemble matrix
*/
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (J != B) {
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
Defines the ODE passed to the ODE solver
*/
static PetscErrorCode IFunction(TS ts,PetscReal t,Vec U,Vec Udot,Vec F,AppCtx *ctx)
{
PetscErrorCode ierr;
PetscScalar *f,Pmax;
const PetscScalar *u,*udot;
PetscFunctionBegin;
/* The next three lines allow us to access the entries of the vectors directly */
ierr = VecGetArrayRead(U,&u);CHKERRQ(ierr);
ierr = VecGetArrayRead(Udot,&udot);CHKERRQ(ierr);
ierr = VecGetArray(F,&f);CHKERRQ(ierr);
if ((t > ctx->tf) && (t < ctx->tcl)) Pmax = 0.0; /* A short-circuit on the generator terminal that drives the electrical power output (Pmax*sin(delta)) to 0 */
else if (t >= ctx->tcl) Pmax = ctx->E/0.745;
else Pmax = ctx->Pmax;
f[0] = udot[0] - ctx->omega_s*(u[1] - 1.0);
f[1] = 2.0*ctx->H*udot[1] + Pmax*PetscSinScalar(u[0]) + ctx->D*(u[1] - 1.0)- ctx->Pm;
ierr = VecRestoreArrayRead(U,&u);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(Udot,&udot);CHKERRQ(ierr);
ierr = VecRestoreArray(F,&f);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode SNESVIProjectOntoBounds(SNES snes,Vec X)
{
PetscErrorCode ierr;
const PetscScalar *xl,*xu;
PetscScalar *x;
PetscInt i,n;
PetscFunctionBegin;
ierr = VecGetLocalSize(X,&n);CHKERRQ(ierr);
ierr = VecGetArray(X,&x);CHKERRQ(ierr);
ierr = VecGetArrayRead(snes->xl,&xl);CHKERRQ(ierr);
ierr = VecGetArrayRead(snes->xu,&xu);CHKERRQ(ierr);
for (i = 0; i<n; i++) {
if (PetscRealPart(x[i]) < PetscRealPart(xl[i])) x[i] = xl[i];
else if (PetscRealPart(x[i]) > PetscRealPart(xu[i])) x[i] = xu[i];
}
ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(snes->xl,&xl);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(snes->xu,&xu);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode Residual1(TS ts,PetscReal t,Vec U,Vec A,Vec R,void *ctx)
{
UserParams *user = (UserParams*)ctx;
PetscReal Omega = user->Omega;
const PetscScalar *u,*a;
PetscScalar *r;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecGetArrayRead(U,&u);CHKERRQ(ierr);
ierr = VecGetArrayRead(A,&a);CHKERRQ(ierr);
ierr = VecGetArray(R,&r);CHKERRQ(ierr);
r[0] = a[0] + (Omega*Omega)*u[0];
ierr = VecRestoreArrayRead(U,&u);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(A,&a);CHKERRQ(ierr);
ierr = VecRestoreArray(R,&r);CHKERRQ(ierr);
ierr = VecAssemblyBegin(R);CHKERRQ(ierr);
ierr = VecAssemblyEnd(R);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode FormFunction(SNES snes, Vec x, Vec F, void *ctx) {
PetscErrorCode ierr;
const double b = 2.0, *ax;
double *aF;
ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
ierr = VecGetArray(F,&aF);CHKERRQ(ierr);
aF[0] = (1.0 / b) * PetscExpReal(b * ax[0]) - ax[1];
aF[1] = ax[0] * ax[0] + ax[1] * ax[1] - 1.0;
ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
ierr = VecRestoreArray(F,&aF);CHKERRQ(ierr);
return 0;
}
PetscErrorCode SetObservation(Userctx* user, PetscReal t, Vec X)
{
PetscErrorCode ierr;
PetscInt idx,obs_len,i;
PetscScalar *mat;
Vec Xgen,Xnet;
PetscScalar *xnet;//, *xgen;
const PetscScalar *x;
PetscScalar *proj_vec;
PetscReal step_num;
PetscFunctionBegin;
/* observations are generated only after restore */
/* t = t - user->tdisturb;*/
t = t - user->trestore;
if(t >= -1e-6*user->dt) {
step_num = round(t / user->data_dt);
if(fabs(step_num - t/user->data_dt)<= 1e-6*user->dt) {
idx = (PetscInt) step_num;
ierr = VecGetSize(user->proj, &obs_len);CHKERRQ(ierr);
//printf("SetObservation: t=%g index=%d proj_len=%d \n", t, idx, obs_len);
idx = idx*2*obs_len;
ierr = MatDenseGetArray(user->obs,&mat);CHKERRQ(ierr);
ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
ierr = VecGetArray(user->proj, &proj_vec);CHKERRQ(ierr);
ierr = DMCompositeGetLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
ierr = DMCompositeScatter(user->dmpgrid,X,Xgen,Xnet);CHKERRQ(ierr);
ierr = VecGetArray(Xnet,&xnet);CHKERRQ(ierr);
//get pointer to xnet and to user->proj
for(i=0;i<obs_len; i++) {
//printf("proj[%d]=%d\n", i, (int)proj_vec[i]);
*(mat+idx+2*i) = xnet[2*((int)proj_vec[i])];
*(mat+idx+2*i+1) = xnet[2*((int)proj_vec[i])+1];
}
//printf("%g \n", xnet[0]);
ierr = MatDenseRestoreArray(user->obs,&mat);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr);
ierr = VecRestoreArray(user->proj,&proj_vec);CHKERRQ(ierr);
ierr = VecRestoreArray(Xnet,&xnet);CHKERRQ(ierr);
ierr = DMCompositeRestoreLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
static PetscErrorCode RHSFunctionfast(TS ts,PetscReal t,Vec U,Vec F,AppCtx *ctx)
{
PetscErrorCode ierr;
const PetscScalar *u;
PetscScalar *f;
PetscFunctionBegin;
ierr = VecGetArrayRead(U,&u);CHKERRQ(ierr);
ierr = VecGetArray(F,&f);CHKERRQ(ierr);
f[0] = 0.05*(-1.0+u[0]*u[0]-PetscCosScalar(t))/(2.0*u[0])-(-2.0+u[1]*u[1]-PetscCosScalar(5.0*t))/(2.0*u[1])-5.0*PetscSinScalar(5.0*t)/(2.0*u[1]);
ierr = VecRestoreArrayRead(U,&u);CHKERRQ(ierr);
ierr = VecRestoreArray(F,&f);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode RHSFunctionfast(TS ts,PetscReal t,Vec U,Vec F,AppCtx *ctx)
{
PetscErrorCode ierr;
const PetscScalar *u;
PetscScalar *f;
PetscFunctionBegin;
ierr = VecGetArrayRead(U,&u);CHKERRQ(ierr);
ierr = VecGetArray(F,&f);CHKERRQ(ierr);
f[0] = u[0]*PetscCosScalar(t*ctx->b);
ierr = VecRestoreArrayRead(U,&u);CHKERRQ(ierr);
ierr = VecRestoreArray(F,&f);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode CostIntegrand(TS ts,PetscReal t,Vec U,Vec R,AppCtx *ctx)
{
PetscErrorCode ierr;
PetscScalar *r;
const PetscScalar *u;
PetscFunctionBegin;
ierr = VecGetArrayRead(U,&u);CHKERRQ(ierr);
ierr = VecGetArray(R,&r);CHKERRQ(ierr);
r[0] = ctx->c*PetscPowScalarInt(PetscMax(0., u[0]-ctx->u_s),ctx->beta);CHKERRQ(ierr);
ierr = VecRestoreArray(R,&r);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(U,&u);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode VecMaxPointwiseDivide_Seq(Vec xin,Vec yin,PetscReal *max)
{
PetscErrorCode ierr;
PetscInt n = xin->map->n,i;
const PetscScalar *xx,*yy;
PetscReal m = 0.0;
PetscFunctionBegin;
ierr = VecGetArrayRead(xin,&xx);CHKERRQ(ierr);
ierr = VecGetArrayRead(yin,&yy);CHKERRQ(ierr);
for(i = 0; i < n; i++) {
if (yy[i] != (PetscScalar)0.0) {
m = PetscMax(PetscAbsScalar(xx[i]/yy[i]), m);
} else {
m = PetscMax(PetscAbsScalar(xx[i]), m);
}
}
ierr = VecRestoreArrayRead(xin,&xx);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(yin,&yy);CHKERRQ(ierr);
ierr = MPI_Allreduce(&m,max,1,MPIU_REAL,MPIU_MAX,((PetscObject)xin)->comm);CHKERRQ(ierr);
ierr = PetscLogFlops(n);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/* Write vector contents */
#if defined(PETSC_HAVE_MPIIO)
ierr = PetscViewerBinaryGetUseMPIIO(viewer,&isMPIIO);CHKERRQ(ierr);
if (!isMPIIO) {
#endif
ierr = PetscViewerBinaryGetDescriptor(viewer,&fdes);CHKERRQ(ierr);
ierr = VecGetArrayRead(xin,&xv);CHKERRQ(ierr);
ierr = PetscBinaryWrite(fdes,(void*)xv,n,PETSC_SCALAR,PETSC_FALSE);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(xin,&xv);CHKERRQ(ierr);
ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
if (format == PETSC_VIEWER_BINARY_MATLAB) {
MPI_Comm comm;
FILE *info;
const char *name;
ierr = PetscObjectGetName((PetscObject)xin,&name);CHKERRQ(ierr);
ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
ierr = PetscViewerBinaryGetInfoPointer(viewer,&info);CHKERRQ(ierr);
ierr = PetscFPrintf(comm,info,"#--- begin code written by PetscViewerBinary for MATLAB format ---#\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm,info,"#$$ Set.%s = PetscBinaryRead(fd);\n",name);CHKERRQ(ierr);
ierr = PetscFPrintf(comm,info,"#--- end code written by PetscViewerBinary for MATLAB format ---#\n\n");CHKERRQ(ierr);
}
#if defined(PETSC_HAVE_MPIIO)
} else {
MPI_Offset off;
MPI_File mfdes;
PetscMPIInt lsize;
ierr = PetscMPIIntCast(n,&lsize);CHKERRQ(ierr);
ierr = PetscViewerBinaryGetMPIIODescriptor(viewer,&mfdes);CHKERRQ(ierr);
ierr = PetscViewerBinaryGetMPIIOOffset(viewer,&off);CHKERRQ(ierr);
ierr = MPI_File_set_view(mfdes,off,MPIU_SCALAR,MPIU_SCALAR,(char*)"native",MPI_INFO_NULL);CHKERRQ(ierr);
ierr = VecGetArrayRead(xin,&xv);CHKERRQ(ierr);
ierr = MPIU_File_write_all(mfdes,(void*)xv,lsize,MPIU_SCALAR,MPI_STATUS_IGNORE);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(xin,&xv);CHKERRQ(ierr);
ierr = PetscViewerBinaryAddMPIIOOffset(viewer,n*sizeof(PetscScalar));CHKERRQ(ierr);
}
#endif
ierr = PetscViewerBinaryGetInfoPointer(viewer,&file);CHKERRQ(ierr);
if (file) {
if (((PetscObject)xin)->prefix) {
ierr = PetscFPrintf(PETSC_COMM_SELF,file,"-%svecload_block_size %D\n",((PetscObject)xin)->prefix,PetscAbs(xin->map->bs));CHKERRQ(ierr);
} else {
ierr = PetscFPrintf(PETSC_COMM_SELF,file,"-vecload_block_size %D\n",PetscAbs(xin->map->bs));CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
#if defined(PETSC_HAVE_MATLAB_ENGINE)
#include <petscmatlab.h>
#include <mat.h> /* MATLAB include file */
PetscErrorCode VecView_Seq_Matlab(Vec vec,PetscViewer viewer)
{
PetscErrorCode ierr;
PetscInt n;
const PetscScalar *array;
PetscFunctionBegin;
ierr = VecGetLocalSize(vec,&n);CHKERRQ(ierr);
ierr = PetscObjectName((PetscObject)vec);CHKERRQ(ierr);
ierr = VecGetArrayRead(vec,&array);CHKERRQ(ierr);
ierr = PetscViewerMatlabPutArray(viewer,n,1,array,((PetscObject)vec)->name);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(vec,&array);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Defines the DAE passed to the time solver
*/
static PetscErrorCode IFunctionSemiExplicit(TS ts,PetscReal t,Vec Y,Vec Ydot,Vec F,void *ctx)
{
PetscErrorCode ierr;
const PetscScalar *y,*ydot;
PetscScalar *f;
PetscFunctionBegin;
/* The next three lines allow us to access the entries of the vectors directly */
ierr = VecGetArrayRead(Y,&y);CHKERRQ(ierr);
ierr = VecGetArrayRead(Ydot,&ydot);CHKERRQ(ierr);
ierr = VecGetArray(F,&f);CHKERRQ(ierr);
f[0]=-400* PetscSinReal(200*PETSC_PI*t) + 1000*y[3] + ydot[0];
f[1]=0.5 - 1/(2.* PetscExpReal((500*(y[0] + y[1] - y[3]))/13.)) + (500*y[1])/9. + ydot[1];
f[2]=-222.5522222222222 + 33/(100.* PetscExpReal((500*(y[0] + y[1] - y[3]))/13.)) + (1000*y[4])/27. + ydot[2];
f[3]=0.0006666766666666667 - 1/(1.e8* PetscExpReal((500*(y[0] + y[1] - y[3]))/13.)) + PetscSinReal(200*PETSC_PI*t)/2500. + y[0]/4500. - (11*y[3])/9000.;
f[4]=0.0006676566666666666 - 99/(1.e8* PetscExpReal((500*(y[0] + y[1] - y[3]))/13.)) + y[2]/9000. - y[4]/4500.;
ierr = VecRestoreArrayRead(Y,&y);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(Ydot,&ydot);CHKERRQ(ierr);
ierr = VecRestoreArray(F,&f);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode DRDYFunction(TS ts,PetscReal t,Vec U,Vec *drdy,AppCtx *ctx)
{
PetscErrorCode ierr;
PetscScalar *ry;
const PetscScalar *u;
PetscFunctionBegin;
ierr = VecGetArrayRead(U,&u);CHKERRQ(ierr);
ierr = VecGetArray(drdy[0],&ry);CHKERRQ(ierr);
ry[0] = ctx->c*ctx->beta*PetscPowScalarInt(PetscMax(0., u[0]-ctx->u_s),ctx->beta-1);CHKERRQ(ierr);
ierr = VecRestoreArray(drdy[0],&ry);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(U,&u);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Defines the DAE passed to the time solver
*/
static PetscErrorCode IFunctionImplicit(TS ts,PetscReal t,Vec Y,Vec Ydot,Vec F,void *ctx)
{
PetscErrorCode ierr;
const PetscScalar *y,*ydot;
PetscScalar *f;
PetscFunctionBegin;
/* The next three lines allow us to access the entries of the vectors directly */
ierr = VecGetArrayRead(Y,&y);CHKERRQ(ierr);
ierr = VecGetArrayRead(Ydot,&ydot);CHKERRQ(ierr);
ierr = VecGetArray(F,&f);CHKERRQ(ierr);
f[0]= PetscSinReal(200*PETSC_PI*t)/2500. - y[0]/1000. - ydot[0]/1.e6 + ydot[1]/1.e6;
f[1]=0.0006666766666666667 - PetscExpReal((500*(y[1] - y[2]))/13.)/1.e8 - y[1]/4500. + ydot[0]/1.e6 - ydot[1]/1.e6;
f[2]=-1.e-6 + PetscExpReal((500*(y[1] - y[2]))/13.)/1.e6 - y[2]/9000. - ydot[2]/500000.;
f[3]=0.0006676566666666666 - (99* PetscExpReal((500*(y[1] - y[2]))/13.))/1.e8 - y[3]/9000. - (3*ydot[3])/1.e6 + (3*ydot[4])/1.e6;
f[4]=-y[4]/9000. + (3*ydot[3])/1.e6 - (3*ydot[4])/1.e6;
ierr = VecRestoreArrayRead(Y,&y);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(Ydot,&ydot);CHKERRQ(ierr);
ierr = VecRestoreArray(F,&f);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode RHSFunction(TS ts, PetscReal t, Vec X, Vec DXDT, void* ptr)
{
AppCtx* user = (AppCtx*)ptr;
PetscInt nb_cells, i;
PetscReal alpha, beta;
PetscReal rho_a, mu_a, D_a;
PetscReal rho_h, mu_h, D_h;
PetscReal a, h, da, dh, d2a, d2h;
PetscErrorCode ierr;
PetscScalar *dxdt;
const PetscScalar *x;
PetscFunctionBegin;
nb_cells = user->nb_cells;
alpha = user->alpha;
beta = user->beta;
rho_a = user->rho_a;
mu_a = user->mu_a;
D_a = user->D_a;
rho_h = user->rho_h;
mu_h = user->mu_h;
D_h = user->D_h;
ierr = VecGetArrayRead(X, &x);CHKERRQ(ierr);
ierr = VecGetArray(DXDT, &dxdt);CHKERRQ(ierr);
for(i = 0 ; i < nb_cells ; i++) {
a = x[2*i];
h = x[2*i+1];
// Reaction:
da = alpha * a*a / (1. + beta * h) + rho_a - mu_a * a;
dh = alpha * a*a + rho_h - mu_h*h;
// Diffusion:
d2a = d2h = 0.;
if(i > 0) {
d2a += (x[2*(i-1)] - a);
d2h += (x[2*(i-1)+1] - h);
}
if(i < nb_cells-1) {
d2a += (x[2*(i+1)] - a);
d2h += (x[2*(i+1)+1] - h);
}
dxdt[2*i] = da + D_a*d2a;
dxdt[2*i+1] = dh + D_h*d2h;
}
ierr = VecRestoreArray(DXDT, &dxdt);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(X, &x);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatSolveTranspose_SeqBAIJ_1_NaturalOrdering(Mat A,Vec bb,Vec xx)
{
Mat_SeqBAIJ *a = (Mat_SeqBAIJ*)A->data;
PetscErrorCode ierr;
const PetscInt *adiag = a->diag,*ai = a->i,*aj = a->j,*vi;
PetscInt i,n = a->mbs,j;
PetscInt nz;
PetscScalar *x,*tmp,s1;
const MatScalar *aa = a->a,*v;
const PetscScalar *b;
PetscFunctionBegin;
ierr = VecGetArrayRead(bb,&b);CHKERRQ(ierr);
ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
tmp = a->solve_work;
/* copy the b into temp work space according to permutation */
for (i=0; i<n; i++) tmp[i] = b[i];
/* forward solve the U^T */
for (i=0; i<n; i++) {
v = aa + adiag[i+1] + 1;
vi = aj + adiag[i+1] + 1;
nz = adiag[i] - adiag[i+1] - 1;
s1 = tmp[i];
s1 *= v[nz]; /* multiply by inverse of diagonal entry */
for (j=0; j<nz; j++) tmp[vi[j]] -= s1*v[j];
tmp[i] = s1;
}
/* backward solve the L^T */
for (i=n-1; i>=0; i--) {
v = aa + ai[i];
vi = aj + ai[i];
nz = ai[i+1] - ai[i];
s1 = tmp[i];
for (j=0; j<nz; j++) tmp[vi[j]] -= s1*v[j];
}
/* copy tmp into x according to permutation */
for (i=0; i<n; i++) x[i] = tmp[i];
ierr = VecRestoreArrayRead(bb,&b);CHKERRQ(ierr);
ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
ierr = PetscLogFlops(2.0*a->nz-A->cmap->n);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PostStepFunction(TS ts)
{
PetscErrorCode ierr;
Vec U;
PetscReal t;
const PetscScalar *u;
PetscFunctionBegin;
ierr = TSGetTime(ts,&t);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&U);CHKERRQ(ierr);
ierr = VecGetArrayRead(U,&u);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF,"delta(%3.2f) = %8.7f\n",(double)t,(double)u[0]);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(U,&u);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode RHSFunction(TS ts,PetscReal t,Vec X,Vec F,void *ptr)
{
PetscErrorCode ierr;
PetscScalar *f;
const PetscScalar *x;
PetscFunctionBegin;
ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
ierr = VecGetArray(F,&f);CHKERRQ(ierr);
f[0] = x[1];
f[1] = 0.0;
ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr);
ierr = VecRestoreArray(F,&f);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode FormFunction(SNES snes,Vec x,Vec f,void *ctx)
{
Vec g = (Vec)ctx;
const PetscScalar *xx,*gg;
PetscScalar *ff,d;
PetscErrorCode ierr;
PetscInt i,n;
/*
Get pointers 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 = VecGetArrayRead(x,&xx);CHKERRQ(ierr);
ierr = VecGetArray(f,&ff);CHKERRQ(ierr);
ierr = VecGetArrayRead(g,&gg);CHKERRQ(ierr);
/*
Compute function
*/
ierr = VecGetSize(x,&n);CHKERRQ(ierr);
d = (PetscReal)(n - 1); d = d*d;
ff[0] = xx[0];
for (i=1; i<n-1; i++) ff[i] = d*(xx[i-1] - 2.0*xx[i] + xx[i+1]) + xx[i]*xx[i] - gg[i];
ff[n-1] = xx[n-1] - 1.0;
/*
Restore vectors
*/
ierr = VecRestoreArrayRead(x,&xx);CHKERRQ(ierr);
ierr = VecRestoreArray(f,&ff);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(g,&gg);CHKERRQ(ierr);
return 0;
}
static PetscErrorCode PCApply_TFS_XYT(PC pc,Vec x,Vec y)
{
PC_TFS *tfs = (PC_TFS*)pc->data;
PetscScalar *yy;
const PetscScalar *xx;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecGetArrayRead(x,&xx);CHKERRQ(ierr);
ierr = VecGetArray(y,&yy);CHKERRQ(ierr);
ierr = XYT_solve(tfs->xyt,yy,(PetscScalar*)xx);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(x,&xx);CHKERRQ(ierr);
ierr = VecRestoreArray(y,&yy);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode EventFunction(TS ts,PetscReal t,Vec U,PetscScalar *fvalue,void *ctx)
{
AppCtx *app=(AppCtx*)ctx;
PetscErrorCode ierr;
const PetscScalar *u;
PetscFunctionBegin;
/* Event for ball height */
ierr = VecGetArrayRead(U,&u);CHKERRQ(ierr);
fvalue[0] = u[0];
/* Event for number of bounces */
fvalue[1] = app->maxbounces - app->nbounces;
ierr = VecRestoreArrayRead(U,&u);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Defines the ODE passed to the ODE solver
*/
static PetscErrorCode IFunction(TS ts,PetscReal t,Vec U,Vec Udot,Vec F,AppCtx *ctx)
{
PetscErrorCode ierr;
PetscScalar *f,r;
const PetscScalar *u,*udot;
static PetscScalar R = .4;
PetscFunctionBegin;
ierr = PetscRandomGetValue(ctx->rand,&r);CHKERRQ(ierr);
if (r > .9) R = .5;
if (r < .1) R = .4;
R = .4;
/* The next three lines allow us to access the entries of the vectors directly */
ierr = VecGetArrayRead(U,&u);CHKERRQ(ierr);
ierr = VecGetArrayRead(Udot,&udot);CHKERRQ(ierr);
ierr = VecGetArray(F,&f);CHKERRQ(ierr);
f[0] = 2.0*ctx->H*udot[0]/ctx->omega_s + ctx->E*ctx->V*PetscSinScalar(u[1])/ctx->X - R;
f[1] = udot[1] - u[0] + ctx->omega_s;
ierr = VecRestoreArrayRead(U,&u);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(Udot,&udot);CHKERRQ(ierr);
ierr = VecRestoreArray(F,&f);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Defines the Jacobian of the ODE passed to the ODE solver. See TSSetIJacobian() for the meaning of a and the Jacobian.
*/
static PetscErrorCode IJacobian(TS ts,PetscReal t,Vec U,Vec Udot,PetscReal a,Mat A,Mat B,AppCtx *ctx)
{
PetscErrorCode ierr;
PetscInt rowcol[] = {0,1};
PetscScalar J[2][2];
const PetscScalar *u,*udot;
PetscFunctionBegin;
ierr = VecGetArrayRead(U,&u);CHKERRQ(ierr);
ierr = VecGetArrayRead(Udot,&udot);CHKERRQ(ierr);
J[0][0] = 2.0*ctx->H*a/ctx->omega_s; J[0][1] = -ctx->E*ctx->V*PetscCosScalar(u[1])/ctx->X;
J[1][0] = -1.0; J[1][1] = a;
ierr = MatSetValues(B,2,rowcol,2,rowcol,&J[0][0],INSERT_VALUES);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(U,&u);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(Udot,&udot);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (A != B) {
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
