ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
rp_u2dbc_mod Module Reference

Functions/Subroutines

subroutine, public rp_u2dbc (ng, tile, kout)
 
subroutine, public rp_u2dbc_tile (ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, krhs, kstp, kout, ubar, vbar, zeta, tl_ubar, tl_vbar, tl_zeta)
 

Function/Subroutine Documentation

◆ rp_u2dbc()

subroutine, public rp_u2dbc_mod::rp_u2dbc ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) kout )

Definition at line 28 of file rp_u2dbc_im.F.

29!***********************************************************************
30!
31 USE mod_param
32 USE mod_ocean
33 USE mod_stepping
34!
35! Imported variable declarations.
36!
37 integer, intent(in) :: ng, tile, kout
38!
39! Local variable declarations.
40!
41# include "tile.h"
42!
43 CALL rp_u2dbc_tile (ng, tile, &
44 & lbi, ubi, lbj, ubj, &
45 & imins, imaxs, jmins, jmaxs, &
46 & krhs(ng), kstp(ng), kout, &
47 & ocean(ng) % ubar, &
48 & ocean(ng) % vbar, &
49 & ocean(ng) % zeta, &
50 & ocean(ng) % tl_ubar, &
51 & ocean(ng) % tl_vbar, &
52 & ocean(ng) % tl_zeta)
53
54 RETURN
mod_ocean
Definition mod_ocean.F:2
mod_ocean::ocean
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
mod_param
Definition mod_param.F:2
mod_stepping
Definition mod_stepping.F:2
mod_stepping::kstp
integer, dimension(:), allocatable kstp
Definition mod_stepping.F:66
mod_stepping::krhs
integer, dimension(:), allocatable krhs
Definition mod_stepping.F:65

References mod_stepping::krhs, mod_stepping::kstp, mod_ocean::ocean, and rp_u2dbc_tile().

Here is the call graph for this function:

◆ rp_u2dbc_tile()

subroutine, public rp_u2dbc_mod::rp_u2dbc_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) krhs,
integer, intent(in) kstp,
integer, intent(in) kout,
real(r8), dimension(lbi:,lbj:,:), intent(in) ubar,
real(r8), dimension(lbi:,lbj:,:), intent(in) vbar,
real(r8), dimension(lbi:,lbj:,:), intent(in) zeta,
real(r8), dimension(lbi:,lbj:,:), intent(inout) tl_ubar,
real(r8), dimension(lbi:,lbj:,:), intent(in) tl_vbar,
real(r8), dimension(lbi:,lbj:,:), intent(in) tl_zeta )

Definition at line 58 of file rp_u2dbc_im.F.

