static void SetInitialProfiles(N_Vector y, realtype dx, realtype dz)
{
int jx, jz;
realtype x, z, cx, cz;
realtype *ydata;
/* Set pointer to data array in vector y. */
ydata = NV_DATA_S(y);
/* Load initial profiles of c1 and c2 into y vector */
for (jz=0; jz < MZ; jz++) {
z = ZMIN + jz*dz;
cz = SQR(RCONST(0.1)*(z - ZMID));
cz = ONE - cz + RCONST(0.5)*SQR(cz);
for (jx=0; jx < MX; jx++) {
x = XMIN + jx*dx;
cx = SQR(RCONST(0.1)*(x - XMID));
cx = ONE - cx + RCONST(0.5)*SQR(cx);
IJKth(ydata,1,jx,jz) = C1_SCALE*cx*cz;
IJKth(ydata,2,jx,jz) = C2_SCALE*cx*cz;
}
}
}
static void CInit(N_Vector c, WebData wdata)
{
int i, ici, ioff, iyoff, jx, jy, ns, mxns;
realtype argx, argy, x, y, dx, dy, x_factor, y_factor, *cdata;
cdata = NV_DATA_S(c);
ns = wdata->ns;
mxns = wdata->mxns;
dx = wdata->dx;
dy = wdata->dy;
x_factor = RCONST(4.0)/SQR(AX);
y_factor = RCONST(4.0)/SQR(AY);
for (jy = 0; jy < MY; jy++) {
y = jy*dy;
argy = SQR(y_factor*y*(AY-y));
iyoff = mxns*jy;
for (jx = 0; jx < MX; jx++) {
x = jx*dx;
argx = SQR(x_factor*x*(AX-x));
ioff = iyoff + ns*jx;
for (i = 1; i <= ns; i++) {
ici = ioff + i-1;
cdata[ici] = RCONST(10.0) + i*argx*argy;
/*if(i==1) cdata[ici] += ONE;*/
}
}
}
/* Initialize quadrature variable to zero */
cdata[NEQ] = ZERO;
}
/* This routine computes and loads the vector of initial values. */
static void CInit(N_Vector c, WebData wdata)
{
int jx, jy, ns, mxns, ioff, iyoff, i, ici;
realtype argx, argy, x, y, dx, dy, x_factor, y_factor, *cdata;
cdata = NV_DATA_S(c);
ns = wdata->ns;
mxns = wdata->mxns;
dx = wdata->dx;
dy = wdata->dy;
x_factor = RCONST(4.0)/SUNSQR(AX);
y_factor = RCONST(4.0)/SUNSQR(AY);
for (jy = 0; jy < MY; jy++) {
y = jy*dy;
argy = SUNSQR(y_factor*y*(AY-y));
iyoff = mxns*jy;
for (jx = 0; jx < MX; jx++) {
x = jx*dx;
argx = SUNSQR(x_factor*x*(AX-x));
ioff = iyoff + ns*jx;
for (i = 1; i <= ns; i++) {
ici = ioff + i-1;
cdata[ici] = RCONST(10.0) + i*argx*argy;
}
}
}
}
static void SetInitialProfiles(N_Vector u, realtype dx, realtype dy)
{
int jx, jy;
realtype x, y, cx, cy;
realtype *udata;
/* Set pointer to data array in vector u. */
udata = NV_DATA_S(u);
/* Load initial profiles of c1 and c2 into u vector */
for (jy=0; jy < MY; jy++) {
y = YMIN + jy*dy;
cy = SQR(RCONST(0.1)*(y - YMID));
cy = ONE - cy + RCONST(0.5)*SQR(cy);
for (jx=0; jx < MX; jx++) {
x = XMIN + jx*dx;
cx = SQR(RCONST(0.1)*(x - XMID));
cx = ONE - cx + RCONST(0.5)*SQR(cx);
IJKth(udata,1,jx,jy) = C1_SCALE*cx*cy;
IJKth(udata,2,jx,jy) = C2_SCALE*cx*cy;
}
}
}
/* Routine to compute the Jacobian matrix from R(y), scaled by the factor c.
We add the result into Jac and do not erase what was already there */
static int ReactionJac(realtype c, N_Vector y, DlsMat Jac, UserData udata)
{
long int N = udata->N; /* set shortcuts */
long int i;
realtype u, v, w;
realtype ep = udata->ep;
realtype *Ydata = N_VGetArrayPointer(y); /* access solution array */
if (check_flag((void *)Ydata, "N_VGetArrayPointer", 0)) return 1;
/* iterate over nodes, filling in Jacobian of reaction terms */
for (i=1; i<N-1; i++) {
u = Ydata[IDX(i,0)]; /* set nodal value shortcuts */
v = Ydata[IDX(i,1)];
w = Ydata[IDX(i,2)];
/* all vars wrt u */
BAND_ELEM(Jac,IDX(i,0),IDX(i,0)) += c*(RCONST(2.0)*u*v-(w+RCONST(1.0)));
BAND_ELEM(Jac,IDX(i,1),IDX(i,0)) += c*(w - RCONST(2.0)*u*v);
BAND_ELEM(Jac,IDX(i,2),IDX(i,0)) += c*(-w);
/* all vars wrt v */
BAND_ELEM(Jac,IDX(i,0),IDX(i,1)) += c*(u*u);
BAND_ELEM(Jac,IDX(i,1),IDX(i,1)) += c*(-u*u);
/* all vars wrt w */
BAND_ELEM(Jac,IDX(i,0),IDX(i,2)) += c*(-u);
BAND_ELEM(Jac,IDX(i,1),IDX(i,2)) += c*(u);
BAND_ELEM(Jac,IDX(i,2),IDX(i,2)) += c*(-RCONST(1.0)/ep - u);
}
return 0; /* Return with success */
}
static void InitUserData(int my_pe, long int local_N, MPI_Comm comm,
UserData data)
{
int isubx, isuby;
/* Set problem constants */
data->om = PI/HALFDAY;
data->dx = (XMAX-XMIN)/((realtype)(MX-1));
data->dy = (YMAX-YMIN)/((realtype)(MY-1));
data->hdco = KH/SQR(data->dx);
data->haco = VEL/(RCONST(2.0)*data->dx);
data->vdco = (RCONST(1.0)/SQR(data->dy))*KV0;
/* Set machine-related constants */
data->comm = comm;
data->my_pe = my_pe;
data->Nlocal = local_N;
/* isubx and isuby are the PE grid indices corresponding to my_pe */
isuby = my_pe/NPEX;
isubx = my_pe - isuby*NPEX;
data->isubx = isubx;
data->isuby = isuby;
/* Set the sizes of a boundary x-line in u and uext */
data->nvmxsub = NVARS*MXSUB;
data->nvmxsub2 = NVARS*(MXSUB+2);
}
static void g(realtype t, N_Vector y, realtype *gout, void *g_data)
{
realtype y1, y3;
y1 = Ith(y,1); y3 = Ith(y,3);
gout[0] = y1 - RCONST(0.0001);
gout[1] = y3 - RCONST(0.01);
}
/* g routine to compute the root-finding function g(t,y). */
static int g(realtype t, N_Vector y, realtype *gout, void *user_data)
{
realtype u = NV_Ith_S(y,0); /* access current solution */
realtype w = NV_Ith_S(y,2);
gout[0] = u - RCONST(0.0001); /* check for u == 1e-4 */
gout[1] = w - RCONST(0.01); /* check for w == 1e-2 */
return 0; /* Return with success */
}
static void f(realtype t, N_Vector y, N_Vector ydot, void *f_data)
{
realtype y1, y2, y3, yd1, yd3;
y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3);
yd1 = Ith(ydot,1) = RCONST(-0.04)*y1 + RCONST(1.0e4)*y2*y3;
yd3 = Ith(ydot,3) = RCONST(3.0e7)*y2*y2;
Ith(ydot,2) = -yd1 - yd3;
}
static int g(realtype t, N_Vector y, realtype *gout, void *user_data)
{
realtype y1, y3;
y1 = Ith(y,1); y3 = Ith(y,3);
gout[0] = y1 - RCONST(0.0001);
gout[1] = y3 - RCONST(0.01);
return(0);
}
static void InitUserData(UserData data)
{
realtype Q1, Q2, C3, A3, A4, KH, VEL, KV0;
/* Set problem parameters */
Q1 = RCONST(1.63e-16); /* Q1 coefficients q1, q2, c3 */
Q2 = RCONST(4.66e-16); /* Q2 */
C3 = RCONST(3.7e16); /* C3 */
A3 = RCONST(22.62); /* A3 coefficient in expression for q3(t) */
A4 = RCONST(7.601); /* A4 coefficient in expression for q4(t) */
KH = RCONST(4.0e-6); /* KH horizontal diffusivity Kh */
VEL = RCONST(0.001); /* VEL advection velocity V */
KV0 = RCONST(1.0e-8); /* KV0 coefficient in Kv(z) */
data->om = PI/HALFDAY;
data->dx = (XMAX-XMIN)/(MX-1);
data->dz = (ZMAX-ZMIN)/(MZ-1);
data->hdco = KH/SQR(data->dx);
data->haco = VEL/(RCONST(2.0)*data->dx);
data->vdco = (ONE/SQR(data->dz))*KV0;
data->p[0] = Q1;
data->p[1] = Q2;
data->p[2] = C3;
data->p[3] = A3;
data->p[4] = A4;
data->p[5] = KH;
data->p[6] = VEL;
data->p[7] = KV0;
}
/* f routine to compute the ODE RHS function f(t,y). */
static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data)
{
UserData udata = (UserData) user_data; /* access problem data */
long int N = udata->N; /* set variable shortcuts */
realtype a = udata->a;
realtype b = udata->b;
realtype ep = udata->ep;
realtype du = udata->du;
realtype dv = udata->dv;
realtype dw = udata->dw;
realtype dx = udata->dx;
realtype *Ydata=NULL, *dYdata=NULL;
realtype uconst, vconst, wconst, u, ul, ur, v, vl, vr, w, wl, wr;
long int i;
/* clear out ydot (to be careful) */
N_VConst(0.0, ydot);
Ydata = N_VGetArrayPointer(y); /* access data arrays */
if (check_flag((void *)Ydata, "N_VGetArrayPointer", 0)) return 1;
dYdata = N_VGetArrayPointer(ydot);
if (check_flag((void *)dYdata, "N_VGetArrayPointer", 0)) return 1;
N_VConst(0.0, ydot); /* initialize ydot to zero */
/* iterate over domain, computing all equations */
uconst = du/dx/dx;
vconst = dv/dx/dx;
wconst = dw/dx/dx;
#pragma omp parallel for default(shared) private(i,u,ul,ur,v,vl,vr,w,wl,wr) schedule(static) num_threads(udata->nthreads)
for (i=1; i<N-1; i++) {
/* set shortcuts */
u = Ydata[IDX(i,0)]; ul = Ydata[IDX(i-1,0)]; ur = Ydata[IDX(i+1,0)];
v = Ydata[IDX(i,1)]; vl = Ydata[IDX(i-1,1)]; vr = Ydata[IDX(i+1,1)];
w = Ydata[IDX(i,2)]; wl = Ydata[IDX(i-1,2)]; wr = Ydata[IDX(i+1,2)];
/* u_t = du*u_xx + a - (w+1)*u + v*u^2 */
dYdata[IDX(i,0)] = (ul - RCONST(2.0)*u + ur)*uconst + a - (w+RCONST(1.0))*u + v*u*u;
/* v_t = dv*v_xx + w*u - v*u^2 */
dYdata[IDX(i,1)] = (vl - RCONST(2.0)*v + vr)*vconst + w*u - v*u*u;
/* w_t = dw*w_xx + (b-w)/ep - w*u */
dYdata[IDX(i,2)] = (wl - RCONST(2.0)*w + wr)*wconst + (b-w)/ep - w*u;
}
/* enforce stationary boundaries */
dYdata[IDX(0,0)] = dYdata[IDX(0,1)] = dYdata[IDX(0,2)] = 0.0;
dYdata[IDX(N-1,0)] = dYdata[IDX(N-1,1)] = dYdata[IDX(N-1,2)] = 0.0;
return 0;
}
static int grob(realtype t, N_Vector yy, N_Vector yp, realtype *gout,
void *user_data)
{
realtype *yval, y1, y3;
yval = NV_DATA_S(yy);
y1 = yval[0]; y3 = yval[2];
gout[0] = y1 - RCONST(0.0001);
gout[1] = y3 - RCONST(0.01);
return(0);
}
static void SetInitialProfiles(N_Vector cc, N_Vector cp, N_Vector id,
UserData webdata)
{
long int loc, yloc, is, jx, jy, np;
realtype xx, yy, xyfactor, fac;
realtype *ccv, *cpv, *idv;
ccv = NV_DATA_S(cc);
cpv = NV_DATA_S(cp);
idv = NV_DATA_S(id);
np = webdata->np;
/* Loop over grid, load cc values and id values. */
for (jy = 0; jy < MY; jy++) {
yy = jy * webdata->dy;
yloc = NSMX * jy;
for (jx = 0; jx < MX; jx++) {
xx = jx * webdata->dx;
xyfactor = RCONST(16.0)*xx*(ONE-xx)*yy*(ONE-yy);
xyfactor *= xyfactor;
loc = yloc + NUM_SPECIES*jx;
fac = ONE + ALPHA * xx * yy + BETA * sin(FOURPI*xx) * sin(FOURPI*yy);
for (is = 0; is < NUM_SPECIES; is++) {
if (is < np) {
ccv[loc+is] = RCONST(10.0) + (realtype)(is+1) * xyfactor;
idv[loc+is] = ONE;
}
else {
ccv[loc+is] = RCONST(1.0e5);
idv[loc+is] = ZERO;
}
}
}
}
/* Set c' for the prey by calling the function Fweb. */
Fweb(ZERO, cc, cp, webdata);
/* Set c' for predators to 0. */
for (jy = 0; jy < MY; jy++) {
yloc = NSMX * jy;
for (jx = 0; jx < MX; jx++) {
loc = yloc + NUM_SPECIES * jx;
for (is = np; is < NUM_SPECIES; is++) {
cpv[loc+is] = ZERO;
}
}
}
}
int resrob(realtype tres, N_Vector yy, N_Vector yp, N_Vector rr, void *user_data)
{
realtype *yval, *ypval, *rval;
yval = NV_DATA_S(yy);
ypval = NV_DATA_S(yp);
rval = NV_DATA_S(rr);
rval[0] = RCONST(-0.04)*yval[0] + RCONST(1.0e4)*yval[1]*yval[2];
rval[1] = -rval[0] - RCONST(3.0e7)*yval[1]*yval[1] - ypval[1];
rval[0] -= ypval[0];
rval[2] = yval[0] + yval[1] + yval[2] - ONE;
return(0);
}
int heatres(realtype tres, N_Vector uu, N_Vector up, N_Vector resval,
void *user_data)
{
long int mm, i, j, offset, loc;
realtype *uv, *upv, *resv, coeff;
UserData data;
uv = N_VGetArrayPointer_Serial(uu); upv = N_VGetArrayPointer_Serial(up); resv = N_VGetArrayPointer_Serial(resval);
data = (UserData)user_data;
mm = data->mm;
coeff = data->coeff;
/* Initialize resval to uu, to take care of boundary equations. */
N_VScale(ONE, uu, resval);
/* Loop over interior points; set res = up - (central difference). */
for (j = 1; j < mm-1; j++) {
offset = mm*j;
for (i = 1; i < mm-1; i++) {
loc = offset + i;
resv[loc] = upv[loc] - coeff *
(uv[loc-1] + uv[loc+1] + uv[loc-mm] + uv[loc+mm] - RCONST(4.0)*uv[loc]);
}
}
return(0);
}
static void SetIC(N_Vector u, UserData data)
{
int i, j;
realtype x, y, dx, dy;
realtype *udata;
/* Extract needed constants from data */
dx = data->dx;
dy = data->dy;
/* Set pointer to data array in vector u. */
udata = N_VGetArrayPointer(u);
/* Load initial profile into u vector */
for (j=1; j <= MY; j++) {
y = j*dy;
for (i=1; i <= MX; i++) {
x = i*dx;
IJth(udata,i,j) = x*(XMAX - x)*y*(YMAX - y)*SUNRexp(RCONST(5.0)*x*y);
}
}
}
static int JacB(int NB, realtype t,
N_Vector y, N_Vector yB, N_Vector fyB,
DlsMat JB, void *user_dataB,
N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B)
{
UserData data;
realtype y1, y2, y3;
realtype p1, p2, p3;
data = (UserData) user_dataB;
/* The p vector */
p1 = data->p[0]; p2 = data->p[1]; p3 = data->p[2];
/* The y vector */
y1 = Ith(y,1); y2 = Ith(y,2); y3 = Ith(y,3);
/* Load JB */
IJth(JB,1,1) = p1; IJth(JB,1,2) = -p1;
IJth(JB,2,1) = -p2*y3; IJth(JB,2,2) = p2*y3+2.0*p3*y2;
IJth(JB,2,3) = RCONST(-2.0)*p3*y2;
IJth(JB,3,1) = -p2*y2; IJth(JB,3,2) = p2*y2;
return(0);
}
/* f routine to compute the ODE RHS function f(t,y). */
static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data)
{
UserData udata = (UserData) user_data; /* access problem data */
sunindextype N = udata->N; /* set variable shortcuts */
realtype k = udata->k;
realtype dx = udata->dx;
realtype *Y=NULL, *Ydot=NULL;
realtype c1, c2;
sunindextype i, isource;
Y = N_VGetArrayPointer(y); /* access data arrays */
if (check_flag((void *) Y, "N_VGetArrayPointer", 0)) return 1;
Ydot = N_VGetArrayPointer(ydot);
if (check_flag((void *) Ydot, "N_VGetArrayPointer", 0)) return 1;
N_VConst(0.0, ydot); /* Initialize ydot to zero */
/* iterate over domain, computing all equations */
c1 = k/dx/dx;
c2 = -RCONST(2.0)*k/dx/dx;
isource = N/2;
Ydot[0] = 0.0; /* left boundary condition */
for (i=1; i<N-1; i++)
Ydot[i] = c1*Y[i-1] + c2*Y[i] + c1*Y[i+1];
Ydot[N-1] = 0.0; /* right boundary condition */
Ydot[isource] += 0.01/dx; /* source term */
return 0; /* Return with success */
}
/* Jacobian routine to compute J(t,y) = df/dy. */
static int Jac(N_Vector v, N_Vector Jv, realtype t, N_Vector y,
N_Vector fy, void *user_data, N_Vector tmp)
{
UserData udata = (UserData) user_data; /* variable shortcuts */
sunindextype N = udata->N;
realtype k = udata->k;
realtype dx = udata->dx;
realtype *V=NULL, *JV=NULL;
realtype c1, c2;
sunindextype i;
V = N_VGetArrayPointer(v); /* access data arrays */
if (check_flag((void *) V, "N_VGetArrayPointer", 0)) return 1;
JV = N_VGetArrayPointer(Jv);
if (check_flag((void *) JV, "N_VGetArrayPointer", 0)) return 1;
N_VConst(0.0, Jv); /* initialize Jv product to zero */
/* iterate over domain, computing all Jacobian-vector products */
c1 = k/dx/dx;
c2 = -RCONST(2.0)*k/dx/dx;
JV[0] = 0.0;
for (i=1; i<N-1; i++)
JV[i] = c1*V[i-1] + c2*V[i] + c1*V[i+1];
JV[N-1] = 0.0;
return 0; /* Return with success */
}
static void SetInitialProfiles(N_Vector cc, N_Vector sc)
{
int i, jx, jy;
realtype *cloc, *sloc;
realtype ctemp[NUM_SPECIES], stemp[NUM_SPECIES];
/* Initialize arrays ctemp and stemp used in the loading process */
for (i = 0; i < NUM_SPECIES/2; i++) {
ctemp[i] = PREYIN;
stemp[i] = ONE;
}
for (i = NUM_SPECIES/2; i < NUM_SPECIES; i++) {
ctemp[i] = PREDIN;
stemp[i] = RCONST(0.00001);
}
/* Load initial profiles into cc and sc vector from ctemp and stemp. */
for (jy = 0; jy < MY; jy++) {
for (jx = 0; jx < MX; jx++) {
cloc = IJ_Vptr(cc,jx,jy);
sloc = IJ_Vptr(sc,jx,jy);
for (i = 0; i < NUM_SPECIES; i++) {
cloc[i] = ctemp[i];
sloc[i] = stemp[i];
}
}
}
}
/* Preconditioner solve routine */
static int PSolve(realtype tn, N_Vector u, N_Vector fu,
N_Vector r, N_Vector z,
realtype gamma, realtype delta,
int lr, void *P_data, N_Vector vtemp)
{
realtype **(*P)[MYSUB];
long int nvmxsub, *(*pivot)[MYSUB];
int lx, ly;
realtype *zdata, *v;
PreconData predata;
UserData data;
/* Extract the P and pivot arrays from P_data */
predata = (PreconData) P_data;
data = (UserData) (predata->f_data);
P = predata->P;
pivot = predata->pivot;
/* Solve the block-diagonal system Px = r using LU factors stored
in P and pivot data in pivot, and return the solution in z.
First copy vector r to z. */
N_VScale(RCONST(1.0), r, z);
nvmxsub = data->nvmxsub;
zdata = NV_DATA_P(z);
for (lx = 0; lx < MXSUB; lx++) {
for (ly = 0; ly < MYSUB; ly++) {
v = &(zdata[lx*NVARS + ly*nvmxsub]);
denGETRS(P[lx][ly], NVARS, pivot[lx][ly], v);
}
}
return(0);
}
/* Jacobian routine to compute J(t,y) = df/dy. */
static int Jac(long int M, long int mu, long int ml,
realtype t, N_Vector y, N_Vector fy,
DlsMat J, void *user_data,
N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
{
UserData udata = (UserData) user_data; /* access problem data */
SetToZero(J); /* Initialize Jacobian to zero */
/* Fill in the Laplace matrix */
LaplaceMatrix(RCONST(1.0), J, udata);
/* Add in the Jacobian of the reaction terms matrix */
ReactionJac(RCONST(1.0), y, J, udata);
return 0; /* Return with success */
}
/* f routine to compute the ODE RHS function f(t,y). */
static int f(realtype t, N_Vector y, N_Vector ydot, void *user_data)
{
UserData udata = (UserData) user_data; /* access problem data */
long int N = udata->N; /* set variable shortcuts */
realtype a = udata->a;
realtype b = udata->b;
realtype ep = udata->ep;
realtype du = udata->du;
realtype dv = udata->dv;
realtype dw = udata->dw;
realtype dx = udata->dx;
realtype *Ydata=NULL, *dYdata=NULL;
realtype uconst, vconst, wconst, u, ul, ur, v, vl, vr, w, wl, wr;
long int i;
Ydata = N_VGetArrayPointer(y); /* access data arrays */
if (check_flag((void *)Ydata, "N_VGetArrayPointer", 0)) return 1;
dYdata = N_VGetArrayPointer(ydot);
if (check_flag((void *)dYdata, "N_VGetArrayPointer", 0)) return 1;
N_VConst(0.0, ydot); /* initialize ydot to zero */
/* iterate over domain, computing all equations */
uconst = du/dx/dx;
vconst = dv/dx/dx;
wconst = dw/dx/dx;
for (i=1; i<N-1; i++) {
/* set shortcuts */
u = Ydata[IDX(i,0)]; ul = Ydata[IDX(i-1,0)]; ur = Ydata[IDX(i+1,0)];
v = Ydata[IDX(i,1)]; vl = Ydata[IDX(i-1,1)]; vr = Ydata[IDX(i+1,1)];
w = Ydata[IDX(i,2)]; wl = Ydata[IDX(i-1,2)]; wr = Ydata[IDX(i+1,2)];
/* Fill in ODE RHS for u */
dYdata[IDX(i,0)] = (ul - RCONST(2.0)*u + ur)*uconst + a - (w+RCONST(1.0))*u + v*u*u;
/* Fill in ODE RHS for v */
dYdata[IDX(i,1)] = (vl - RCONST(2.0)*v + vr)*vconst + w*u - v*u*u;
/* Fill in ODE RHS for w */
dYdata[IDX(i,2)] = (wl - RCONST(2.0)*w + wr)*wconst + (b-w)/ep - w*u;
}
/* enforce stationary boundaries */
dYdata[IDX(0,0)] = dYdata[IDX(0,1)] = dYdata[IDX(0,2)] = 0.0;
dYdata[IDX(N-1,0)] = dYdata[IDX(N-1,1)] = dYdata[IDX(N-1,2)] = 0.0;
return 0; /* Return with success */
}
static void SetInitialProfiles(N_Vector cc, N_Vector cp, N_Vector id,
N_Vector res, UserData webdata)
{
int ixsub, jysub, mxsub, mysub, nsmxsub, np, ix, jy, is;
realtype *cxy, *idxy, *cpxy, dx, dy, xx, yy, xyfactor;
ixsub = webdata->ixsub;
jysub = webdata->jysub;
mxsub = webdata->mxsub;
mysub = webdata->mxsub;
nsmxsub = webdata->nsmxsub;
dx = webdata->dx;
dy = webdata->dy;
np = webdata->np;
/* Loop over grid, load cc values and id values. */
for (jy = 0; jy < mysub; jy++) {
yy = (jy + jysub*mysub) * dy;
for (ix = 0; ix < mxsub; ix++) {
xx = (ix + ixsub*mxsub) * dx;
xyfactor = RCONST(16.0)*xx*(ONE - xx)*yy*(ONE - yy);
xyfactor *= xyfactor;
cxy = IJ_Vptr(cc,ix,jy);
idxy = IJ_Vptr(id,ix,jy);
for (is = 0; is < NUM_SPECIES; is++) {
if (is < np) { cxy[is] = RCONST(10.0) + (realtype)(is+1)*xyfactor; idxy[is] = ONE; }
else { cxy[is] = 1.0e5; idxy[is] = ZERO; }
}
}
}
/* Set c' for the prey by calling the residual function with cp = 0. */
N_VConst(ZERO, cp);
resweb(ZERO, cc, cp, res, webdata);
N_VScale(-ONE, res, cp);
/* Set c' for predators to 0. */
for (jy = 0; jy < mysub; jy++) {
for (ix = 0; ix < mxsub; ix++) {
cpxy = IJ_Vptr(cp,ix,jy);
for (is = np; is < NUM_SPECIES; is++) cpxy[is] = ZERO;
}
}
}
static realtype doubleIntgr(N_Vector c, int i, WebData wdata)
{
realtype *cdata;
int ns, mx, my, mxns;
realtype dx, dy;
realtype intgr_xy, intgr_x;
int jx, jy;
cdata = N_VGetArrayPointer(c);
ns = wdata->ns;
mx = wdata->mx;
my = wdata->my;
mxns = wdata->mxns;
dx = wdata->dx;
dy = wdata->dy;
jy = 0;
intgr_x = cdata[(i-1)+jy*mxns];
for (jx = 1; jx < mx-1; jx++) {
intgr_x += RCONST(2.0)*cdata[(i-1) + jx*ns + jy*mxns];
}
intgr_x += cdata[(i-1)+(mx-1)*ns+jy*mxns];
intgr_x *= RCONST(0.5)*dx;
intgr_xy = intgr_x;
for (jy = 1; jy < my-1; jy++) {
intgr_x = cdata[(i-1)+jy*mxns];
for (jx = 1; jx < mx-1; jx++) {
intgr_x += RCONST(2.0)*cdata[(i-1) + jx*ns + jy*mxns];
}
intgr_x += cdata[(i-1)+(mx-1)*ns+jy*mxns];
intgr_x *= RCONST(0.5)*dx;
intgr_xy += RCONST(2.0)*intgr_x;
}
jy = my-1;
intgr_x = cdata[(i-1)+jy*mxns];
for (jx = 1; jx < mx-1; jx++) {
intgr_x += RCONST(2.0)*cdata[(i-1) + jx*ns + jy*mxns];
}
intgr_x += cdata[(i-1)+(mx-1)*ns+jy*mxns];
intgr_x *= RCONST(0.5)*dx;
intgr_xy += intgr_x;
intgr_xy *= RCONST(0.5)*dy;
return(intgr_xy);
}
static int SetInitialProfile(N_Vector uu, N_Vector up, N_Vector id,
N_Vector res, UserData data)
{
int i, iloc, j, jloc, offset, loc, ixsub, jysub;
int ixbegin, ixend, jybegin, jyend;
realtype xfact, yfact, *udata, *iddata, dx, dy;
/* Initialize uu. */
udata = N_VGetArrayPointer_Parallel(uu);
iddata = N_VGetArrayPointer_Parallel(id);
/* Set mesh spacings and subgrid indices for this PE. */
dx = data->dx;
dy = data->dy;
ixsub = data->ixsub;
jysub = data->jysub;
/* Set beginning and ending locations in the global array corresponding
to the portion of that array assigned to this processor. */
ixbegin = MXSUB*ixsub;
ixend = MXSUB*(ixsub+1) - 1;
jybegin = MYSUB*jysub;
jyend = MYSUB*(jysub+1) - 1;
/* Loop over the local array, computing the initial profile value.
The global indices are (i,j) and the local indices are (iloc,jloc).
Also set the id vector to zero for boundary points, one otherwise. */
N_VConst(ONE,id);
for (j = jybegin, jloc = 0; j <= jyend; j++, jloc++) {
yfact = data->dy*j;
offset= jloc*MXSUB;
for (i = ixbegin, iloc = 0; i <= ixend; i++, iloc++) {
xfact = data->dx * i;
loc = offset + iloc;
udata[loc] = RCONST(16.0) * xfact * (ONE - xfact) * yfact * (ONE - yfact);
if (i == 0 || i == MX-1 || j == 0 || j == MY-1) iddata[loc] = ZERO;
}
}
/* Initialize up. */
N_VConst(ZERO, up); /* Initially set up = 0. */
/* heatres sets res to negative of ODE RHS values at interior points. */
heatres(ZERO, uu, up, res, data);
/* Copy -res into up to get correct initial up values. */
N_VScale(-ONE, res, up);
return(0);
}
void RateStateSimWindow::recalc(void) {
std::vector<std::vector<realtype> > results;
double time_max = 200, time_step = 0.01;
RSParams params(NBLOCKS, NEQ, NPARAMS, time_step, time_max);
unsigned int i, npoints;
double xi, vi, hi;
std::cerr << param_a << " " << param_b << " " << param_k << " " << param_r << " " << param_w << std::endl;
for (i=0;i<params.num_blocks();++i) {
params.param(i, A_PARAM) = RCONST(param_a);
params.param(i, B_PARAM) = RCONST(param_b);
params.param(i, K_PARAM) = RCONST(param_k);
params.param(i, R_PARAM) = RCONST(param_r);
params.param(i, W_PARAM) = RCONST(param_w);
params.init_val(i, EQ_X) = RCONST(-10.0);
params.init_val(i, EQ_V) = RCONST(1.0);
params.init_val(i, EQ_H) = RCONST(1.0);
}
run_rate_state_sim(results, params);
npoints = results.size();
QVector<QPointF> xdata(npoints), vdata(npoints), hdata(npoints), fdata(npoints), dp_data(npoints);
double force_integral=0, old_t=0;
for (i=0;i<results.size();++i) {
xi = results[i][1];
vi = results[i][2];
hi = results[i][3];
xdata[i] = QPointF(results[i][0], xi);
vdata[i] = QPointF(results[i][0], vi);
hdata[i] = QPointF(results[i][0], hi);
fdata[i] = QPointF(results[i][0], F(0, vi, hi, params));
dp_data[i] = QPointF(results[i][0], results[i][0]);
force_integral += (results[i][0]-old_t)*F(0, vi, hi, params);
old_t = results[i][0];
}
force_integral /= (results.size()/(time_step*time_max));
//std::cerr << force_integral << std::endl;
position_data->setData(new QwtPointSeriesData(xdata));
velocity_data->setData(new QwtPointSeriesData(vdata));
theta_data->setData(new QwtPointSeriesData(hdata));
force_data->setData(new QwtPointSeriesData(fdata));
driver_data->setData(new QwtPointSeriesData(dp_data));
position_plot->replot();
velocity_plot->replot();
theta_plot->replot();
force_plot->replot();
}
static realtype Xintgr(realtype *z, sunindextype l, realtype dx)
{
realtype my_intgr;
sunindextype i;
my_intgr = RCONST(0.5)*(z[0] + z[l-1]);
for (i = 1; i < l-1; i++)
my_intgr += z[i];
my_intgr *= dx;
return(my_intgr);
}
/* Routine to compute the stiffness matrix from (L*y), scaled by the factor c.
We add the result into Jac and do not erase what was already there */
static int LaplaceMatrix(realtype c, DlsMat Jac, UserData udata)
{
long int i; /* set shortcuts */
long int N = udata->N;
realtype dx = udata->dx;
/* iterate over intervals, filling in Jacobian of (L*y) */
for (i=1; i<N-1; i++) {
BAND_ELEM(Jac,IDX(i,0),IDX(i-1,0)) += c*udata->du/dx/dx;
BAND_ELEM(Jac,IDX(i,1),IDX(i-1,1)) += c*udata->dv/dx/dx;
BAND_ELEM(Jac,IDX(i,2),IDX(i-1,2)) += c*udata->dw/dx/dx;
BAND_ELEM(Jac,IDX(i,0),IDX(i,0)) += -c*RCONST(2.0)*udata->du/dx/dx;
BAND_ELEM(Jac,IDX(i,1),IDX(i,1)) += -c*RCONST(2.0)*udata->dv/dx/dx;
BAND_ELEM(Jac,IDX(i,2),IDX(i,2)) += -c*RCONST(2.0)*udata->dw/dx/dx;
BAND_ELEM(Jac,IDX(i,0),IDX(i+1,0)) += c*udata->du/dx/dx;
BAND_ELEM(Jac,IDX(i,1),IDX(i+1,1)) += c*udata->dv/dx/dx;
BAND_ELEM(Jac,IDX(i,2),IDX(i+1,2)) += c*udata->dw/dx/dx;
}
return 0; /* Return with success */
}