static void tracer_hordiff(void)
{
/* This subroutine does along-coordinate diffusion of all tracers, */
/* using the diffusivity KHTR. Multiple iterations are used (if */
/* necessary) so that there is no limit on the acceptable time */
/* increment. */
double khdt_rem_x[NXMEM][NYMEM]; /* The value of KHTR*dt which must */
/* be accomodated by later iterations */
/* in the zonal direction, in m2. */
double khdt_rem_y[NXMEM][NYMEM]; /* The value of KHTR*dt which must */
/* be accomodated by later iterations */
/* in the meridional direction, in m2.*/
double Coef_x[NXMEM][NYMEM]; /* The coefficient relating zonal */
/* tracer differences to fluxes, m3. */
double Coef_y[NXMEM][NYMEM]; /* The coefficient relating meridional*/
/* tracer differences to fluxes, m3. */
double Coef_x0[NXMEM][NYMEM]; /* The coefficient relating zonal */
/* tracer differences to fluxes, m3. */
double Coef_y0[NXMEM][NYMEM]; /* The coefficient relating meridional*/
/* tracer differences to fluxes, m3. */
double Ihdxdy[NXMEM][NYMEM]; /* The inverse of the volume of fluid */
/* in a layer in a grid cell, m-3. */
static double Max_khdt_x[NXMEM][NYMEM]; /* The maximum value of */
/* KHTR*dt which can be stably accom- */
/* odated within a single iteration in*/
/* the zonal-direction, in m2. */
static double Max_khdt_y[NXMEM][NYMEM]; /* The maximum value of */
/* KHTR*dt which can be stably accom- */
/* odated within a single iteration in*/
/* the meridional-direction, in m2. */
static double khdt_rem_x0[NXMEM][NYMEM]; /* The value of KHTR*dt which must */
/* be accomodated by later iterations */
/* in the zonal direction, in m2. */
static double khdt_rem_y0[NXMEM][NYMEM]; /* The value of KHTR*dt which must */
/* be accomodated by later iterations */
/* in the meridional direction, in m2.*/
extern double umask[NXMEM][NYMEM]; /* _mask are 1 over ocean and 0 */
extern double vmask[NXMEM][NYMEM]; /* over land on the u & v grids. */
static int zero_if_first_call = 0;
int i, j, k, ii, m, domore_k, itt;
double C0; /* A work variable with units of m2. */
printf("DIFFUSING TRACER - isopycnal\n");
if (zero_if_first_call == 0) {
for (j=Y1;j<=ny;j++)
for (i=X0;i<=nx;i++)
Max_khdt_x[i][j] = 0.125 / (DYu(i,j) * IDXu(i,j) *
((IDXDYh(i,j)>IDXDYh(i+1,j)) ? IDXDYh(i,j) : IDXDYh(i+1,j)));
for (i=X1;i<=nx;i++)
for (j=Y0;j<=ny;j++)
Max_khdt_y[i][j] = 0.125 / (DXv(i,j) * IDYv(i,j) *
((IDXDYh(i,j)>IDXDYh(i,j+1)) ? IDXDYh(i,j) : IDXDYh(i,j+1)));
for (i=X0;i<=nx;i++)
for (j=Y1;j<=ny;j++)
khdt_rem_x0[i][j] = dt*KHTR*DYu(i,j)*IDXu(i,j)*umask[i][j];
for (i=X1;i<=nx;i++)
for (j=Y0;j<=ny;j++)
khdt_rem_y0[i][j] = dt*KHTR*DXv(i,j)*IDYv(i,j)*vmask[i][j];
zero_if_first_call = 1;
}
//#pragma omp parallel for private(k,i,j,khdt_rem_x,khdt_rem_y,C0,Coef_y,Coef_x,Ihdxdy,m,ii,itt,domore_k)
for (k=0;k<NZ;k++) {
for (i=X0;i<=nx;i++)
for (j=Y1;j<=ny;j++)
khdt_rem_x[i][j] = khdt_rem_x0[i][j];
for (i=X1;i<=nx;i++)
for (j=Y0;j<=ny;j++)
khdt_rem_y[i][j] = khdt_rem_y0[i][j];
for (i=X1;i<=nx;i++)
for (j=Y0;j<=ny;j++)
Coef_y0[i][j] = 2.0*h[k][i][j]*h[k][i][j+1] / (h[k][i][j]+h[k][i][j+1]);
for (j=Y1;j<=ny;j++)
for (i=X0;i<=nx;i++)
Coef_x0[i][j] = 2.0*h[k][i][j]*h[k][i+1][j] / (h[k][i][j]+h[k][i+1][j]);
for (j=Y1;j<=ny;j++)
for (i=X1;i<=nx;i++)
Ihdxdy[i][j] = IDXDYh(i,j) / h[k][i][j];
itt = 0; domore_k = 1;
while (domore_k) {
domore_k = 0; itt++;
for (i=X1;i<=nx;i++) {
for (j=Y0;j<=ny;j++) {
if (khdt_rem_y[i][j] < Max_khdt_y[i][j]) C0 = khdt_rem_y[i][j];
else {C0 = Max_khdt_y[i][j]; domore_k++;}
khdt_rem_y[i][j] -= C0;
Coef_y[i][j] = C0*Coef_y0[i][j];
}
}
for (j=Y1;j<=ny;j++) {
for (i=X0;i<=nx;i++) {
if (khdt_rem_x[i][j] < Max_khdt_x[i][j]) C0 = khdt_rem_x[i][j];
else {C0 = Max_khdt_x[i][j]; domore_k++;}
khdt_rem_x[i][j] -= C0;
Coef_x[i][j] = C0*Coef_x0[i][j];
}
}
for (j=0;j<NYMEM;j++) {
Coef_x[nx+1][j] = Coef_x[2][j];
Coef_x[nx+2][j] = Coef_x[3][j];
Coef_x[0][j] = Coef_x[nx-1][j];
Coef_x[1][j] = Coef_x[nx][j];
Coef_y[nx+1][j] = Coef_y[2][j];
Coef_y[nx+2][j] = Coef_y[3][j];
Coef_y[0][j] = Coef_y[nx-1][j];
Coef_y[1][j] = Coef_y[nx][j];
}
for (i=2;i<=nx;i++) {
ii = 363 - i;
Coef_x[ii][ny+1] = Coef_x[i][ny];
Coef_x[ii][ny+2] = Coef_x[i][ny-1];
Coef_y[ii][ny+1] = Coef_y[i][ny];
Coef_y[ii][ny+2] = Coef_y[i][ny-1];
}
for (m=0;m<NTR;m++) {
for (i=X1;i<=nx;i++)
for (j=Y1;j<=ny;j++)
tr[m][k][i][j] += Ihdxdy[i][j] *
(Coef_x[i-1][j] * (tr[m][k][i-1][j] - tr[m][k][i][j]) -
Coef_x[i][j] * (tr[m][k][i][j] - tr[m][k][i+1][j]) +
Coef_y[i][j-1] * (tr[m][k][i][j-1] - tr[m][k][i][j]) -
Coef_y[i][j] * (tr[m][k][i][j] - tr[m][k][i][j+1]));
//BX-a
//BX add re-entrace values here
/* zonal re-entrance */
for (j=0;j<NYMEM;j++) {
tr[m][k][nx+1][j] = tr[m][k][2][j];
tr[m][k][nx+2][j] = tr[m][k][3][j];
tr[m][k][0][j] = tr[m][k][nx-1][j];
tr[m][k][1][j] = tr[m][k][nx][j];
}
/* meridional re-entrance */
for (i=2;i<=nx;i++) {
ii = 363 - i;
tr[m][k][ii][ny+1] = tr[m][k][i][ny];
tr[m][k][ii][ny+2] = tr[m][k][i][ny-1];
}
//BX-e
//BX-e
} // m
if (itt > 10) {
domore_k = 0; /* break loop */
}
} /* end while */
} /* end k loop */
} /* end of subroutine */
void set_metrics(void)
{
int i,j;
extern double areagr[NXMEM][NYMEM];
double Iareagr[NXMEM][NYMEM];
/* Calculate the values of the metric terms that might be used */
/* and save them in arrays. */
#ifdef CARTESIAN
/* On a cartesian grid, the various DX... and DY... macros all */
/* point to the same scalars. */
i = 0; j = 0;
DXh(i,j) = RE * LENLON * M_PI / (180.0 * NXTOT);
DYh(i,j) = RE * LENLAT * M_PI / (180.0 * NYTOT);
IDXh(i,j) = 1.0 / DXh(i,j);
IDYh(i,j) = 1.0 / DYh(i,j);
DXDYh(i,j) = DXh(i,j) * DYh(i,j);
IDXDYh(i,j) = IDXh(i,j) * IDYh(i,j);
for (j=Y0-1;j<=ny+2;j++)
latq[j] = LOWLAT + LENLAT*(double)(j-Y0+Y0abs)/(double)NYTOT;
for (j=Y0;j<=ny;j++)
lath[j] = LOWLAT + LENLAT*((double)(j-Y0+Y0abs)-0.5)/(double)NYTOT;
for (i=X0-1;i<=nx+2;i++)
lonq[i] = WESTLON + LENLON*(double)(i-X0+X0abs)/(double)NXTOT;
for (i=X0;i<=nx;i++)
lonh[i] = WESTLON + LENLON*((double)(i-X0+X0abs)-0.5)/(double)NXTOT;
# if defined(PARALLEL_Y) && !defined(PARALLEL_IO) && defined(NETCDF_OUTPUT)
for (j=Y0;j<=NYTOT+Y0;j++)
latq_tot[j] = LOWLAT + LENLAT*(double)(j-Y0)/(double)NYTOT;
for (j=Y0;j<=NYTOT+Y0;j++)
lath_tot[j] = LOWLAT + LENLAT*((double)(j-Y0)-0.5)/(double)NYTOT;
# endif
# if defined(PARALLEL_X) && !defined(PARALLEL_IO) && defined(NETCDF_OUTPUT)
for (i=X0;i<=NXTOT+X0;i++)
lonq_tot[i] = WESTLON + LENLON*(double)(i-X0)/(double)NXTOT;
for (i=X0;i<=NXTOT+X0;i++)
lonh_tot[i] = WESTLON + LENLON*((double)(i-X0)-0.5)/(double)NXTOT;
# endif
#else
/* All of the metric terms should be defined over the domain from */
/* X0-1 to nx+2. Outside of the physical domain, both the metrics */
/* and their inverses may be set to zero. */
/* Any points that are outside of the computational domain should */
/* have their values set to zero _BEFORE_ setting the other metric */
/* terms, because these macros may or may not expand to 2-dimensional */
/* arrays. */
/* The metric terms within the computational domain are set here. */
# ifdef ISOTROPIC
{
double C0, I_C0, yq, yh, jd;
double fnRef, yRef; /* fnRef is the value of the integral of */
/* 1/(dx*cos(lat)) from the equator to a */
/* reference latitude, while yRef is the */
/* j-index of that reference latitude. */
int itt1, itt2;
C0 = M_PI*((double) LENLON / (double) (180*NXTOT)); I_C0 = 1.0 / C0;
/* With an isotropic grid, the north-south extent of the domain, */
/* the east-west extent, and the number of grid points in each */
/* direction are _not_ independent. Here the north-south extent */
/* will be determined to fit the east-west extent and the number of */
/* grid points. The grid is perfectly isotropic. */
# ifdef NORTHREFERENCE
/* The following 2 lines fixes the refererence latitude at the */
/* northern edge of the domain, LOWLAT+LENLAT at j=NYTOT+Y0. */
yRef = Y0abs - Y0 - NYTOT;
fnRef = I_C0 * INTSECY(((LOWLAT+LENLAT)*M_PI/180.0));
# else
/* The following line sets the refererence latitude LOWLAT at j=Y0. */
yRef = Y0abs - Y0; fnRef = I_C0 * INTSECY((LOWLAT*M_PI/180.0));
# endif
/* Everything else should pretty much work. */
yq = LOWLAT*M_PI/180.0;
/* If the model is in parallel in the Y-direction, do the same set of */
/* calculations which would occur on a single processor. */
for (j=Y0-1-Y0abs;j<Y0-1;j++) {
jd = fnRef + (double) (j + yRef) - 0.5;
yh = find_root(jd,yq,&itt1);
jd = fnRef + (double) (j + yRef);
yq = find_root(jd,yh,&itt2);
# if defined(PARALLEL_Y) && !defined(PARALLEL_IO) && defined(NETCDF_OUTPUT)
latq_tot[j+Y0abs] = yq*180.0/M_PI;
lath_tot[j+Y0abs] = yh*180.0/M_PI;
# endif
}
for (j=Y0-1;j<=ny+2;j++) {
jd = fnRef + (double) (j + yRef) - 0.5;
yh = find_root(jd,yq,&itt1);
jd = fnRef + (double) (j + yRef);
yq = find_root(jd,yh,&itt2);
latq[j] = yq*180.0/M_PI;
lath[j] = yh*180.0/M_PI;
# if defined(PARALLEL_Y) && !defined(PARALLEL_IO) && defined(NETCDF_OUTPUT)
latq_tot[j+Y0abs] = yq*180.0/M_PI;
lath_tot[j+Y0abs] = yh*180.0/M_PI;
# endif
for (i=X0-1;i<=nx+2;i++) {
DXq(i,j) = cos(yq) * (RE * C0);
DYq(i,j) = DXq(i,j);
DXv(i,j) = DXq(i,j);
DYv(i,j) = DYq(i,j);
DXh(i,j) = cos(yh) * (RE * C0);
DYh(i,j) = DXh(i,j);
DXu(i,j) = DXh(i,j);
DYu(i,j) = DYh(i,j);
}
}
# if defined(PARALLEL_Y) && !defined(PARALLEL_IO) && defined(NETCDF_OUTPUT)
for (j=ny+3;j<=NYTOT+Y0-Y0abs;j++) {
jd = fnRef + (double) (j + yRef) - 0.5;
yh = find_root(jd,yq,&itt1);
jd = fnRef + (double) (j + yRef);
yq = find_root(jd,yh,&itt2);
latq_tot[j+Y0abs] = yq*180.0/M_PI;
lath_tot[j+Y0abs] = yh*180.0/M_PI;
}
# endif
}
for (i=X0-1;i<=nx+2;i++)
lonq[i] = WESTLON + LENLON*(double)(i-X0+X0abs)/(double)NXTOT;
for (i=X0;i<=nx;i++)
lonh[i] = WESTLON + LENLON*((double)(i-X0+X0abs)-0.5)/(double)NXTOT;
# if defined(PARALLEL_X) && !defined(PARALLEL_IO) && defined(NETCDF_OUTPUT)
for (i=X0;i<=NXTOT+X0;i++)
lonq_tot[i] = WESTLON + LENLON*(double)(i-X0)/(double)NXTOT;
for (i=X0;i<=NXTOT+X0;i++)
lonh_tot[i] = WESTLON + LENLON*((double)(i-X0)-0.5)/(double)NXTOT;
# endif
# else /* ISOTROPIC */
/* This code implements latitude/longitude coordinates on a sphere. */
//BX-a
// for (j=0;j<=NYTOT-1;j++) {
//HF for (j=Y0-1;j<=ny+2;j++) {
for (j=2;j<NYTOT+2;j++) {
latq[j] = qlat[j];
lath[j] = hlat[j];
}
//BX-e
/* HF for (i=0;i<=NXTOT-1;i++) {
for (j=0;j<=NYTOT-1;j++) {
DXq(i+2,j+2) = dxq[j][i];
DYq(i+2,j+2) = dyq[j][i];
DXv(i+2,j+2) = dxv[j][i];
DYv(i+2,j+2) = dyv[j][i];
DXh(i+2,j+2) = dxh[j][i];
DYh(i+2,j+2) = dyh[j][i];
DXu(i+2,j+2) = dxu[j][i];
DYu(i+2,j+2) = dyu[j][i];
}
} */
//BX-a
for (i=X0-1;i<=nx+2;i++)
lonq[i] = WESTLON + LENLON*(double)(i-X0+X0abs)/(double)NXTOT;
for (i=X0;i<=nx;i++)
lonh[i] = WESTLON + LENLON*((double)(i-X0+X0abs)-0.5)/(double)NXTOT;
//BX-e
#endif
/* The remaining code should not be changed. */
for (i=X0-1;i<=nx+2;i++) {
for (j=Y0-1;j<=ny+2;j++) {
IDXh(i,j) = (DXh(i,j) > 0.0) ? (1.0 / DXh(i,j)) : 0.0;
IDXu(i,j) = (DXu(i,j) > 0.0) ? (1.0 / DXu(i,j)) : 0.0;
IDXv(i,j) = (DXv(i,j) > 0.0) ? (1.0 / DXv(i,j)) : 0.0;
IDXq(i,j) = (DXq(i,j) > 0.0) ? (1.0 / DXq(i,j)) : 0.0;
IDYh(i,j) = (DYh(i,j) > 0.0) ? (1.0 / DYh(i,j)) : 0.0;
IDYu(i,j) = (DYu(i,j) > 0.0) ? (1.0 / DYu(i,j)) : 0.0;
IDYv(i,j) = (DYv(i,j) > 0.0) ? (1.0 / DYv(i,j)) : 0.0;
IDYq(i,j) = (DYq(i,j) > 0.0) ? (1.0 / DYq(i,j)) : 0.0;
//HF alternate def: DXDYh(i,j) = DXh(i,j) * DYh(i,j);
//HF alternate def: IDXDYh(i,j) = IDXh(i,j) * IDYh(i,j);
DXDYq(i,j) = DXq(i,j) * DYq(i,j);
IDXDYq(i,j) = IDXq(i,j) * IDYq(i,j);
Iareagr[i][j] = (areagr[i][j] > 0.0) ? (1.0 / areagr[i][j]) : 0.0;
DXDYh(i,j) = areagr[i][j];
IDXDYh(i,j) = Iareagr[i][j];
}
}
#endif /* CARTESIAN */
}