64!***********************************************************************
65!
66 USE mod_param
67 USE mod_boundary
68 USE mod_clima
69 USE mod_forces
70 USE mod_grid
71 USE mod_ncparam
72 USE mod_scalars
73!
74! Imported variable declarations.
75!
76 integer, intent(in) :: ng, tile
77 integer, intent(in) :: LBi, UBi, LBj, UBj
78 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
79 integer, intent(in) :: krhs, kstp, kout
80!
81# ifdef ASSUMED_SHAPE
82 real(r8), intent(in) :: ubar(LBi:,LBj:,:)
83 real(r8), intent(in) :: vbar(LBi:,LBj:,:)
84 real(r8), intent(in) :: zeta(LBi:,LBj:,:)
85 real(r8), intent(in) :: tl_vbar(LBi:,LBj:,:)
86 real(r8), intent(in) :: tl_zeta(LBi:,LBj:,:)
87
88 real(r8), intent(inout) :: tl_ubar(LBi:,LBj:,:)
89# else
90 real(r8), intent(in) :: ubar(LBi:UBi,LBj:UBj,:)
91 real(r8), intent(in) :: vbar(LBi:UBi,LBj:UBj,:)
92 real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,:)
93 real(r8), intent(in) :: tl_vbar(LBi:UBi,LBj:UBj,:)
94 real(r8), intent(in) :: tl_zeta(LBi:UBi,LBj:UBj,:)
95
96 real(r8), intent(inout) :: tl_ubar(LBi:UBi,LBj:UBj,:)
97# endif
98!
99! Local variable declarations.
100!
101 integer :: Imin, Imax
102 integer :: i, j, know
103
104 real(r8) :: Ce, Cx, Zx
105 real(r8) :: bry_pgr, bry_cor, bry_str
106 real(r8) :: cff, cff1, cff2, cff3, dt2d
107 real(r8) :: obc_in, obc_out, tau
108# if defined ATM_PRESS && defined PRESS_COMPENSATE
109 real(r8) :: OneAtm, fac
110# endif
111
112 real(r8) :: tl_Ce, tl_Cx, tl_Zx
113 real(r8) :: tl_bry_pgr, tl_bry_cor, tl_bry_str, tl_bry_val
114 real(r8) :: tl_cff, tl_cff1, tl_cff2, tl_cff3
115
116 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_grad
117
118# include "set_bounds.h"
119!
120!-----------------------------------------------------------------------
121! Set time-indices
122!-----------------------------------------------------------------------
123!
124 IF (first_2d_step) THEN
125 know=krhs
126 dt2d=dtfast(ng)
127 ELSE IF (predictor_2d_step(ng)) THEN
128 know=krhs
129 dt2d=2.0_r8*dtfast(ng)
130 ELSE
131 know=kstp
132 dt2d=dtfast(ng)
133 END IF
134# if defined ATM_PRESS && defined PRESS_COMPENSATE
135 oneatm=1013.25_r8 ! 1 atm = 1013.25 mb
136 fac=100.0_r8/(g*rho0)
137# endif
138!
139!-----------------------------------------------------------------------
140! Lateral boundary conditions at the western edge.
141!-----------------------------------------------------------------------
142!
143 IF (domain(ng)%Western_Edge(tile)) THEN
144!
145! Western edge, implicit upstream radiation condition.
146!
147 IF (tl_lbc(iwest,isubar,ng)%radiation) THEN
148 IF (iic(ng).ne.0) THEN
149 DO j=jstr,jend+1
150!^ grad(Istr,j)=ubar(Istr,j ,know)- &
151!^ & ubar(Istr,j-1,know)
152!^
153 tl_grad(istr,j)=0.0_r8
154 END DO
155 DO j=jstr,jend
156 IF (lbc_apply(ng)%west(j)) THEN
157# if defined CELERITY_READ && defined FORWARD_READ
158 IF (tl_lbc(iwest,isubar,ng)%nudging) THEN
159 IF (lnudgem2clm(ng)) THEN
160 obc_out=0.5_r8* &
161 & (clima(ng)%M2nudgcof(istr-1,j)+ &
162 & clima(ng)%M2nudgcof(istr ,j))
163 obc_in =obcfac(ng)*obc_out
164 ELSE
165 obc_out=m2obc_out(ng,iwest)
166 obc_in =m2obc_in(ng,iwest)
167 END IF
168 IF (boundary(ng)%ubar_west_Cx(j).lt.0.0_r8) THEN
169 tau=obc_in
170 ELSE
171 tau=obc_out
172 END IF
173 tau=tau*dt2d
174 END IF
175 cx=boundary(ng)%ubar_west_Cx(j)
176# ifdef RADIATION_2D
177 ce=boundary(ng)%ubar_west_Ce(j)
178# else
179 ce=0.0_r8
180# endif
181 cff=boundary(ng)%ubar_west_C2(j)
182# endif
183!^ ubar(Istr,j,kout)=(cff*ubar(Istr ,j,know)+ &
184!^ & Cx *ubar(Istr+1,j,kout)- &
185!^ & MAX(Ce,0.0_r8)*grad(Istr,j )- &
186!^ & MIN(Ce,0.0_r8)*grad(Istr,j+1))/ &
187!^ & (cff+Cx)
188!^
189 tl_ubar(istr,j,kout)=(cff*tl_ubar(istr ,j,know)+ &
190 & cx *tl_ubar(istr+1,j,kout)- &
191 & max(ce,0.0_r8)* &
192 & tl_grad(istr,j )- &
193 & min(ce,0.0_r8)* &
194 & tl_grad(istr,j+1))/ &
195 & (cff+cx)
196
197 IF (tl_lbc(iwest,isubar,ng)%nudging) THEN
198!^ ubar(Istr,j,kout)=ubar(Istr,j,kout)+ &
199!^ & tau*(BOUNDARY(ng)%ubar_west(j)- &
200!^ & ubar(Istr,j,know)) &
201!^
202 tl_ubar(istr,j,kout)=tl_ubar(istr,j,kout)- &
203 & tau*tl_ubar(istr,j,know)
204 END IF
205# ifdef MASKING
206!^ ubar(Istr,j,kout)=ubar(Istr,j,kout)* &
207!^ & GRID(ng)%umask(Istr,j)
208!^
209 tl_ubar(istr,j,kout)=tl_ubar(istr,j,kout)* &
210 & grid(ng)%umask(istr,j)
211# endif
212 END IF
213 END DO
214 END IF
215!
216! Western edge, Flather boundary condition.
217!
218 ELSE IF (tl_lbc(iwest,isubar,ng)%Flather) THEN
219 DO j=jstr,jend
220 IF (lbc_apply(ng)%west(j)) THEN
221# if defined SSH_TIDES_NOT_YET && !defined UV_TIDES_NOT_YET
222 IF (tl_lbc(iwest,isfsur,ng)%acquire) THEN
223 bry_pgr=-g*(zeta(istr,j,know)- &
224 & boundary(ng)%zeta_west(j))* &
225 & 0.5_r8*grid(ng)%pm(istr,j)
226 tl_bry_pgr=-g*(tl_zeta(istr,j,know)- &
227 & boundary(ng)%tl_zeta_west(j))* &
228 & 0.5_r8*grid(ng)%pm(istr,j)
229 ELSE
230 bry_pgr=-g*(zeta(istr ,j,know)- &
231 & zeta(istr-1,j,know))* &
232 & 0.5_r8*(grid(ng)%pm(istr-1,j)+ &
233 & grid(ng)%pm(istr ,j))
234 tl_bry_pgr=-g*(tl_zeta(istr ,j,know)- &
235 & tl_zeta(istr-1,j,know))* &
236 & 0.5_r8*(grid(ng)%pm(istr-1,j)+ &
237 & grid(ng)%pm(istr ,j))
238 END IF
239# ifdef UV_COR
240 bry_cor=0.125_r8*(vbar(istr-1,j ,know)+ &
241 & vbar(istr-1,j+1,know)+ &
242 & vbar(istr ,j ,know)+ &
243 & vbar(istr ,j+1,know))* &
244 & (grid(ng)%f(istr-1,j)+ &
245 & grid(ng)%f(istr ,j))
246 tl_bry_cor=0.125_r8*(tl_vbar(istr-1,j ,know)+ &
247 & tl_vbar(istr-1,j+1,know)+ &
248 & tl_vbar(istr ,j ,know)+ &
249 & tl_vbar(istr ,j+1,know))* &
250 & (grid(ng)%f(istr-1,j)+ &
251 & grid(ng)%f(istr ,j))
252# else
253 bry_cor=0.0_r8
254 tl_bry_cor=0.0_r8
255# endif
256 cff1=1.0_r8/(0.5_r8*(grid(ng)%h(istr-1,j)+ &
257 & zeta(istr-1,j,know)+ &
258 & grid(ng)%h(istr ,j)+ &
259 & zeta(istr ,j,know)))
260 tl_cff1=-cff1*cff1*0.5_r8*(grid(ng)%tl_h(istr-1,j)+ &
261 & tl_zeta(istr-1,j,know)+ &
262 & grid(ng)%tl_h(istr ,j)+ &
263 & tl_zeta(istr ,j,know))+ &
264# ifdef TL_IOMS
265 & 2.0_r8*cff1
266# endif
267 bry_str=cff1*(forces(ng)%sustr(istr,j)- &
268 & forces(ng)%bustr(istr,j))
269 tl_bry_str=tl_cff1*(forces(ng)%sustr(istr,j)- &
270 & forces(ng)%bustr(istr,j))+ &
271 & cff1*(forces(ng)%tl_sustr(istr,j)- &
272 & forces(ng)%tl_bustr(istr,j))- &
273# ifdef TL_IOMS
274 & bry_str
275# endif
276 cx=1.0_r8/sqrt(g*0.5_r8*(grid(ng)%h(istr-1,j)+ &
277 & zeta(istr-1,j,know)+ &
278 & grid(ng)%h(istr ,j)+ &
279 & zeta(istr ,j,know)))
280 tl_cx=-cx*cx*cx*0.25_r8*g*(grid(ng)%tl_h(istr-1,j)+ &
281 & tl_zeta(istr-1,j,know)+ &
282 & grid(ng)%tl_h(istr ,j)+ &
283 & tl_zeta(istr ,j,know))+ &
284# ifdef TL_IOMS
285 & g*0.5_r8*cx*cx*cx*(grid(ng)%h(istr-1,j)+ &
286 & zeta(istr-1,j,know)+ &
287 & grid(ng)%h(istr ,j)+ &
288 & zeta(istr ,j,know))
289# endif
290 cff2=grid(ng)%om_u(istr,j)*cx
291 tl_cff2=grid(ng)%om_u(istr,j)*tl_cx
292!^ bry_val=ubar(Istr+1,j,know)+ &
293!^ & cff2*(bry_pgr+ &
294!^ & bry_cor+ &
295!^ & bry_str)
296!^
297 tl_bry_val=tl_ubar(istr+1,j,know)+ &
298 & tl_cff2*(bry_pgr+ &
299 & bry_cor+ &
300 & bry_str)+ &
301 & cff2*(tl_bry_pgr+ &
302 & tl_bry_cor+ &
303 & tl_bry_str)- &
304# ifdef TL_IOMS
305 & cff2*(bry_pgr+bry_cor+bry_str)
306# endif
307# else
308!^ bry_val=BOUNDARY(ng)%ubar_west(j)
309!^
310 tl_bry_val=boundary(ng)%tl_ubar_west(j)
311# endif
312 cff=1.0_r8/(0.5_r8*(grid(ng)%h(istr-1,j)+ &
313 & zeta(istr-1,j,know)+ &
314 & grid(ng)%h(istr ,j)+ &
315 & zeta(istr ,j,know)))
316 tl_cff=-cff*cff*(0.5_r8*(grid(ng)%tl_h(istr-1,j)+ &
317 & tl_zeta(istr-1,j,know)+ &
318 & grid(ng)%tl_h(istr ,j)+ &
319 & tl_zeta(istr ,j,know)))+ &
320# ifdef TL_IOMS
321 & 2.0_r8*cff
322# endif
323 cx=sqrt(g*cff)
324 tl_cx=0.5_r8*g*tl_cff/cx+ &
325# ifdef TL_IOMS
326 & 0.5_r8*cx
327# endif
328# if defined ATM_PRESS && defined PRESS_COMPENSATE
329!^ ubar(Istr,j,kout)=bry_val- &
330!^ & Cx*(0.5_r8* &
331!^ & (zeta(Istr-1,j,know)+ &
332!^ & zeta(Istr ,j,know)+ &
333!^ & fac*(FORCES(ng)%Pair(Istr-1,j)+ &
334!^ & FORCES(ng)%Pair(Istr ,j)- &
335!^ & 2.0_r8*OneAtm))- &
336!^ & BOUNDARY(ng)%zeta_west(j))
337!^
338 tl_ubar(istr,j,kout)=tl_bry_val- &
339 & tl_cx* &
340 & (0.5_r8* &
341 & (zeta(istr-1,j,know)+ &
342 & zeta(istr ,j,know)+ &
343 & fac*(forces(ng)%Pair(istr-1,j)+ &
344 & forces(ng)%Pair(istr ,j)- &
345 & 2.0_r8*oneatm))- &
346 & boundary(ng)%zeta_west(j))- &
347 & cx* &
348 & (0.5_r8* &
349 & (tl_zeta(istr-1,j,know)+ &
350 & tl_zeta(istr ,j,know)))+ &
351# ifdef TL_IOMS
352 & cx* &
353 & (0.5_r8* &
354 & (zeta(istr-1,j,know)+ &
355 & zeta(istr ,j,know)+ &
356 & fac*(forces(ng)%Pair(istr-1,j)+ &
357 & forces(ng)%Pair(istr ,j)- &
358 & 2.0_r8*oneatm))- &
359 & boundary(ng)%zeta_west(j))
360# endif
361# else
362!^ ubar(Istr,j,kout)=bry_val- &
363!^ & Cx*(0.5_r8*(zeta(Istr-1,j,know)+ &
364!^ & zeta(Istr ,j,know))- &
365!^ & BOUNDARY(ng)%zeta_west(j))
366!^
367 tl_ubar(istr,j,kout)=tl_bry_val- &
368 & tl_cx* &
369 & (0.5_r8*(zeta(istr-1,j,know)+ &
370 & zeta(istr ,j,know))- &
371 & boundary(ng)%zeta_west(j))- &
372 & cx* &
373 & (0.5_r8*(tl_zeta(istr-1,j,know)+ &
374 & tl_zeta(istr ,j,know))- &
375 & boundary(ng)%tl_zeta_west(j))+ &
376# ifdef TL_IOMS
377 & cx* &
378 & (0.5_r8*(zeta(istr-1,j,know)+ &
379 & zeta(istr ,j,know))- &
380 & boundary(ng)%zeta_west(j))
381# endif
382# endif
383# ifdef MASKING
384!^ ubar(Istr,j,kout)=ubar(Istr,j,kout)* &
385!^ & GRID(ng)%umask(Istr,j)
386!^
387 tl_ubar(istr,j,kout)=tl_ubar(istr,j,kout)* &
388 & grid(ng)%umask(istr,j)
389# endif
390 END IF
391 END DO
392!
393! Western edge, Shchepetkin boundary condition (Maison et al., 2010).
394!
395 ELSE IF (tl_lbc(iwest,isubar,ng)%Shchepetkin) THEN
396 DO j=jstr,jend
397 IF (lbc_apply(ng)%west(j)) THEN
398# if defined SSH_TIDES_NOT_YET && !defined UV_TIDES_NOT_YET
399 IF (tl_lbc(iwest,isfsur,ng)%acquire) THEN
400 bry_pgr=-g*(zeta(istr,j,know)- &
401 & boundary(ng)%zeta_west(j))* &
402 & 0.5_r8*grid(ng)%pm(istr,j)
403 tl_bry_pgr=-g*(tl_zeta(istr,j,know)- &
404 & boundary(ng)%tl_zeta_west(j))* &
405 & 0.5_r8*grid(ng)%pm(istr,j)
406 ELSE
407 bry_pgr=-g*(zeta(istr ,j,know)- &
408 & zeta(istr-1,j,know))* &
409 & 0.5_r8*(grid(ng)%pm(istr-1,j)+ &
410 & grid(ng)%pm(istr ,j))
411 tl_bry_pgr=-g*(tl_zeta(istr ,j,know)- &
412 & tl_zeta(istr-1,j,know))* &
413 & 0.5_r8*(grid(ng)%pm(istr-1,j)+ &
414 & grid(ng)%pm(istr ,j))
415 END IF
416# ifdef UV_COR
417 bry_cor=0.125_r8*(vbar(istr-1,j ,know)+ &
418 & vbar(istr-1,j+1,know)+ &
419 & vbar(istr ,j ,know)+ &
420 & vbar(istr ,j+1,know))* &
421 & (grid(ng)%f(istr-1,j)+ &
422 & grid(ng)%f(istr ,j))
423 tl_bry_cor=0.125_r8*(tl_vbar(istr-1,j ,know)+ &
424 & tl_vbar(istr-1,j+1,know)+ &
425 & tl_vbar(istr ,j ,know)+ &
426 & tl_vbar(istr ,j+1,know))* &
427 & (grid(ng)%f(istr-1,j)+ &
428 & grid(ng)%f(istr ,j))
429# else
430 bry_cor=0.0_r8
431 tl_bry_cor=0.0_r8
432# endif
433 cff1=1.0_r8/(0.5_r8*(grid(ng)%h(istr-1,j)+ &
434 & zeta(istr-1,j,know)+ &
435 & grid(ng)%h(istr ,j)+ &
436 & zeta(istr ,j,know)))
437 tl_cff1=-cff1*cff1*0.5_r8*(grid(ng)%tl_h(istr-1,j)+ &
438 & tl_zeta(istr-1,j,know)+ &
439 & grid(ng)%tl_h(istr ,j)+ &
440 & tl_zeta(istr ,j,know))+ &
441# ifdef TL_IOMS
442 & 2.0_r8*cff1
443# endif
444 bry_str=cff1*(forces(ng)%sustr(istr,j)- &
445 & forces(ng)%bustr(istr,j))
446 tl_bry_str=tl_cff1*(forces(ng)%sustr(istr,j)- &
447 & forces(ng)%bustr(istr,j))+ &
448 & cff1*(forces(ng)%tl_sustr(istr,j)- &
449 & forces(ng)%tl_bustr(istr,j))- &
450# ifdef TL_IOMS
451 & bry_str
452# endif
453 cx=1.0_r8/sqrt(g*0.5_r8*(grid(ng)%h(istr-1,j)+ &
454 & zeta(istr-1,j,know)+ &
455 & grid(ng)%h(istr ,j)+ &
456 & zeta(istr ,j,know)))
457 tl_cx=-cx*cx*cx*0.25_r8*g*(grid(ng)%tl_h(istr-1,j)+ &
458 & tl_zeta(istr-1,j,know)+ &
459 & grid(ng)%tl_h(istr ,j)+ &
460 & tl_zeta(istr ,j,know))+ &
461# ifdef TL_IOMS
462 & g*0.5_r8*cx*cx*cx*(grid(ng)%h(istr-1,j)+ &
463 & zeta(istr-1,j,know)+ &
464 & grid(ng)%h(istr ,j)+ &
465 & zeta(istr ,j,know))
466# endif
467 cff2=grid(ng)%om_u(istr,j)*cx
468 tl_cff2=grid(ng)%om_u(istr,j)*tl_cx
469!^ bry_val=ubar(Istr+1,j,know)+ &
470!^ & cff2*(bry_pgr+ &
471!^ & bry_cor+ &
472!^ & bry_str)
473!^
474 tl_bry_val=tl_ubar(istr+1,j,know)+ &
475 & tl_cff2*(bry_pgr+ &
476 & bry_cor+ &
477 & bry_str)+ &
478 & cff2*(tl_bry_pgr+ &
479 & tl_bry_cor+ &
480 & tl_bry_str)- &
481# ifdef TL_IOMS
482 & cff2*(bry_pgr+bry_cor+bry_str)
483# endif
484# else
485!^ bry_val=BOUNDARY(ng)%ubar_west(j)
486!^
487 tl_bry_val=boundary(ng)%tl_ubar_west(j)
488# endif
489# ifdef WET_DRY_NOT_YET
490 cff=0.5_r8*(grid(ng)%h(istr-1,j)+ &
491 & zeta(istr-1,j,know)+ &
492 & grid(ng)%h(istr ,j)+ &
493 & zeta(istr ,j,know))
494 tl_cff=0.5_r8*(grid(ng)%tl_h(istr-1,j)+ &
495 & tl_zeta(istr-1,j,know)+ &
496 & grid(ng)%tl_h(istr ,j)+ &
497 & tl_zeta(istr ,j,know))
498# else
499 cff=0.5_r8*(grid(ng)%h(istr-1,j)+ &
500 & grid(ng)%h(istr ,j))
501 tl_cff=0.5_r8*(grid(ng)%tl_h(istr-1,j)+ &
502 & grid(ng)%tl_h(istr ,j))
503# endif
504 cff1=sqrt(g/cff)
505 tl_cff1=-0.5_r8*cff1*tl_cff/cff+ &
506# ifdef TL_IOMS
507 & 0.5_r8*cff1
508# endif
509 cx=dt2d*cff1*cff*0.5_r8*(grid(ng)%pm(istr-1,j)+ &
510 & grid(ng)%pm(istr ,j))
511 tl_cx=dt2d*0.5_r8*(grid(ng)%pm(istr-1,j)+ &
512 & grid(ng)%pm(istr ,j))* &
513 & (cff1*tl_cff+ &
514 & tl_cff1*cff)- &
515# ifdef TL_IOMS
516 & cx
517# endif
518 zx=(0.5_r8+cx)*zeta(istr ,j,know)+ &
519 & (0.5_r8-cx)*zeta(istr-1,j,know)
520 tl_zx=(0.5_r8+cx)*tl_zeta(istr ,j,know)+ &
521 & (0.5_r8-cx)*tl_zeta(istr-1,j,know)+ &
522 & tl_cx*(zeta(istr ,j,know)- &
523 & zeta(istr-1,j,know))- &
524# ifdef TL_IOMS
525 & zx ! HGA check
526# endif
527 IF (cx.gt.co) THEN
528 cff2=(1.0_r8-co/cx)**2
529 tl_cff2=2.0_r8*cff2*co*tl_cx/(cx*cx)- &
530# ifdef TL_IOMS
531 & cff2 ! HGA check
532# endif
533 cff3=zeta(istr,j,kout)+ &
534 & cx*zeta(istr-1,j,know)- &
535 & (1.0_r8+cx)*zeta(istr,j,know)
536 tl_cff3=tl_zeta(istr,j,kout)+ &
537 & cx*tl_zeta(istr-1,j,know)+ &
538 & tl_cx*(zeta(istr-1,j,know)+ &
539 & zeta(istr ,j,know))- &
540 & (1.0_r8+cx)*tl_zeta(istr,j,know)- &
541# ifdef TL_IOMS
542 & cx*zeta(istr-1,j,know)+ &
543 & (1.0_r8+cx)*zeta(istr,j,know) ! HGA check
544# endif
545 zx=zx+cff2*cff3
546 tl_zx=tl_zx+cff2*tl_cff3+ &
547 & tl_cff2*cff3- &
548# ifdef TL_IOMS
549 & cff2*cff3 ! HGA check
550# endif
551 END IF
552!^ ubar(Istr,j,kout)=0.5_r8* &
553!^ & ((1.0_r8-Cx)*ubar(Istr,j,know)+ &
554!^ & Cx*ubar(Istr+1,j,know)+ &
555!^ & bry_val- &
556!^ & cff1*(Zx-BOUNDARY(ng)%zeta_west(j)))
557!^
558 tl_ubar(istr,j,kout)=0.5_r8* &
559 & ((1.0_r8-cx)* &
560 & tl_ubar(istr,j,know)- &
561 & tl_cx*(ubar(istr ,j,know)- &
562 & ubar(istr+1,j,know))+ &
563 & cx*tl_ubar(istr+1,j,know)+ &
564 & tl_bry_val- &
565 & tl_cff1* &
566 & (zx-boundary(ng)%zeta_west(j))- &
567 & cff1*tl_zx)- &
568# ifdef TL_IOMS
569 & 0.5_r8* &
570 & ((1.0_r8-cx)*ubar(istr,j,know)+ &
571 & cx*ubar(istr+1,j,know)+ &
572 & cff1* &
573 & (zx-boundary(ng)%zeta_west(j)))
574!! ! HGA check
575# endif
576# ifdef ADJUST_BOUNDARY
577 IF (lobc(iwest,isubar,ng)) THEN
578 tl_ubar(istr,j,kout)=tl_ubar(istr,j,kout)+ &
579 & 0.5_r8*cff1* &
580 & boundary(ng)%tl_zeta_west(j)
581 END IF
582# endif
583# ifdef MASKING
584!^ ubar(Istr,j,kout)=ubar(Istr,j,kout)* &
585!^ & GRID(ng)%umask(Istr,j)
586!^
587 tl_ubar(istr,j,kout)=tl_ubar(istr,j,kout)* &
588 & grid(ng)%umask(istr,j)
589# endif
590 END IF
591 END DO
592!
593! Western edge, clamped boundary condition.
594!
595 ELSE IF (tl_lbc(iwest,isubar,ng)%clamped) THEN
596 DO j=jstr,jend
597 IF (lbc_apply(ng)%west(j)) THEN
598!^ ubar(Istr,j,kout)=BOUNDARY(ng)%ubar_west(j)
599!^
600 tl_ubar(istr,j,kout)=boundary(ng)%tl_ubar_west(j)
601# ifdef MASKING
602!^ ubar(Istr,j,kout)=ubar(Istr,j,kout)* &
603!^ & GRID(ng)%umask(Istr,j)
604!^
605 tl_ubar(istr,j,kout)=tl_ubar(istr,j,kout)* &
606 & grid(ng)%umask(istr,j)
607# endif
608 END IF
609 END DO
610!
611! Western edge, gradient boundary condition.
612!
613 ELSE IF (tl_lbc(iwest,isubar,ng)%gradient) THEN
614 DO j=jstr,jend
615 IF (lbc_apply(ng)%west(j)) THEN
616!^ ubar(Istr,j,kout)=ubar(Istr+1,j,kout)
617!^
618 tl_ubar(istr,j,kout)=tl_ubar(istr+1,j,kout)
619# ifdef MASKING
620!^ ubar(Istr,j,kout)=ubar(Istr,j,kout)* &
621!^ & GRID(ng)%umask(Istr,j)
622!^
623 tl_ubar(istr,j,kout)=tl_ubar(istr,j,kout)* &
624 & grid(ng)%umask(istr,j)
625# endif
626 END IF
627 END DO
628!
629! Western edge, reduced-physics boundary condition.
630!
631 ELSE IF (tl_lbc(iwest,isubar,ng)%reduced) THEN
632 DO j=jstr,jend
633 IF (lbc_apply(ng)%west(j)) THEN
634 IF (tl_lbc(iwest,isfsur,ng)%acquire) THEN
635!^ bry_pgr=-g*(zeta(Istr,j,know)- &
636!^ & BOUNDARY(ng)%zeta_west(j))* &
637!^ & 0.5_r8*GRID(ng)%pm(Istr,j)
638!^
639 tl_bry_pgr=-g*(tl_zeta(istr,j,know)- &
640 & boundary(ng)%tl_zeta_west(j))* &
641 & 0.5_r8*grid(ng)%pm(istr,j)
642 ELSE
643!^ bry_pgr=-g*(zeta(Istr,j,know)- &
644!^ & zeta(Istr-1,j,know))* &
645!^ & 0.5_r8*(GRID(ng)%pm(Istr-1,j)+ &
646!^ & GRID(ng)%pm(Istr ,j))
647!^
648 tl_bry_pgr=-g*(tl_zeta(istr ,j,know)- &
649 & tl_zeta(istr-1,j,know))* &
650 & 0.5_r8*(grid(ng)%pm(istr-1,j)+ &
651 & grid(ng)%pm(istr ,j))
652 END IF
653# ifdef UV_COR
654!^ bry_cor=0.125_r8*(vbar(Istr-1,j ,know)+ &
655!^ & vbar(Istr-1,j+1,know)+ &
656!^ & vbar(Istr ,j ,know)+ &
657!^ & vbar(Istr ,j+1,know))* &
658!^ & (GRID(ng)%f(Istr-1,j)+ &
659!^ & GRID(ng)%f(Istr ,j))
660!^
661 tl_bry_cor=0.125_r8*(tl_vbar(istr-1,j ,know)+ &
662 & tl_vbar(istr-1,j+1,know)+ &
663 & tl_vbar(istr ,j ,know)+ &
664 & tl_vbar(istr ,j+1,know))* &
665 & (grid(ng)%f(istr-1,j)+ &
666 & grid(ng)%f(istr ,j))
667# else
668!^ bry_cor=0.0_r8
669!^
670 tl_bry_cor=0.0_r8
671# endif
672 cff=1.0_r8/(0.5_r8*(grid(ng)%h(istr-1,j)+ &
673 & zeta(istr-1,j,know)+ &
674 & grid(ng)%h(istr ,j)+ &
675 & zeta(istr ,j,know)))
676 tl_cff=-cff*cff*0.5_r8*(grid(ng)%tl_h(istr-1,j)+ &
677 & tl_zeta(istr-1,j,know)+ &
678 & grid(ng)%tl_h(istr ,j)+ &
679 & tl_zeta(istr ,j,know))+ &
680# ifdef TL_IOMS
681 & 2.0_r8*cff
682# endif
683!^ bry_str=cff*(FORCES(ng)%sustr(Istr,j)- &
684!^ & FORCES(ng)%bustr(Istr,j))
685!^
686 tl_bry_str=tl_cff*(forces(ng)%sustr(istr,j)- &
687 & forces(ng)%bustr(istr,j))+ &
688 & cff*(forces(ng)%tl_sustr(istr,j)- &
689 & forces(ng)%tl_bustr(istr,j))- &
690# ifdef TL_IOMS
691 & cff*(forces(ng)%sustr(istr,j)- &
692 & forces(ng)%bustr(istr,j))
693# endif
694!^ ubar(Istr,j,kout)=ubar(Istr,j,know)+ &
695!^ & dt2d*(bry_pgr+ &
696!^ & bry_cor+ &
697!^ & bry_str)
698!^
699 tl_ubar(istr,j,kout)=tl_ubar(istr,j,know)+ &
700 & dt2d*(tl_bry_pgr+ &
701 & tl_bry_cor+ &
702 & tl_bry_str)
703# ifdef MASKING
704!^ ubar(Istr,j,kout)=ubar(Istr,j,kout)* &
705!^ & GRID(ng)%umask(Istr,j)
706!^
707 tl_ubar(istr,j,kout)=tl_ubar(istr,j,kout)* &
708 & grid(ng)%umask(istr,j)
709# endif
710 END IF
711 END DO
712!
713! Western edge, closed boundary condition.
714!
715 ELSE IF (tl_lbc(iwest,isubar,ng)%closed) THEN
716 DO j=jstr,jend
717 IF (lbc_apply(ng)%west(j)) THEN
718!^ ubar(Istr,j,kout)=0.0_r8
719!^
720 tl_ubar(istr,j,kout)=0.0_r8
721 END IF
722 END DO
723 END IF
724 END IF
725!
726!-----------------------------------------------------------------------
727! Lateral boundary conditions at the eastern edge.
728!-----------------------------------------------------------------------
729!
730 IF (domain(ng)%Eastern_Edge(tile)) THEN
731!
732! Eastern edge, implicit upstream radiation condition.
733!
734 IF (tl_lbc(ieast,isubar,ng)%radiation) THEN
735 IF (iic(ng).ne.0) THEN
736 DO j=jstr,jend+1
737!^ grad(Iend+1,j)=ubar(Iend+1,j ,know)- &
738!^ & ubar(Iend+1,j-1,know)
739!^
740 tl_grad(iend+1,j)=0.0_r8
741 END DO
742 DO j=jstr,jend
743 IF (lbc_apply(ng)%east(j)) THEN
744# if defined CELERITY_READ && defined FORWARD_READ
745 IF (tl_lbc(ieast,isubar,ng)%nudging) THEN
746 IF (lnudgem2clm(ng)) THEN
747 obc_out=0.5_r8* &
748 & (clima(ng)%M2nudgcof(iend ,j)+ &
749 & clima(ng)%M2nudgcof(iend+1,j))
750 obc_in =obcfac(ng)*obc_out
751 ELSE
752 obc_out=m2obc_out(ng,ieast)
753 obc_in =m2obc_in(ng,ieast)
754 END IF
755 IF (boundary(ng)%ubar_east_Cx(j).lt.0.0_r8) THEN
756 tau=obc_in
757 ELSE
758 tau=obc_out
759 END IF
760 tau=tau*dt2d
761 END IF
762 cx=boundary(ng)%ubar_east_Cx(j)
763# ifdef RADIATION_2D
764 ce=boundary(ng)%ubar_east_Ce(j)
765# else
766 ce=0.0_r8
767# endif
768 cff=boundary(ng)%ubar_east_C2(j)
769# endif
770!^ ubar(Iend+1,j,kout)=(cff*ubar(Iend+1,j,know)+ &
771!^ & Cx *ubar(Iend ,j,kout)- &
772!^ & MAX(Ce,0.0_r8)*grad(Iend+1,j )- &
773!^ & MIN(Ce,0.0_r8)*grad(Iend+1,j+1))/ &
774!^ & (cff+Cx)
775!^
776 tl_ubar(iend+1,j,kout)=(cff*tl_ubar(iend+1,j,know)+ &
777 & cx *tl_ubar(iend ,j,kout)- &
778 & max(ce,0.0_r8)* &
779 & tl_grad(iend+1,j )- &
780 & min(ce,0.0_r8)* &
781 & tl_grad(iend+1,j+1))/ &
782 & (cff+cx)
783
784 IF (tl_lbc(ieast,isubar,ng)%nudging) THEN
785!^ ubar(Iend+1,j,kout)=ubar(Iend+1,j,kout)+ &
786!^ & tau*(BOUNDARY(ng)%ubar_east(j)- &
787!^ & ubar(Iend+1,j,know))
788!^
789 tl_ubar(iend+1,j,kout)=tl_ubar(iend+1,j,kout)- &
790 & tau*tl_ubar(iend+1,j,know)
791 END IF
792# ifdef MASKING
793!^ ubar(Iend+1,j,kout)=ubar(Iend+1,j,kout)* &
794!^ & GRID(ng)%umask(Iend+1,j)
795!^
796 tl_ubar(iend+1,j,kout)=tl_ubar(iend+1,j,kout)* &
797 & grid(ng)%umask(iend+1,j)
798# endif
799 END IF
800 END DO
801 END IF
802!
803! Eastern edge, Flather boundary condition.
804!
805 ELSE IF (tl_lbc(ieast,isubar,ng)%Flather) THEN
806 DO j=jstr,jend
807 IF (lbc_apply(ng)%east(j)) THEN
808# if defined SSH_TIDES_NOT_YET && !defined UV_TIDES_NOT_YET
809 IF (tl_lbc(ieast,isfsur,ng)%acquire) THEN
810 bry_pgr=-g*(boundary(ng)%zeta_east(j)- &
811 & zeta(iend,j,know))* &
812 & 0.5_r8*grid(ng)%pm(iend,j)
813 tl_bry_pgr=-g*(boundary(ng)%tl_zeta_east(j)- &
814 & tl_zeta(iend,j,know))* &
815 & 0.5_r8*grid(ng)%pm(iend,j)
816 ELSE
817 bry_pgr=-g*(zeta(iend+1,j,know)- &
818 & zeta(iend ,j,know))* &
819 & 0.5_r8*(grid(ng)%pm(iend ,j)+ &
820 & grid(ng)%pm(iend+1,j))
821 tl_bry_pgr=-g*(tl_zeta(iend+1,j,know)- &
822 & tl_zeta(iend ,j,know))* &
823 & 0.5_r8*(grid(ng)%pm(iend ,j)+ &
824 & grid(ng)%pm(iend+1,j))
825 END IF
826# ifdef UV_COR
827 bry_cor=0.125_r8*(vbar(iend ,j ,know)+ &
828 & vbar(iend ,j+1,know)+ &
829 & vbar(iend+1,j ,know)+ &
830 & vbar(iend+1,j+1,know))* &
831 & (grid(ng)%f(iend ,j)+ &
832 & grid(ng)%f(iend+1,j))
833 tl_bry_cor=0.125_r8*(tl_vbar(iend ,j ,know)+ &
834 & tl_vbar(iend ,j+1,know)+ &
835 & tl_vbar(iend+1,j ,know)+ &
836 & tl_vbar(iend+1,j+1,know))* &
837 & (grid(ng)%f(iend ,j)+ &
838 & grid(ng)%f(iend+1,j))
839# else
840 bry_cor=0.0_r8
841 tl_bry_cor=0.0_r8
842# endif
843 cff1=1.0_r8/(0.5_r8*(grid(ng)%h(iend ,j)+ &
844 & zeta(iend ,j,know)+ &
845 & grid(ng)%h(iend+1,j)+ &
846 & zeta(iend+1,j,know)))
847 tl_cff1=-cff1*cff1*0.5_r8*(grid(ng)%tl_h(iend ,j)+ &
848 & tl_zeta(iend ,j,know)+ &
849 & grid(ng)%tl_h(iend+1,j)+ &
850 & tl_zeta(iend+1,j,know))+ &
851# ifdef TL_IOMS
852 & 2.0_r8*cff1
853# endif
854 bry_str=cff1*(forces(ng)%sustr(iend+1,j)- &
855 & forces(ng)%bustr(iend+1,j))
856 tl_bry_str=tl_cff1*(forces(ng)%sustr(iend+1,j)- &
857 & forces(ng)%bustr(iend+1,j))+ &
858 & cff1*(forces(ng)%tl_sustr(iend+1,j)- &
859 & forces(ng)%tl_bustr(iend+1,j))- &
860# ifdef TL_IOMS
861 & bry_str
862# endif
863 cx=1.0_r8/sqrt(g*0.5_r8*(grid(ng)%h(iend+1,j)+ &
864 & zeta(iend+1,j,know)+ &
865 & grid(ng)%h(iend ,j)+ &
866 & zeta(iend ,j,know)))
867 tl_cx=-cx*cx*cx*0.25_r8*g*(grid(ng)%tl_h(iend+1,j)+ &
868 & tl_zeta(iend+1,j,know)+ &
869 & grid(ng)%tl_h(iend ,j)+ &
870 & tl_zeta(iend ,j,know))+ &
871# ifdef TL_IOMS
872 & g*0.5_r8*cx*cx*cx*(grid(ng)%h(iend+1,j)+ &
873 & zeta(iend+1,j,know)+ &
874 & grid(ng)%h(iend ,j)+ &
875 & zeta(iend ,j,know))
876# endif
877 cff2=grid(ng)%om_u(iend+1,j)*cx
878 tl_cff2=grid(ng)%om_u(iend+1,j)*tl_cx
879!^ bry_val=ubar(Iend,j,know)+ &
880!^ & cff2*(bry_pgr+ &
881!^ & bry_cor+ &
882!^ & bry_str)
883!^
884 tl_bry_val=tl_ubar(iend,j,know)+ &
885 & tl_cff2*(bry_pgr+ &
886 & bry_cor+ &
887 & bry_str)+ &
888 & cff2*(tl_bry_pgr+ &
889 & tl_bry_cor+ &
890 & tl_bry_str)-
891# ifdef TL_IOMS
892 & cff2*(bry_pgr+bry_cor+bry_str)
893# endif
894# else
895!^ bry_val=BOUNDARY(ng)%ubar_east(j)
896!^
897 tl_bry_val=boundary(ng)%tl_ubar_east(j)
898# endif
899 cff=1.0_r8/(0.5_r8*(grid(ng)%h(iend ,j)+ &
900 & zeta(iend ,j,know)+ &
901 & grid(ng)%h(iend+1,j)+ &
902 & zeta(iend+1,j,know)))
903 tl_cff=-cff*cff*(0.5_r8*(grid(ng)%tl_h(iend ,j)+ &
904 & tl_zeta(iend ,j,know)+ &
905 & grid(ng)%tl_h(iend+1,j)+ &
906 & tl_zeta(iend+1,j,know)))+ &
907# ifdef TL_IOMS
908 & 2.0_r8*cff
909# endif
910 cx=sqrt(g*cff)
911 tl_cx=0.5_r8*g*tl_cff/cx+ &
912# ifdef TL_IOMS
913 & 0.5_r8*cx
914# endif
915# if defined ATM_PRESS && defined PRESS_COMPENSATE
916!^ ubar(Iend+1,j,kout)=bry_val+ &
917!^ & Cx*(0.5_r8* &
918!^ & (zeta(Iend ,j,know)+ &
919!^ & zeta(Iend+1,j,know)+ &
920!^ & fac*(FORCES(ng)%Pair(Iend ,j)+ &
921!^ & FORCES(ng)%Pair(Iend+1,j)- &
922!^ & 2.0_r8*OneAtm))- &
923!^ & BOUNDARY(ng)%zeta_east(j))
924!^
925 tl_ubar(iend+1,j,kout)=tl_bry_val+ &
926 & tl_cx* &
927 & (0.5_r8* &
928 & (zeta(iend ,j,know)+ &
929 & zeta(iend+1,j,know)+ &
930 & fac*(forces(ng)%Pair(iend ,j)+ &
931 & forces(ng)%Pair(iend+1,j)- &
932 & 2.0_r8*oneatm))- &
933 & boundary(ng)%zeta_east(j))+ &
934 & cx* &
935 & (0.5_r8*(tl_zeta(iend ,j,know)+ &
936 & tl_zeta(iend+1,j,know)))- &
937# ifdef TL_IOMS
938 & cx* &
939 & (0.5_r8* &
940 & (zeta(iend ,j,know)+ &
941 & zeta(iend+1,j,know)+ &
942 & fac*(forces(ng)%Pair(iend ,j)+ &
943 & forces(ng)%Pair(iend+1,j)- &
944 & 2.0_r8*oneatm))- &
945 & boundary(ng)%zeta_east(j))
946# endif
947# else
948!^ ubar(Iend+1,j,kout)=bry_val+ &
949!^ & Cx*(0.5_r8*(zeta(Iend ,j,know)+ &
950!^ & zeta(Iend+1,j,know))- &
951!^ & BOUNDARY(ng)%zeta_east(j))
952!^
953 tl_ubar(iend+1,j,kout)=tl_bry_val+ &
954 & tl_cx* &
955 & (0.5_r8*(zeta(iend ,j,know)+ &
956 & zeta(iend+1,j,know))- &
957 & boundary(ng)%zeta_east(j))+ &
958 & cx* &
959 & (0.5_r8*(tl_zeta(iend ,j,know)+ &
960 & tl_zeta(iend+1,j,know))- &
961 & boundary(ng)%tl_zeta_east(j))- &
962# ifdef TL_IOMS
963 & cx* &
964 & (0.5_r8*(zeta(iend ,j,know)+ &
965 & zeta(iend+1,j,know))- &
966 & boundary(ng)%zeta_east(j))
967# endif
968# endif
969# ifdef MASKING
970!^ & ubar(Iend+1,j,kout)=ubar(Iend+1,j,kout)* &
971!^ & GRID(ng)%umask(Iend+1,j)
972!^
973 tl_ubar(iend+1,j,kout)=tl_ubar(iend+1,j,kout)* &
974 & grid(ng)%umask(iend+1,j)
975# endif
976 END IF
977 END DO
978!
979! Eastern edge, Shchepetkin boundary condition (Maison et al., 2010).
980!
981 ELSE IF (tl_lbc(ieast,isubar,ng)%Shchepetkin) THEN
982 DO j=jstr,jend
983 IF (lbc_apply(ng)%east(j)) THEN
984# if defined SSH_TIDES_NOT_YET && !defined UV_TIDES_NOT_YET
985 IF (tl_lbc(ieast,isfsur,ng)%acquire) THEN
986 bry_pgr=-g*(boundary(ng)%zeta_east(j)- &
987 & zeta(iend,j,know))* &
988 & 0.5_r8*grid(ng)%pm(iend,j)
989 tl_bry_pgr=-g*(boundary(ng)%tl_zeta_east(j)- &
990 & tl_zeta(iend,j,know))* &
991 & 0.5_r8*grid(ng)%pm(iend,j)
992 ELSE
993 bry_pgr=-g*(zeta(iend+1,j,know)- &
994 & zeta(iend ,j,know))* &
995 & 0.5_r8*(grid(ng)%pm(iend ,j)+ &
996 & grid(ng)%pm(iend+1,j))
997 tl_bry_pgr=-g*(tl_zeta(iend+1,j,know)- &
998 & tl_zeta(iend ,j,know))* &
999 & 0.5_r8*(grid(ng)%pm(iend ,j)+ &
1000 & grid(ng)%pm(iend+1,j))
1001 END IF
1002# ifdef UV_COR
1003 bry_cor=0.125_r8*(vbar(iend ,j ,know)+ &
1004 & vbar(iend ,j+1,know)+ &
1005 & vbar(iend+1,j ,know)+ &
1006 & vbar(iend+1,j+1,know))* &
1007 & (grid(ng)%f(iend ,j)+ &
1008 & grid(ng)%f(iend+1,j))
1009 tl_bry_cor=0.125_r8*(tl_vbar(iend ,j ,know)+ &
1010 & tl_vbar(iend ,j+1,know)+ &
1011 & tl_vbar(iend+1,j ,know)+ &
1012 & tl_vbar(iend+1,j+1,know))* &
1013 & (grid(ng)%f(iend ,j)+ &
1014 & grid(ng)%f(iend+1,j))
1015# else
1016 bry_cor=0.0_r8
1017 tl_bry_cor=0.0_r8
1018# endif
1019 cff1=1.0_r8/(0.5_r8*(grid(ng)%h(iend ,j)+ &
1020 & zeta(iend ,j,know)+ &
1021 & grid(ng)%h(iend+1,j)+ &
1022 & zeta(iend+1,j,know)))
1023 tl_cff1=-cff1*cff1*0.5_r8*(grid(ng)%tl_h(iend ,j)+ &
1024 & tl_zeta(iend ,j,know)+ &
1025 & grid(ng)%tl_h(iend+1,j)+ &
1026 & tl_zeta(iend+1,j,know))+ &
1027# ifdef TL_IOMS
1028 & 2.0_r8*cff1
1029# endif
1030 bry_str=cff1*(forces(ng)%sustr(iend+1,j)- &
1031 & forces(ng)%bustr(iend+1,j))
1032 tl_bry_str=tl_cff1*(forces(ng)%sustr(iend+1,j)- &
1033 & forces(ng)%bustr(iend+1,j))+ &
1034 & cff1*(forces(ng)%tl_sustr(iend+1,j)- &
1035 & forces(ng)%tl_bustr(iend+1,j))- &
1036# ifdef TL_IOMS
1037 & bry_str
1038# endif
1039 cx=1.0_r8/sqrt(g*0.5_r8*(grid(ng)%h(iend+1,j)+ &
1040 & zeta(iend+1,j,know)+ &
1041 & grid(ng)%h(iend ,j)+ &
1042 & zeta(iend ,j,know)))
1043 tl_cx=-cx*cx*cx*0.25_r8*g*(grid(ng)%tl_h(iend+1,j)+ &
1044 & tl_zeta(iend+1,j,know)+ &
1045 & grid(ng)%tl_h(iend ,j)+ &
1046 & tl_zeta(iend ,j,know))+ &
1047# ifdef TL_IOMS
1048 & g*0.5_r8*cx*cx*cx*(grid(ng)%h(iend+1,j)+ &
1049 & zeta(iend+1,j,know)+ &
1050 & grid(ng)%h(iend ,j)+ &
1051 & zeta(iend ,j,know))
1052# endif
1053 cff2=grid(ng)%om_u(iend+1,j)*cx
1054 tl_cff2=grid(ng)%om_u(iend+1,j)*tl_cx
1055!^ bry_val=ubar(Iend,j,know)+ &
1056!^ & cff2*(bry_pgr+ &
1057!^ & bry_cor+ &
1058!^ & bry_str)
1059!^
1060 tl_bry_val=tl_ubar(iend,j,know)+ &
1061 & tl_cff2*(bry_pgr+ &
1062 & bry_cor+ &
1063 & bry_str)+ &
1064 & cff2*(tl_bry_pgr+ &
1065 & tl_bry_cor+ &
1066 & tl_bry_str)-
1067# ifdef TL_IOMS
1068 & cff2*(bry_pgr+bry_cor+bry_str)
1069# endif
1070# else
1071!^ bry_val=BOUNDARY(ng)%ubar_east(j)
1072!^
1073 tl_bry_val=boundary(ng)%tl_ubar_east(j)
1074# endif
1075# ifdef WET_DRY_NOT_YET
1076 cff=0.5_r8*(grid(ng)%h(iend ,j)+ &
1077 & zeta(iend ,j,know)+ &
1078 & grid(ng)%h(iend+1,j)+ &
1079 & zeta(iend+1,j,know))
1080 tl_cff=0.5_r8*(grid(ng)%tl_h(iend ,j)+ &
1081 & tl_zeta(iend ,j,know)+ &
1082 & grid(ng)%tl_h(iend+1,j)+ &
1083 & tl_zeta(iend+1,j,know))
1084# else
1085 cff=0.5_r8*(grid(ng)%h(iend ,j)+ &
1086 & grid(ng)%h(iend+1,j))
1087 tl_cff=0.5_r8*(grid(ng)%tl_h(iend ,j)+ &
1088 & grid(ng)%tl_h(iend+1,j))
1089# endif
1090 cff1=sqrt(g/cff)
1091 tl_cff1=-0.5_r8*cff1*tl_cff/cff+ &
1092# ifdef TL_IOMS
1093 & 0.5_r8*cff1
1094# endif
1095 cx=dt2d*cff1*cff*0.5_r8*(grid(ng)%pm(iend ,j)+ &
1096 & grid(ng)%pm(iend+1,j))
1097 tl_cx=dt2d*0.5_r8*(grid(ng)%pm(iend ,j)+ &
1098 & grid(ng)%pm(iend+1,j))* &
1099 & (cff1*tl_cff+ &
1100 & tl_cff1*cff)- &
1101# ifdef TL_IOMS
1102 & cx
1103# endif
1104 zx=(0.5_r8+cx)*zeta(iend ,j,know)+ &
1105 & (0.5_r8-cx)*zeta(iend+1,j,know)
1106 tl_zx=(0.5_r8+cx)*tl_zeta(iend ,j,know)+ &
1107 & (0.5_r8-cx)*tl_zeta(iend+1,j,know)+ &
1108 & tl_cx*(zeta(iend ,j,know)- &
1109 & zeta(iend+1,j,know))- &
1110# ifdef TL_IOMS
1111 & zx ! HGA check
1112# endif
1113 IF (cx.gt.co) THEN
1114 cff2=(1.0_r8-co/cx)**2
1115 tl_cff2=2.0_r8*cff2*co*tl_cx/(cx*cx)- &
1116# ifdef TL_IOMS
1117 & cff2 ! HGA check
1118# endif
1119 cff3=zeta(iend,j,kout)+ &
1120 & cx*zeta(iend+1,j,know)- &
1121 & (1.0_r8+cx)*zeta(iend,j,know)
1122 tl_cff3=tl_zeta(iend,j,kout)+ &
1123 & cx*tl_zeta(iend+1,j,know)+ &
1124 & tl_cx*(zeta(iend ,j,know)+ &
1125 & zeta(iend+1,j,know))- &
1126 & (1.0_r8+cx)*tl_zeta(iend,j,know)- &
1127# ifdef TL_IOMS
1128 & cx*zeta(istr-1,j,know)+ &
1129 & (1.0_r8+cx)*zeta(istr,j,know) ! HGA check
1130# endif
1131 zx=zx+cff2*cff3
1132 tl_zx=tl_zx+cff2*tl_cff3+ &
1133 & tl_cff2*cff3- &
1134# ifdef TL_IOMS
1135 & cff2*cff3 ! HGA check
1136# endif
1137 END IF
1138!^ ubar(Iend+1,j,kout)=0.5_r8* &
1139!^ & ((1.0_r8-Cx)*ubar(Iend+1,j,know)+ &
1140!^ & Cx*ubar(Iend,j,know)+ &
1141!^ & bry_val+ &
1142!^ & cff1*(Zx-BOUNDARY(ng)%zeta_east(j)))
1143!^
1144 tl_ubar(iend+1,j,kout)=0.5_r8* &
1145 & ((1.0_r8-cx)* &
1146 & tl_ubar(iend+1,j,know)+ &
1147 & tl_cx*(ubar(iend ,j,know)- &
1148 & ubar(iend+1,j,know))+ &
1149 & cx*tl_ubar(iend,j,know)+ &
1150 & tl_bry_val+ &
1151 & tl_cff1* &
1152 & (zx-boundary(ng)%zeta_east(j))- &
1153 & cff1*tl_zx)- &
1154# ifdef TL_IOMS
1155 & 0.5_r8* &
1156 & ((1.0_r8-cx)*ubar(iend+1,j,know)+ &
1157 & cx*ubar(iend,j,know)+ &
1158 & cff1* &
1159 & (zx-boundary(ng)%zeta_east(j)))
1160!! ! HGA check
1161# endif
1162# ifdef ADJUST_BOUNDARY
1163 IF (lobc(ieast,isubar,ng)) THEN
1164 tl_ubar(iend+1,j,kout)=tl_ubar(iend+1,j,kout)- &
1165 & 0.5_r8*cff1* &
1166 & boundary(ng)%tl_zeta_east(j)
1167 END IF
1168# endif
1169# ifdef MASKING
1170!^ & ubar(Iend+1,j,kout)=ubar(Iend+1,j,kout)* &
1171!^ & GRID(ng)%umask(Iend+1,j)
1172!^
1173 tl_ubar(iend+1,j,kout)=tl_ubar(iend+1,j,kout)* &
1174 & grid(ng)%umask(iend+1,j)
1175# endif
1176 END IF
1177 END DO
1178!
1179! Eastern edge, clamped boundary condition.
1180!
1181 ELSE IF (tl_lbc(ieast,isubar,ng)%clamped) THEN
1182 DO j=jstr,jend
1183 IF (lbc_apply(ng)%east(j)) THEN
1184!^ ubar(Iend+1,j,kout)=BOUNDARY(ng)%ubar_east(j)
1185!^
1186 tl_ubar(iend+1,j,kout)=boundary(ng)%tl_ubar_east(j)
1187# ifdef MASKING
1188!^ ubar(Iend+1,j,kout)=ubar(Iend+1,j,kout)* &
1189!^ & GRID(ng)%umask(Iend+1,j)
1190!^
1191 tl_ubar(iend+1,j,kout)=tl_ubar(iend+1,j,kout)* &
1192 & grid(ng)%umask(iend+1,j)
1193# endif
1194 END IF
1195 END DO
1196!
1197! Eastern edge, gradient boundary condition.
1198!
1199 ELSE IF (tl_lbc(ieast,isubar,ng)%gradient) THEN
1200 DO j=jstr,jend
1201 IF (lbc_apply(ng)%east(j)) THEN
1202!^ ubar(Iend+1,j,kout)=ubar(Iend,j,kout)
1203!^
1204 tl_ubar(iend+1,j,kout)=tl_ubar(iend,j,kout)
1205# ifdef MASKING
1206!^ ubar(Iend+1,j,kout)=ubar(Iend+1,j,kout)* &
1207!^ & GRID(ng)%umask(Iend+1,j)
1208!^
1209 tl_ubar(iend+1,j,kout)=tl_ubar(iend+1,j,kout)* &
1210 & grid(ng)%umask(iend+1,j)
1211# endif
1212 END IF
1213 END DO
1214!
1215! Eastern edge, reduced-physics boundary condition.
1216!
1217 ELSE IF (tl_lbc(ieast,isubar,ng)%reduced) THEN
1218 DO j=jstr,jend
1219 IF (lbc_apply(ng)%east(j)) THEN
1220 IF (tl_lbc(ieast,isfsur,ng)%acquire) THEN
1221!^ bry_pgr=-g*(BOUNDARY(ng)%zeta_east(j)- &
1222!^ & zeta(Iend,j,know))* &
1223!^ & 0.5_r8*GRID(ng)%pm(Iend,j)
1224!^
1225 tl_bry_pgr=-g*(boundary(ng)%tl_zeta_east(j)- &
1226 & tl_zeta(iend,j,know))* &
1227 & 0.5_r8*grid(ng)%pm(iend,j)
1228 ELSE
1229!^ bry_pgr=-g*(zeta(Iend+1,j,know)- &
1230!^ & zeta(Iend ,j,know))* &
1231!^ & 0.5_r8*(GRID(ng)%pm(Iend ,j)+ &
1232!^ & GRID(ng)%pm(Iend+1,j))
1233!^
1234 tl_bry_pgr=-g*(tl_zeta(iend+1,j,know)- &
1235 & tl_zeta(iend ,j,know))* &
1236 & 0.5_r8*(grid(ng)%pm(iend ,j)+ &
1237 & grid(ng)%pm(iend+1,j))
1238 END IF
1239# ifdef UV_COR
1240!^ bry_cor=0.125_r8*(vbar(Iend ,j ,know)+ &
1241!^ & vbar(Iend ,j+1,know)+ &
1242!^ & vbar(Iend+1,j ,know)+ &
1243!^ & vbar(Iend+1,j+1,know))* &
1244!^ & (GRID(ng)%f(Iend ,j)+ &
1245!^ & GRID(ng)%f(Iend+1,j))
1246!^
1247 tl_bry_cor=0.125_r8*(tl_vbar(iend, j ,know)+ &
1248 & tl_vbar(iend ,j+1,know)+ &
1249 & tl_vbar(iend+1,j ,know)+ &
1250 & tl_vbar(iend+1,j+1,know))* &
1251 & (grid(ng)%f(iend ,j)+ &
1252 & grid(ng)%f(iend+1,j))
1253# else
1254!^ bry_cor=0.0_r8
1255!^
1256 tl_bry_cor=0.0_r8
1257# endif
1258 cff=1.0_r8/(0.5_r8*(grid(ng)%h(iend ,j)+ &
1259 & zeta(iend ,j,know)+ &
1260 & grid(ng)%h(iend+1,j)+ &
1261 & zeta(iend+1,j,know)))
1262 tl_cff=-cff*cff*0.5_r8*(grid(ng)%tl_h(iend ,j)+ &
1263 & tl_zeta(iend ,j,know)+ &
1264 & grid(ng)%tl_h(iend+1,j)+ &
1265 & tl_zeta(iend+1,j,know))+ &
1266# ifdef TL_IOMS
1267 & 2.0_r8*cff
1268# endif
1269!^ bry_str=cff*(FORCES(ng)%sustr(Iend+1,j)- &
1270!^ & FORCES(ng)%bustr(Iend+1,j))
1271!^
1272 tl_bry_str=tl_cff*(forces(ng)%sustr(iend+1,j)- &
1273 & forces(ng)%bustr(iend+1,j))+ &
1274 & cff*(forces(ng)%tl_sustr(iend+1,j)- &
1275 & forces(ng)%tl_bustr(iend+1,j))- &
1276# ifdef TL_IOMS
1277 & cff*(forces(ng)%sustr(iend+1,j)- &
1278 & forces(ng)%bustr(iend+1,j))
1279# endif
1280!^ ubar(Iend+1,j,kout)=ubar(Iend+1,j,know)+ &
1281!^ & dt2d*(bry_pgr+ &
1282!^ & bry_cor+ &
1283!^ & bry_str)
1284!^
1285 tl_ubar(iend+1,j,kout)=tl_ubar(iend+1,j,know)+ &
1286 & dt2d*(tl_bry_pgr+ &
1287 & tl_bry_cor+ &
1288 & tl_bry_str)
1289# ifdef MASKING
1290!^ ubar(Iend+1,j,kout)=ubar(Iend+1,j,kout)* &
1291!^ & GRID(ng)%umask(Iend+1,j)
1292!^
1293 tl_ubar(iend+1,j,kout)=tl_ubar(iend+1,j,kout)* &
1294 & grid(ng)%umask(iend+1,j)
1295# endif
1296 END IF
1297 END DO
1298!
1299! Eastern edge, closed boundary condition.
1300!
1301 ELSE IF (tl_lbc(ieast,isubar,ng)%closed) THEN
1302 DO j=jstr,jend
1303 IF (lbc_apply(ng)%east(j)) THEN
1304!^ ubar(Iend+1,j,kout)=0.0_r8
1305!^
1306 tl_ubar(iend+1,j,kout)=0.0_r8
1307 END IF
1308 END DO
1309 END IF
1310 END IF
1311!
1312!-----------------------------------------------------------------------
1313! Lateral boundary conditions at the southern edge.
1314!-----------------------------------------------------------------------
1315!
1316 IF (domain(ng)%Southern_Edge(tile)) THEN
1317!
1318! Southern edge, implicit upstream radiation condition.
1319!
1320 IF (tl_lbc(isouth,isubar,ng)%radiation) THEN
1321 IF (iic(ng).ne.0) THEN
1322 DO i=istru-1,iend
1323!^ grad(i,Jstr-1)=ubar(i+1,Jstr-1,know)- &
1324!^ & ubar(i ,Jstr-1,know)
1325!^
1326 tl_grad(i,jstr-1)=0.0_r8
1327 END DO
1328 DO i=istru,iend
1329 IF (lbc_apply(ng)%south(i)) THEN
1330# if defined CELERITY_READ && defined FORWARD_READ
1331 IF (tl_lbc(isouth,isubar,ng)%nudging) THEN
1332 IF (lnudgem2clm(ng)) THEN
1333 obc_out=0.5_r8* &
1334 & (clima(ng)%M2nudgcof(i-1,jstr-1)+ &
1335 & clima(ng)%M2nudgcof(i ,jstr-1))
1336 obc_in =obcfac(ng)*obc_out
1337 ELSE
1338 obc_out=m2obc_out(ng,isouth)
1339 obc_in =m2obc_in(ng,isouth)
1340 END IF
1341 IF (boundary(ng)%ubar_south_Ce(i).lt.0.0_r8) THEN
1342 tau=obc_in
1343 ELSE
1344 tau=obc_out
1345 END IF
1346 tau=tau*dt2d
1347 END IF
1348# ifdef RADIATION_2D
1349 cx=boundary(ng)%ubar_south_Cx(i)
1350# else
1351 cx=0.0_r8
1352# endif
1353 ce=boundary(ng)%ubar_south_Ce(i)
1354 cff=boundary(ng)%ubar_south_C2(i)
1355# endif
1356!^ ubar(i,Jstr-1,kout)=(cff*ubar(i,Jstr-1,know)+ &
1357!^ & Ce *ubar(i,Jstr ,kout)- &
1358!^ & MAX(Cx,0.0_r8)*grad(i-1,Jstr-1)- &
1359!^ & MIN(Cx,0.0_r8)*grad(i ,Jstr-1))/ &
1360!^ & (cff+Ce)
1361!^
1362 tl_ubar(i,jstr-1,kout)=(cff*tl_ubar(i,jstr-1,know)+ &
1363 & ce *tl_ubar(i,jstr ,kout)- &
1364 & max(cx,0.0_r8)* &
1365 & tl_grad(i-1,jstr-1)- &
1366 & min(cx,0.0_r8)* &
1367 & tl_grad(i ,jstr-1))/ &
1368 & (cff+ce)
1369
1370 IF (tl_lbc(isouth,isubar,ng)%nudging) THEN
1371!^ ubar(i,Jstr-1,kout)=ubar(i,Jstr-1,kout)+ &
1372!^ & tau*(BOUNDARY(ng)%ubar_south(i)- &
1373!^ & ubar(i,Jstr-1,know))
1374!^
1375 tl_ubar(i,jstr-1,kout)=tl_ubar(i,jstr-1,kout)- &
1376 & tau*tl_ubar(i,jstr-1,know)
1377 END IF
1378# ifdef MASKING
1379!^ ubar(i,Jstr-1,kout)=ubar(i,Jstr-1,kout)* &
1380!^ & GRID(ng)%umask(i,Jstr-1)
1381!^
1382 tl_ubar(i,jstr-1,kout)=tl_ubar(i,jstr-1,kout)* &
1383 & grid(ng)%umask(i,jstr-1)
1384# endif
1385 END IF
1386 END DO
1387 END IF
1388!
1389! Southern edge, Chapman boundary condition.
1390!
1391 ELSE IF (tl_lbc(isouth,isubar,ng)%Flather.or. &
1392 & tl_lbc(isouth,isubar,ng)%reduced.or. &
1393 & tl_lbc(isouth,isubar,ng)%Shchepetkin) THEN
1394 DO i=istru,iend
1395 IF (lbc_apply(ng)%south(i)) THEN
1396 cff=dt2d*0.5_r8*(grid(ng)%pn(i-1,jstr)+ &
1397 & grid(ng)%pn(i ,jstr))
1398 cff1=sqrt(g*0.5_r8*(grid(ng)%h(i-1,jstr)+ &
1399 & zeta(i-1,jstr,know)+ &
1400 & grid(ng)%h(i ,jstr)+ &
1401 & zeta(i ,jstr,know)))
1402 tl_cff1=0.25_r8*g*(grid(ng)%tl_h(i-1,jstr)+ &
1403 & tl_zeta(i-1,jstr,know)+ &
1404 & grid(ng)%tl_h(i ,jstr)+ &
1405 & tl_zeta(i ,jstr,know))/cff1+ &
1406# ifdef TL_IOMS
1407 & 0.5_r8*cff1
1408# endif
1409 ce=cff*cff1
1410 tl_ce=cff*tl_cff1
1411 cff2=1.0_r8/(1.0_r8+ce)
1412 tl_cff2=-cff2*cff2*tl_ce+ &
1413# ifdef TL_IOMS
1414 & cff2*cff2*(1.0_r8+2.0_r8*ce)
1415# endif
1416!^ ubar(i,Jstr-1,kout)=cff2*(ubar(i,Jstr-1,know)+ &
1417!^ & Ce*ubar(i,Jstr,kout))
1418!^
1419 tl_ubar(i,jstr-1,kout)=tl_cff2*(ubar(i,jstr-1,know)+ &
1420 & ce*ubar(i,jstr,kout))+ &
1421 & cff2*(tl_ubar(i,jstr-1,know)+ &
1422 & tl_ce*ubar(i,jstr,kout)+ &
1423 & ce*tl_ubar(i,jstr,kout))- &
1424# ifdef TL_IOMS
1425 & cff2*(ubar(i,jstr-1,know)+ &
1426 & 2.0_r8*ce*ubar(i,jstr,kout))
1427# endif
1428# ifdef MASKING
1429!^ ubar(i,Jstr-1,kout)=ubar(i,Jstr-1,kout)* &
1430!^ & GRID(ng)%umask(i,Jstr-1)
1431!^
1432 tl_ubar(i,jstr-1,kout)=tl_ubar(i,jstr-1,kout)* &
1433 & grid(ng)%umask(i,jstr-1)
1434# endif
1435 END IF
1436 END DO
1437!
1438! Southern edge, clamped boundary condition.
1439!
1440 ELSE IF (tl_lbc(isouth,isubar,ng)%clamped) THEN
1441 DO i=istru,iend
1442 IF (lbc_apply(ng)%south(i)) THEN
1443!^ ubar(i,Jstr-1,kout)=BOUNDARY(ng)%ubar_south(i)
1444!^
1445 tl_ubar(i,jstr-1,kout)=boundary(ng)%tl_ubar_south(i)
1446# ifdef MASKING
1447!^ ubar(i,Jstr-1,kout)=ubar(i,Jstr-1,kout)* &
1448!^ & GRID(ng)%umask(i,Jstr-1)
1449!^
1450 tl_ubar(i,jstr-1,kout)=tl_ubar(i,jstr-1,kout)* &
1451 & grid(ng)%umask(i,jstr-1)
1452# endif
1453 END IF
1454 END DO
1455!
1456! Southern edge, gradient boundary condition.
1457!
1458 ELSE IF (tl_lbc(isouth,isubar,ng)%gradient) THEN
1459 DO i=istru,iend
1460 IF (lbc_apply(ng)%south(i)) THEN
1461!^ ubar(i,Jstr-1,kout)=ubar(i,Jstr,kout)
1462!^
1463 tl_ubar(i,jstr-1,kout)=tl_ubar(i,jstr,kout)
1464# ifdef MASKING
1465!^ ubar(i,Jstr-1,kout)=ubar(i,Jstr-1,kout)* &
1466!^ & GRID(ng)%umask(i,Jstr-1)
1467!^
1468 tl_ubar(i,jstr-1,kout)=tl_ubar(i,jstr-1,kout)* &
1469 & grid(ng)%umask(i,jstr-1)
1470# endif
1471 END IF
1472 END DO
1473!
1474! Southern edge, closed boundary condition: free slip (gamma2=1) or
1475! no slip (gamma2=-1).
1476!
1477 ELSE IF (tl_lbc(isouth,isubar,ng)%closed) THEN
1478 IF (ewperiodic(ng)) THEN
1479 imin=istru
1480 imax=iend
1481 ELSE
1482 imin=istr
1483 imax=iendr
1484 END IF
1485 DO i=imin,imax
1486 IF (lbc_apply(ng)%south(i)) THEN
1487!^ ubar(i,Jstr-1,kout)=gamma2(ng)*ubar(i,Jstr,kout)
1488!^
1489 tl_ubar(i,jstr-1,kout)=gamma2(ng)*tl_ubar(i,jstr,kout)
1490# ifdef MASKING
1491!^ ubar(i,Jstr-1,kout)=ubar(i,Jstr-1,kout)* &
1492!^ & GRID(ng)%umask(i,Jstr-1)
1493!^
1494 tl_ubar(i,jstr-1,kout)=tl_ubar(i,jstr-1,kout)* &
1495 & grid(ng)%umask(i,jstr-1)
1496# endif
1497 END IF
1498 END DO
1499 END IF
1500 END IF
1501!
1502!-----------------------------------------------------------------------
1503! Lateral boundary conditions at the northern edge.
1504!-----------------------------------------------------------------------
1505!
1506 IF (domain(ng)%Northern_Edge(tile)) THEN
1507!
1508! Northern edge, implicit upstream radiation condition.
1509!
1510 IF (tl_lbc(inorth,isubar,ng)%radiation) THEN
1511 IF (iic(ng).ne.0) THEN
1512 DO i=istru-1,iend
1513!^ grad(i,Jend+1)=ubar(i+1,Jend+1,know)- &
1514!^ & ubar(i ,Jend+1,know)
1515!^
1516 tl_grad(i,jend+1)=0.0_r8
1517 END DO
1518 DO i=istru,iend
1519 IF (lbc_apply(ng)%north(i)) THEN
1520# if defined CELERITY_READ && defined FORWARD_READ
1521 IF (tl_lbc(inorth,isubar,ng)%nudging) THEN
1522 IF (lnudgem2clm(ng)) THEN
1523 obc_out=0.5_r8* &
1524 & (clima(ng)%M2nudgcof(i-1,jend+1)+ &
1525 & clima(ng)%M2nudgcof(i ,jend+1))
1526 obc_in =obcfac(ng)*obc_out
1527 ELSE
1528 obc_out=m2obc_out(ng,inorth)
1529 obc_in =m2obc_in(ng,inorth)
1530 END IF
1531 IF (boundary(ng)%ubar_north_Ce(i).lt.0.0_r8) THEN
1532 tau=obc_in
1533 ELSE
1534 tau=obc_out
1535 END IF
1536 tau=tau*dt2d
1537 END IF
1538# ifdef RADIATION_2D
1539 cx=boundary(ng)%ubar_north_Cx(i)
1540# else
1541 cx=0.0_r8
1542# endif
1543 ce=boundary(ng)%ubar_north_Ce(i)
1544 cff=boundary(ng)%ubar_north_C2(i)
1545# endif
1546!^ ubar(i,Jend+1,kout)=(cff*ubar(i,Jend+1,know)+ &
1547!^ & Ce *ubar(i,Jend ,kout)- &
1548!^ & MAX(Cx,0.0_r8)*grad(i-1,Jend+1)- &
1549!^ & MIN(Cx,0.0_r8)*grad(i ,Jend+1))/ &
1550!^ & (cff+Ce)
1551!^
1552 tl_ubar(i,jend+1,kout)=(cff*tl_ubar(i,jend+1,know)+ &
1553 & ce *tl_ubar(i,jend ,kout)- &
1554 & max(cx,0.0_r8)* &
1555 & tl_grad(i-1,jend+1)- &
1556 & min(cx,0.0_r8)* &
1557 & tl_grad(i ,jend+1))/ &
1558 & (cff+ce)
1559
1560 IF (tl_lbc(inorth,isubar,ng)%nudging) THEN
1561!^ ubar(i,Jend+1,kout)=ubar(i,Jend+1,kout)+ &
1562!^ & tau*(BOUNDARY(ng)%ubar_north(i)- &
1563!^ & ubar(i,Jend+1,know))
1564!^
1565 tl_ubar(i,jend+1,kout)=tl_ubar(i,jend+1,kout)- &
1566 & tau*tl_ubar(i,jend+1,know)
1567 END IF
1568# ifdef MASKING
1569!^ ubar(i,Jend+1,kout)=ubar(i,Jend+1,kout)* &
1570!^ & GRID(ng)%umask(i,Jend+1)
1571!^
1572 tl_ubar(i,jend+1,kout)=tl_ubar(i,jend+1,kout)* &
1573 & grid(ng)%umask(i,jend+1)
1574# endif
1575 END IF
1576 END DO
1577 END IF
1578!
1579! Northern edge, Chapman boundary condition.
1580!
1581 ELSE IF (tl_lbc(inorth,isubar,ng)%Flather.or. &
1582 & tl_lbc(inorth,isubar,ng)%reduced.or. &
1583 & tl_lbc(inorth,isubar,ng)%Shchepetkin) THEN
1584 DO i=istru,iend
1585 IF (lbc_apply(ng)%north(i)) THEN
1586 cff=dt2d*0.5_r8*(grid(ng)%pn(i-1,jend)+ &
1587 & grid(ng)%pn(i ,jend))
1588 cff1=sqrt(g*0.5_r8*(grid(ng)%h(i-1,jend)+ &
1589 & zeta(i-1,jend,know)+ &
1590 & grid(ng)%h(i ,jend)+ &
1591 & zeta(i ,jend,know)))
1592 tl_cff1=0.25_r8*g*(grid(ng)%tl_h(i-1,jend)+ &
1593 & tl_zeta(i-1,jend,know)+ &
1594 & grid(ng)%tl_h(i ,jend)+ &
1595 & tl_zeta(i ,jend,know))/cff1+ &
1596# ifdef TL_IOMS
1597 & 0.5_r8*cff1
1598# endif
1599 ce=cff*cff1
1600 tl_ce=cff*tl_cff1
1601 cff2=1.0_r8/(1.0_r8+ce)
1602 tl_cff2=-cff2*cff2*tl_ce+ &
1603# ifdef TL_IOMS
1604 & cff2*cff2*(1.0_r8+2.0_r8*ce)
1605# endif
1606!^ ubar(i,Jend+1,kout)=cff2*(ubar(i,Jend+1,know)+ &
1607!^ & Ce*ubar(i,Jend,kout))
1608!^
1609 tl_ubar(i,jend+1,kout)=tl_cff2*(ubar(i,jend+1,know)+ &
1610 & ce*ubar(i,jend,kout))+ &
1611 & cff2*(tl_ubar(i,jend+1,know)+ &
1612 & tl_ce*ubar(i,jend,kout)+ &
1613 & ce*tl_ubar(i,jend,kout))- &
1614# ifdef TL_IOMS
1615 & cff2*(ubar(i,jend+1,know)+ &
1616 & 2.0_r8*ce*ubar(i,jend,kout))
1617# endif
1618# ifdef MASKING
1619!^ ubar(i,Jend+1,kout)=ubar(i,Jend+1,kout)* &
1620!^ & GRID(ng)%umask(i,Jend+1)
1621!^
1622 tl_ubar(i,jend+1,kout)=tl_ubar(i,jend+1,kout)* &
1623 & grid(ng)%umask(i,jend+1)
1624# endif
1625 END IF
1626 END DO
1627!
1628! Northern edge, clamped boundary condition.
1629!
1630 ELSE IF (tl_lbc(inorth,isubar,ng)%clamped) THEN
1631 DO i=istru,iend
1632 IF (lbc_apply(ng)%north(i)) THEN
1633!^ ubar(i,Jend+1,kout)=BOUNDARY(ng)%ubar_north(i)
1634!^
1635 tl_ubar(i,jend+1,kout)=boundary(ng)%tl_ubar_north(i)
1636# ifdef MASKING
1637!^ ubar(i,Jend+1,kout)=ubar(i,Jend+1,kout)* &
1638!^ & GRID(ng)%umask(i,Jend+1)
1639!^
1640 tl_ubar(i,jend+1,kout)=tl_ubar(i,jend+1,kout)* &
1641 & grid(ng)%umask(i,jend+1)
1642# endif
1643 END IF
1644 END DO
1645!
1646! Northern edge, gradient boundary condition.
1647!
1648 ELSE IF (tl_lbc(inorth,isubar,ng)%gradient) THEN
1649 DO i=istru,iend
1650 IF (lbc_apply(ng)%north(i)) THEN
1651!^ ubar(i,Jend+1,kout)=ubar(i,Jend,kout)
1652!^
1653 tl_ubar(i,jend+1,kout)=tl_ubar(i,jend,kout)
1654# ifdef MASKING
1655!^ ubar(i,Jend+1,kout)=ubar(i,Jend+1,kout)* &
1656!^ & GRID(ng)%umask(i,Jend+1)
1657!^
1658 tl_ubar(i,jend+1,kout)=tl_ubar(i,jend+1,kout)* &
1659 & grid(ng)%umask(i,jend+1)
1660# endif
1661 END IF
1662 END DO
1663!
1664! Northern edge, closed boundary condition: free slip (gamma2=1) or
1665! no slip (gamma2=-1).
1666!
1667 ELSE IF (tl_lbc(inorth,isubar,ng)%closed) THEN
1668 IF (ewperiodic(ng)) THEN
1669 imin=istru
1670 imax=iend
1671 ELSE
1672 imin=istr
1673 imax=iendr
1674 END IF
1675 DO i=imin,imax
1676 IF (lbc_apply(ng)%north(i)) THEN
1677!^ ubar(i,Jend+1,kout)=gamma2(ng)*ubar(i,Jend,kout)
1678!^
1679 tl_ubar(i,jend+1,kout)=gamma2(ng)*tl_ubar(i,jend,kout)
1680
1681# ifdef MASKING
1682!^ ubar(i,Jend+1,kout)=ubar(i,Jend+1,kout)* &
1683!^ & GRID(ng)%GRID(ng)%umask(i,Jend+1)
1684!^
1685 tl_ubar(i,jend+1,kout)=tl_ubar(i,jend+1,kout)* &
1686 & grid(ng)%umask(i,jend+1)
1687# endif
1688 END IF
1689 END DO
1690 END IF
1691 END IF
1692!
1693!-----------------------------------------------------------------------
1694! Boundary corners.
1695!-----------------------------------------------------------------------
1696!
1697 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
1698 IF (domain(ng)%SouthWest_Corner(tile)) THEN
1699 IF (lbc_apply(ng)%south(istr ).and. &
1700 & lbc_apply(ng)%west (jstr-1)) THEN
1701!^ ubar(Istr,Jstr-1,kout)=0.5_r8*(ubar(Istr+1,Jstr-1,kout)+ &
1702!^ & ubar(Istr ,Jstr ,kout))
1703!^
1704 tl_ubar(istr,jstr-1,kout)=0.5_r8* &
1705 & (tl_ubar(istr+1,jstr-1,kout)+ &
1706 & tl_ubar(istr ,jstr ,kout))
1707 END IF
1708 END IF
1709 IF (domain(ng)%SouthEast_Corner(tile)) THEN
1710 IF (lbc_apply(ng)%south(iend+1).and. &
1711 & lbc_apply(ng)%east (jstr-1)) THEN
1712!^ ubar(Iend+1,Jstr-1,kout)=0.5_r8*(ubar(Iend ,Jstr-1,kout)+ &
1713!^ & ubar(Iend+1,Jstr ,kout))
1714!^
1715 tl_ubar(iend+1,jstr-1,kout)=0.5_r8* &
1716 & (tl_ubar(iend ,jstr-1,kout)+ &
1717 & tl_ubar(iend+1,jstr ,kout))
1718 END IF
1719 END IF
1720 IF (domain(ng)%NorthWest_Corner(tile)) THEN
1721 IF (lbc_apply(ng)%north(istr ).and. &
1722 & lbc_apply(ng)%west (jend+1)) THEN
1723!^ ubar(Istr,Jend+1,kout)=0.5_r8*(ubar(Istr ,Jend ,kout)+ &
1724!^ & ubar(Istr+1,Jend+1,kout))
1725!^
1726 tl_ubar(istr,jend+1,kout)=0.5_r8* &
1727 & (tl_ubar(istr ,jend ,kout)+ &
1728 & tl_ubar(istr+1,jend+1,kout))
1729 END IF
1730 END IF
1731 IF (domain(ng)%NorthEast_Corner(tile)) THEN
1732 IF (lbc_apply(ng)%north(iend+1).and. &
1733 & lbc_apply(ng)%east (jend+1)) THEN
1734!^ ubar(Iend+1,Jend+1,kout)=0.5_r8*(ubar(Iend+1,Jend ,kout)+ &
1735!^ & ubar(Iend ,Jend+1,kout))
1736!^
1737 tl_ubar(iend+1,jend+1,kout)=0.5_r8* &
1738 & (tl_ubar(iend+1,jend ,kout)+ &
1739 & tl_ubar(iend ,jend+1,kout))
1740 END IF
1741 END IF
1742 END IF
1743
1744# if defined WET_DRY_NOT_YET
1745!
1746!-----------------------------------------------------------------------
1747! Impose wetting and drying conditions.
1748!
1749! HGA: need RPM code here.
1750!-----------------------------------------------------------------------
1751!
1752 IF (.not.ewperiodic(ng)) THEN
1753 IF (domain(ng)%Western_Edge(tile)) THEN
1754 DO j=jstr,jend
1755 IF (lbc_apply(ng)%west(j).or. &
1756 & lbc(iwest,isubar,ng)%nested) THEN
1757!^ cff1=ABS(ABS(GRID(ng)%umask_wet(Istr,j))-1.0_r8)
1758!^ cff2=0.5_r8+DSIGN(0.5_r8,ubar(Istr,j,kout))* &
1759!^ & GRID(ng)%umask_wet(Istr,j)
1760!^ cff=0.5_r8*GRID(ng)%umask_wet(Istr,j)*cff1+ &
1761!^ & cff2*(1.0_r8-cff1)
1762!^ ubar(Istr,j,kout)=ubar(Istr,j,kout)*cff
1763 END IF
1764 END DO
1765 END IF
1766 IF (domain(ng)%Eastern_Edge(tile)) THEN
1767 DO j=jstr,jend
1768 IF (lbc_apply(ng)%east(j).or. &
1769 & lbc(ieast,isubar,ng)%nested) THEN
1770!^ cff1=ABS(ABS(GRID(ng)%umask_wet(Iend+1,j))-1.0_r8)
1771!^ cff2=0.5_r8+DSIGN(0.5_r8,ubar(Iend+1,j,kout))* &
1772!^ & GRID(ng)%umask_wet(Iend+1,j)
1773!^ cff=0.5_r8*GRID(ng)%umask_wet(Iend+1,j)*cff1+ &
1774!^ & cff2*(1.0_r8-cff1)
1775!^ ubar(Iend+1,j,kout)=ubar(Iend+1,j,kout)*cff
1776 END IF
1777 END DO
1778 END IF
1779 END IF
1780!
1781 IF (.not.nsperiodic(ng)) THEN
1782 IF (domain(ng)%Southern_Edge(tile)) THEN
1783 DO i=istru,iend
1784 IF (lbc_apply(ng)%south(i).or. &
1785 & lbc(isouth,isubar,ng)%nested) THEN
1786!^ cff1=ABS(ABS(GRID(ng)%umask_wet(i,Jstr-1))-1.0_r8)
1787!^ cff2=0.5_r8+DSIGN(0.5_r8,ubar(i,Jstr-1,kout))* &
1788!^ & GRID(ng)%umask_wet(i,Jstr-1)
1789!^ cff=0.5_r8*GRID(ng)%umask_wet(i,Jstr-1)*cff1+ &
1790!^ & cff2*(1.0_r8-cff1)
1791!^ ubar(i,Jstr-1,kout)=ubar(i,Jstr-1,kout)*cff
1792 END IF
1793 END DO
1794 END IF
1795 IF (domain(ng)%Northern_Edge(tile)) THEN
1796 DO i=istr,iend
1797 IF (lbc_apply(ng)%north(i).or. &
1798 & lbc(inorth,isubar,ng)%nested) THEN
1799!^ cff1=ABS(ABS(GRID(ng)%umask_wet(i,Jend+1))-1.0_r8)
1800!^ cff2=0.5_r8+DSIGN(0.5_r8,ubar(i,Jend+1,kout))* &
1801!^ & GRID(ng)%umask_wet(i,Jend+1)
1802!^ cff=0.5_r8*GRID(ng)%umask_wet(i,Jend+1)*cff1+ &
1803!^ & cff2*(1.0_r8-cff1)
1804!^ ubar(i,Jend+1,kout)=ubar(i,Jend+1,kout)*cff
1805 END IF
1806 END DO
1807 END IF
1808 END IF
1809!
1810 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
1811 IF (domain(ng)%SouthWest_Corner(tile)) THEN
1812 IF ((lbc_apply(ng)%south(istr ).and. &
1813 & lbc_apply(ng)%west (jstr-1)).or. &
1814 & (lbc(iwest,isubar,ng)%nested.and. &
1815 & lbc(isouth,isubar,ng)%nested)) THEN
1816!^ cff1=ABS(ABS(GRID(ng)%umask_wet(Istr,Jstr-1))-1.0_r8)
1817!^ cff2=0.5_r8+DSIGN(0.5_r8,ubar(Istr,Jstr-1,kout))* &
1818!^ & GRID(ng)%umask_wet(Istr,Jstr-1)
1819!^ cff=0.5_r8*GRID(ng)%umask_wet(Istr,Jstr-1)*cff1+ &
1820!^ & cff2*(1.0_r8-cff1)
1821!^ ubar(Istr,Jstr-1,kout)=ubar(Istr,Jstr-1,kout)*cff
1822 END IF
1823 END IF
1824 IF (domain(ng)%SouthEast_Corner(tile)) THEN
1825 IF ((lbc_apply(ng)%south(iend+1).and. &
1826 & lbc_apply(ng)%east (jstr-1)).or. &
1827 & (lbc(ieast,isubar,ng)%nested.and. &
1828 & lbc(isouth,isubar,ng)%nested)) THEN
1829!^ cff1=ABS(ABS(GRID(ng)%umask_wet(Iend+1,Jstr-1))-1.0_r8)
1830!^ cff2=0.5_r8+DSIGN(0.5_r8,ubar(Iend+1,Jstr-1,kout))* &
1831!^ & GRID(ng)%umask_wet(Iend+1,Jstr-1)
1832!^ cff=0.5_r8*GRID(ng)%umask_wet(Iend+1,Jstr-1)*cff1+ &
1833!^ & cff2*(1.0_r8-cff1)
1834!^ ubar(Iend+1,Jstr-1,kout)=ubar(Iend+1,Jstr-1,kout)*cff
1835 END IF
1836 END IF
1837 IF (domain(ng)%NorthWest_Corner(tile)) THEN
1838 IF ((lbc_apply(ng)%north(istr ).and. &
1839 & lbc_apply(ng)%west (jend+1)).or. &
1840 & (lbc(iwest,isubar,ng)%nested.and. &
1841 & lbc(inorth,isubar,ng)%nested)) THEN
1842!^ cff1=ABS(ABS(GRID(ng)%umask_wet(Istr,Jend+1))-1.0_r8)
1843!^ cff2=0.5_r8+DSIGN(0.5_r8,ubar(Istr,Jend+1,kout))* &
1844!^ & GRID(ng)%umask_wet(Istr,Jend+1)
1845!^ cff=0.5_r8*GRID(ng)%umask_wet(Istr,Jend+1)*cff1+ &
1846!^ & cff2*(1.0_r8-cff1)
1847!^ ubar(Istr,Jend+1,kout)=ubar(Istr,Jend+1,kout)*cff
1848 END IF
1849 END IF
1850 IF (domain(ng)%NorthEast_Corner(tile)) THEN
1851 IF ((lbc_apply(ng)%north(iend+1).and. &
1852 & lbc_apply(ng)%east (jend+1)).or. &
1853 & (lbc(ieast,isubar,ng)%nested.and. &
1854 & lbc(inorth,isubar,ng)%nested)) THEN
1855!^ cff1=ABS(ABS(GRID(ng)%umask_wet(Iend+1,Jend+1))-1.0_r8)
1856!^ cff2=0.5_r8+DSIGN(0.5_r8,ubar(Iend+1,Jend+1,kout))* &
1857!^ & GRID(ng)%umask_wet(Iend+1,Jend+1)
1858!^ cff=0.5_r8*GRID(ng)%umask_wet(Iend+1,Jend+1)*cff1+ &
1859!^ & cff2*(1.0_r8-cff1)
1860!^ ubar(Iend+1,Jend+1,kout)=ubar(Iend+1,Jend+1,kout)*cff
1861 END IF
1862 END IF
1863 END IF
1864# endif
1865!
1866 RETURN
mod_boundary
Definition mod_boundary.F:2
mod_boundary::boundary
type(t_boundary), dimension(:), allocatable boundary
Definition mod_boundary.F:746
mod_boundary::lbc_apply
type(t_apply), dimension(:), allocatable lbc_apply
Definition mod_boundary.F:394
mod_clima
Definition mod_clima.F:2
mod_clima::clima
type(t_clima), dimension(:), allocatable clima
Definition mod_clima.F:153
mod_forces
Definition mod_forces.F:2
mod_forces::forces
type(t_forces), dimension(:), allocatable forces
Definition mod_forces.F:554
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::isfsur
integer isfsur
Definition mod_ncparam.F:503
mod_ncparam::isubar
integer isubar
Definition mod_ncparam.F:504
mod_param::tl_lbc
type(t_lbc), dimension(:,:,:), allocatable tl_lbc
Definition mod_param.F:379
mod_param::lbc
type(t_lbc), dimension(:,:,:), allocatable lbc
Definition mod_param.F:375
mod_param::domain
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
mod_scalars
Definition mod_scalars.F:2
mod_scalars::co
real(r8) co
Definition mod_scalars.F:648
mod_scalars::lnudgem2clm
logical, dimension(:), allocatable lnudgem2clm
Definition mod_scalars.F:533
mod_scalars::iic
integer, dimension(:), allocatable iic
Definition mod_scalars.F:249
mod_scalars::lobc
logical, dimension(:,:,:), allocatable lobc
Definition mod_scalars.F:1127
mod_scalars::ewperiodic
logical, dimension(:), allocatable ewperiodic
Definition mod_scalars.F:510
mod_scalars::iwest
integer, parameter iwest
Definition mod_scalars.F:1432
mod_scalars::nsperiodic
logical, dimension(:), allocatable nsperiodic
Definition mod_scalars.F:511
mod_scalars::predictor_2d_step
logical, dimension(:), allocatable predictor_2d_step
Definition mod_scalars.F:245
mod_scalars::obcfac
real(dp), dimension(:), allocatable obcfac
Definition mod_scalars.F:1437
mod_scalars::gamma2
real(r8), dimension(:), allocatable gamma2
Definition mod_scalars.F:743
mod_scalars::isouth
integer, parameter isouth
Definition mod_scalars.F:1433
mod_scalars::dtfast
real(dp), dimension(:), allocatable dtfast
Definition mod_scalars.F:270
mod_scalars::m2obc_out
real(dp), dimension(:,:), allocatable m2obc_out
Definition mod_scalars.F:1441
mod_scalars::ieast
integer, parameter ieast
Definition mod_scalars.F:1434
mod_scalars::g
real(dp) g
Definition mod_scalars.F:464
mod_scalars::rho0
real(dp) rho0
Definition mod_scalars.F:787
mod_scalars::inorth
integer, parameter inorth
Definition mod_scalars.F:1435
mod_scalars::m2obc_in
real(dp), dimension(:,:), allocatable m2obc_in
Definition mod_scalars.F:1440

References mod_boundary::boundary, mod_clima::clima, mod_scalars::co, mod_param::domain, mod_scalars::dtfast, mod_scalars::ewperiodic, mod_forces::forces, mod_scalars::g, mod_scalars::gamma2, mod_grid::grid, mod_scalars::ieast, mod_scalars::iic, mod_scalars::inorth, mod_ncparam::isfsur, mod_scalars::isouth, mod_ncparam::isubar, mod_scalars::iwest, mod_param::lbc, mod_boundary::lbc_apply, mod_scalars::lnudgem2clm, mod_scalars::lobc, mod_scalars::m2obc_in, mod_scalars::m2obc_out, mod_scalars::nsperiodic, mod_scalars::obcfac, mod_scalars::predictor_2d_step, mod_scalars::rho0, and mod_param::tl_lbc.

Referenced by rp_ini_fields_mod::rp_ini_fields_tile(), rp_step2d_mod::rp_step2d_tile(), rp_step2d_mod::rp_step2d_tile(), rp_step2d_mod::rp_step2d_tile(), and rp_u2dbc().

Here is the caller graph for this function: