1 |
C $Header$ |
C $Header$ |
2 |
|
C $Name$ |
3 |
|
|
4 |
#include "COST_CPPOPTIONS.h" |
#include "COST_CPPOPTIONS.h" |
5 |
#ifdef ALLOW_OBCS |
#ifdef ALLOW_OBCS |
71 |
_RL fctile |
_RL fctile |
72 |
_RL fcthread |
_RL fcthread |
73 |
|
|
74 |
_RL rholoc (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
_RL rholoc (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
75 |
_RL xzgrdrho(1-olx:snx+olx,Nr,nsx,nsy) |
_RL xzgrdrho(1-olx:snx+olx,Nr,nsx,nsy) |
76 |
_RL yzgrdrho(1-oly:sny+oly,Nr,nsx,nsy) |
_RL yzgrdrho(1-oly:sny+oly,Nr,nsx,nsy) |
77 |
_RL xzdvel1 (1-olx:snx+olx,nr,nsx,nsy) |
_RL xzdvel1 (1-olx:snx+olx,nr,nsx,nsy) |
220 |
do k = 1,nr-1 |
do k = 1,nr-1 |
221 |
do i = imin, imax |
do i = imin, imax |
222 |
j = ob_jn(i,bi,bj) |
j = ob_jn(i,bi,bj) |
223 |
cgg All these points need to be wet. |
cgg All these points need to be wet. |
224 |
if (j .eq. 0) then |
if (j .eq. 0) then |
225 |
maskxzageos(i,k,bi,bj) = 0. |
maskxzageos(i,k,bi,bj) = 0. |
226 |
else |
else |
227 |
maskxzageos(i,k,bi,bj) = |
maskxzageos(i,k,bi,bj) = |
228 |
& hfacC(i,j+jp1,k,bi,bj)*hfacC(i+1,j+jp1,k,bi,bj) * |
& hfacC(i,j+jp1,k,bi,bj)*hfacC(i+1,j+jp1,k,bi,bj) * |
229 |
& hfacC(i-1,j+jp1,k,bi,bj)*hfacC(i,j+jp1,k+1,bi,bj)* |
& hfacC(i-1,j+jp1,k,bi,bj)*hfacC(i,j+jp1,k+1,bi,bj)* |
230 |
& hfacC(i-1,j+jp1,k+1,bi,bj)*hfacC(i+1,j+jp1,k+1,bi,bj)* |
& hfacC(i-1,j+jp1,k+1,bi,bj)*hfacC(i+1,j+jp1,k+1,bi,bj)* |
232 |
endif |
endif |
233 |
enddo |
enddo |
234 |
enddo |
enddo |
235 |
|
|
236 |
do k = 1,nr |
do k = 1,nr |
237 |
call find_rho(bi,bj,imin,imax,jmin,jmax,k,k, |
call find_rho(bi,bj,imin,imax,jmin,jmax,k,k, |
238 |
& tbar,sbar,rholoc,mythid) |
& tbar,sbar,rholoc,mythid) |
241 |
cgg Compute centered difference horizontal gradient on bdy. |
cgg Compute centered difference horizontal gradient on bdy. |
242 |
do i = imin, imax |
do i = imin, imax |
243 |
j = ob_jn(i,bi,bj) |
j = ob_jn(i,bi,bj) |
244 |
xzgrdrho(i,k,bi,bj) = |
xzgrdrho(i,k,bi,bj) = |
245 |
& (rholoc(i-1,j+jp1,bi,bj)-rholoc(i+1,j+jp1,bi,bj)) |
& (rholoc(i-1,j+jp1,bi,bj)-rholoc(i+1,j+jp1,bi,bj)) |
246 |
& /(2.*dxc(i,j+jp1,bi,bj)) |
& /(2.*dxc(i,j+jp1,bi,bj)) |
247 |
enddo |
enddo |
282 |
if (j .eq. 0) then |
if (j .eq. 0) then |
283 |
maskxzageos(i,k,bi,bj) = 0. |
maskxzageos(i,k,bi,bj) = 0. |
284 |
else |
else |
285 |
cgg All these points need to be wet. |
cgg All these points need to be wet. |
286 |
maskxzageos(i,k,bi,bj) = |
maskxzageos(i,k,bi,bj) = |
287 |
& hfacC(i,j+jp1,k,bi,bj)*hfacC(i+1,j+jp1,k,bi,bj) * |
& hfacC(i,j+jp1,k,bi,bj)*hfacC(i+1,j+jp1,k,bi,bj) * |
288 |
& hfacC(i-1,j+jp1,k,bi,bj)*hfacC(i,j+jp1,k+1,bi,bj)* |
& hfacC(i-1,j+jp1,k,bi,bj)*hfacC(i,j+jp1,k+1,bi,bj)* |
289 |
& hfacC(i-1,j+jp1,k+1,bi,bj)*hfacC(i+1,j+jp1,k+1,bi,bj)* |
& hfacC(i-1,j+jp1,k+1,bi,bj)*hfacC(i+1,j+jp1,k+1,bi,bj)* |
290 |
& hfacS(i,j+jp1,k,bi,bj)*hfacS(i,j+jp1,k+1,bi,bj) |
& hfacS(i,j+jp1,k,bi,bj)*hfacS(i,j+jp1,k+1,bi,bj) |
291 |
endif |
endif |
292 |
enddo |
enddo |
293 |
enddo |
enddo |
294 |
|
|
301 |
cgg Compute centered difference horizontal gradient on bdy. |
cgg Compute centered difference horizontal gradient on bdy. |
302 |
do i = imin, imax |
do i = imin, imax |
303 |
j = ob_js(i,bi,bj) |
j = ob_js(i,bi,bj) |
304 |
xzgrdrho(i,k,bi,bj) = |
xzgrdrho(i,k,bi,bj) = |
305 |
& (rholoc(i-1,j+jp1,bi,bj)-rholoc(i+1,j+jp1,bi,bj)) |
& (rholoc(i-1,j+jp1,bi,bj)-rholoc(i+1,j+jp1,bi,bj)) |
306 |
& /(2.*dxc(i,j+jp1,bi,bj)) |
& /(2.*dxc(i,j+jp1,bi,bj)) |
307 |
enddo |
enddo |
341 |
cgg All these points need to be wet. |
cgg All these points need to be wet. |
342 |
if (i.eq. 0) then |
if (i.eq. 0) then |
343 |
maskyzageos(j,k,bi,bj) = 0. |
maskyzageos(j,k,bi,bj) = 0. |
344 |
else |
else |
345 |
maskyzageos(j,k,bi,bj) = |
maskyzageos(j,k,bi,bj) = |
346 |
& hfacC(i+ip1,j,k,bi,bj)*hfacC(i+ip1,j+1,k,bi,bj) * |
& hfacC(i+ip1,j,k,bi,bj)*hfacC(i+ip1,j+1,k,bi,bj) * |
347 |
& hfacC(i+ip1,j-1,k,bi,bj)*hfacC(i+ip1,j,k+1,bi,bj)* |
& hfacC(i+ip1,j-1,k,bi,bj)*hfacC(i+ip1,j,k+1,bi,bj)* |
348 |
& hfacC(i+ip1,j-1,k+1,bi,bj)*hfacC(i+ip1,j+1,k+1,bi,bj)* |
& hfacC(i+ip1,j-1,k+1,bi,bj)*hfacC(i+ip1,j+1,k+1,bi,bj)* |
361 |
do j = jmin, jmax |
do j = jmin, jmax |
362 |
i = ob_iw(j,bi,bj) |
i = ob_iw(j,bi,bj) |
363 |
cgg Negative sign due to geostrophy. |
cgg Negative sign due to geostrophy. |
364 |
yzgrdrho(j,k,bi,bj) = |
yzgrdrho(j,k,bi,bj) = |
365 |
& (rholoc(i+ip1,j+1,bi,bj)-rholoc(i+ip1,j-1,bi,bj)) |
& (rholoc(i+ip1,j+1,bi,bj)-rholoc(i+ip1,j-1,bi,bj)) |
366 |
& /(2.*dyc(i+ip1,j,bi,bj)) |
& /(2.*dyc(i+ip1,j,bi,bj)) |
367 |
enddo |
enddo |
400 |
if (i.eq.0) then |
if (i.eq.0) then |
401 |
maskyzageos(j,k,bi,bj) =0. |
maskyzageos(j,k,bi,bj) =0. |
402 |
else |
else |
403 |
cgg All these points need to be wet. |
cgg All these points need to be wet. |
404 |
maskyzageos(j,k,bi,bj) = |
maskyzageos(j,k,bi,bj) = |
405 |
& hfacC(i+ip1,j,k,bi,bj)*hfacC(i+ip1,j+1,k,bi,bj) * |
& hfacC(i+ip1,j,k,bi,bj)*hfacC(i+ip1,j+1,k,bi,bj) * |
406 |
& hfacC(i+ip1,j-1,k,bi,bj)*hfacC(i+ip1,j,k+1,bi,bj)* |
& hfacC(i+ip1,j-1,k,bi,bj)*hfacC(i+ip1,j,k+1,bi,bj)* |
407 |
& hfacC(i+ip1,j-1,k+1,bi,bj)*hfacC(i+ip1,j+1,k+1,bi,bj)* |
& hfacC(i+ip1,j-1,k+1,bi,bj)*hfacC(i+ip1,j+1,k+1,bi,bj)* |
420 |
do j = jmin, jmax |
do j = jmin, jmax |
421 |
i = ob_ie(j,bi,bj) |
i = ob_ie(j,bi,bj) |
422 |
cgg Negative sign due to geostrophy. |
cgg Negative sign due to geostrophy. |
423 |
yzgrdrho(j,k,bi,bj) = |
yzgrdrho(j,k,bi,bj) = |
424 |
& (rholoc(i+ip1,,j+1,bi,bj)-rholoc(i+ip1,j-1,bi,bj)) |
& (rholoc(i+ip1,,j+1,bi,bj)-rholoc(i+ip1,j-1,bi,bj)) |
425 |
& /(2.*dyc(i+ip1,j,bi,bj)) |
& /(2.*dyc(i+ip1,j,bi,bj)) |
426 |
enddo |
enddo |