107 & LBi, UBi, LBj, UBj, &
108 & IminS, ImaxS, JminS, JmaxS, &
111 & umask_wet, vmask_wet, &
113 & Hz, om_v, on_u, z_w, &
115#ifdef TIDE_GENERATING_FORCES
135 integer,
intent(in) :: ng, tile
136 integer,
intent(in) :: LBi, UBi, LBj, UBj
137 integer,
intent(in) :: IminS, ImaxS, JminS, JmaxS
138 integer,
intent(in) :: nrhs
142 real(r8),
intent(in) :: umask_wet(LBi:,LBj:)
143 real(r8),
intent(in) :: vmask_wet(LBi:,LBj:)
145 real(r8),
intent(in) :: Hz(LBi:,LBj:,:)
146 real(r8),
intent(in) :: om_v(LBi:,LBj:)
147 real(r8),
intent(in) :: on_u(LBi:,LBj:)
148 real(r8),
intent(in) :: z_w(LBi:,LBj:,0:)
149 real(r8),
intent(in) :: rho(LBi:,LBj:,:)
150# ifdef TIDE_GENERATING_FORCES
151 real(r8),
intent(in) :: eq_tide(LBi:,LBj:)
154 real(r8),
intent(in) :: zetat(LBi:,LBj:)
157 real(r8),
intent(in) :: Pair(LBi:,LBj:)
159# ifdef DIAGNOSTICS_UV
160 real(r8),
intent(inout) :: DiaRU(LBi:,LBj:,:,:,:)
161 real(r8),
intent(inout) :: DiaRV(LBi:,LBj:,:,:,:)
163 real(r8),
intent(inout) :: ru(LBi:,LBj:,0:,:)
164 real(r8),
intent(inout) :: rv(LBi:,LBj:,0:,:)
167 real(r8),
intent(in) :: umask_wet(LBi:UBi,LBj:UBj)
168 real(r8),
intent(in) :: vmask_wet(LBi:UBi,LBj:UBj)
170 real(r8),
intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
171 real(r8),
intent(in) :: om_v(LBi:UBi,LBj:UBj)
172 real(r8),
intent(in) :: on_u(LBi:UBi,LBj:UBj)
173 real(r8),
intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
174 real(r8),
intent(in) :: rho(LBi:UBi,LBj:UBj,N(ng))
175# ifdef TIDE_GENERATING_FORCES
176 real(r8),
intent(in) :: eq_tide(LBi:UBi,LBj:UBj)
179 real(r8),
intent(in) :: zetat(LBi:UBi,LBj:UBj)
182 real(r8),
intent(in) :: Pair(LBi:UBi,LBj:UBj)
184# ifdef DIAGNOSTICS_UV
185 real(r8),
intent(inout) :: DiaRU(LBi:UBi,LBj:UBj,N(ng),2,NDrhs)
186 real(r8),
intent(inout) :: DiaRV(LBi:UBi,LBj:UBj,N(ng),2,NDrhs)
188 real(r8),
intent(inout) :: ru(LBi:UBi,LBj:UBj,0:N(ng),2)
189 real(r8),
intent(inout) :: rv(LBi:UBi,LBj:UBj,0:N(ng),2)
196 real(r8),
parameter :: eps = 1.0e-8_r8
198 real(r8) :: Ampl, Hdd, cff, cff1, cff2, cff3, cffL, cffR
199 real(r8) :: deltaL, deltaR, dh, delP, limtr, rr
201 real(r8) :: OneAtm, fac
203 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,0:N(ng)) :: P
204 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,0:N(ng)) :: r
205 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,0:N(ng)) :: d
207 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS,N(ng)) :: FX
209 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: FC
210 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: aL
211 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: aR
212 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: dL
213 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: dR
214 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: d1
215 real(r8),
dimension(IminS:ImaxS,0:N(ng)) :: r1
217#include "set_bounds.h"
230 fc(i,k)=1.0_r8/(hz(i,j,k+1)+hz(i,j,k))
231 r(i,j,k)=fc(i,k)*(rho(i,j,k+1)*hz(i,j,k )+ &
232 & rho(i,j,k )*hz(i,j,k+1))
233 d(i,j,k)=fc(i,k)*(rho(i,j,k+1)-rho(i,j,k))
245 deltar=hz(i,j,k)*d(i,j,k )
246 deltal=hz(i,j,k)*d(i,j,k-1)
247 IF ((deltar*deltal).lt.0.0_r8)
THEN
251 cff=hz(i,j,k-1)+2.0_r8*hz(i,j,k)+hz(i,j,k+1)
254 IF (abs(deltar).gt.abs(cffl)) deltar=cffl
255 IF (abs(deltal).gt.abs(cffr)) deltal=cffr
256 cff=(deltar-deltal)/(hz(i,j,k-1)+hz(i,j,k)+hz(i,j,k+1))
257 deltar=deltar-cff*hz(i,j,k+1)
258 deltal=deltal+cff*hz(i,j,k-1)
259 ar(i,k)=rho(i,j,k)+deltar
260 al(i,k)=rho(i,j,k)-deltal
261 dr(i,k)=(2.0_r8*deltar-deltal)**2
262 dl(i,k)=(2.0_r8*deltal-deltar)**2
267 al(i,n(ng))=ar(i,n(ng)-1)
268 ar(i,n(ng))=2.0_r8*rho(i,j,n(ng))-al(i,n(ng))
269 dr(i,n(ng))=(2.0_r8*ar(i,n(ng))+al(i,n(ng))- &
270 & 3.0_r8*rho(i,j,n(ng)))**2
271 dl(i,n(ng))=(3.0_r8*rho(i,j,n(ng))- &
272 & 2.0_r8*al(i,n(ng))-ar(i,n(ng)))**2
274 al(i,1)=2.0_r8*rho(i,j,1)-ar(i,1)
275 dr(i,1)=(2.0_r8*ar(i,1)+al(i,1)-3.0_r8*rho(i,j,1))**2
276 dl(i,1)=(3.0_r8*rho(i,j,1)-2.0_r8*al(i,1)-ar(i,1))**2
281 deltal=max(dl(i,k ),eps)
282 deltar=max(dr(i,k+1),eps)
283 r1(i,k)=(deltar*ar(i,k)+deltal*al(i,k+1))/(deltar+deltal)
289 r1(i,n(ng))=1.5_r8*rho(i,j,n(ng))-0.5_r8*r1(i,n(ng)-1)
290 r1(i,0)=1.5_r8*rho(i,j,1)-0.5_r8*r1(i,1)
292 r1(i,n(ng))=2.0_r8*rho(i,j,n(ng))-r1(i,n(ng)-1)
293 r1(i,0)=2.0_r8*rho(i,j,1)-r1(i,1)
317 deltar=r1(i,k)-rho(i,j,k)
318 deltal=rho(i,j,k)-r1(i,k-1)
321 cff=(deltar+deltal)/cff
327 IF (cffl.gt.3.0_r8)
THEN
330 ELSE IF (cffr.gt.3.0_r8)
THEN
334 cffl=4.0_r8*deltal-2.0_r8*deltar
335 cffr=4.0_r8*deltar-2.0_r8*deltal
354 d(i,j,k)=fc(i,k)*(hz(i,j,k+1)*dl(i,k+1)+hz(i,j,k)*dr(i,k))
355 cffr=8.0_r8*(dr(i,k )+2.0_r8*dl(i,k ))
356 cffl=8.0_r8*(dl(i,k+1)+2.0_r8*dr(i,k+1))
357 IF (abs(d(i,j,k)).gt.abs(cffr)) d(i,j,k)=cffr
358 IF (abs(d(i,j,k)).gt.abs(cffl)) d(i,j,k)=cffl
359 IF ((dl(i,k+1)-dr(i,k))* &
360 & (rho(i,j,k+1)-rho(i,j,k)).gt.0.0_r8)
THEN
361 hdd=hz(i,j,k)*(d(i,j,k)-dr(i,k))
362 rr=rho(i,j,k)-r1(i,k-1)
364 hdd=hz(i,j,k+1)*(dl(i,k+1)-d(i,j,k))
365 rr=r1(i,k+1)-rho(i,j,k+1)
374 cff=rr*rr+0.0763636363636363636_r8*hdd* &
375 & (rr+0.004329004329004329_r8*hdd)
377 ampl=ampl*(rr+0.0363636363636363636_r8*hdd)/cff
381 r(i,j,k)=r1(i,k)+ampl
386 r(i,j,0)=1.5_r8*rho(i,j,1)-0.5_r8*r(i,j,1)
387 r(i,j,n(ng))=1.5_r8*rho(i,j,n(ng))-0.5_r8*r(i,j,n(ng)-1)
391 r(i,j,0)=2.0_r8*rho(i,j,1)-r(i,j,1)
392 r(i,j,n(ng))=2.0_r8*rho(i,j,n(ng))-r(i,j,n(ng)-1)
394 d(i,j,n(ng))=d(i,j,n(ng)-1)
404 p(i,j,n(ng))=p(i,j,n(ng))+zetat(i,j)
407 p(i,j,n(ng))=p(i,j,n(ng))+fac*(pair(i,j)-oneatm)
409#ifdef TIDE_GENERATING_FORCES
410 p(i,j,n(ng))=p(i,j,n(ng))-
g*eq_tide(i,j)
416 p(i,j,k-1)=p(i,j,k)+hz(i,j,k)*rho(i,j,k)
417 fx(i,j,k)=0.5_r8*hz(i,j,k)* &
418 & (p(i,j,k)+p(i,j,k-1)+ &
419 & 0.2_r8*hz(i,j,k)* &
420 & (r(i,j,k)-r(i,j,k-1)- &
421 & cff3*hz(i,j,k)*(d(i,j,k)+d(i,j,k-1))))
437 dh=z_w(i,j,k-1)-z_w(i-1,j,k-1)
438 delp=p(i-1,j,k-1)-p(i,j,k-1)
439 rr=0.5_r8*dh*(r(i,j,k-1)+r(i-1,j,k-1)- &
440 & cff2*dh*(d(i,j,k-1)-d(i-1,j,k-1)))
443 IF (limtr.gt.eps*rr)
THEN
448 fc(i,k-1)=0.5_r8*dh* &
449 & (p(i,j,k-1)+p(i-1,j,k-1)+ &
451 & (r(i,j,k-1)-r(i-1,j,k-1)- &
452 & cff3*dh*(d(i,j,k-1)+d(i-1,j,k-1))))
453 ru(i,j,k,nrhs)=(cff*(hz(i-1,j,k)+hz(i,j,k))* &
454 & (z_w(i-1,j,n(ng))-z_w(i,j,n(ng)))+ &
455 & cff1*(fx(i-1,j,k)-fx(i,j,k)+ &
456 & fc(i,k)-fc(i,k-1)))*on_u(i,j)
458 ru(i,j,k,nrhs)=ru(i,j,k,nrhs)*umask_wet(i,j)
461 diaru(i,j,k,nrhs,
m3pgrd)=ru(i,j,k,nrhs)
477 dh=z_w(i,j,k-1)-z_w(i,j-1,k-1)
478 delp=p(i,j-1,k-1)-p(i,j,k-1)
479 rr=0.5_r8*dh*(r(i,j,k-1)+r(i,j-1,k-1)- &
480 & cff2*dh*(d(i,j,k-1)-d(i,j-1,k-1)))
483 IF (limtr.gt.eps*rr)
THEN
488 fc(i,k-1)=0.5_r8*dh* &
489 & (p(i,j,k-1)+p(i,j-1,k-1)+ &
491 & (r(i,j,k-1)-r(i,j-1,k-1)- &
492 & cff3*dh*(d(i,j,k-1)+d(i,j-1,k-1))))
493 rv(i,j,k,nrhs)=(cff*(hz(i,j-1,k)+hz(i,j,k))* &
494 & (z_w(i,j-1,n(ng))-z_w(i,j,n(ng)))+ &
495 & cff1*(fx(i,j-1,k)-fx(i,j,k)+ &
496 & fc(i,k)-fc(i,k-1)))*om_v(i,j)
498 rv(i,j,k,nrhs)=rv(i,j,k,nrhs)*vmask_wet(i,j)
501 diarv(i,j,k,nrhs,
m3pgrd)=rv(i,j,k,nrhs)