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 */ }