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 = N_VGetArrayPointer_Serial(u);
/* Load initial profiles of c1 and c2 into u vector */
for (jy = 0; jy < MY; jy++) {
y = YMIN + jy*dy;
cy = SUNSQR(RCONST(0.1)*(y - YMID));
cy = ONE - cy + RCONST(0.5)*SUNSQR(cy);
for (jx = 0; jx < MX; jx++) {
x = XMIN + jx*dx;
cx = SUNSQR(RCONST(0.1)*(x - XMID));
cx = ONE - cx + RCONST(0.5)*SUNSQR(cx);
IJKth(udata,1,jx,jy) = C1_SCALE*cx*cy;
IJKth(udata,2,jx,jy) = C2_SCALE*cx*cy;
}
}
}
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 int PSolve(realtype tn, N_Vector y, N_Vector fy,
N_Vector r, N_Vector z,
realtype gamma, realtype delta,
int lr, void *P_data, N_Vector vtemp)
{
realtype **(*P)[MZ];
long int *(*pivot)[MZ];
int jx, jz;
realtype *zdata, *v;
UserData data;
/* Extract the P and pivot arrays from P_data. */
data = (UserData) P_data;
P = data->P;
pivot = data->pivot;
zdata = NV_DATA_S(z);
N_VScale(ONE, r, z);
/* Solve the block-diagonal system Px = r using LU factors stored
in P and pivot data in pivot, and return the solution in z. */
for (jx=0; jx < MX; jx++) {
for (jz=0; jz < MZ; jz++) {
v = &(IJKth(zdata, 1, jx, jz));
gesl(P[jx][jz], NUM_SPECIES, pivot[jx][jz], v);
}
}
return(0);
}
static int PSolve(realtype tn, N_Vector u, N_Vector fu,
N_Vector r, N_Vector z,
realtype gamma, realtype delta,
int lr, void *user_data, N_Vector vtemp)
{
realtype **(*P)[MY];
long int *(*pivot)[MY];
int jx, jy;
realtype *zdata, *v;
UserData data;
/* Extract the P and pivot arrays from user_data. */
data = (UserData) user_data;
P = data->P;
pivot = data->pivot;
zdata = N_VGetArrayPointer_Serial(z);
N_VScale(ONE, r, z);
/* Solve the block-diagonal system Px = r using LU factors stored
in P and pivot data in pivot, and return the solution in z. */
for (jx=0; jx < MX; jx++) {
for (jy=0; jy < MY; jy++) {
v = &(IJKth(zdata, 1, jx, jy));
denseGETRS(P[jx][jy], NUM_SPECIES, pivot[jx][jy], v);
}
}
return(0);
}
static void PrintOutput(long int iopt[], realtype ropt[], N_Vector y,realtype t)
{
realtype *ydata;
ydata = NV_DATA_S(y);
printf("t = %.2e no. steps = %ld order = %ld stepsize = %.2e\n",
t, iopt[NST], iopt[QU], ropt[HU]);
printf("c1 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n",
IJKth(ydata,1,0,0), IJKth(ydata,1,4,4), IJKth(ydata,1,9,9));
printf("c2 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n\n",
IJKth(ydata,2,0,0), IJKth(ydata,2,4,4), IJKth(ydata,2,9,9));
}
static int f(realtype t, N_Vector u, N_Vector udot,void *user_data)
{
realtype q3, c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt;
realtype c1rt, c2rt, cydn, cyup, hord1, hord2, horad1, horad2;
realtype qq1, qq2, qq3, qq4, rkin1, rkin2, s, vertd1, vertd2, ydn, yup;
realtype q4coef, dely, verdco, hordco, horaco;
realtype *udata, *dudata;
int idn, iup, ileft, iright, jx, jy;
UserData data;
data = (UserData) user_data;
udata = N_VGetArrayPointer_Serial(u);
dudata = N_VGetArrayPointer_Serial(udot);
/* Set diurnal rate coefficients. */
s = sin(data->om*t);
if (s > ZERO) {
q3 = SUNRexp(-A3/s);
data->q4 = SUNRexp(-A4/s);
} else {
q3 = ZERO;
data->q4 = ZERO;
}
/* Make local copies of problem variables, for efficiency. */
q4coef = data->q4;
dely = data->dy;
verdco = data->vdco;
hordco = data->hdco;
horaco = data->haco;
/* Loop over all grid points. */
for (jy = 0; jy < MY; jy++) {
/* Set vertical diffusion coefficients at jy +- 1/2 */
ydn = YMIN + (jy - RCONST(0.5))*dely;
yup = ydn + dely;
cydn = verdco*SUNRexp(RCONST(0.2)*ydn);
cyup = verdco*SUNRexp(RCONST(0.2)*yup);
idn = (jy == 0) ? 1 : -1;
iup = (jy == MY-1) ? -1 : 1;
for (jx = 0; jx < MX; jx++) {
/* Extract c1 and c2, and set kinetic rate terms. */
c1 = IJKth(udata,1,jx,jy);
c2 = IJKth(udata,2,jx,jy);
qq1 = Q1*c1*C3;
qq2 = Q2*c1*c2;
qq3 = q3*C3;
qq4 = q4coef*c2;
rkin1 = -qq1 - qq2 + TWO*qq3 + qq4;
rkin2 = qq1 - qq2 - qq4;
/* Set vertical diffusion terms. */
c1dn = IJKth(udata,1,jx,jy+idn);
c2dn = IJKth(udata,2,jx,jy+idn);
c1up = IJKth(udata,1,jx,jy+iup);
c2up = IJKth(udata,2,jx,jy+iup);
vertd1 = cyup*(c1up - c1) - cydn*(c1 - c1dn);
vertd2 = cyup*(c2up - c2) - cydn*(c2 - c2dn);
/* Set horizontal diffusion and advection terms. */
ileft = (jx == 0) ? 1 : -1;
iright =(jx == MX-1) ? -1 : 1;
c1lt = IJKth(udata,1,jx+ileft,jy);
c2lt = IJKth(udata,2,jx+ileft,jy);
c1rt = IJKth(udata,1,jx+iright,jy);
c2rt = IJKth(udata,2,jx+iright,jy);
hord1 = hordco*(c1rt - TWO*c1 + c1lt);
hord2 = hordco*(c2rt - TWO*c2 + c2lt);
horad1 = horaco*(c1rt - c1lt);
horad2 = horaco*(c2rt - c2lt);
/* Load all terms into udot. */
IJKth(dudata, 1, jx, jy) = vertd1 + hord1 + horad1 + rkin1;
IJKth(dudata, 2, jx, jy) = vertd2 + hord2 + horad2 + rkin2;
}
}
return(0);
}
static void PrintOutput(void *cvode_mem, N_Vector u,realtype t)
{
long int nst;
int qu, flag;
realtype hu, *udata;
int mxh = MX/2 - 1, myh = MY/2 - 1, mx1 = MX - 1, my1 = MY - 1;
udata = N_VGetArrayPointer_Serial(u);
flag = CVodeGetNumSteps(cvode_mem, &nst);
check_flag(&flag, "CVodeGetNumSteps", 1);
flag = CVodeGetLastOrder(cvode_mem, &qu);
check_flag(&flag, "CVodeGetLastOrder", 1);
flag = CVodeGetLastStep(cvode_mem, &hu);
check_flag(&flag, "CVodeGetLastStep", 1);
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("t = %.2Le no. steps = %ld order = %d stepsize = %.2Le\n",
t, nst, qu, hu);
printf("c1 (bot.left/middle/top rt.) = %12.3Le %12.3Le %12.3Le\n",
IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1));
printf("c2 (bot.left/middle/top rt.) = %12.3Le %12.3Le %12.3Le\n\n",
IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1));
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("t = %.2e no. steps = %ld order = %d stepsize = %.2e\n",
t, nst, qu, hu);
printf("c1 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n",
IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1));
printf("c2 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n\n",
IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1));
#else
printf("t = %.2e no. steps = %ld order = %d stepsize = %.2e\n",
t, nst, qu, hu);
printf("c1 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n",
IJKth(udata,1,0,0), IJKth(udata,1,mxh,myh), IJKth(udata,1,mx1,my1));
printf("c2 (bot.left/middle/top rt.) = %12.3e %12.3e %12.3e\n\n",
IJKth(udata,2,0,0), IJKth(udata,2,mxh,myh), IJKth(udata,2,mx1,my1));
#endif
}
static void PrintOutputS(N_Vector *uS)
{
realtype *sdata;
sdata = NV_DATA_S(uS[0]);
printf(" ----------------------------------------\n");
printf(" Sensitivity 1 ");
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("%12.4Le %12.4Le \n", IJKth(sdata,1,0,0), IJKth(sdata,1,MX-1,MZ-1));
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("%12.4le %12.4le \n", IJKth(sdata,1,0,0), IJKth(sdata,1,MX-1,MZ-1));
#else
printf("%12.4e %12.4e \n", IJKth(sdata,1,0,0), IJKth(sdata,1,MX-1,MZ-1));
#endif
printf(" ");
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("%12.4Le %12.4Le \n", IJKth(sdata,2,0,0), IJKth(sdata,2,MX-1,MZ-1));
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("%12.4le %12.4le \n", IJKth(sdata,2,0,0), IJKth(sdata,2,MX-1,MZ-1));
#else
printf("%12.4e %12.4e \n", IJKth(sdata,2,0,0), IJKth(sdata,2,MX-1,MZ-1));
#endif
sdata = NV_DATA_S(uS[1]);
printf(" ----------------------------------------\n");
printf(" Sensitivity 2 ");
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("%12.4Le %12.4Le \n", IJKth(sdata,1,0,0), IJKth(sdata,1,MX-1,MZ-1));
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("%12.4le %12.4le \n", IJKth(sdata,1,0,0), IJKth(sdata,1,MX-1,MZ-1));
#else
printf("%12.4e %12.4e \n", IJKth(sdata,1,0,0), IJKth(sdata,1,MX-1,MZ-1));
#endif
printf(" ");
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("%12.4Le %12.4Le \n", IJKth(sdata,2,0,0), IJKth(sdata,2,MX-1,MZ-1));
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("%12.4le %12.4le \n", IJKth(sdata,2,0,0), IJKth(sdata,2,MX-1,MZ-1));
#else
printf("%12.4e %12.4e \n", IJKth(sdata,2,0,0), IJKth(sdata,2,MX-1,MZ-1));
#endif
}
static void PrintOutput(void *cvode_mem, realtype t, N_Vector y)
{
long int nst;
int qu, flag;
realtype hu;
realtype *ydata;
ydata = NV_DATA_S(y);
flag = CVodeGetNumSteps(cvode_mem, &nst);
check_flag(&flag, "CVodeGetNumSteps", 1);
flag = CVodeGetLastOrder(cvode_mem, &qu);
check_flag(&flag, "CVodeGetLastOrder", 1);
flag = CVodeGetLastStep(cvode_mem, &hu);
check_flag(&flag, "CVodeGetLastStep", 1);
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("%8.3Le %2d %8.3Le %5ld\n", t,qu,hu,nst);
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("%8.3le %2d %8.3le %5ld\n", t,qu,hu,nst);
#else
printf("%8.3e %2d %8.3e %5ld\n", t,qu,hu,nst);
#endif
printf(" Solution ");
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("%12.4Le %12.4Le \n", IJKth(ydata,1,0,0), IJKth(ydata,1,MX-1,MZ-1));
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("%12.4le %12.4le \n", IJKth(ydata,1,0,0), IJKth(ydata,1,MX-1,MZ-1));
#else
printf("%12.4e %12.4e \n", IJKth(ydata,1,0,0), IJKth(ydata,1,MX-1,MZ-1));
#endif
printf(" ");
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("%12.4Le %12.4Le \n", IJKth(ydata,2,0,0), IJKth(ydata,2,MX-1,MZ-1));
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("%12.4le %12.4le \n", IJKth(ydata,2,0,0), IJKth(ydata,2,MX-1,MZ-1));
#else
printf("%12.4e %12.4e \n", IJKth(ydata,2,0,0), IJKth(ydata,2,MX-1,MZ-1));
#endif
}
static int Precond(realtype tn, N_Vector y, N_Vector fy, booleantype jok,
booleantype *jcurPtr, realtype gamma, void *P_data,
N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3)
{
realtype c1, c2, czdn, czup, diag, zdn, zup, q4coef, delz, verdco, hordco;
realtype **(*P)[MZ], **(*Jbd)[MZ];
long int *(*pivot)[MZ];
int ier, jx, jz;
realtype *ydata, **a, **j;
UserData data;
realtype Q1, Q2, C3, A3, A4, KH, VEL, KV0;
/* Make local copies of pointers in P_data, and of pointer to y's data */
data = (UserData) P_data;
P = data->P;
Jbd = data->Jbd;
pivot = data->pivot;
ydata = NV_DATA_S(y);
/* Load problem coefficients and parameters */
Q1 = data->p[0];
Q2 = data->p[1];
C3 = data->p[2];
A3 = data->p[3];
A4 = data->p[4];
KH = data->p[5];
VEL = data->p[6];
KV0 = data->p[7];
if (jok) {
/* jok = TRUE: Copy Jbd to P */
for (jz=0; jz < MZ; jz++)
for (jx=0; jx < MX; jx++)
dencopy(Jbd[jx][jz], P[jx][jz], NUM_SPECIES);
*jcurPtr = FALSE;
}
else {
/* jok = FALSE: Generate Jbd from scratch and copy to P */
/* Make local copies of problem variables, for efficiency. */
q4coef = data->q4;
delz = data->dz;
verdco = data->vdco;
hordco = data->hdco;
/* Compute 2x2 diagonal Jacobian blocks (using q4 values
computed on the last f call). Load into P. */
for (jz=0; jz < MZ; jz++) {
zdn = ZMIN + (jz - RCONST(0.5))*delz;
zup = zdn + delz;
czdn = verdco*EXP(RCONST(0.2)*zdn);
czup = verdco*EXP(RCONST(0.2)*zup);
diag = -(czdn + czup + RCONST(2.0)*hordco);
for (jx=0; jx < MX; jx++) {
c1 = IJKth(ydata,1,jx,jz);
c2 = IJKth(ydata,2,jx,jz);
j = Jbd[jx][jz];
a = P[jx][jz];
IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag;
IJth(j,1,2) = -Q2*c1 + q4coef;
IJth(j,2,1) = Q1*C3 - Q2*c2;
IJth(j,2,2) = (-Q2*c1 - q4coef) + diag;
dencopy(j, a, NUM_SPECIES);
}
}
*jcurPtr = TRUE;
}
/* Scale by -gamma */
for (jz=0; jz < MZ; jz++)
for (jx=0; jx < MX; jx++)
denscale(-gamma, P[jx][jz], NUM_SPECIES);
/* Add identity matrix and do LU decompositions on blocks in place. */
for (jx=0; jx < MX; jx++) {
for (jz=0; jz < MZ; jz++) {
denaddI(P[jx][jz], NUM_SPECIES);
ier = gefa(P[jx][jz], NUM_SPECIES, pivot[jx][jz]);
if (ier != 0) return(1);
}
}
return(0);
}
static int f(realtype t, N_Vector y, N_Vector ydot, void *f_data)
{
realtype q3, c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt;
realtype c1rt, c2rt, czdn, czup, hord1, hord2, horad1, horad2;
realtype qq1, qq2, qq3, qq4, rkin1, rkin2, s, vertd1, vertd2, zdn, zup;
realtype q4coef, delz, verdco, hordco, horaco;
realtype *ydata, *dydata;
int jx, jz, idn, iup, ileft, iright;
UserData data;
realtype Q1, Q2, C3, A3, A4, KH, VEL, KV0;
data = (UserData) f_data;
ydata = NV_DATA_S(y);
dydata = NV_DATA_S(ydot);
/* Load problem coefficients and parameters */
Q1 = data->p[0];
Q2 = data->p[1];
C3 = data->p[2];
A3 = data->p[3];
A4 = data->p[4];
KH = data->p[5];
VEL = data->p[6];
KV0 = data->p[7];
/* Set diurnal rate coefficients. */
s = sin(data->om*t);
if (s > ZERO) {
q3 = EXP(-A3/s);
data->q4 = EXP(-A4/s);
} else {
q3 = ZERO;
data->q4 = ZERO;
}
/* Make local copies of problem variables, for efficiency. */
q4coef = data->q4;
delz = data->dz;
verdco = data->vdco;
hordco = data->hdco;
horaco = data->haco;
/* Loop over all grid points. */
for (jz=0; jz < MZ; jz++) {
/* Set vertical diffusion coefficients at jz +- 1/2 */
zdn = ZMIN + (jz - RCONST(0.5))*delz;
zup = zdn + delz;
czdn = verdco*EXP(RCONST(0.2)*zdn);
czup = verdco*EXP(RCONST(0.2)*zup);
idn = (jz == 0) ? 1 : -1;
iup = (jz == MZ-1) ? -1 : 1;
for (jx=0; jx < MX; jx++) {
/* Extract c1 and c2, and set kinetic rate terms. */
c1 = IJKth(ydata,1,jx,jz);
c2 = IJKth(ydata,2,jx,jz);
qq1 = Q1*c1*C3;
qq2 = Q2*c1*c2;
qq3 = q3*C3;
qq4 = q4coef*c2;
rkin1 = -qq1 - qq2 + RCONST(2.0)*qq3 + qq4;
rkin2 = qq1 - qq2 - qq4;
/* Set vertical diffusion terms. */
c1dn = IJKth(ydata,1,jx,jz+idn);
c2dn = IJKth(ydata,2,jx,jz+idn);
c1up = IJKth(ydata,1,jx,jz+iup);
c2up = IJKth(ydata,2,jx,jz+iup);
vertd1 = czup*(c1up - c1) - czdn*(c1 - c1dn);
vertd2 = czup*(c2up - c2) - czdn*(c2 - c2dn);
/* Set horizontal diffusion and advection terms. */
ileft = (jx == 0) ? 1 : -1;
iright =(jx == MX-1) ? -1 : 1;
c1lt = IJKth(ydata,1,jx+ileft,jz);
c2lt = IJKth(ydata,2,jx+ileft,jz);
c1rt = IJKth(ydata,1,jx+iright,jz);
c2rt = IJKth(ydata,2,jx+iright,jz);
hord1 = hordco*(c1rt - RCONST(2.0)*c1 + c1lt);
hord2 = hordco*(c2rt - RCONST(2.0)*c2 + c2lt);
horad1 = horaco*(c1rt - c1lt);
horad2 = horaco*(c2rt - c2lt);
/* Load all terms into ydot. */
IJKth(dydata, 1, jx, jz) = vertd1 + hord1 + horad1 + rkin1;
IJKth(dydata, 2, jx, jz) = vertd2 + hord2 + horad2 + rkin2;
}
}
return(0);
}
static int Precond(realtype tn, N_Vector u, N_Vector fu,
booleantype jok, booleantype *jcurPtr, realtype gamma,
void *P_data, N_Vector vtemp1, N_Vector vtemp2,
N_Vector vtemp3)
{
realtype c1, c2, cydn, cyup, diag, ydn, yup, q4coef, dely, verdco, hordco;
realtype **(*P)[MY], **(*Jbd)[MY];
long int *(*pivot)[MY], ier;
int jx, jy;
realtype *udata, **a, **j;
UserData data;
/* Make local copies of pointers in P_data, and of pointer to u's data */
data = (UserData) P_data;
P = data->P;
Jbd = data->Jbd;
pivot = data->pivot;
udata = NV_DATA_S(u);
if (jok) {
/* jok = TRUE: Copy Jbd to P */
for (jy=0; jy < MY; jy++)
for (jx=0; jx < MX; jx++)
dencopy(Jbd[jx][jy], P[jx][jy], NUM_SPECIES);
*jcurPtr = FALSE;
}
else {
/* jok = FALSE: Generate Jbd from scratch and copy to P */
/* Make local copies of problem variables, for efficiency. */
q4coef = data->q4;
dely = data->dy;
verdco = data->vdco;
hordco = data->hdco;
/* Compute 2x2 diagonal Jacobian blocks (using q4 values
computed on the last f call). Load into P. */
for (jy=0; jy < MY; jy++) {
ydn = YMIN + (jy - RCONST(0.5))*dely;
yup = ydn + dely;
cydn = verdco*exp(RCONST(0.2)*ydn);
cyup = verdco*exp(RCONST(0.2)*yup);
diag = -(cydn + cyup + TWO*hordco);
for (jx=0; jx < MX; jx++) {
c1 = IJKth(udata,1,jx,jy);
c2 = IJKth(udata,2,jx,jy);
j = Jbd[jx][jy];
a = P[jx][jy];
IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag;
IJth(j,1,2) = -Q2*c1 + q4coef;
IJth(j,2,1) = Q1*C3 - Q2*c2;
IJth(j,2,2) = (-Q2*c1 - q4coef) + diag;
dencopy(j, a, NUM_SPECIES);
}
}
*jcurPtr = TRUE;
}
/* Scale by -gamma */
for (jy=0; jy < MY; jy++)
for (jx=0; jx < MX; jx++)
denscale(-gamma, P[jx][jy], NUM_SPECIES);
/* Add identity matrix and do LU decompositions on blocks in place. */
for (jx=0; jx < MX; jx++) {
for (jy=0; jy < MY; jy++) {
denaddI(P[jx][jy], NUM_SPECIES);
ier = gefa(P[jx][jy], NUM_SPECIES, pivot[jx][jy]);
if (ier != 0) return(1);
}
}
return(0);
}
static int jtv(N_Vector v, N_Vector Jv, realtype t,
N_Vector u, N_Vector fu,
void *user_data, N_Vector tmp)
{
realtype c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt, c1rt, c2rt;
realtype v1, v2, v1dn, v2dn, v1up, v2up, v1lt, v2lt, v1rt, v2rt;
realtype Jv1, Jv2;
realtype cydn, cyup;
realtype s, ydn, yup;
realtype q4coef, dely, verdco, hordco, horaco;
int jx, jy, idn, iup, ileft, iright;
realtype *udata, *vdata, *Jvdata;
UserData data;
data = (UserData) user_data;
udata = N_VGetArrayPointer_Serial(u);
vdata = N_VGetArrayPointer_Serial(v);
Jvdata = N_VGetArrayPointer_Serial(Jv);
/* Set diurnal rate coefficients. */
s = sin(data->om*t);
if (s > ZERO) {
data->q4 = SUNRexp(-A4/s);
} else {
data->q4 = ZERO;
}
/* Make local copies of problem variables, for efficiency. */
q4coef = data->q4;
dely = data->dy;
verdco = data->vdco;
hordco = data->hdco;
horaco = data->haco;
/* Loop over all grid points. */
for (jy=0; jy < MY; jy++) {
/* Set vertical diffusion coefficients at jy +- 1/2 */
ydn = YMIN + (jy - RCONST(0.5))*dely;
yup = ydn + dely;
cydn = verdco*SUNRexp(RCONST(0.2)*ydn);
cyup = verdco*SUNRexp(RCONST(0.2)*yup);
idn = (jy == 0) ? 1 : -1;
iup = (jy == MY-1) ? -1 : 1;
for (jx=0; jx < MX; jx++) {
Jv1 = ZERO;
Jv2 = ZERO;
/* Extract c1 and c2 at the current location and at neighbors */
c1 = IJKth(udata,1,jx,jy);
c2 = IJKth(udata,2,jx,jy);
v1 = IJKth(vdata,1,jx,jy);
v2 = IJKth(vdata,2,jx,jy);
c1dn = IJKth(udata,1,jx,jy+idn);
c2dn = IJKth(udata,2,jx,jy+idn);
c1up = IJKth(udata,1,jx,jy+iup);
c2up = IJKth(udata,2,jx,jy+iup);
v1dn = IJKth(vdata,1,jx,jy+idn);
v2dn = IJKth(vdata,2,jx,jy+idn);
v1up = IJKth(vdata,1,jx,jy+iup);
v2up = IJKth(vdata,2,jx,jy+iup);
ileft = (jx == 0) ? 1 : -1;
iright =(jx == MX-1) ? -1 : 1;
c1lt = IJKth(udata,1,jx+ileft,jy);
c2lt = IJKth(udata,2,jx+ileft,jy);
c1rt = IJKth(udata,1,jx+iright,jy);
c2rt = IJKth(udata,2,jx+iright,jy);
v1lt = IJKth(vdata,1,jx+ileft,jy);
v2lt = IJKth(vdata,2,jx+ileft,jy);
v1rt = IJKth(vdata,1,jx+iright,jy);
v2rt = IJKth(vdata,2,jx+iright,jy);
/* Set kinetic rate terms. */
/*
rkin1 = -Q1*C3 * c1 - Q2 * c1*c2 + q4coef * c2 + TWO*C3*q3;
rkin2 = Q1*C3 * c1 - Q2 * c1*c2 - q4coef * c2;
*/
Jv1 += -(Q1*C3 + Q2*c2) * v1 + (q4coef - Q2*c1) * v2;
Jv2 += (Q1*C3 - Q2*c2) * v1 - (q4coef + Q2*c1) * v2;
/* Set vertical diffusion terms. */
/*
vertd1 = -(cyup+cydn) * c1 + cyup * c1up + cydn * c1dn;
vertd2 = -(cyup+cydn) * c2 + cyup * c2up + cydn * c2dn;
*/
Jv1 += -(cyup+cydn) * v1 + cyup * v1up + cydn * v1dn;
Jv2 += -(cyup+cydn) * v2 + cyup * v2up + cydn * v2dn;
/* Set horizontal diffusion and advection terms. */
/*
hord1 = hordco*(c1rt - TWO*c1 + c1lt);
hord2 = hordco*(c2rt - TWO*c2 + c2lt);
*/
Jv1 += hordco*(v1rt - TWO*v1 + v1lt);
Jv2 += hordco*(v2rt - TWO*v2 + v2lt);
/*
horad1 = horaco*(c1rt - c1lt);
horad2 = horaco*(c2rt - c2lt);
*/
Jv1 += horaco*(v1rt - v1lt);
Jv2 += horaco*(v2rt - v2lt);
/* Load two components of J*v */
/*
IJKth(dudata, 1, jx, jy) = vertd1 + hord1 + horad1 + rkin1;
IJKth(dudata, 2, jx, jy) = vertd2 + hord2 + horad2 + rkin2;
*/
IJKth(Jvdata, 1, jx, jy) = Jv1;
IJKth(Jvdata, 2, jx, jy) = Jv2;
}
}
return(0);
}
static void f(integertype N, realtype t, N_Vector y, N_Vector ydot,void *f_data)
{
realtype q3, c1, c2, c1dn, c2dn, c1up, c2up, c1lt, c2lt;
realtype c1rt, c2rt, czdn, czup, hord1, hord2, horad1, horad2;
realtype qq1, qq2, qq3, qq4, rkin1, rkin2, s, vertd1, vertd2, zdn, zup;
realtype q4coef, delz, verdco, hordco, horaco;
realtype *ydata, *dydata;
int jx, jz, idn, iup, ileft, iright;
UserData data;
data = (UserData) f_data;
ydata = NV_DATA_S(y);
dydata = NV_DATA_S(ydot);
/* Set diurnal rate coefficients. */
s = sin(data->om*t);
if (s > 0.0) {
q3 = exp(-A3/s);
data->q4 = exp(-A4/s);
} else {
q3 = 0.0;
data->q4 = 0.0;
}
/* Make local copies of problem variables, for efficiency. */
q4coef = data->q4;
delz = data->dz;
verdco = data->vdco;
hordco = data->hdco;
horaco = data->haco;
/* Loop over all grid points. */
for (jz = 0; jz < MZ; jz++) {
/* Set vertical diffusion coefficients at jz +- 1/2 */
zdn = ZMIN + (jz - .5)*delz;
zup = zdn + delz;
czdn = verdco*exp(0.2*zdn);
czup = verdco*exp(0.2*zup);
idn = (jz == 0) ? 1 : -1;
iup = (jz == MZ-1) ? -1 : 1;
for (jx = 0; jx < MX; jx++) {
/* Extract c1 and c2, and set kinetic rate terms. */
c1 = IJKth(ydata,1,jx,jz);
c2 = IJKth(ydata,2,jx,jz);
qq1 = Q1*c1*C3;
qq2 = Q2*c1*c2;
qq3 = q3*C3;
qq4 = q4coef*c2;
rkin1 = -qq1 - qq2 + 2.0*qq3 + qq4;
rkin2 = qq1 - qq2 - qq4;
/* Set vertical diffusion terms. */
c1dn = IJKth(ydata,1,jx,jz+idn);
c2dn = IJKth(ydata,2,jx,jz+idn);
c1up = IJKth(ydata,1,jx,jz+iup);
c2up = IJKth(ydata,2,jx,jz+iup);
vertd1 = czup*(c1up - c1) - czdn*(c1 - c1dn);
vertd2 = czup*(c2up - c2) - czdn*(c2 - c2dn);
/* Set horizontal diffusion and advection terms. */
ileft = (jx == 0) ? 1 : -1;
iright =(jx == MX-1) ? -1 : 1;
c1lt = IJKth(ydata,1,jx+ileft,jz);
c2lt = IJKth(ydata,2,jx+ileft,jz);
c1rt = IJKth(ydata,1,jx+iright,jz);
c2rt = IJKth(ydata,2,jx+iright,jz);
hord1 = hordco*(c1rt - 2.0*c1 + c1lt);
hord2 = hordco*(c2rt - 2.0*c2 + c2lt);
horad1 = horaco*(c1rt - c1lt);
horad2 = horaco*(c2rt - c2lt);
/* Load all terms into ydot. */
IJKth(dydata, 1, jx, jz) = vertd1 + hord1 + horad1 + rkin1;
IJKth(dydata, 2, jx, jz) = vertd2 + hord2 + horad2 + rkin2;
}
}
}