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

Functions/Subroutines

subroutine, public ad_v2dbc (ng, tile, kout)
 
subroutine, public ad_v2dbc_tile (ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, krhs, kstp, kout, ubar, vbar, zeta, ad_ubar, ad_vbar, ad_zeta)
 

Function/Subroutine Documentation

◆ ad_v2dbc()

subroutine, public ad_v2dbc_mod::ad_v2dbc ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) kout )

Definition at line 28 of file ad_v2dbc_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 ad_v2dbc_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) % ad_ubar, &
51 & ocean(ng) % ad_vbar, &
52 & ocean(ng) % ad_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 ad_v2dbc_tile(), mod_stepping::krhs, mod_stepping::kstp, and mod_ocean::ocean.

Here is the call graph for this function:

◆ ad_v2dbc_tile()

subroutine, public ad_v2dbc_mod::ad_v2dbc_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) ad_ubar,
real(r8), dimension(lbi:,lbj:,:), intent(inout) ad_vbar,
real(r8), dimension(lbi:,lbj:,:), intent(inout) ad_zeta )

Definition at line 59 of file ad_v2dbc_im.F.

65!***********************************************************************
66!
67 USE mod_param
68 USE mod_boundary
69 USE mod_clima
70 USE mod_forces
71 USE mod_grid
72 USE mod_ncparam
73 USE mod_scalars
74!
75! Imported variable declarations.
76!
77 integer, intent(in) :: ng, tile
78 integer, intent(in) :: LBi, UBi, LBj, UBj
79 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
80 integer, intent(in) :: krhs, kstp, kout
81!
82# ifdef ASSUMED_SHAPE
83 real(r8), intent(in) :: ubar(LBi:,LBj:,:)
84 real(r8), intent(in) :: vbar(LBi:,LBj:,:)
85 real(r8), intent(in) :: zeta(LBi:,LBj:,:)
86
87 real(r8), intent(inout) :: ad_ubar(LBi:,LBj:,:)
88 real(r8), intent(inout) :: ad_vbar(LBi:,LBj:,:)
89 real(r8), intent(inout) :: ad_zeta(LBi:,LBj:,:)
90# else
91 real(r8), intent(in) :: ubar(LBi:UBi,LBj:UBj,:)
92 real(r8), intent(in) :: vbar(LBi:UBi,LBj:UBj,:)
93 real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,:)
94
95 real(r8), intent(inout) :: ad_ubar(LBi:UBi,LBj:UBj,:)
96 real(r8), intent(inout) :: ad_vbar(LBi:UBi,LBj:UBj,:)
97 real(r8), intent(inout) :: ad_zeta(LBi:UBi,LBj:UBj,:)
98# endif
99!
100! Local variable declarations.
101!
102 integer :: Jmin, Jmax
103 integer :: i, j, know
104
105 real(r8) :: Ce, Cx, Ze
106 real(r8) :: bry_pgr, bry_cor, bry_str, bry_val
107 real(r8) :: cff, cff1, cff2, cff3, dt2d
108 real(r8) :: obc_in, obc_out, tau
109# if defined ATM_PRESS && defined PRESS_COMPENSATE
110 real(r8) :: OneAtm, fac
111# endif
112
113 real(r8) :: ad_Ce, ad_Cx
114 real(r8) :: ad_bry_pgr, ad_bry_cor, ad_bry_str, ad_bry_val, ad_Ze
115 real(r8) :: ad_cff, ad_cff1, ad_cff2, ad_cff3
116 real(r8) :: adfac
117
118 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ad_grad
119
120# include "set_bounds.h"
121!
122!-----------------------------------------------------------------------
123! Initialize adjoint private variables.
124!-----------------------------------------------------------------------
125!
126 ad_ce=0.0_r8
127 ad_cx=0.0_r8
128 ad_ze=0.0_r8
129 ad_cff=0.0_r8
130 ad_cff1=0.0_r8
131 ad_cff2=0.0_r8
132 ad_cff3=0.0_r8
133 ad_bry_pgr=0.0_r8
134 ad_bry_cor=0.0_r8
135 ad_bry_str=0.0_r8
136 ad_bry_val=0.0_r8
137
138 ad_grad(lbi:ubi,lbj:ubj)=0.0_r8
139!
140!-----------------------------------------------------------------------
141! Set time-indices
142!-----------------------------------------------------------------------
143!
144 IF (first_2d_step) THEN
145 know=krhs
146 dt2d=dtfast(ng)
147 ELSE IF (predictor_2d_step(ng)) THEN
148 know=krhs
149 dt2d=2.0_r8*dtfast(ng)
150 ELSE
151 know=kstp
152 dt2d=dtfast(ng)
153 END IF
154# if defined ATM_PRESS && defined PRESS_COMPENSATE
155 oneatm=1013.25_r8 ! 1 atm = 1013.25 mb
156 fac=100.0_r8/(g*rho0)
157# endif
158
159# if defined WET_DRY_NOT_YET
160!
161!-----------------------------------------------------------------------
162! Impose wetting and drying conditions.
163!
164! HGA: need ADM code here for the NLM code below.
165!-----------------------------------------------------------------------
166!
167 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
168 IF (domain(ng)%NorthEast_Corner(tile)) THEN
169 IF ((lbc_apply(ng)%north(iend+1).and. &
170 & lbc_apply(ng)%east (jend+1)).or. &
171 & (lbc(ieast,isvbar,ng)%nested.and. &
172 & lbc(inorth,isvbar,ng)%nested)) THEN
173!^ cff1=ABS(ABS(GRID(ng)%vmask_wet(Iend+1,Jend+1))-1.0_r8)
174!^ cff2=0.5_r8+DSIGN(0.5_r8,vbar(Iend+1,Jend+1,kout))* &
175!^ & GRID(ng)%vmask_wet(Iend+1,Jend+1)
176!^ cff=0.5_r8*GRID(ng)%vmask_wet(Iend+1,Jend+1)*cff1+ &
177!^ & cff2*(1.0_r8-cff1)
178!^ vbar(Iend+1,Jend+1,kout)=vbar(Iend+1,Jend+1,kout)*cff
179 END IF
180 END IF
181 IF (domain(ng)%NorthWest_Corner(tile)) THEN
182 IF ((lbc_apply(ng)%north(istr-1).and. &
183 & lbc_apply(ng)%west (jend+1)).or. &
184 & (lbc(iwest,isvbar,ng)%nested.and. &
185 & lbc(inorth,isvbar,ng)%nested)) THEN
186!^ cff1=ABS(ABS(GRID(ng)%vmask_wet(Istr-1,Jend+1))-1.0_r8)
187!^ cff2=0.5_r8+DSIGN(0.5_r8,vbar(Istr-1,Jend+1,kout))* &
188!^ & GRID(ng)%vmask_wet(Istr-1,Jend+1)
189!^ cff=0.5_r8*GRID(ng)%vmask_wet(Istr-1,Jend+1)*cff1+ &
190!^ & cff2*(1.0_r8-cff1)
191!^ vbar(Istr-1,Jend+1,kout)=vbar(Istr-1,Jend+1,kout)*cff
192 END IF
193 END IF
194 IF (domain(ng)%SouthEast_Corner(tile)) THEN
195 IF ((lbc_apply(ng)%south(iend+1).and. &
196 & lbc_apply(ng)%east (jstr )).or. &
197 & (lbc(ieast,isvbar,ng)%nested.and. &
198 & lbc(isouth,isvbar,ng)%nested)) THEN
199!^ cff1=ABS(ABS(GRID(ng)%vmask_wet(Iend+1,Jstr))-1.0_r8)
200!^ cff2=0.5_r8+DSIGN(0.5_r8,vbar(Iend+1,Jstr,kout))* &
201!^ & GRID(ng)%vmask_wet(Iend+1,Jstr)
202!^ cff=0.5_r8*GRID(ng)%vmask_wet(Iend+1,Jstr)*cff1+ &
203!^ & cff2*(1.0_r8-cff1)
204!^ vbar(Iend+1,Jstr,kout)=vbar(Iend+1,Jstr,kout)*cff
205 END IF
206 END IF
207 IF (domain(ng)%SouthWest_Corner(tile)) THEN
208 IF ((lbc_apply(ng)%south(istr-1).and. &
209 & lbc_apply(ng)%west (jstr )).or. &
210 & (lbc(iwest,isvbar,ng)%nested.and. &
211 & lbc(isouth,isvbar,ng)%nested)) THEN
212!^ cff1=ABS(ABS(GRID(ng)%vmask_wet(Istr-1,Jstr))-1.0_r8)
213!^ cff2=0.5_r8+DSIGN(0.5_r8,vbar(Istr-1,Jstr,kout))* &
214!^ & GRID(ng)%vmask_wet(Istr-1,Jstr)
215!^ cff=0.5_r8*GRID(ng)%vmask_wet(Istr-1,Jstr)*cff1+ &
216!^ & cff2*(1.0_r8-cff1)
217!^ vbar(Istr-1,Jstr,kout)=vbar(Istr-1,Jstr,kout)*cff
218 END IF
219 END IF
220 END IF
221!
222 IF (.not.nsperiodic(ng)) THEN
223 IF (domain(ng)%Northern_Edge(tile)) THEN
224 DO i=istr,iend
225 IF (lbc_apply(ng)%north(i).or. &
226 & lbc(inorth,isvbar,ng)%nested) THEN
227!^ cff1=ABS(ABS(GRID(ng)%vmask_wet(i,Jend+1))-1.0_r8)
228!^ cff2=0.5_r8+DSIGN(0.5_r8,vbar(i,Jend+1,kout))* &
229!^ & GRID(ng)%vmask_wet(i,Jend+1)
230!^ cff=0.5_r8*GRID(ng)%vmask_wet(i,Jend+1)*cff1+ &
231!^ & cff2*(1.0_r8-cff1)
232!^ vbar(i,Jend+1,kout)=vbar(i,Jend+1,kout)*cff
233 END IF
234 END DO
235 END IF
236 IF (domain(ng)%Southern_Edge(tile)) THEN
237 DO i=istr,iend
238 IF (lbc_apply(ng)%south(i).or. &
239 & lbc(isouth,isvbar,ng)%nested) THEN
240!^ cff1=ABS(ABS(GRID(ng)%vmask_wet(i,Jstr))-1.0_r8)
241!^ cff2=0.5_r8+DSIGN(0.5_r8,vbar(i,Jstr,kout))* &
242!^ & GRID(ng)%vmask_wet(i,Jstr)
243!^ cff=0.5_r8*GRID(ng)%vmask_wet(i,Jstr)*cff1+ &
244!^ & cff2*(1.0_r8-cff1)
245!^ vbar(i,Jstr,kout)=vbar(i,Jstr,kout)*cff
246 END IF
247 END DO
248 END IF
249 END IF
250!
251 IF (.not.ewperiodic(ng)) THEN
252 IF (domain(ng)%Eastern_Edge(tile)) THEN
253 DO j=jstrv,jend
254 IF (lbc_apply(ng)%east(j).or. &
255 & lbc(ieast,isvbar,ng)%nested) THEN
256!^ cff1=ABS(ABS(GRID(ng)%vmask_wet(Iend+1,j))-1.0_r8)
257!^ cff2=0.5_r8+DSIGN(0.5_r8,vbar(Iend+1,j,kout))* &
258!^ & GRID(ng)%vmask_wet(Iend+1,j)
259!^ cff=0.5_r8*GRID(ng)%vmask_wet(Iend+1,j)*cff1+ &
260!^ & cff2*(1.0_r8-cff1)
261!^ vbar(Iend+1,j,kout)=vbar(Iend+1,j,kout)*cff
262 END IF
263 END DO
264 END IF
265 IF (domain(ng)%Western_Edge(tile)) THEN
266 DO j=jstrv,jend
267 IF (lbc_apply(ng)%west(j).or. &
268 & lbc(iwest,isvbar,ng)%nested) THEN
269!^ cff1=ABS(ABS(GRID(ng)%vmask_wet(Istr-1,j))-1.0_r8)
270!^ cff2=0.5_r8+DSIGN(0.5_r8,vbar(Istr-1,j,kout))* &
271!^ & GRID(ng)%vmask_wet(Istr-1,j)
272!^ cff=0.5_r8*GRID(ng)%vmask_wet(Istr-1,j)*cff1+ &
273!^ & cff2*(1.0_r8-cff1)
274!^ vbar(Istr,j,kout)=vbar(Istr,j,kout)*cff
275 END IF
276 END DO
277 END IF
278 ENDIF
279# endif
280!
281!-----------------------------------------------------------------------
282! Boundary corners.
283!-----------------------------------------------------------------------
284!
285 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
286 IF (domain(ng)%NorthEast_Corner(tile)) THEN
287 IF (lbc_apply(ng)%north(iend+1).and. &
288 & lbc_apply(ng)%east (jend+1)) THEN
289!^ tl_vbar(Iend+1,Jend+1,kout)=0.5_r8* &
290!^ & (tl_vbar(Iend+1,Jend ,kout)+ &
291!^ & tl_vbar(Iend ,Jend+1,kout))
292!^
293 adfac=0.5_r8*ad_vbar(iend+1,jend+1,kout)
294 ad_vbar(iend+1,jend ,kout)=ad_vbar(iend+1,jend ,kout)+ &
295 & adfac
296 ad_vbar(iend ,jend+1,kout)=ad_vbar(iend ,jend+1,kout)+ &
297 & adfac
298 ad_vbar(iend+1,jend+1,kout)=0.0_r8
299 END IF
300 END IF
301 IF (domain(ng)%NorthWest_Corner(tile)) THEN
302 IF (lbc_apply(ng)%north(istr-1).and. &
303 & lbc_apply(ng)%west (jend+1)) THEN
304!^ tl_vbar(Istr-1,Jend+1,kout)=0.5_r8* &
305!^ & (tl_vbar(Istr-1,Jend ,kout)+ &
306!^ & tl_vbar(Istr ,Jend+1,kout))
307!^
308 adfac=0.5_r8*ad_vbar(istr-1,jend+1,kout)
309 ad_vbar(istr-1,jend ,kout)=ad_vbar(istr-1,jend ,kout)+ &
310 & adfac
311 ad_vbar(istr ,jend+1,kout)=ad_vbar(istr ,jend+1,kout)+ &
312 & adfac
313 ad_vbar(istr-1,jend+1,kout)=0.0_r8
314 END IF
315 END IF
316 IF (domain(ng)%SouthEast_Corner(tile)) THEN
317 IF (lbc_apply(ng)%south(iend+1).and. &
318 & lbc_apply(ng)%east (jstr )) THEN
319!^ tl_vbar(Iend+1,Jstr,kout)=0.5_r8* &
320!^ & (tl_vbar(Iend ,Jstr ,kout)+ &
321!^ & tl_vbar(Iend+1,Jstr+1,kout))
322!^
323 adfac=0.5_r8*ad_vbar(iend+1,jstr,kout)
324 ad_vbar(iend ,jstr ,kout)=ad_vbar(iend ,jstr ,kout)+ &
325 & adfac
326 ad_vbar(iend+1,jstr+1,kout)=ad_vbar(iend+1,jstr+1,kout)+ &
327 & adfac
328 ad_vbar(iend+1,jstr ,kout)=0.0_r8
329 END IF
330 END IF
331 IF (domain(ng)%SouthWest_Corner(tile)) THEN
332 IF (lbc_apply(ng)%south(istr-1).and. &
333 & lbc_apply(ng)%west (jstr )) THEN
334!^ tl_vbar(Istr-1,Jstr,kout)=0.5_r8* &
335!^ & (tl_vbar(Istr ,Jstr ,kout)+ &
336!^ & tl_vbar(Istr-1,Jstr+1,kout))
337!^
338 adfac=0.5_r8*ad_vbar(istr-1,jstr,kout)
339 ad_vbar(istr ,jstr ,kout)=ad_vbar(istr ,jstr ,kout)+ &
340 & adfac
341 ad_vbar(istr-1,jstr+1,kout)=ad_vbar(istr-1,jstr+1,kout)+ &
342 & adfac
343 ad_vbar(istr-1,jstr ,kout)=0.0_r8
344 END IF
345 END IF
346 END IF
347!
348!-----------------------------------------------------------------------
349! Lateral boundary conditions at the eastern edge.
350!-----------------------------------------------------------------------
351!
352 IF (domain(ng)%Eastern_Edge(tile)) THEN
353!
354! Eastern edge, implicit upstream radiation condition.
355!
356 IF (ad_lbc(ieast,isvbar,ng)%radiation) THEN
357 IF (iic(ng).ne.0) THEN
358 DO j=jstrv,jend
359 IF (lbc_apply(ng)%east(j)) THEN
360# if defined CELERITY_READ && defined FORWARD_READ
361 IF (ad_lbc(ieast,isvbar,ng)%nudging) THEN
362 IF (lnudgem2clm(ng)) THEN
363 obc_out=0.5_r8* &
364 & (clima(ng)%M2nudgcof(iend+1,j-1)+ &
365 & clima(ng)%M2nudgcof(iend+1,j ))
366 obc_in =obcfac(ng)*obc_out
367 ELSE
368 obc_out=m2obc_out(ng,ieast)
369 obc_in =m2obc_in(ng,ieast)
370 END IF
371 IF (boundary(ng)%vbar_east_Cx(j).lt.0.0_r8) THEN
372 tau=obc_in
373 ELSE
374 tau=obc_out
375 END IF
376 tau=tau*dt2d
377 END IF
378 cx=boundary(ng)%vbar_east_Cx(j)
379# ifdef RADIATION_2D
380 ce=boundary(ng)%vbar_east_Ce(j)
381# else
382 ce=0.0_r8
383# endif
384 cff=boundary(ng)%vbar_east_C2(j)
385# endif
386# ifdef MASKING
387!^ tl_vbar(Iend+1,j,kout)=tl_vbar(Iend+1,j,kout)* &
388!^ & GRID(ng)%vmask(Iend+1,j)
389!^
390 ad_vbar(iend+1,j,kout)=ad_vbar(iend+1,j,kout)* &
391 & grid(ng)%vmask(iend+1,j)
392# endif
393 IF (ad_lbc(ieast,isvbar,ng)%nudging) THEN
394!^ tl_vbar(Iend+1,j,kout)=tl_vbar(Iend+1,j,kout)- &
395!^ & tau*tl_vbar(Iend+1,j,know)
396!^
397 ad_vbar(iend+1 ,j,know)=ad_vbar(iend+1 ,j,know)- &
398 & tau*ad_vbar(iend+1,j,kout)
399 END IF
400!^ tl_vbar(Iend+1,j,kout)=(cff*tl_vbar(Iend+1,j,know)+ &
401!^ & Cx *tl_vbar(Iend ,j,kout)- &
402!^ & MAX(Ce,0.0_r8)* &
403!^ & tl_grad(Iend+1,j-1)- &
404!^ & MIN(Ce,0.0_r8)* &
405!^ & tl_grad(Iend+1,j ))/ &
406!^ & (cff+Cx)
407!^
408 adfac=ad_vbar(iend+1,j,kout)/(cff+cx)
409 ad_grad(iend+1,j-1)=ad_grad(iend+1,j-1)- &
410 & max(ce,0.0_r8)*adfac
411 ad_grad(iend+1,j )=ad_grad(iend+1,j )- &
412 & min(ce,0.0_r8)*adfac
413 ad_vbar(iend ,j,kout)=ad_vbar(iend ,j,kout)+cx* adfac
414 ad_vbar(iend+1,j,know)=ad_vbar(iend+1,j,know)+cff*adfac
415 ad_vbar(iend+1,j,kout)=0.0_r8
416 END IF
417 END DO
418 END IF
419!
420! Eastern edge, Chapman boundary condition.
421!
422 ELSE IF (ad_lbc(ieast,isvbar,ng)%Flather.or. &
423 & ad_lbc(ieast,isvbar,ng)%reduced.or. &
424 & ad_lbc(ieast,isvbar,ng)%Shchepetkin) THEN
425 DO j=jstrv,jend
426 IF (lbc_apply(ng)%east(j)) THEN
427 cff=dt2d*0.5_r8*(grid(ng)%pm(iend,j-1)+ &
428 & grid(ng)%pm(iend,j ))
429 cff1=sqrt(g*0.5_r8*(grid(ng)%h(iend,j-1)+ &
430 & zeta(iend,j-1,know)+ &
431 & grid(ng)%h(iend,j )+ &
432 & zeta(iend,j ,know)))
433 cx=cff*cff1
434 cff2=1.0_r8/(1.0_r8+cx)
435# ifdef MASKING
436!^ tl_vbar(Iend+1,j,kout)=tl_vbar(Iend+1,j,kout)* &
437!^ & GRID(ng)%vmask(Iend+1,j)
438!^
439 ad_vbar(iend+1,j,kout)=ad_vbar(iend+1,j,kout)* &
440 & grid(ng)%vmask(iend+1,j)
441# endif
442!^ tl_vbar(Iend+1,j,kout)=tl_cff2*(vbar(Iend+1,j,know)+ &
443!^ & Cx*vbar(Iend,j,kout))+ &
444!^ & cff2*(tl_vbar(Iend+1,j,know)+ &
445!^ & tl_Cx*vbar(Iend,j,kout)+ &
446!^ & Cx*tl_vbar(Iend,j,kout))
447!^
448 adfac=cff2*ad_vbar(iend+1,j,kout)
449 ad_vbar(iend ,j,kout)=ad_vbar(iend ,j,kout)+cx*adfac
450 ad_vbar(iend+1,j,know)=ad_vbar(iend+1,j,know)+adfac
451 ad_cx=ad_cx+vbar(iend,j,kout)*adfac
452 ad_cff2=ad_cff2+ &
453 & (vbar(iend+1,j,know)+ &
454 & cx*vbar(iend,j,kout))*ad_vbar(iend+1,j,kout)
455 ad_vbar(iend+1,j,kout)=0.0_r8
456!^ tl_cff2=-cff2*cff2*tl_Cx
457!^
458 ad_cx=ad_cx-cff2*cff2*ad_cff2
459 ad_cff2=0.0_r8
460!^ tl_Cx=cff*tl_cff1
461!^
462 ad_cff1=ad_cff1+cff*ad_cx
463 ad_cx=0.0_r8
464!^ tl_cff1=0.25_r8*g*(GRID(ng)%tl_h(Iend,j-1)+ &
465!^ & tl_zeta(Iend,j-1,know)+ &
466!^ & GRID(ng)%tl_h(Iend,j )+ &
467!^ & tl_zeta(Iend,j ,know))/cff1
468!^
469 adfac=0.25_r8*g*ad_cff1/cff1
470 grid(ng)%ad_h(iend,j-1)=grid(ng)%ad_h(iend,j-1)+adfac
471 grid(ng)%ad_h(iend,j )=grid(ng)%ad_h(iend,j )+adfac
472 ad_zeta(iend,j-1,know)=ad_zeta(iend,j-1,know)+adfac
473 ad_zeta(iend,j ,know)=ad_zeta(iend,j ,know)+adfac
474 ad_cff1=0.0_r8
475 END IF
476 END DO
477!
478! Eastern edge, clamped boundary condition.
479!
480 ELSE IF (ad_lbc(ieast,isvbar,ng)%clamped) THEN
481 DO j=jstrv,jend
482 IF (lbc_apply(ng)%east(j)) THEN
483# ifdef MASKING
484!^ tl_vbar(Iend+1,j,kout)=tl_vbar(Iend+1,j,kout)* &
485!^ & GRID(ng)%vmask(Iend+1,j)
486!^
487 ad_vbar(iend+1,j,kout)=ad_vbar(iend+1,j,kout)* &
488 & grid(ng)%vmask(iend+1,j)
489# endif
490# ifdef ADJUST_BOUNDARY
491 IF (lobc(ieast,isvbar,ng)) THEN
492!^ tl_vbar(Iend+1,j,kout)=BOUNDARY(ng)%tl_vbar_east(j)
493!^
494 boundary(ng)%ad_vbar_east(j)= &
495 & boundary(ng)%ad_vbar_east(j)+ &
496 & ad_vbar(iend+1,j,kout)
497 ad_vbar(iend+1,j,kout)=0.0_r8
498 ELSE
499!^ tl_vbar(Iend+1,j,kout)=0.0_r8
500!^
501 ad_vbar(iend+1,j,kout)=0.0_r8
502 END IF
503# else
504!^ tl_vbar(Iend+1,j,kout)=0.0_r8
505!^
506 ad_vbar(iend+1,j,kout)=0.0_r8
507# endif
508 END IF
509 END DO
510!
511! Eastern edge, gradient boundary condition.
512!
513 ELSE IF (ad_lbc(ieast,isvbar,ng)%gradient) THEN
514 DO j=jstrv,jend
515 IF (lbc_apply(ng)%east(j)) THEN
516# ifdef MASKING
517!^ tl_vbar(Iend+1,j,kout)=tl_vbar(Iend+1,j,kout)* &
518!^ & GRID(ng)%vmask(Iend+1,j)
519!^
520 ad_vbar(iend+1,j,kout)=ad_vbar(iend+1,j,kout)* &
521 & grid(ng)%vmask(iend+1,j)
522# endif
523!^ tl_vbar(Iend+1,j,kout)=tl_vbar(Iend,j,kout)
524!^
525 ad_vbar(iend ,j,kout)=ad_vbar(iend,j,kout)+ &
526 & ad_vbar(iend+1,j,kout)
527 ad_vbar(iend+1,j,kout)=0.0_r8
528 END IF
529 END DO
530!
531! Eastern edge, closed boundary condition: free slip (gamma2=1) or
532! no slip (gamma2=-1).
533!
534 ELSE IF (ad_lbc(ieast,isvbar,ng)%closed) THEN
535 IF (nsperiodic(ng)) THEN
536 jmin=jstrv
537 jmax=jend
538 ELSE
539 jmin=jstr
540 jmax=jendr
541 END IF
542 DO j=jmin,jmax
543 IF (lbc_apply(ng)%east(j)) THEN
544# ifdef MASKING
545!^ tl_vbar(Iend+1,j,kout)=tl_vbar(Iend+1,j,kout)* &
546!^ & GRID(ng)%vmask(Iend+1,j)
547!^
548 ad_vbar(iend+1,j,kout)=ad_vbar(iend+1,j,kout)* &
549 & grid(ng)%vmask(iend+1,j)
550# endif
551!^ tl_vbar(Iend+1,j,kout)=gamma2(ng)*tl_vbar(Iend,j,kout)
552!^
553 ad_vbar(iend ,j,kout)=ad_vbar(iend,j,kout)+ &
554 & gamma2(ng)*ad_vbar(iend+1,j,kout)
555 ad_vbar(iend+1,j,kout)=0.0_r8
556 END IF
557 END DO
558 END IF
559 END IF
560!
561!-----------------------------------------------------------------------
562! Lateral boundary conditions at the western edge.
563!-----------------------------------------------------------------------
564!
565 IF (domain(ng)%Western_Edge(tile)) THEN
566!
567! Western edge, implicit upstream radiation condition.
568!
569 IF (ad_lbc(iwest,isvbar,ng)%radiation) THEN
570 IF (iic(ng).ne.0) THEN
571 DO j=jstrv,jend
572 IF (lbc_apply(ng)%west(j)) THEN
573# if defined CELERITY_READ && defined FORWARD_READ
574 IF (ad_lbc(iwest,isvbar,ng)%nudging) THEN
575 IF (lnudgem2clm(ng)) THEN
576 obc_out=0.5_r8* &
577 & (clima(ng)%M2nudgcof(istr-1,j-1)+ &
578 & clima(ng)%M2nudgcof(istr-1,j ))
579 obc_in =obcfac(ng)*obc_out
580 ELSE
581 obc_out=m2obc_out(ng,iwest)
582 obc_in =m2obc_in(ng,iwest)
583 END IF
584 IF (boundary(ng)%vbar_west_Cx(j).lt.0.0_r8) THEN
585 tau=obc_in
586 ELSE
587 tau=obc_out
588 END IF
589 tau=tau*dt2d
590 END IF
591 cx=boundary(ng)%vbar_west_Cx(j)
592# ifdef RADIATION_2D
593 ce=boundary(ng)%vbar_west_Ce(j)
594# else
595 ce=0.0_r8
596# endif
597 cff=boundary(ng)%vbar_west_C2(j)
598# endif
599# ifdef MASKING
600!^ tl_vbar(Istr-1,j,kout)=tl_vbar(Istr-1,j,kout)* &
601!^ & GRID(ng)%vmask(Istr-1,j)
602!^
603 ad_vbar(istr-1,j,kout)=ad_vbar(istr-1,j,kout)* &
604 & grid(ng)%vmask(istr-1,j)
605# endif
606 IF (ad_lbc(iwest,isvbar,ng)%nudging) THEN
607!^ tl_vbar(Istr-1,j,kout)=tl_vbar(Istr-1,j,kout)- &
608!^ & tau*tl_vbar(1,j,know)
609!^
610 ad_vbar(istr,j,know)=ad_vbar(istr,j,know)- &
611 & tau*ad_vbar(istr-1,j,kout)
612 END IF
613!^ tl_vbar(Istr-1,j,kout)=(cff*tl_vbar(Istr-1,j,know)+ &
614!^ & Cx *tl_vbar(1,j,kout)- &
615!^ & MAX(Ce,0.0_r8)* &
616!^ & tl_grad(Istr-1,j-1)- &
617!^ & MIN(Ce,0.0_r8)* &
618!^ & tl_grad(Istr-1,j ))/ &
619!^ & (cff+Cx)
620!^
621 adfac=ad_vbar(istr-1,j,kout)/(cff+cx)
622 ad_grad(istr-1,j-1)=ad_grad(istr-1,j-1)- &
623 & max(ce,0.0_r8)*adfac
624 ad_grad(istr-1,j )=ad_grad(istr-1,j )- &
625 & min(ce,0.0_r8)*adfac
626 ad_vbar(istr-1,j,know)=ad_vbar(istr-1,j,know)+cff*adfac
627 ad_vbar(istr ,j,kout)=ad_vbar(istr ,j,kout)+cx *adfac
628 ad_vbar(istr-1,j,kout)=0.0_r8
629 END IF
630 END DO
631 END IF
632!
633! Western edge, Chapman boundary condition.
634!
635 ELSE IF (ad_lbc(iwest,isvbar,ng)%Flather.or. &
636 & ad_lbc(iwest,isvbar,ng)%reduced.or. &
637 & ad_lbc(iwest,isvbar,ng)%Shchepetkin) THEN
638 DO j=jstrv,jend
639 IF (lbc_apply(ng)%west(j)) THEN
640 cff=dt2d*0.5_r8*(grid(ng)%pm(istr,j-1)+ &
641 & grid(ng)%pm(istr,j ))
642 cff1=sqrt(g*0.5_r8*(grid(ng)%h(istr,j-1)+ &
643 & zeta(istr,j-1,know)+ &
644 & grid(ng)%h(istr,j )+ &
645 & zeta(istr,j ,know)))
646 cx=cff*cff1
647 cff2=1.0_r8/(1.0_r8+cx)
648# ifdef MASKING
649!^ tl_vbar(Istr-1,j,kout)=tl_vbar(Istr-1,j,kout)* &
650!^ & GRID(ng)%vmask(Istr-1,j)
651!^
652 ad_vbar(istr-1,j,kout)=ad_vbar(istr-1,j,kout)* &
653 & grid(ng)%vmask(istr-1,j)
654# endif
655!^ tl_vbar(Istr-1,j,kout)=tl_cff2*(vbar(Istr-1,j,know)+ &
656!^ & Cx*vbar(Istr,j,kout))+ &
657!^ & cff2*(tl_vbar(Istr-1,j,know)+ &
658!^ & tl_Cx*vbar(Istr,j,kout)+ &
659!^ & Cx*tl_vbar(Istr,j,kout))
660!^
661 adfac=cff2*ad_vbar(istr-1,j,kout)
662 ad_vbar(istr-1,j,know)=ad_vbar(istr-1,j,know)+adfac
663 ad_vbar(istr ,j,kout)=ad_vbar(istr ,j,kout)+cx*adfac
664 ad_cx=ad_cx+vbar(istr,j,kout)*adfac
665 ad_cff2=ad_cff2+ &
666 & (vbar(istr-1,j,know)+ &
667 & cx*vbar(istr,j,kout))*ad_vbar(istr-1,j,kout)
668 ad_vbar(istr-1,j,kout)=0.0_r8
669!^ tl_cff2=-cff2*cff2*tl_Cx
670!^
671 ad_cx=ad_cx-cff2*cff2*ad_cff2
672 ad_cff2=0.0_r8
673!^ tl_Cx=cff*tl_cff1
674!^
675 ad_cff1=ad_cff1+cff*ad_cx
676 ad_cx=0.0_r8
677!^ tl_cff1=0.25_r8*g*(GRID(ng)%tl_h(Istr,j-1)+ &
678!^ & tl_zeta(Istr,j-1,know)+ &
679!^ & GRID(ng)%tl_h(Istr,j )+ &
680!^ & tl_zeta(Istr,j ,know))/cff1
681!^
682 adfac=0.25_r8*g*ad_cff1/cff1
683 grid(ng)%ad_h(istr,j-1)=grid(ng)%ad_h(istr,j-1)+adfac
684 grid(ng)%ad_h(istr,j )=grid(ng)%ad_h(istr,j )+adfac
685 ad_zeta(istr,j-1,know)=ad_zeta(istr,j-1,know)+adfac
686 ad_zeta(istr,j ,know)=ad_zeta(istr,j ,know)+adfac
687 ad_cff1=0.0_r8
688 END IF
689 END DO
690!
691! Western edge, clamped boundary condition.
692!
693 ELSE IF (ad_lbc(iwest,isvbar,ng)%clamped) THEN
694 DO j=jstrv,jend
695 IF (lbc_apply(ng)%west(j)) THEN
696# ifdef MASKING
697!^ tl_vbar(Istr-1,j,kout)=tl_vbar(Istr-1,j,kout)* &
698!^ & GRID(ng)%vmask(Istr-1,j)
699!^
700 ad_vbar(istr-1,j,kout)=ad_vbar(istr-1,j,kout)* &
701 & grid(ng)%vmask(istr-1,j)
702# endif
703# ifdef ADJUST_BOUNDARY
704 IF (lobc(iwest,isvbar,ng)) THEN
705!^ tl_vbar(Istr-1,j,kout)=BOUNDARY(ng)%tl_vbar_west(j)
706!^
707 boundary(ng)%ad_vbar_west(j)= &
708 & boundary(ng)%ad_vbar_west(j)+ &
709 & ad_vbar(istr-1,j,kout)
710 ad_vbar(istr-1,j,kout)=0.0_r8
711 ELSE
712!^ tl_vbar(Istr-1,j,kout)=0.0_r8
713!^
714 ad_vbar(istr-1,j,kout)=0.0_r8
715 END IF
716# else
717!^ tl_vbar(Istr-1,j,kout)=0.0_r8
718!^
719 ad_vbar(istr-1,j,kout)=0.0_r8
720# endif
721 END IF
722 END DO
723!
724! Western edge, gradient boundary condition.
725!
726 ELSE IF (ad_lbc(iwest,isvbar,ng)%gradient) THEN
727 DO j=jstrv,jend
728 IF (lbc_apply(ng)%west(j)) THEN
729# ifdef MASKING
730!^ tl_vbar(Istr-1,j,kout)=tl_vbar(Istr-1,j,kout)* &
731!^ & GRID(ng)%vmask(Istr-1,j)
732!^
733 ad_vbar(istr-1,j,kout)=ad_vbar(istr-1,j,kout)* &
734 & grid(ng)%vmask(istr-1,j)
735# endif
736!^ tl_vbar(Istr-1,j,kout)=tl_vbar(Istr,j,kout)
737!^
738 ad_vbar(istr ,j,kout)=ad_vbar(istr,j,kout)+ &
739 & ad_vbar(istr-1,j,kout)
740 ad_vbar(istr-1,j,kout)=0.0_r8
741 END IF
742 END DO
743!
744! Western edge, closed boundary condition: free slip (gamma2=1) or
745! no slip (gamma2=-1).
746!
747 ELSE IF (ad_lbc(iwest,isvbar,ng)%closed) THEN
748 IF (nsperiodic(ng)) THEN
749 jmin=jstrv
750 jmax=jend
751 ELSE
752 jmin=jstr
753 jmax=jendr
754 END IF
755 DO j=jmin,jmax
756 IF (lbc_apply(ng)%west(j)) THEN
757# ifdef MASKING
758!^ tl_vbar(Istr-1,j,kout)=tl_vbar(Istr-1,j,kout)* &
759!^ & GRID(ng)%vmask(Istr-1,j)
760!^
761 ad_vbar(istr-1,j,kout)=ad_vbar(istr-1,j,kout)* &
762 & grid(ng)%vmask(istr-1,j)
763# endif
764!^ tl_vbar(Istr-1,j,kout)=gamma2(ng)*tl_vbar(Istr,j,kout)
765!^
766 ad_vbar(istr ,j,kout)=ad_vbar(istr,j,kout)+ &
767 & gamma2(ng)*ad_vbar(istr-1,j,kout)
768 ad_vbar(istr-1,j,kout)=0.0_r8
769 END IF
770 END DO
771 END IF
772 END IF
773!
774!-----------------------------------------------------------------------
775! Lateral boundary conditions at the northern edge.
776!-----------------------------------------------------------------------
777!
778 IF (domain(ng)%Northern_Edge(tile)) THEN
779!
780! Northern edge, implicit upstream radiation condition.
781!
782 IF (ad_lbc(inorth,isvbar,ng)%radiation) THEN
783 IF (iic(ng).ne.0) THEN
784 DO i=istr,iend
785 IF (lbc_apply(ng)%north(i)) THEN
786# if defined CELERITY_READ && defined FORWARD_READ
787 IF (ad_lbc(inorth,isvbar,ng)%nudging) THEN
788 IF (lnudgem2clm(ng)) THEN
789 obc_out=0.5_r8* &
790 & (clima(ng)%M2nudgcof(i,jend )+ &
791 & clima(ng)%M2nudgcof(i,jend+1))
792 obc_in =obcfac(ng)*obc_out
793 ELSE
794 obc_out=m2obc_out(ng,inorth)
795 obc_in =m2obc_in(ng,inorth)
796 END IF
797 IF (boundary(ng)%vbar_north_Ce(i).lt.0.0_r8) THEN
798 tau=obc_in
799 ELSE
800 tau=obc_out
801 END IF
802 tau=tau*dt2d
803 END IF
804# ifdef RADIATION_2D
805 cx=boundary(ng)%vbar_north_Cx(i)
806# else
807 cx=0.0_r8
808# endif
809 ce=boundary(ng)%vbar_north_Ce(i)
810 cff=boundary(ng)%vbar_north_C2(i)
811# endif
812# ifdef MASKING
813!^ tl_vbar(i,Jend+1,kout)=tl_vbar(i,Jend+1,kout)* &
814!^ & GRID(ng)%vmask(i,Jend+1)
815!^
816 ad_vbar(i,jend+1,kout)=ad_vbar(i,jend+1,kout)* &
817 & grid(ng)%vmask(i,jend+1)
818# endif
819 IF (ad_lbc(inorth,isvbar,ng)%nudging) THEN
820!^ tl_vbar(i,Jend+1,kout)=tl_vbar(i,Jend+1,kout)- &
821!^ & tau*tl_vbar(i,Jend+1,know)
822!^
823 ad_vbar(i,jend+1 ,know)=ad_vbar(i,jend+1 ,know)- &
824 & tau*ad_vbar(i,jend+1,kout)
825 END IF
826!^ tl_vbar(i,Jend+1,kout)=(cff*tl_vbar(i,Jend+1,know)+ &
827!^ & Ce *tl_vbar(i,Jend ,kout)- &
828!^ & MAX(Cx,0.0_r8)* &
829!^ & tl_grad(i ,Jend+1)- &
830!^ & MIN(Cx,0.0_r8)* &
831!^ & tl_grad(i+1,Jend+1))/ &
832!^ & (cff+Ce)
833!^
834 adfac=ad_vbar(i,jend+1,kout)/(cff+ce)
835 ad_grad(i ,jend+1)=ad_grad(i ,jend+1)- &
836 & max(cx,0.0_r8)*adfac
837 ad_grad(i+1,jend+1)=ad_grad(i+1,jend+1)- &
838 & min(cx,0.0_r8)*adfac
839 ad_vbar(i,jend ,kout)=ad_vbar(i,jend ,kout)+ce*adfac
840 ad_vbar(i,jend+1,know)=ad_vbar(i,jend+1,know)+cff*adfac
841 ad_vbar(i,jend+1,kout)=0.0_r8
842 END IF
843 END DO
844 END IF
845!
846! Northern edge, Flather boundary condition.
847!
848 ELSE IF (ad_lbc(inorth,isvbar,ng)%Flather) THEN
849 DO i=istr,iend
850 IF (lbc_apply(ng)%north(i)) THEN
851 cff=1.0_r8/(0.5_r8*(grid(ng)%h(i,jend )+ &
852 & zeta(i,jend ,know)+ &
853 & grid(ng)%h(i,jend+1)+ &
854 & zeta(i,jend+1,know)))
855 ce=sqrt(g*cff)
856# ifdef MASKING
857!^ tl_vbar(i,Jend+1,kout)=tl_vbar(i,Jend+1,kout)* &
858!^ & GRID(ng)%vmask(i,Jend+1)
859!^
860 ad_vbar(i,jend+1,kout)=ad_vbar(i,jend+1,kout)* &
861 & grid(ng)%vmask(i,jend+1)
862# endif
863# ifdef ADJUST_BOUNDARY
864 IF (lobc(inorth,isvbar,ng)) THEN
865!^ tl_vbar(i,Jend+1,kout)=tl_vbar(i,Jend+1,kout)- &
866!^ & Ce*BOUNDARY(ng)%tl_zeta_north(i)
867!^
868 boundary(ng)%ad_zeta_north(i)=boundary(ng)% &
869 & ad_zeta_north(i)- &
870 & ce*ad_vbar(i,jend+1,kout)
871 END IF
872# endif
873# if defined ATM_PRESS && defined PRESS_COMPENSATE
874!^ tl_vbar(i,Jstr,kout)=tl_bry_val- &
875!^ & tl_Ce* &
876!^ & (0.5_r8* &
877!^ & (zeta(i,Jstr-1,know)+ &
878!^ & zeta(i,Jstr ,know)+ &
879!^ & fac*(FORCES(ng)%Pair(i,Jstr-1)+ &
880!^ & FORCES(ng)%Pair(i,Jstr )- &
881!^ & 2.0_r8*OneAtm))- &
882!^ & BOUNDARY(ng)%zeta_south(i))- &
883!^ & Ce* &
884!^ & (0.5_r8*(tl_zeta(i,Jstr-1,know)+ &
885!^ & tl_zeta(i,Jstr ,know)))
886!^
887 adfac=ce*0.5_r8*ad_vbar(i,jend+1,kout)
888 ad_zeta(i,jend ,know)=ad_zeta(i,jend ,know)+adfac
889 ad_zeta(i,jend+1,know)=ad_zeta(i,jend+1,know)+adfac
890 ad_ce=ad_ce+ &
891 & (0.5_r8*(zeta(i,jend ,know)+ &
892 & zeta(i,jend+1,know)+ &
893 & fac*(forces(ng)%Pair(i,jstr-1)+ &
894 & forces(ng)%Pair(i,jstr )- &
895 & 2.0_r8*oneatm))- &
896 & boundary(ng)%zeta_north(i))*ad_vbar(i,jend+1,kout)
897 ad_bry_val=ad_bry_val+ad_vbar(i,jend+1,kout)
898 ad_vbar(i,jend+1,kout)=0.0_r8
899# else
900!^ tl_vbar(i,Jend+1,kout)=tl_bry_val+ &
901!^ & tl_Ce* &
902!^ & (0.5_r8*(zeta(i,Jend ,know)+ &
903!^ & zeta(i,Jend+1,know))- &
904!^ & BOUNDARY(ng)%zeta_north(i))+ &
905!^ & Ce* &
906!^ & (0.5_r8*(tl_zeta(i,Jend ,know)+ &
907!^ & tl_zeta(i,Jend+1,know)))
908!^
909 adfac=ce*0.5_r8*ad_vbar(i,jend+1,kout)
910 ad_zeta(i,jend ,know)=ad_zeta(i,jend ,know)+adfac
911 ad_zeta(i,jend+1,know)=ad_zeta(i,jend+1,know)+adfac
912 ad_ce=ad_ce+ &
913 & (0.5_r8*(zeta(i,jend ,know)+ &
914 & zeta(i,jend+1,know))- &
915 & boundary(ng)%zeta_north(i))*ad_vbar(i,jend+1,kout)
916 ad_bry_val=ad_bry_val+ad_vbar(i,jend+1,kout)
917 ad_vbar(i,jend+1,kout)=0.0_r8
918# endif
919!^ tl_Ce=0.5_r8*g*tl_cff/Ce
920!^
921 ad_cff=ad_cff+0.5_r8*g*ad_ce/ce
922 ad_ce=0.0_r8
923!^ tl_cff=-cff*cff*(0.5_r8*(GRID(ng)%tl_h(i,Jend )+ &
924!^ & tl_zeta(i,Jend ,know)+ &
925!^ & GRID(ng)%tl_h(i,Jend+1)+ &
926!^ & tl_zeta(i,Jend+1,know)))
927!^
928 adfac=-cff*cff*0.5_r8*ad_cff
929 grid(ng)%ad_h(i,jend )=grid(ng)%ad_h(i,jend )+adfac
930 grid(ng)%ad_h(i,jend+1)=grid(ng)%ad_h(i,jend+1)+adfac
931 ad_zeta(i,jend ,know)=ad_zeta(i,jend ,know)+adfac
932 ad_zeta(i,jend+1,know)=ad_zeta(i,jend+1,know)+adfac
933 ad_cff=0.0_r8
934
935# if defined SSH_TIDES_NOT_YET && !defined UV_TIDES_NOT_YET
936 IF (ad_lbc(inorth,isfsur,ng)%acquire) THEN
937 bry_pgr=-g*(boundary(ng)%zeta_north(i)- &
938 & zeta(i,jend,know))* &
939 & 0.5_r8*grid(ng)%pn(i,jend)
940 ELSE
941 bry_pgr=-g*(zeta(i,jend+1,know)- &
942 & zeta(i,jend ,know))* &
943 & 0.5_r8*(grid(ng)%pn(i,jend )+ &
944 & grid(ng)%pn(i,jend+1))
945 END IF
946# ifdef UV_COR
947 bry_cor=-0.125_r8*(ubar(i ,jend ,know)+ &
948 & ubar(i+1,jend ,know)+ &
949 & ubar(i ,jend+1,know)+ &
950 & ubar(i+1,jend+1,know))* &
951 & (grid(ng)%f(i,jend )+ &
952 & grid(ng)%f(i,jend+1))
953# else
954 bry_cor=0.0_r8
955# endif
956 cff1=1.0_r8/(0.5_r8*(grid(ng)%h(i,jend )+ &
957 & zeta(i,jend ,know)+ &
958 & grid(ng)%h(i,jend+1)+ &
959 & zeta(i,jend+1,know)))
960 bry_str=cff1*(forces(ng)%svstr(i,jend+1)- &
961 & forces(ng)%bvstr(i,jend+1))
962 ce=1.0_r8/sqrt(g*0.5_r8*(grid(ng)%h(i,jend+1)+ &
963 & zeta(i,jend+1,know)+ &
964 & grid(ng)%h(i,jend )+ &
965 & zeta(i,jend ,know)))
966 cff2=grid(ng)%on_v(i,jend+1)*ce
967!^ tl_bry_val=tl_vbar(i,Jend,know)+ &
968!^ & tl_cff2*(bry_pgr+ &
969!^ & bry_cor+ &
970!^ & bry_str)+ &
971!^ & cff2*(tl_bry_pgr+ &
972!^ & tl_bry_cor+ &
973!^ & tl_bry_str)
974!^
975 adfac=cff2*ad_bry_val
976 ad_bry_pgr=ad_bry_pgr+adfac
977 ad_bry_cor=ad_bry_cor+adfac
978 ad_bry_str=ad_bry_str+adfac
979 ad_cff2=ad_cff2+(bry_pgr+ &
980 & bry_cor+ &
981 & bry_str)*ad_bry_val
982 ad_vbar(i,jend,know)=ad_vbar(i,jend,know)+ad_bry_val
983 ad_bry_val=0.0_r8
984!^ tl_cff2=GRID(ng)%on_v(i,Jend+1)*tl_Ce
985!^
986 ad_ce=ad_ce+grid(ng)%on_v(i,jend+1)*ad_cff2
987 ad_cff2=0.0_r8
988!^ tl_Ce=-Ce*Ce*Ce*0.25_r8*g*(GRID(ng)%tl_h(i,Jend+1)+ &
989!^ & tl_zeta(i,Jend+1,know)+ &
990!^ & GRID(ng)%tl_h(i,Jend )+ &
991!^ & tl_zeta(i,Jend ,know))
992!^
993 adfac=-ce*ce*ce*0.25_r8*g*ad_ce
994 ad_zeta(i,jend ,know)=ad_zeta(i,jend ,know)+adfac
995 ad_zeta(i,jend+1,know)=ad_zeta(i,jend+1,know)+adfac
996 grid(ng)%ad_h(i,jend )=grid(ng)%ad_h(i,jend )+adfac
997 grid(ng)%ad_h(i,jend+1)=grid(ng)%ad_h(i,jend+1)+adfac
998 ad_ce=0.0_r8
999!^ tl_bry_str=tl_cff1*(FORCES(ng)%svstr(i,Jend+1)- &
1000!^ & FORCES(ng)%bvstr(i,Jend+1))+ &
1001!^ & cff1*(FORCES(ng)%tl_svstr(i,Jend+1)- &
1002!^ & FORCES(ng)%tl_bvstr(i,Jend+1))
1003!^
1004 adfac=cff1*ad_bry_str
1005 forces(ng)%ad_svstr(i,jend+1)= &
1006 & forces(ng)%ad_svstr(i,jend+1)+ &
1007 & adfac
1008 forces(ng)%ad_bvstr(i,jend+1)= &
1009 & forces(ng)%ad_bvstr(i,jend+1)- &
1010 & adfac
1011 ad_cff1=ad_cff1+(forces(ng)%svstr(i,jend+1)- &
1012 & forces(ng)%bvstr(i,jend+1))*ad_bry_str
1013
1014 ad_bry_str=0.0_r8
1015!^ tl_cff1=-cff1*cff1*0.5_r8*(GRID(ng)%tl_h(i,Jend )+ &
1016!^ & tl_zeta(i,Jend ,know)+ &
1017!^ & GRID(ng)%tl_h(i,Jend+1)+ &
1018!^ & tl_zeta(i,Jend+1,know))
1019!^
1020 adfac=-cff1*cff1*0.5_r8*ad_cff1
1021 ad_zeta(i,jend ,know)=ad_zeta(i,jend ,know)+adfac
1022 ad_zeta(i,jend+1,know)=ad_zeta(i,jend+1,know)+adfac
1023 grid(ng)%ad_h(i,jend )=grid(ng)%ad_h(i,jend )+adfac
1024 grid(ng)%ad_h(i,jend+1)=grid(ng)%ad_h(i,jend+1)+adfac
1025 ad_cff1=0.0_r8
1026# ifdef UV_COR
1027!^ tl_bry_cor=-0.125_r8*(tl_ubar(i ,Jend ,know)+ &
1028!^ & tl_ubar(i+1,Jend ,know)+ &
1029!^ & tl_ubar(i ,Jend+1,know)+ &
1030!^ & tl_ubar(i+1,Jend+1,know))* &
1031!^ & (GRID(ng)%f(i,Jend )+ &
1032!^ & GRID(ng)%f(i,Jend+1))
1033!^
1034 adfac=0.125_r8*(grid(ng)%f(i,jend )+ &
1035 & grid(ng)%f(i,jend+1))*ad_bry_cor
1036 ad_ubar(i ,jend ,know)=ad_ubar(i ,jend ,know)-adfac
1037 ad_ubar(i+1,jend ,know)=ad_ubar(i+1,jend ,know)-adfac
1038 ad_ubar(i ,jend+1,know)=ad_ubar(i ,jend+1,know)-adfac
1039 ad_ubar(i+1,jend+1,know)=ad_ubar(i+1,jend+1,know)-adfac
1040 ad_bry_cor=0.0_r8
1041# else
1042!^ tl_bry_cor=0.0_r8
1043!^
1044# endif
1045 IF (ad_lbc(inorth,isfsur,ng)%acquire) THEN
1046# ifdef ADJUST_BOUNDARY
1047 IF (lobc(inorth,isvbar,ng)) THEN
1048!^ tl_bry_pgr=tl_bry_pgr- &
1049!^ & g*BOUNDARY(ng)%tl_zeta_north(i)* &
1050!^ & 0.5_r8*GRID(ng)%pn(i,Jend)
1051!^
1052 boundary(ng)%ad_zeta_north(i)=boundary(ng)% &
1053 & ad_zeta_north(i)- &
1054 & g*0.5_r8* &
1055 & grid(ng)%pn(i,jend)* &
1056 & ad_bry_pgr
1057 END IF
1058# endif
1059!^ tl_bry_pgr=g*tl_zeta(i,Jend,know)* &
1060!^ & 0.5_r8*GRID(ng)%pn(i,Jend)
1061!^
1062 ad_zeta(i,jend,know)=ad_zeta(i,jend,know)+ &
1063 & g*0.5_r8*grid(ng)%pn(i,jend)* &
1064 & ad_bry_pgr
1065 ad_bry_pgr=0.0_r8
1066 ELSE
1067!^ tl_bry_pgr=-g*(tl_zeta(i,Jend+1,know)- &
1068!^ & tl_zeta(i,Jend ,know))* &
1069!^ & 0.5_r8*(GRID(ng)%pn(i,Jend )+ &
1070!^ & GRID(ng)%pn(i,Jend+1))
1071!^
1072 adfac=-g*0.5_r8*(grid(ng)%pn(i,jend )+ &
1073 & grid(ng)%pn(i,jend+1))*ad_bry_pgr
1074 ad_zeta(i,jend ,know)=ad_zeta(i,jend ,know)-adfac
1075 ad_zeta(i,jend+1,know)=ad_zeta(i,jend+1,know)+adfac
1076 ad_bry_pgr=0.0_r8
1077 END IF
1078# else
1079# ifdef ADJUST_BOUNDARY
1080 IF (lobc(inorth,isvbar,ng)) THEN
1081!^ tl_bry_val=BOUNDARY(ng)%tl_vbar_north(i)
1082!^
1083 boundary(ng)%ad_vbar_north(i)=boundary(ng)% &
1084 & ad_vbar_north(i)+ &
1085 & ad_bry_val
1086 ad_bry_val=0.0_r8
1087 ELSE
1088!^ tl_bry_val=0.0_r8
1089!^
1090 ad_bry_val=0.0_r8
1091 END IF
1092# else
1093!^ tl_bry_val=0.0_r8
1094!^
1095 ad_bry_val=0.0_r8
1096# endif
1097# endif
1098 END IF
1099 END DO
1100!
1101! Northern edge, Shchepetkin boundary condition (Maison et al., 2010).
1102!
1103 ELSE IF (ad_lbc(inorth,isvbar,ng)%Shchepetkin) THEN
1104 DO i=istr,iend
1105 IF (lbc_apply(ng)%north(i)) THEN
1106 cff=0.5_r8*(grid(ng)%h(i,jend )+ &
1107 & grid(ng)%h(i,jend+1))
1108 cff1=sqrt(g/cff)
1109 ce=dt2d*cff1*cff*0.5_r8*(grid(ng)%pn(i,jend )+ &
1110 & grid(ng)%pn(i,jend+1))
1111 ze=(0.5_r8+ce)*zeta(i,jend ,know)+ &
1112 & (0.5_r8-ce)*zeta(i,jend+1,know)
1113 IF (ce.gt.co) THEN
1114 cff2=(1.0_r8-co/ce)**2
1115 cff3=zeta(i,jend,kout)+ &
1116 & ce*zeta(i,jend+1,know)- &
1117 & (1.0_r8+ce)*zeta(i,jend,know)
1118 ze=ze+cff2*cff3
1119 END IF
1120# ifdef MASKING
1121!^ tl_vbar(i,Jend+1,kout)=tl_vbar(i,Jend+1,kout)* &
1122!^ & GRID(ng)%vmask(i,Jend+1)
1123!^
1124 ad_vbar(i,jend+1,kout)=ad_vbar(i,jend+1,kout)* &
1125 & grid(ng)%vmask(i,jend+1)
1126# endif
1127# ifdef ADJUST_BOUNDARY
1128 IF (lobc(inorth,isvbar,ng)) THEN
1129!^ tl_vbar(i,Jend+1,kout)=tl_vbar(i,Jend+1,kout)- &
1130!^ & Ce*BOUNDARY(ng)%tl_zeta_north(i)
1131!^
1132 boundary(ng)%ad_zeta_north(i)=boundary(ng)% &
1133 & ad_zeta_north(i)- &
1134 & ce*ad_vbar(i,jend+1,kout)
1135 END IF
1136# endif
1137!^ tl_vbar(i,Jend+1,kout)=0.5_r8* &
1138!^ & ((1.0_r8-Ce)* &
1139!^ & tl_vbar(i,Jend+1,know)+ &
1140!^ & tl_Ce*(vbar(i,Jend ,know)- &
1141!^ & vbar(i,Jend+1,know))+ &
1142!^ & Ce*tl_vbar(i,Jend,know)+ &
1143!^ & tl_bry_val+ &
1144!^ & tl_cff1* &
1145!^ & (Ze-BOUNDARY(ng)%zeta_north(i))- &
1146!^ & cff1*tl_ze)
1147!^
1148 adfac=0.5_r8*ad_vbar(i,jend+1,kout)
1149 ad_vbar(i,jend+1,know)=ad_vbar(i,jend+1,know)+ &
1150 & (1.0_r8-ce)*adfac
1151 ad_vbar(i,jend ,know)=ad_vbar(i,jend ,know)+ &
1152 & ce*adfac
1153 ad_ce=ad_ce+ &
1154 & (vbar(i,jend ,know)- &
1155 & vbar(i,jend+1,know))*adfac
1156 ad_cff1=ad_cff1+ &
1157 & (ze-boundary(ng)%zeta_north(i))*adfac
1158 ad_ze=ad_ze-cff1*adfac
1159 ad_vbar(i,jend+1,kout)=0.0_r8
1160
1161 IF (ce.gt.co) THEN
1162!^ tl_Ze=tl_Ze+cff2*tl_cff3+ &
1163!^ & tl_cff2*cff3
1164!^
1165 ad_cff2=ad_cff2+cff3*ad_ze
1166 ad_cff3=ad_cff3+cff2*ad_ze
1167!^ tl_cff3=tl_zeta(i,Jend,kout)+ &
1168!^ & Ce*tl_zeta(i,Jend+1,know)+ &
1169!^ & tl_Ce*(zeta(i,Jend ,know)+ &
1170!^ & zeta(i,Jend+1,know))- &
1171!^ & (1.0_r8+Ce)*tl_zeta(i,Jend,know)
1172!^
1173 ad_zeta(i,jend ,kout)=ad_zeta(i,jend ,kout)+ &
1174 & ad_cff3
1175 ad_zeta(i,jend ,know)=ad_zeta(i,jend ,know)- &
1176 & (1.0_r8+ce)*ad_cff3
1177 ad_zeta(i,jend+1,know)=ad_zeta(i,jend+1,know)+ &
1178 & ce*ad_cff3
1179 ad_ce=ad_ce+ &
1180 & (zeta(i,jend ,know)+ &
1181 & zeta(i,jend+1,know))*ad_cff3
1182 ad_cff3=0.0_r8
1183!^ tl_cff2=2.0_r8*cff2*Co*tl_Ce/(Ce*Ce)
1184!^
1185 ad_ce=ad_ce+ &
1186 & 2.0_r8*cff2*co*ad_cff2/(ce*ce)
1187 ad_cff2=0.0_r8
1188 END IF
1189!^ tl_Ze=(0.5_r8+Ce)*tl_zeta(i,Jend ,know)+ &
1190!^ & (0.5_r8-Ce)*tl_zeta(i,Jend+1,know)+ &
1191!^ & tl_Ce*(zeta(i,Jend ,know)- &
1192!^ & zeta(i,Jend+1,know))
1193!^
1194 ad_zeta(i,jend ,know)=ad_zeta(i,jend ,know)+ &
1195 & (0.5_r8+ce)*ad_ze
1196 ad_zeta(i,jend+1,know)=ad_zeta(i,jend+1,know)+ &
1197 & (0.5_r8-ce)*ad_ze
1198 ad_ce=ad_ce+ &
1199 & (zeta(i,jend ,know)- &
1200 & zeta(i,jend+1,know))*ad_ze
1201 ad_ze=0.0_r8
1202!^ tl_Ce=dt2d*0.5_r8*(GRID(ng)%pn(i,Jend )+ &
1203!^ & GRID(ng)%pn(i,Jend+1))* &
1204!^ & (cff1*tl_cff+ &
1205!^ & tl_cff1*cff)
1206!^
1207 adfac=dt2d*0.5_r8*(grid(ng)%pn(i,jend )+ &
1208 & grid(ng)%pn(i,jend+1))*ad_ce
1209 ad_cff=ad_cff+cff1*adfac
1210 ad_cff1=ad_cff1+cff*adfac
1211 ad_ce=0.0_r8
1212!^ tl_cff1=-0.5_r8*cff1*tl_cff/cff
1213!^
1214 ad_cff=ad_cff- &
1215 & 0.5_r8*cff1*ad_cff1/cff
1216 ad_cff1=0.0_r8
1217
1218# ifdef WET_DRY_NOT_YET
1219!^ tl_cff=0.5_r8*(GRID(ng)%tl_h(i,Jend )+ &
1220!^ & tl_zeta(i,Jend ,know)+ &
1221!^ & GRID(ng)%tl_h(i,Jend+1)+ &
1222!^ & tl_zeta(i,Jend+1,know))
1223!^
1224 adfac=0.5_r8*ad_cff
1225 grid(ng)%ad_h(i,jend )=grid(ng)%ad_h(i,jend )+adfac
1226 grid(ng)%ad_h(i,jend+1)=grid(ng)%ad_h(i,jend+1)+adfac
1227 ad_zeta(i,jend ,know)=ad_zeta(i,jend ,know)+adfac
1228 ad_zeta(i,jend+1,know)=ad_zeta(i,jend+1,know)+adfac
1229 ad_cff=0.0_r8
1230# else
1231!^ tl_cff=0.5_r8*(GRID(ng)%tl_h(i,Jend )+ &
1232!^ & GRID(ng)%tl_h(i,Jend+1))
1233!^
1234 adfac=0.5_r8*ad_cff
1235 grid(ng)%ad_h(i,jend )=grid(ng)%ad_h(i,jend )+adfac
1236 grid(ng)%ad_h(i,jend+1)=grid(ng)%ad_h(i,jend+1)+adfac
1237 ad_cff=0.0_r8
1238# endif
1239
1240# if defined SSH_TIDES_NOT_YET && !defined UV_TIDES_NOT_YET
1241 IF (ad_lbc(inorth,isfsur,ng)%acquire) THEN
1242 bry_pgr=-g*(boundary(ng)%zeta_north(i)- &
1243 & zeta(i,jend,know))* &
1244 & 0.5_r8*grid(ng)%pn(i,jend)
1245 ELSE
1246 bry_pgr=-g*(zeta(i,jend+1,know)- &
1247 & zeta(i,jend ,know))* &
1248 & 0.5_r8*(grid(ng)%pn(i,jend )+ &
1249 & grid(ng)%pn(i,jend+1))
1250 END IF
1251# ifdef UV_COR
1252 bry_cor=-0.125_r8*(ubar(i ,jend ,know)+ &
1253 & ubar(i+1,jend ,know)+ &
1254 & ubar(i ,jend+1,know)+ &
1255 & ubar(i+1,jend+1,know))* &
1256 & (grid(ng)%f(i,jend )+ &
1257 & grid(ng)%f(i,jend+1))
1258# else
1259 bry_cor=0.0_r8
1260# endif
1261 cff1=1.0_r8/(0.5_r8*(grid(ng)%h(i,jend )+ &
1262 & zeta(i,jend ,know)+ &
1263 & grid(ng)%h(i,jend+1)+ &
1264 & zeta(i,jend+1,know)))
1265 bry_str=cff1*(forces(ng)%svstr(i,jend+1)- &
1266 & forces(ng)%bvstr(i,jend+1))
1267 ce=1.0_r8/sqrt(g*0.5_r8*(grid(ng)%h(i,jend+1)+ &
1268 & zeta(i,jend+1,know)+ &
1269 & grid(ng)%h(i,jend )+ &
1270 & zeta(i,jend ,know)))
1271 cff2=grid(ng)%on_v(i,jend+1)*ce
1272!^ tl_bry_val=tl_vbar(i,Jend,know)+ &
1273!^ & tl_cff2*(bry_pgr+ &
1274!^ & bry_cor+ &
1275!^ & bry_str)+ &
1276!^ & cff2*(tl_bry_pgr+ &
1277!^ & tl_bry_cor+ &
1278!^ & tl_bry_str)
1279!^
1280 adfac=cff2*ad_bry_val
1281 ad_bry_pgr=ad_bry_pgr+adfac
1282 ad_bry_cor=ad_bry_cor+adfac
1283 ad_bry_str=ad_bry_str+adfac
1284 ad_cff2=ad_cff2+(bry_pgr+ &
1285 & bry_cor+ &
1286 & bry_str)*ad_bry_val
1287 ad_vbar(i,jend,know)=ad_vbar(i,jend,know)+ad_bry_val
1288 ad_bry_val=0.0_r8
1289!^ tl_cff2=GRID(ng)%on_v(i,Jend+1)*tl_Ce
1290!^
1291 ad_ce=ad_ce+grid(ng)%on_v(i,jend+1)*ad_cff2
1292 ad_cff2=0.0_r8
1293!^ tl_Ce=-Ce*Ce*Ce*0.25_r8*g*(GRID(ng)%tl_h(i,Jend+1)+ &
1294!^ & tl_zeta(i,Jend+1,know)+ &
1295!^ & GRID(ng)%tl_h(i,Jend )+ &
1296!^ & tl_zeta(i,Jend ,know))
1297!^
1298 adfac=-ce*ce*ce*0.25_r8*g*ad_ce
1299 ad_zeta(i,jend ,know)=ad_zeta(i,jend ,know)+adfac
1300 ad_zeta(i,jend+1,know)=ad_zeta(i,jend+1,know)+adfac
1301 grid(ng)%ad_h(i,jend )=grid(ng)%ad_h(i,jend )+adfac
1302 grid(ng)%ad_h(i,jend+1)=grid(ng)%ad_h(i,jend+1)+adfac
1303 ad_ce=0.0_r8
1304!^ tl_bry_str=tl_cff1*(FORCES(ng)%svstr(i,Jend+1)- &
1305!^ & FORCES(ng)%bvstr(i,Jend+1))+ &
1306!^ & cff1*(FORCES(ng)%tl_svstr(i,Jend+1)- &
1307!^ & FORCES(ng)%tl_bvstr(i,Jend+1))
1308!^
1309 adfac=cff1*ad_bry_str
1310 forces(ng)%ad_svstr(i,jend+1)= &
1311 & forces(ng)%ad_svstr(i,jend+1)+ &
1312 & adfac
1313 forces(ng)%ad_bvstr(i,jend+1)= &
1314 & forces(ng)%ad_bvstr(i,jend+1)- &
1315 & adfac
1316 ad_cff1=ad_cff1+(forces(ng)%svstr(i,jend+1)- &
1317 & forces(ng)%bvstr(i,jend+1))*ad_bry_str
1318
1319 ad_bry_str=0.0_r8
1320!^ tl_cff1=-cff1*cff1*0.5_r8*(GRID(ng)%tl_h(i,Jend )+ &
1321!^ & tl_zeta(i,Jend ,know)+ &
1322!^ & GRID(ng)%tl_h(i,Jend+1)+ &
1323!^ & tl_zeta(i,Jend+1,know))
1324!^
1325 adfac=-cff1*cff1*0.5_r8*ad_cff1
1326 ad_zeta(i,jend ,know)=ad_zeta(i,jend ,know)+adfac
1327 ad_zeta(i,jend+1,know)=ad_zeta(i,jend+1,know)+adfac
1328 grid(ng)%ad_h(i,jend )=grid(ng)%ad_h(i,jend )+adfac
1329 grid(ng)%ad_h(i,jend+1)=grid(ng)%ad_h(i,jend+1)+adfac
1330 ad_cff1=0.0_r8
1331# ifdef UV_COR
1332!^ tl_bry_cor=-0.125_r8*(tl_ubar(i ,Jend ,know)+ &
1333!^ & tl_ubar(i+1,Jend ,know)+ &
1334!^ & tl_ubar(i ,Jend+1,know)+ &
1335!^ & tl_ubar(i+1,Jend+1,know))* &
1336!^ & (GRID(ng)%f(i,Jend )+ &
1337!^ & GRID(ng)%f(i,Jend+1))
1338!^
1339 adfac=0.125_r8*(grid(ng)%f(i,jend )+ &
1340 & grid(ng)%f(i,jend+1))*ad_bry_cor
1341 ad_ubar(i ,jend ,know)=ad_ubar(i ,jend ,know)-adfac
1342 ad_ubar(i+1,jend ,know)=ad_ubar(i+1,jend ,know)-adfac
1343 ad_ubar(i ,jend+1,know)=ad_ubar(i ,jend+1,know)-adfac
1344 ad_ubar(i+1,jend+1,know)=ad_ubar(i+1,jend+1,know)-adfac
1345 ad_bry_cor=0.0_r8
1346# else
1347!^ tl_bry_cor=0.0_r8
1348!^
1349# endif
1350 IF (ad_lbc(inorth,isfsur,ng)%acquire) THEN
1351# ifdef ADJUST_BOUNDARY
1352 IF (lobc(inorth,isvbar,ng)) THEN
1353!^ tl_bry_pgr=tl_bry_pgr- &
1354!^ & g*BOUNDARY(ng)%tl_zeta_north(i)* &
1355!^ & 0.5_r8*GRID(ng)%pn(i,Jend)
1356!^
1357 boundary(ng)%ad_zeta_north(i)=boundary(ng)% &
1358 & ad_zeta_north(i)- &
1359 & g*0.5_r8* &
1360 & grid(ng)%pn(i,jend)* &
1361 & ad_bry_pgr
1362 END IF
1363# endif
1364!^ tl_bry_pgr=g*tl_zeta(i,Jend,know)* &
1365!^ & 0.5_r8*GRID(ng)%pn(i,Jend)
1366!^
1367 ad_zeta(i,jend,know)=ad_zeta(i,jend,know)+ &
1368 & g*0.5_r8*grid(ng)%pn(i,jend)* &
1369 & ad_bry_pgr
1370 ad_bry_pgr=0.0_r8
1371 ELSE
1372!^ tl_bry_pgr=-g*(tl_zeta(i,Jend+1,know)- &
1373!^ & tl_zeta(i,Jend ,know))* &
1374!^ & 0.5_r8*(GRID(ng)%pn(i,Jend )+ &
1375!^ & GRID(ng)%pn(i,Jend+1))
1376!^
1377 adfac=-g*0.5_r8*(grid(ng)%pn(i,jend )+ &
1378 & grid(ng)%pn(i,jend+1))*ad_bry_pgr
1379 ad_zeta(i,jend ,know)=ad_zeta(i,jend ,know)-adfac
1380 ad_zeta(i,jend+1,know)=ad_zeta(i,jend+1,know)+adfac
1381 ad_bry_pgr=0.0_r8
1382 END IF
1383# else
1384# ifdef ADJUST_BOUNDARY
1385 IF (lobc(inorth,isvbar,ng)) THEN
1386!^ tl_bry_val=BOUNDARY(ng)%tl_vbar_north(i)
1387!^
1388 boundary(ng)%ad_vbar_north(i)=boundary(ng)% &
1389 & ad_vbar_north(i)+ &
1390 & ad_bry_val
1391 ad_bry_val=0.0_r8
1392 ELSE
1393!^ tl_bry_val=0.0_r8
1394!^
1395 ad_bry_val=0.0_r8
1396 END IF
1397# else
1398!^ tl_bry_val=0.0_r8
1399!^
1400 ad_bry_val=0.0_r8
1401# endif
1402# endif
1403 END IF
1404 END DO
1405!
1406! Northern edge, clamped boundary condition.
1407!
1408 ELSE IF (ad_lbc(inorth,isvbar,ng)%clamped) THEN
1409 DO i=istr,iend
1410 IF (lbc_apply(ng)%north(i)) THEN
1411# ifdef MASKING
1412!^ tl_vbar(i,Jend+1,kout)=tl_vbar(i,Jend+1,kout)* &
1413!^ & GRID(ng)%vmask(i,Jend+1)
1414!^
1415 ad_vbar(i,jend+1,kout)=ad_vbar(i,jend+1,kout)* &
1416 & grid(ng)%vmask(i,jend+1)
1417# endif
1418# ifdef ADJUST_BOUNDARY
1419 IF (lobc(inorth,isvbar,ng)) THEN
1420!^ tl_vbar(i,Jend+1,kout)=BOUNDARY(ng)%tl_vbar_north(i)
1421!^
1422 boundary(ng)%ad_vbar_north(i)=boundary(ng)% &
1423 & ad_vbar_north(i)+ &
1424 & ad_vbar(i,jend+1,kout)
1425 ad_vbar(i,jend+1,kout)=0.0_r8
1426 ELSE
1427!^ tl_vbar(i,Jend+1,kout)=0.0_r8
1428!^
1429 ad_vbar(i,jend+1,kout)=0.0_r8
1430 END IF
1431# else
1432!^ tl_vbar(i,Jend+1,kout)=0.0_r8
1433!^
1434 ad_vbar(i,jend+1,kout)=0.0_r8
1435# endif
1436 END IF
1437 END DO
1438!
1439! Northern edge, gradient boundary condition.
1440!
1441 ELSE IF (ad_lbc(inorth,isvbar,ng)%gradient) THEN
1442 DO i=istr,iend
1443 IF (lbc_apply(ng)%north(i)) THEN
1444# ifdef MASKING
1445!^ tl_vbar(i,Jend+1,kout)=tl_vbar(i,Jend+1,kout)* &
1446!^ & GRID(ng)%vmask(i,Jend+1)
1447!^
1448 ad_vbar(i,jend+1,kout)=ad_vbar(i,jend+1,kout)* &
1449 & grid(ng)%vmask(i,jend+1)
1450# endif
1451!^ tl_vbar(i,Jend+1,kout)=tl_vbar(i,Jend,kout)
1452!^
1453 ad_vbar(i,jend ,kout)=ad_vbar(i,jend,kout)+ &
1454 & ad_vbar(i,jend+1,kout)
1455 ad_vbar(i,jend+1,kout)=0.0_r8
1456 END IF
1457 END DO
1458!
1459! Northern edge, reduced-physics boundary condition.
1460!
1461 ELSE IF (ad_lbc(inorth,isvbar,ng)%reduced) THEN
1462 DO i=istr,iend
1463 IF (lbc_apply(ng)%north(i)) THEN
1464 cff=1.0_r8/(0.5_r8*(grid(ng)%h(i,jend )+ &
1465 & zeta(i,jend ,know)+ &
1466 & grid(ng)%h(i,jend+1)+ &
1467 & zeta(i,jend+1,know)))
1468# ifdef MASKING
1469!^ tl_vbar(i,Jend+1,kout)=tl_vbar(i,Jend+1,kout)* &
1470!^ & GRID(ng)%vmask(i,Jend+1)
1471!^
1472 ad_vbar(i,jend+1,kout)=ad_vbar(i,jend+1,kout)* &
1473 & grid(ng)%vmask(i,jend+1)
1474# endif
1475!^ tl_vbar(i,Jend+1,kout)=tl_vbar(i,Jend+1,know)+ &
1476!^ & dt2d*(tl_bry_pgr+ &
1477!^ & tl_bry_cor+ &
1478!^ & tl_bry_str)
1479!^
1480 adfac=dt2d*ad_vbar(i,jend+1,kout)
1481 ad_bry_pgr=ad_bry_pgr+adfac
1482 ad_bry_cor=ad_bry_cor+adfac
1483 ad_bry_str=ad_bry_str+adfac
1484 ad_vbar(i,jend+1,know)=ad_vbar(i,jend+1,know)+ &
1485 & ad_vbar(i,jend+1,kout)
1486 ad_vbar(i,jend+1,kout)=0.0_r8
1487!^ tl_bry_str=tl_cff*(FORCES(ng)%svstr(i,Jend+1)- &
1488!^ & FORCES(ng)%bvstr(i,Jend+1))+ &
1489!^ & cff*(FORCES(ng)%tl_svstr(i,Jend+1)- &
1490!^ & FORCES(ng)%tl_bvstr(i,Jend+1))
1491!^
1492 adfac=cff*ad_bry_str
1493 forces(ng)%ad_svstr(i,jend+1)= &
1494 & forces(ng)%ad_svstr(i,jend+1)+ &
1495 & adfac
1496 forces(ng)%ad_bvstr(i,jend+1)= &
1497 & forces(ng)%ad_bvstr(i,jend+1)- &
1498 & adfac
1499 ad_cff=ad_cff+(forces(ng)%svstr(i,jend+1)- &
1500 & forces(ng)%bvstr(i,jend+1))*ad_bry_str
1501 ad_bry_str=0.0_r8
1502!^ tl_cff=-cff*cff*0.5_r8*(GRID(ng)%tl_h(i,Jend )+ &
1503!^ & tl_zeta(i,Jend ,know)+ &
1504!^ & GRID(ng)%tl_h(i,Jend+1)+ &
1505!^ & tl_zeta(i,Jend+1,know))
1506!^
1507 adfac=-cff*cff*0.5_r8*ad_cff
1508 ad_zeta(i,jend ,know)=ad_zeta(i,jend ,know)+adfac
1509 ad_zeta(i,jend+1,know)=ad_zeta(i,jend+1,know)+adfac
1510 grid(ng)%ad_h(i,jend )=grid(ng)%ad_h(i,jend )+adfac
1511 grid(ng)%ad_h(i,jend+1)=grid(ng)%ad_h(i,jend+1)+adfac
1512 ad_cff=0.0_r8
1513# ifdef UV_COR
1514!^ tl_bry_cor=-0.125_r8*(tl_ubar(i ,Jend ,know)+ &
1515!^ & tl_ubar(i+1,Jend ,know)+ &
1516!^ & tl_ubar(i ,Jend+1,know)+ &
1517!^ & tl_ubar(i+1,Jend+1,know))* &
1518!^ & (GRID(ng)%f(i,Jend )+ &
1519!^ & GRID(ng)%f(i,Jend+1))
1520!^
1521 adfac=-0.125_r8*(grid(ng)%f(i,jend )+ &
1522 & grid(ng)%f(i,jend+1))*ad_bry_cor
1523 ad_ubar(i ,jend ,know)=ad_ubar(i ,jend ,know)+adfac
1524 ad_ubar(i+1,jend ,know)=ad_ubar(i+1,jend ,know)+adfac
1525 ad_ubar(i ,jend+1,know)=ad_ubar(i ,jend+1,know)+adfac
1526 ad_ubar(i+1,jend+1,know)=ad_ubar(i+1,jend+1,know)+adfac
1527 ad_bry_cor=0.0_r8
1528# else
1529!^ tl_bry_cor=0.0_r8
1530!^
1531 ad_bry_cor=0.0_r8
1532# endif
1533 IF (ad_lbc(inorth,isfsur,ng)%acquire) THEN
1534# ifdef ADJUST_BOUNDARY
1535 IF (lobc(inorth,isvbar,ng)) THEN
1536!^ tl_bry_pgr=tl_bry_pgr- &
1537!^ & g*BOUNDARY(ng)%tl_zeta_north(i)* &
1538!^ & 0.5_r8*GRID(ng)%pn(i,Jend)
1539!^
1540 boundary(ng)%ad_zeta_north(i)=boundary(ng)% &
1541 & ad_zeta_north(i)- &
1542 & g*0.5_r8* &
1543 & grid(ng)%pn(i,jend)* &
1544 & ad_bry_pgr
1545 END IF
1546# endif
1547!^ tl_bry_pgr=g*tl_zeta(i,Jend,know)* &
1548!^ & 0.5_r8*GRID(ng)%pn(i,Jend)
1549!^
1550 ad_zeta(i,jend,know)=ad_zeta(i,jend,know)+ &
1551 & g*0.5_r8*grid(ng)%pn(i,jend)* &
1552 & ad_bry_pgr
1553 ad_bry_pgr=0.0_r8
1554 ELSE
1555!^ tl_bry_pgr=-g*(tl_zeta(i,Jend+1,know)- &
1556!^ & tl_zeta(i,Jend ,know))* &
1557!^ & 0.5_r8*(GRID(ng)%pn(i,Jend )+ &
1558!^ & GRID(ng)%pn(i,Jend+1))
1559!^
1560 adfac=-g*0.5_r8*(grid(ng)%pn(i,jend )+ &
1561 & grid(ng)%pn(i,jend+1))*ad_bry_pgr
1562 ad_zeta(i,jend ,know)=ad_zeta(i,jend ,know)-adfac
1563 ad_zeta(i,jend+1,know)=ad_zeta(i,jend+1,know)+adfac
1564 ad_bry_pgr=0.0_r8
1565 END IF
1566 END IF
1567 END DO
1568!
1569! Northern edge, closed boundary condition.
1570!
1571 ELSE IF (ad_lbc(inorth,isvbar,ng)%closed) THEN
1572 DO i=istr,iend
1573 IF (lbc_apply(ng)%north(i)) THEN
1574!^ tl_vbar(i,Jend+1,kout)=0.0_r8
1575!^
1576 ad_vbar(i,jend+1,kout)=0.0_r8
1577 END IF
1578 END DO
1579 END IF
1580 END IF
1581!
1582!-----------------------------------------------------------------------
1583! Lateral boundary conditions at the southern edge.
1584!-----------------------------------------------------------------------
1585!
1586 IF (domain(ng)%Southern_Edge(tile)) THEN
1587!
1588! Southern edge, implicit upstream radiation condition.
1589!
1590 IF (ad_lbc(isouth,isvbar,ng)%radiation) THEN
1591 IF (iic(ng).ne.0) THEN
1592 DO i=istr,iend
1593 IF (lbc_apply(ng)%south(i)) THEN
1594# if defined CELERITY_READ && defined FORWARD_READ
1595 IF (ad_lbc(isouth,isvbar,ng)%nudging) THEN
1596 IF (lnudgem2clm(ng)) THEN
1597 obc_out=0.5_r8* &
1598 & (clima(ng)%M2nudgcof(i,jstr-1)+ &
1599 & clima(ng)%M2nudgcof(i,jstr ))
1600 obc_in =obcfac(ng)*obc_out
1601 ELSE
1602 obc_out=m2obc_out(ng,isouth)
1603 obc_in =m2obc_in(ng,isouth)
1604 END IF
1605 IF (boundary(ng)%vbar_south_Ce(i).lt.0.0_r8) THEN
1606 tau=obc_in
1607 ELSE
1608 tau=obc_out
1609 END IF
1610 tau=tau*dt2d
1611 END IF
1612# ifdef RADIATION_2D
1613 cx=boundary(ng)%vbar_south_Cx(i)
1614# else
1615 cx=0.0_r8
1616# endif
1617 ce=boundary(ng)%vbar_south_Ce(i)
1618 cff=boundary(ng)%vbar_south_C2(i)
1619# endif
1620# ifdef MASKING
1621!^ tl_vbar(i,Jstr,kout)=tl_vbar(i,Jstr,kout)* &
1622!^ & GRID(ng)%vmask(i,Jstr)
1623!^
1624 ad_vbar(i,jstr,kout)=ad_vbar(i,jstr,kout)* &
1625 & grid(ng)%vmask(i,jstr)
1626# endif
1627 IF (ad_lbc(isouth,isvbar,ng)%nudging) THEN
1628!^ tl_vbar(i,Jstr,kout)=tl_vbar(i,Jstr,kout)- &
1629!^ & tau*tl_vbar(i,Jstr,know)
1630!^
1631 ad_vbar(i,jstr,know)=ad_vbar(i,jstr,know)- &
1632 & tau*ad_vbar(i,jstr,kout)
1633 END IF
1634!^ tl_vbar(i,Jstr,kout)=(cff*tl_vbar(i,Jstr ,know)+ &
1635!^ & Ce *tl_vbar(i,Jstr+1,kout)- &
1636!^ & MAX(Cx,0.0_r8)* &
1637!^ & tl_grad(i ,Jstr)- &
1638!^ & MIN(Cx,0.0_r8)* &
1639!^ & tl_grad(i+1,Jstr))/ &
1640!^ & (cff+Ce)
1641!^
1642 adfac=ad_vbar(i,jstr,kout)/(cff+ce)
1643 ad_grad(i ,jstr)=ad_grad(i ,jstr)-max(cx,0.0_r8)*adfac
1644 ad_grad(i+1,jstr)=ad_grad(i+1,jstr)-min(cx,0.0_r8)*adfac
1645 ad_vbar(i,jstr ,know)=ad_vbar(i,jstr ,know)+cff*adfac
1646 ad_vbar(i,jstr-1,kout)=ad_vbar(i,jstr-1,kout)+ce *adfac
1647 ad_vbar(i,jstr ,kout)=0.0_r8
1648 END IF
1649 END DO
1650 END IF
1651!
1652! Southern edge, Flather boundary condition.
1653!
1654 ELSE IF (ad_lbc(isouth,isvbar,ng)%Flather) THEN
1655 DO i=istr,iend
1656 IF (lbc_apply(ng)%south(i)) THEN
1657 cff=1.0_r8/(0.5_r8*(grid(ng)%h(i,jstr-1)+ &
1658 & zeta(i,jstr-1,know)+ &
1659 & grid(ng)%h(i,jstr )+ &
1660 & zeta(i,jstr ,know)))
1661 ce=sqrt(g*cff)
1662# ifdef MASKING
1663!^ tl_vbar(i,Jstr,kout)=tl_vbar(i,Jstr,kout)* &
1664!^ & GRID(ng)%vmask(i,Jstr)
1665!^
1666 ad_vbar(i,jstr,kout)=ad_vbar(i,jstr,kout)* &
1667 & grid(ng)%vmask(i,jstr)
1668# endif
1669# ifdef ADJUST_BOUNDARY
1670 IF (lobc(isouth,isvbar,ng)) THEN
1671!^ tl_vbar(i,Jstr,kout)=tl_vbar(i,Jstr,kout)+ &
1672!^ & Ce*BOUNDARY(ng)%tl_zeta_south(i)
1673!^
1674 boundary(ng)%ad_zeta_south(i)=boundary(ng)% &
1675 & ad_zeta_south(i)+ &
1676 & ce*ad_vbar(i,jstr,kout)
1677 END IF
1678# endif
1679# if defined ATM_PRESS && defined PRESS_COMPENSATE
1680!^ tl_vbar(i,Jstr,kout)=tl_bry_val- &
1681!^ & tl_Ce* &
1682!^ & (0.5_r8* &
1683!^ & (zeta(i,Jstr-1,know)+ &
1684!^ & zeta(i,Jstr ,know)+ &
1685!^ & fac*(FORCES(ng)%Pair(i,Jstr-1)+ &
1686!^ & FORCES(ng)%Pair(i,Jstr )- &
1687!^ & 2.0_r8*OneAtm))- &
1688!^ & BOUNDARY(ng)%zeta_south(i))- &
1689!^ & Ce* &
1690!^ & (0.5_r8*(tl_zeta(i,Jstr-1,know)+ &
1691!^ & tl_zeta(i,Jstr ,know)))
1692!^
1693 adfac=ce*0.5_r8*ad_vbar(i,jstr,kout)
1694 ad_zeta(i,jstr-1,know)=ad_zeta(i,jstr-1,know)-adfac
1695 ad_zeta(i,jstr ,know)=ad_zeta(i,jstr ,know)-adfac
1696 ad_ce=ad_ce- &
1697 & (0.5_r8*(zeta(i,jstr-1,know)+ &
1698 & zeta(i,jstr ,know)+ &
1699 & fac*(forces(ng)%Pair(i,jstr-1)+ &
1700 & forces(ng)%Pair(i,jstr )- &
1701 & 2.0_r8*oneatm))- &
1702 & boundary(ng)%zeta_south(i))*ad_vbar(i,jstr,kout)
1703 ad_bry_val=ad_bry_val+ad_vbar(i,jstr,kout)
1704 ad_vbar(i,jstr,kout)=0.0_r8
1705# else
1706!^ tl_vbar(i,Jstr,kout)=tl_bry_val- &
1707!^ & tl_Ce* &
1708!^ & (0.5_r8*(zeta(i,Jstr-1,know)+ &
1709!^ & zeta(i,Jstr ,know))- &
1710!^ & BOUNDARY(ng)%zeta_south(i))- &
1711!^ & Ce* &
1712!^ & (0.5_r8*(tl_zeta(i,Jstr-1,know)+ &
1713!^ & tl_zeta(i,Jstr ,know)))
1714!^
1715 adfac=ce*0.5_r8*ad_vbar(i,jstr,kout)
1716 ad_zeta(i,jstr-1,know)=ad_zeta(i,jstr-1,know)-adfac
1717 ad_zeta(i,jstr ,know)=ad_zeta(i,jstr ,know)-adfac
1718 ad_ce=ad_ce- &
1719 & (0.5_r8*(zeta(i,jstr-1,know)+ &
1720 & zeta(i,jstr ,know))- &
1721 & boundary(ng)%zeta_south(i))*ad_vbar(i,jstr,kout)
1722 ad_bry_val=ad_bry_val+ad_vbar(i,jstr,kout)
1723 ad_vbar(i,jstr,kout)=0.0_r8
1724# endif
1725!^ tl_Ce=0.5_r8*g*tl_cff/Ce
1726!^
1727 ad_cff=ad_cff+0.5_r8*g*ad_ce/ce
1728 ad_ce=0.0_r8
1729!^ tl_cff=-cff*cff*(0.5_r8*(GRID(ng)%tl_h(i,Jstr-1)+ &
1730!^ & tl_zeta(i,Jstr-1,know)+ &
1731!^ & GRID(ng)%tl_h(i,Jstr )+ &
1732!^ & tl_zeta(i,Jstr ,know)))
1733!^
1734 adfac=-cff*cff*0.5_r8*ad_cff
1735 grid(ng)%ad_h(i,jstr-1)=grid(ng)%ad_h(i,jstr-1)+adfac
1736 grid(ng)%ad_h(i,jstr )=grid(ng)%ad_h(i,jstr )+adfac
1737 ad_zeta(i,jstr-1,know)=ad_zeta(i,jstr-1,know)+adfac
1738 ad_zeta(i,jstr ,know)=ad_zeta(i,jstr ,know)+adfac
1739 ad_cff=0.0_r8
1740
1741# if defined SSH_TIDES_NOT_YET && !defined UV_TIDES_NOT_YET
1742 IF (ad_lbc(isouth,isfsur,ng)%acquire) THEN
1743 bry_pgr=-g*(zeta(i,jstr,know)- &
1744 & boundary(ng)%zeta_south(i))* &
1745 & 0.5_r8*grid(ng)%pn(i,jstr)
1746 ELSE
1747 bry_pgr=-g*(zeta(i,jstr ,know)- &
1748 & zeta(i,jstr-1,know))* &
1749 & 0.5_r8*(grid(ng)%pn(i,jstr-1)+ &
1750 & grid(ng)%pn(i,jstr ))
1751 END IF
1752# ifdef UV_COR
1753 bry_cor=-0.125_r8*(ubar(i ,jstr-1,know)+ &
1754 & ubar(i+1,jstr-1,know)+ &
1755 & ubar(i ,jstr ,know)+ &
1756 & ubar(i+1,jstr ,know))* &
1757 & (grid(ng)%f(i,jstr-1)+ &
1758 & grid(ng)%f(i,jstr ))
1759# else
1760 bry_cor=0.0_r8
1761# endif
1762 cff1=1.0_r8/(0.5_r8*(grid(ng)%h(i,jstr-1)+ &
1763 & zeta(i,jstr-1,know)+ &
1764 & grid(ng)%h(i,jstr )+ &
1765 & zeta(i,jstr ,know)))
1766 bry_str=cff1*(forces(ng)%svstr(i,jstr)- &
1767 & forces(ng)%bvstr(i,jstr))
1768 ce=1.0_r8/sqrt(g*0.5_r8*(grid(ng)%h(i,jstr-1)+ &
1769 & zeta(i,jstr-1,know)+ &
1770 & grid(ng)%h(i,jstr )+ &
1771 & zeta(i,jstr ,know)))
1772 cff2=grid(ng)%on_v(i,jstr)*ce
1773!^ tl_bry_val=tl_vbar(i,Jstr+1,know)+ &
1774!^ & tl_cff2*(bry_pgr+ &
1775!^ & bry_cor+ &
1776!^ & bry_str)+ &
1777!^ & cff2*(tl_bry_pgr+ &
1778!^ & tl_bry_cor+ &
1779!^ & tl_bry_str)
1780!^
1781 adfac=cff2*ad_bry_val
1782 tl_bry_pgr=tl_bry_pgr+adfac
1783 tl_bry_cor=tl_bry_cor+adfac
1784 tl_bry_str=tl_bry_str+adfac
1785 ad_cff2=ad_cff2+(bry_pgr+ &
1786 & bry_cor+ &
1787 & bry_str)*ad_bry_val
1788 ad_vbar(i,jstr+1,know)=ad_vbar(i,jstr+1,know)+ad_bry_val
1789 ad_bry_val=0.0_r8
1790!^ tl_cff2=GRID(ng)%on_v(i,Jstr)*tl_Ce
1791!^
1792 ad_ce=ad_ce+grid(ng)%on_v(i,jstr)*ad_cff2
1793 ad_cff2=0.0_r8
1794!^ tl_Ce=-Ce*Ce*Ce*0.25_r8*g*(GRID(ng)%tl_h(i,Jstr-1)+ &
1795!^ & tl_zeta(i,Jstr-1,know)+ &
1796!^ & GRID(ng)%tl_h(i,Jstr )+ &
1797!^ & tl_zeta(i,Jstr ,know))
1798!^
1799 adfac=-ce*ce*ce*0.25_r8*g*ad_ce
1800 ad_zeta(i,jstr-1,know)=ad_zeta(i,jstr-1,know)+adfac
1801 ad_zeta(i,jstr ,know)=ad_zeta(i,jstr ,know)+adfac
1802 grid(ng)%ad_h(i,jstr-1)=grid(ng)%ad_h(i,jstr-1)+adfac
1803 grid(ng)%ad_h(i,jstr )=grid(ng)%ad_h(i,jstr )+adfac
1804 ad_ce=0.0_r8
1805!^ tl_bry_str=tl_cff1*(FORCES(ng)%svstr(i,Jstr)- &
1806!^ & FORCES(ng)%bvstr(i,Jstr))+ &
1807!^ & cff1*(FORCES(ng)%tl_svstr(i,Jstr)- &
1808!^ & FORCES(ng)%tl_bvstr(i,Jstr))
1809!^
1810 adfac=cff1*ad_bry_str
1811 forces(ng)%ad_svstr(i,jstr)=forces(ng)%ad_svstr(i,jstr)+ &
1812 & adfac
1813 forces(ng)%ad_bvstr(i,jstr)=forces(ng)%ad_bvstr(i,jstr)- &
1814 & adfac
1815 ad_cff1=ad_cff1+(forces(ng)%svstr(i,jstr)- &
1816 & forces(ng)%bvstr(i,jstr))*ad_bry_str
1817 ad_bry_str=0.0_r8
1818!^ tl_cff1=-cff1*cff1*(0.5_r8*(GRID(ng)%tl_h(i,Jstr-1)+ &
1819!^ & tl_zeta(i,Jstr-1,know)+ &
1820!^ & GRID(ng)%tl_h(i,Jstr )+ &
1821!^ & tl_zeta(i,Jstr ,know)))
1822!^
1823 adfac=-cff1*cff1*0.5_r8*ad_cff1
1824 ad_zeta(i,jstr-1,know)=ad_zeta(i,jstr-1,know)+adfac
1825 ad_zeta(i,jstr ,know)=ad_zeta(i,jstr ,know)+adfac
1826 grid(ng)%ad_h(i,jstr-1)=grid(ng)%ad_h(i,jstr-1)+adfac
1827 grid(ng)%ad_h(i,jstr )=grid(ng)%ad_h(i,jstr )+adfac
1828 ad_cff1=0.0_r8
1829# ifdef UV_COR
1830!^ tl_bry_cor=-0.125_r8*(tl_ubar(i ,Jstr-1,know)+ &
1831!^ & tl_ubar(i+1,Jstr-1,know)+ &
1832!^ & tl_ubar(i ,Jstr ,know)+ &
1833!^ & tl_ubar(i+1,Jstr ,know))* &
1834!^ & (GRID(ng)%f(i,Jstr-1)+ &
1835!^ & GRID(ng)%f(i,Jstr ))
1836!^
1837 adfac=-0.125_r8*(grid(ng)%f(i,jstr-1)+ &
1838 & grid(ng)%f(i,jstr ))*ad_bry_cor
1839 ad_ubar(i ,jstr-1,know)=ad_ubar(i ,jstr-1,know)+adfac
1840 ad_ubar(i+1,jstr-1,know)=ad_ubar(i+1,jstr-1,know)+adfac
1841 ad_ubar(i ,jstr ,know)=ad_ubar(i ,jstr ,know)+adfac
1842 ad_ubar(i+1,jstr ,know)=ad_ubar(i+1,jstr ,know)+adfac
1843 ad_bry_cor=0.0_r8
1844# else
1845!^ tl_bry_cor=0.0_r8
1846!^
1847 ad_bry_cor=0.0_r8
1848# endif
1849 IF (ad_lbc(isouth,isfsur,ng)%acquire) THEN
1850# ifdef ADJUST_BOUNDARY
1851 IF (lobc(isouth,isvbar,ng)) THEN
1852!^ tl_bry_pgr=tl_bry_pgr+ &
1853!^ & g*BOUNDARY(ng)%tl_zeta_south(i)* &
1854!^ & 0.5_r8*GRID(ng)%pn(i,Jstr)
1855!^
1856 boundary(ng)%ad_zeta_south(i)=boundary(ng)% &
1857 & ad_zeta_south(i)+ &
1858 & g*0.5_r8* &
1859 & grid(ng)%pn(i,jstr)* &
1860 & ad_bry_pgr
1861 END IF
1862# endif
1863!^ tl_bry_pgr=-g*tl_zeta(i,Jstr,know)* &
1864!^ & 0.5_r8*GRID(ng)%pn(i,Jstr)
1865!^
1866 tl_zeta(i,jstr,know)=tl_zeta(i,jstr,know)- &
1867 & g*0.5_r8*grid(ng)%pn(i,jstr)* &
1868 & ad_bry_pgr
1869 ad_bry_pgr=0.0_r8
1870 ELSE
1871!^ tl_bry_pgr=-g*(tl_zeta(i,Jstr ,know)- &
1872!^ & tl_zeta(i,Jstr-1,know))* &
1873!^ & 0.5_r8*(GRID(ng)%pn(i,Jstr-1)+ &
1874!^ & GRID(ng)%pn(i,Jstr ))
1875!^
1876 adfac=-g*0.5_r8*(grid(ng)%pn(i,jstr-1)+ &
1877 & grid(ng)%pn(i,jstr ))*ad_bry_pgr
1878 ad_zeta(i,jstr-1,know)=ad_zeta(i,jstr-1,know)-adfac
1879 ad_zeta(i,jstr ,know)=ad_zeta(i,jstr ,know)+adfac
1880 ad_bry_pgr=0.0_r8
1881 END IF
1882# else
1883# ifdef ADJUST_BOUNDARY
1884 IF (lobc(isouth,isvbar,ng)) THEN
1885!^ tl_bry_val=BOUNDARY(ng)%tl_vbar_south(i)
1886!^
1887 boundary(ng)%ad_vbar_south(i)=boundary(ng)% &
1888 & ad_vbar_south(i)+ &
1889 & ad_bry_val
1890 ad_bry_val=0.0_r8
1891 ELSE
1892!^ tl_bry_val=0.0_r8
1893!^
1894 ad_bry_val=0.0_r8
1895 END IF
1896# else
1897!^ tl_bry_val=0.0_r8
1898!^
1899 ad_bry_val=0.0_r8
1900# endif
1901# endif
1902 END IF
1903 END DO
1904!
1905! Southern edge, Shchepetkin boundary condition (Maison et al., 2010).
1906!
1907 ELSE IF (ad_lbc(isouth,isvbar,ng)%Shchepetkin) THEN
1908 DO i=istr,iend
1909 IF (lbc_apply(ng)%south(i)) THEN
1910 cff=0.5_r8*(grid(ng)%h(i,jstr-1)+ &
1911 & grid(ng)%h(i,jstr ))
1912 cff1=sqrt(g/cff)
1913 ce=dt2d*cff1*cff*0.5_r8*(grid(ng)%pn(i,jstr-1)+ &
1914 & grid(ng)%pn(i,jstr ))
1915 ze=(0.5_r8+ce)*zeta(i,jstr ,know)+ &
1916 & (0.5_r8-ce)*zeta(i,jstr-1,know)
1917 IF (ce.gt.co) THEN
1918 cff2=(1.0_r8-co/ce)**2
1919 cff3=zeta(i,jstr,kout)+ &
1920 & ce*zeta(i,jstr-1,know)- &
1921 & (1.0_r8+ce)*zeta(i,jstr,know)
1922 ze=ze+cff2*cff3
1923 END IF
1924# ifdef MASKING
1925!^ tl_vbar(i,Jstr,kout)=tl_vbar(i,Jstr,kout)* &
1926!^ & GRID(ng)%vmask(i,Jstr)
1927!^
1928 ad_vbar(i,jstr,kout)=ad_vbar(i,jstr,kout)* &
1929 & grid(ng)%vmask(i,jstr)
1930# endif
1931# ifdef ADJUST_BOUNDARY
1932 IF (lobc(isouth,isvbar,ng)) THEN
1933!^ tl_vbar(i,Jstr,kout)=tl_vbar(i,Jstr,kout)+ &
1934!^ & Ce*BOUNDARY(ng)%tl_zeta_south(i)
1935!^
1936 boundary(ng)%ad_zeta_south(i)=boundary(ng)% &
1937 & ad_zeta_south(i)+ &
1938 & ce*ad_vbar(i,jstr,kout)
1939 END IF
1940# endif
1941!^ tl_vbar(i,Jstr,kout)=0.5_r8* &
1942!^ & ((1.0_r8-Ce)* &
1943!^ & tl_vbar(i,Jstr,know)- &
1944!^ & tl_Ce*(vbar(i,Jstr ,know)- &
1945!^ & vbar(i,Jstr+1,know))+ &
1946!^ & Ce*tl_vbar(i,Jstr+1,know)+ &
1947!^ & tl_bry_val- &
1948!^ & tl_cff1* &
1949!^ & (Ze-BOUNDARY(ng)%zeta_south(i))- &
1950!^ & cff1*tl_Ze)
1951!^
1952 adfac=0.5_r8*ad_vbar(i,jstr,kout)
1953 ad_vbar(i,jstr ,know)=ad_vbar(i,jstr,know)+ &
1954 & (1.0_r8-ce)*adfac
1955 ad_vbar(i,jstr+1,know)=ad_vbar(i,jstr+1,know)+ &
1956 & ce*adfac
1957 ad_ce=ad_ce- &
1958 & (vbar(i,jstr ,know)- &
1959 & vbar(i,jstr+1,know))*adfac
1960 ad_bry_val=ad_bry_val+adfac
1961 ad_cff1=ad_cff1- &
1962 & (ze-boundary(ng)%zeta_south(i))*adfac
1963 ad_ze=ad_ze+cff1*adfac
1964 ad_vbar(i,jstr,kout)=0.0_r8
1965 IF (ce.gt.co) THEN
1966!^ tl_Ze=tl_Ze+cff2*tl_cff3+ &
1967!^ & tl_cff2*cff3
1968!^
1969 ad_cff2=ad_cff2+cff3*ad_ze
1970 ad_cff3=ad_cff3+cff2*ad_ze
1971!^ tl_cff3=tl_zeta(i,Jstr,kout)+ &
1972!^ & Ce*tl_zeta(i,Jstr-1,know)+ &
1973!^ & tl_Ce*(zeta(i,Jstr-1,know)+ &
1974!^ & zeta(i,Jstr ,know))- &
1975!^ & (1.0_r8+Ce)*tl_zeta(i,Jstr,know)
1976!^
1977 ad_zeta(i,jstr ,kout)=ad_zeta(i,jstr ,kout)+ &
1978 & ad_cff3
1979 ad_zeta(i,jstr ,know)=ad_zeta(i,jstr ,know)- &
1980 & (1.0_r8+ce)*ad_cff3
1981 ad_zeta(i,jstr-1,know)=ad_zeta(i,jstr-1,know)+ &
1982 & ce*ad_cff3
1983 ad_ce=ad_ce+ &
1984 & (zeta(i,jstr-1,know)+ &
1985 & zeta(i,jstr ,know))*ad_cff3
1986 ad_cff3=0.0_r8
1987!^ tl_cff2=2.0_r8*cff2*Co*tl_Ce/(Ce*Ce)
1988!^
1989 ad_ce=ad_ce+ &
1990 & 2.0_r8*cff2*co*ad_cff2/(ce*ce)
1991 ad_cff2=0.0_r8
1992 END IF
1993!^ tl_Ze=(0.5_r8+Ce)*tl_zeta(i,Jstr ,know)+ &
1994!^ & (0.5_r8-Ce)*tl_zeta(i,Jstr-1,know)+ &
1995!^ & tl_Ce*(zeta(i,Jstr ,know)- &
1996!^ & zeta(i,Jstr-1,know))
1997!^
1998 ad_zeta(i,jstr ,know)=ad_zeta(i,jstr ,know)+ &
1999 & (0.5_r8+ce)*ad_ze
2000 ad_zeta(i,jstr-1,know)=ad_zeta(i,jstr-1,know)+ &
2001 & (0.5_r8-ce)*ad_ze
2002 ad_ce=ad_ce+ &
2003 & (zeta(i,jstr ,know)- &
2004 & zeta(i,jstr-1,know))*ad_ze
2005 ad_ze=0.0_r8
2006!^ tl_Ce=dt2d*0.5_r8*(GRID(ng)%pn(i,Jstr-1)+ &
2007!^ & GRID(ng)%pn(i,Jstr ))* &
2008!^ & (cff1*tl_cff+ &
2009!^ & tl_cff1*cff)
2010!^
2011 adfac=dt2d*0.5_r8*(grid(ng)%pn(i,jstr-1)+ &
2012 & grid(ng)%pn(i,jstr ))*ad_ce
2013 ad_cff=ad_cff+cff1*adfac
2014 ad_cff1=ad_cff1+cff*adfac
2015 ad_ce=0.0_r8
2016!^ tl_cff1=-0.5_r8*cff1*tl_cff/cff
2017!^
2018 ad_cff=ad_cff- &
2019 & 0.5_r8*cff1*ad_cff1/cff
2020 ad_cff1=0.0_r8
2021
2022# ifdef WET_DRY_NOT_YET
2023!^ tl_cff=0.5_r8*(GRID(ng)%tl_h(i,Jstr-1)+ &
2024!^ & tl_zeta(i,Jstr-1,know)+ &
2025!^ & GRID(ng)%tl_h(i,Jstr )+ &
2026!^ & tl_zeta(i,Jstr ,know))
2027!^
2028 adfac=0.5_r8*ad_cff
2029 grid(ng)%ad_h(i,jstr-1)=grid(ng)%ad_h(i,jstr-1)+adfac
2030 grid(ng)%ad_h(i,jstr )=grid(ng)%ad_h(i,jstr )+adfac
2031 ad_zeta(i,jstr-1,know)=ad_zeta(i,jstr-1,know)+adfac
2032 ad_zeta(i,jstr ,know)=ad_zeta(i,jstr ,know)+adfac
2033 ad_cff=0.0_r8
2034# else
2035!^ tl_cff=0.5_r8*(GRID(ng)%tl_h(i,Jstr-1)+ &
2036!^ & GRID(ng)%tl_h(i,Jstr ))
2037!^
2038 adfac=0.5_r8*ad_cff
2039 grid(ng)%ad_h(i,jstr-1)=grid(ng)%ad_h(i,jstr-1)+adfac
2040 grid(ng)%ad_h(i,jstr )=grid(ng)%ad_h(i,jstr )+adfac
2041 ad_cff=0.0_r8
2042# endif
2043
2044# if defined SSH_TIDES_NOT_YET && !defined UV_TIDES_NOT_YET
2045 IF (ad_lbc(isouth,isfsur,ng)%acquire) THEN
2046 bry_pgr=-g*(zeta(i,jstr,know)- &
2047 & boundary(ng)%zeta_south(i))* &
2048 & 0.5_r8*grid(ng)%pn(i,jstr)
2049 ELSE
2050 bry_pgr=-g*(zeta(i,jstr ,know)- &
2051 & zeta(i,jstr-1,know))* &
2052 & 0.5_r8*(grid(ng)%pn(i,jstr-1)+ &
2053 & grid(ng)%pn(i,jstr ))
2054 END IF
2055# ifdef UV_COR
2056 bry_cor=-0.125_r8*(ubar(i ,jstr-1,know)+ &
2057 & ubar(i+1,jstr-1,know)+ &
2058 & ubar(i ,jstr ,know)+ &
2059 & ubar(i+1,jstr ,know))* &
2060 & (grid(ng)%f(i,jstr-1)+ &
2061 & grid(ng)%f(i,jstr ))
2062# else
2063 bry_cor=0.0_r8
2064# endif
2065 cff1=1.0_r8/(0.5_r8*(grid(ng)%h(i,jstr-1)+ &
2066 & zeta(i,jstr-1,know)+ &
2067 & grid(ng)%h(i,jstr )+ &
2068 & zeta(i,jstr ,know)))
2069 bry_str=cff1*(forces(ng)%svstr(i,jstr)- &
2070 & forces(ng)%bvstr(i,jstr))
2071 ce=1.0_r8/sqrt(g*0.5_r8*(grid(ng)%h(i,jstr-1)+ &
2072 & zeta(i,jstr-1,know)+ &
2073 & grid(ng)%h(i,jstr )+ &
2074 & zeta(i,jstr ,know)))
2075 cff2=grid(ng)%on_v(i,jstr)*ce
2076!^ tl_bry_val=tl_vbar(i,Jstr+1,know)+ &
2077!^ & tl_cff2*(bry_pgr+ &
2078!^ & bry_cor+ &
2079!^ & bry_str)+ &
2080!^ & cff2*(tl_bry_pgr+ &
2081!^ & tl_bry_cor+ &
2082!^ & tl_bry_str)
2083!^
2084 adfac=cff2*ad_bry_val
2085 tl_bry_pgr=tl_bry_pgr+adfac
2086 tl_bry_cor=tl_bry_cor+adfac
2087 tl_bry_str=tl_bry_str+adfac
2088 ad_cff2=ad_cff2+(bry_pgr+ &
2089 & bry_cor+ &
2090 & bry_str)*ad_bry_val
2091 ad_vbar(i,jstr+1,know)=ad_vbar(i,jstr+1,know)+ad_bry_val
2092 ad_bry_val=0.0_r8
2093!^ tl_cff2=GRID(ng)%on_v(i,Jstr)*tl_Ce
2094!^
2095 ad_ce=ad_ce+grid(ng)%on_v(i,jstr)*ad_cff2
2096 ad_cff2=0.0_r8
2097!^ tl_Ce=-Ce*Ce*Ce*0.25_r8*g*(GRID(ng)%tl_h(i,Jstr-1)+ &
2098!^ & tl_zeta(i,Jstr-1,know)+ &
2099!^ & GRID(ng)%tl_h(i,Jstr )+ &
2100!^ & tl_zeta(i,Jstr ,know))
2101!^
2102 adfac=-ce*ce*ce*0.25_r8*g*ad_ce
2103 ad_zeta(i,jstr-1,know)=ad_zeta(i,jstr-1,know)+adfac
2104 ad_zeta(i,jstr ,know)=ad_zeta(i,jstr ,know)+adfac
2105 grid(ng)%ad_h(i,jstr-1)=grid(ng)%ad_h(i,jstr-1)+adfac
2106 grid(ng)%ad_h(i,jstr )=grid(ng)%ad_h(i,jstr )+adfac
2107 ad_ce=0.0_r8
2108!^ tl_bry_str=tl_cff1*(FORCES(ng)%svstr(i,Jstr)- &
2109!^ & FORCES(ng)%bvstr(i,Jstr))+ &
2110!^ & cff1*(FORCES(ng)%tl_svstr(i,Jstr)- &
2111!^ & FORCES(ng)%tl_bvstr(i,Jstr))
2112!^
2113 adfac=cff1*ad_bry_str
2114 forces(ng)%ad_svstr(i,jstr)=forces(ng)%ad_svstr(i,jstr)+ &
2115 & adfac
2116 forces(ng)%ad_bvstr(i,jstr)=forces(ng)%ad_bvstr(i,jstr)- &
2117 & adfac
2118 ad_cff1=ad_cff1+(forces(ng)%svstr(i,jstr)- &
2119 & forces(ng)%bvstr(i,jstr))*ad_bry_str
2120 ad_bry_str=0.0_r8
2121!^ tl_cff1=-cff1*cff1*(0.5_r8*(GRID(ng)%tl_h(i,Jstr-1)+ &
2122!^ & tl_zeta(i,Jstr-1,know)+ &
2123!^ & GRID(ng)%tl_h(i,Jstr )+ &
2124!^ & tl_zeta(i,Jstr ,know)))
2125!^
2126 adfac=-cff1*cff1*0.5_r8*ad_cff1
2127 ad_zeta(i,jstr-1,know)=ad_zeta(i,jstr-1,know)+adfac
2128 ad_zeta(i,jstr ,know)=ad_zeta(i,jstr ,know)+adfac
2129 grid(ng)%ad_h(i,jstr-1)=grid(ng)%ad_h(i,jstr-1)+adfac
2130 grid(ng)%ad_h(i,jstr )=grid(ng)%ad_h(i,jstr )+adfac
2131 ad_cff1=0.0_r8
2132# ifdef UV_COR
2133!^ tl_bry_cor=-0.125_r8*(tl_ubar(i ,Jstr-1,know)+ &
2134!^ & tl_ubar(i+1,Jstr-1,know)+ &
2135!^ & tl_ubar(i ,Jstr ,know)+ &
2136!^ & tl_ubar(i+1,Jstr ,know))* &
2137!^ & (GRID(ng)%f(i,Jstr-1)+ &
2138!^ & GRID(ng)%f(i,Jstr ))
2139!^
2140 adfac=-0.125_r8*(grid(ng)%f(i,jstr-1)+ &
2141 & grid(ng)%f(i,jstr ))*ad_bry_cor
2142 ad_ubar(i ,jstr-1,know)=ad_ubar(i ,jstr-1,know)+adfac
2143 ad_ubar(i+1,jstr-1,know)=ad_ubar(i+1,jstr-1,know)+adfac
2144 ad_ubar(i ,jstr ,know)=ad_ubar(i ,jstr ,know)+adfac
2145 ad_ubar(i+1,jstr ,know)=ad_ubar(i+1,jstr ,know)+adfac
2146 ad_bry_cor=0.0_r8
2147# else
2148!^ tl_bry_cor=0.0_r8
2149!^
2150 ad_bry_cor=0.0_r8
2151# endif
2152 IF (ad_lbc(isouth,isfsur,ng)%acquire) THEN
2153# ifdef ADJUST_BOUNDARY
2154 IF (lobc(isouth,isvbar,ng)) THEN
2155!^ tl_bry_pgr=tl_bry_pgr+ &
2156!^ & g*BOUNDARY(ng)%tl_zeta_south(i)* &
2157!^ & 0.5_r8*GRID(ng)%pn(i,Jstr)
2158!^
2159 boundary(ng)%ad_zeta_south(i)=boundary(ng)% &
2160 & ad_zeta_south(i)+ &
2161 & g*0.5_r8* &
2162 & grid(ng)%pn(i,jstr)* &
2163 & ad_bry_pgr
2164 END IF
2165# endif
2166!^ tl_bry_pgr=-g*tl_zeta(i,Jstr,know)* &
2167!^ & 0.5_r8*GRID(ng)%pn(i,Jstr)
2168!^
2169 tl_zeta(i,jstr,know)=tl_zeta(i,jstr,know)- &
2170 & g*0.5_r8*grid(ng)%pn(i,jstr)* &
2171 & ad_bry_pgr
2172 ad_bry_pgr=0.0_r8
2173 ELSE
2174!^ tl_bry_pgr=-g*(tl_zeta(i,Jstr ,know)- &
2175!^ & tl_zeta(i,Jstr-1,know))* &
2176!^ & 0.5_r8*(GRID(ng)%pn(i,Jstr-1)+ &
2177!^ & GRID(ng)%pn(i,Jstr ))
2178!^
2179 adfac=-g*0.5_r8*(grid(ng)%pn(i,jstr-1)+ &
2180 & grid(ng)%pn(i,jstr ))*ad_bry_pgr
2181 ad_zeta(i,jstr-1,know)=ad_zeta(i,jstr-1,know)-adfac
2182 ad_zeta(i,jstr ,know)=ad_zeta(i,jstr ,know)+adfac
2183 ad_bry_pgr=0.0_r8
2184 END IF
2185# else
2186# ifdef ADJUST_BOUNDARY
2187 IF (lobc(isouth,isvbar,ng)) THEN
2188!^ tl_bry_val=BOUNDARY(ng)%tl_vbar_south(i)
2189!^
2190 boundary(ng)%ad_vbar_south(i)=boundary(ng)% &
2191 & ad_vbar_south(i)+ &
2192 & ad_bry_val
2193 ad_bry_val=0.0_r8
2194 ELSE
2195!^ tl_bry_val=0.0_r8
2196!^
2197 ad_bry_val=0.0_r8
2198 END IF
2199# else
2200!^ tl_bry_val=0.0_r8
2201!^
2202 ad_bry_val=0.0_r8
2203# endif
2204# endif
2205 END IF
2206 END DO
2207!
2208! Southern edge, clamped boundary condition.
2209!
2210 ELSE IF (ad_lbc(isouth,isvbar,ng)%clamped) THEN
2211 DO i=istr,iend
2212 IF (lbc_apply(ng)%south(i)) THEN
2213# ifdef MASKING
2214!^ tl_vbar(i,Jstr,kout)=tl_vbar(i,Jstr,kout)* &
2215!^ & GRID(ng)%vmask(i,Jstr)
2216!^
2217 ad_vbar(i,jstr,kout)=ad_vbar(i,jstr,kout)* &
2218 & grid(ng)%vmask(i,jstr)
2219# endif
2220# ifdef ADJUST_BOUNDARY
2221 IF (lobc(isouth,isvbar,ng)) THEN
2222!^ tl_vbar(i,Jstr,kout)=BOUNDARY(ng)%tl_vbar_south(i)
2223!^
2224 boundary(ng)%ad_vbar_south(i)=boundary(ng)% &
2225 & ad_vbar_south(i)+ &
2226 & ad_vbar(i,jstr,kout)
2227 ad_vbar(i,jstr,kout)=0.0_r8
2228 ELSE
2229!^ tl_vbar(i,Jstr,kout)=0.0_r8
2230!^
2231 ad_vbar(i,jstr,kout)=0.0_r8
2232 END IF
2233# else
2234!^ tl_vbar(i,Jstr,kout)=0.0_r8
2235!^
2236 ad_vbar(i,jstr,kout)=0.0_r8
2237# endif
2238 END IF
2239 END DO
2240!
2241! Southern edge, gradient boundary condition.
2242!
2243 ELSE IF (ad_lbc(isouth,isvbar,ng)%gradient) THEN
2244 DO i=istr,iend
2245 IF (lbc_apply(ng)%south(i)) THEN
2246# ifdef MASKING
2247!^ tl_vbar(i,Jstr,kout)=tl_vbar(i,Jstr,kout)* &
2248!^ & GRID(ng)%vmask(i,Jstr)
2249!^
2250 ad_vbar(i,jstr,kout)=ad_vbar(i,jstr,kout)* &
2251 & grid(ng)%vmask(i,jstr)
2252# endif
2253!^ tl_vbar(i,Jstr,kout)=tl_vbar(i,Jstr+1,kout)
2254!^
2255 ad_vbar(i,jstr+1,kout)=ad_vbar(i,jstr+1,kout)+ &
2256 & ad_vbar(i,jstr,kout)
2257 ad_vbar(i,jstr ,kout)=0.0_r8
2258 END IF
2259 END DO
2260!
2261! Southern edge, reduced-physics boundary condition.
2262!
2263 ELSE IF (ad_lbc(isouth,isvbar,ng)%reduced) THEN
2264 DO i=istr,iend
2265 IF (lbc_apply(ng)%south(i)) THEN
2266 cff=1.0_r8/(0.5_r8*(grid(ng)%h(i,jstr-1)+ &
2267 & zeta(i,jstr-1,know)+ &
2268 & grid(ng)%h(i,jstr )+ &
2269 & zeta(i,jstr ,know)))
2270# ifdef MASKING
2271!^ tl_vbar(i,Jstr,kout)=tl_vbar(i,Jstr,kout)* &
2272!^ & GRID(ng)%vmask(i,Jstr)
2273!^
2274 ad_vbar(i,jstr,kout)=ad_vbar(i,jstr,kout)* &
2275 & grid(ng)%vmask(i,jstr)
2276# endif
2277!^ tl_vbar(i,Jstr,kout)=tl_vbar(i,Jstr,know)+ &
2278!^ & dt2d*(tl_bry_pgr+ &
2279!^ & tl_bry_cor+ &
2280!^ & tl_bry_str)
2281!^
2282 adfac=dt2d*ad_vbar(i,jstr,kout)
2283 ad_bry_pgr=ad_bry_pgr+adfac
2284 ad_bry_cor=ad_bry_cor+adfac
2285 ad_bry_str=ad_bry_str+adfac
2286 ad_vbar(i,jstr,know)=ad_vbar(i,jstr,know)+ &
2287 & ad_vbar(i,jstr,kout)
2288 ad_vbar(i,jstr,kout)=0.0_r8
2289!^ tl_bry_str=tl_cff*(FORCES(ng)%svstr(i,Jstr)- &
2290!^ & FORCES(ng)%bvstr(i,Jstr))+ &
2291!^ & cff*(FORCES(ng)%tl_svstr(i,Jstr)- &
2292!^ & FORCES(ng)%tl_bvstr(i,Jstr))
2293!^
2294 adfac=cff*ad_bry_str
2295 forces(ng)%ad_svstr(i,jstr)=forces(ng)%ad_svstr(i,jstr)+ &
2296 & adfac
2297 forces(ng)%ad_bvstr(i,jstr)=forces(ng)%ad_bvstr(i,jstr)- &
2298 & adfac
2299 ad_cff=ad_cff+(forces(ng)%svstr(i,jstr)- &
2300 & forces(ng)%bvstr(i,jstr))*ad_bry_str
2301 ad_bry_str=0.0_r8
2302!^ tl_cff=-cff*cff*0.5_r8*(GRID(ng)%tl_h(i,Jstr-1)+ &
2303!^ & tl_zeta(i,Jstr-1,know)+ &
2304!^ & GRID(ng)%tl_h(i,Jstr )+ &
2305!^ & tl_zeta(i,Jstr ,know))
2306!^
2307 adfac=-cff*cff*0.5_r8*ad_cff
2308 ad_zeta(i,jstr-1,know)=ad_zeta(i,jstr-1,know)+adfac
2309 ad_zeta(i,jstr ,know)=ad_zeta(i,jstr ,know)+adfac
2310 grid(ng)%ad_h(i,jstr-1)=grid(ng)%ad_h(i,jstr-1)+adfac
2311 grid(ng)%ad_h(i,jstr )=grid(ng)%ad_h(i,jstr )+adfac
2312 ad_cff=0.0_r8
2313# ifdef UV_COR
2314!^ tl_bry_cor=-0.125_r8*(tl_ubar(i ,Jstr-1,know)+ &
2315!^ & tl_ubar(i+1,Jstr-1,know)+ &
2316!^ & tl_ubar(i ,Jstr ,know)+ &
2317!^ & tl_ubar(i+1,Jstr ,know))* &
2318!^ & (GRID(ng)%f(i,Jstr-1)+ &
2319!^ & GRID(ng)%f(i,Jstr ))
2320!^
2321 adfac=-0.125_r8*(grid(ng)%f(i,jstr-1)+ &
2322 & grid(ng)%f(i,jstr ))*ad_bry_cor
2323 ad_ubar(i ,jstr-1,know)=ad_ubar(i ,jstr-1,know)+adfac
2324 ad_ubar(i+1,jstr-1,know)=ad_ubar(i+1,jstr-1,know)+adfac
2325 ad_ubar(i ,jstr ,know)=ad_ubar(i ,jstr ,know)+adfac
2326 ad_ubar(i+1,jstr ,know)=ad_ubar(i+1,jstr ,know)+adfac
2327 ad_bry_cor=0.0_r8
2328# else
2329!^ bry_cor=0.0_r8
2330!^
2331 tl_bry_cor=0.0_r8
2332# endif
2333 IF (ad_lbc(isouth,isfsur,ng)%acquire) THEN
2334# ifdef ADJUST_BOUNDARY
2335 IF (lobc(isouth,isvbar,ng)) THEN
2336!^ tl_bry_pgr=tl_bry_pgr+ &
2337!^ & g*BOUNDARY(ng)%tl_zeta_south(i)* &
2338!^ & 0.5_r8*GRID(ng)%pn(i,Jstr)
2339!^
2340 boundary(ng)%ad_zeta_south(i)=boundary(ng)% &
2341 & ad_zeta_south(i)+ &
2342 & g*0.5_r8* &
2343 & grid(ng)%pn(i,jstr)* &
2344 & ad_bry_pgr
2345 END IF
2346# endif
2347!^ tl_bry_pgr=-g*tl_zeta(i,Jstr,know)* &
2348!^ & 0.5_r8*GRID(ng)%pn(i,Jstr)
2349!^
2350 ad_zeta(i,jstr,know)=ad_zeta(i,jstr,know)- &
2351 & g*0.5_r8*grid(ng)%pn(i,jstr)* &
2352 & ad_bry_pgr
2353 ad_bry_pgr=0.0_r8
2354 ELSE
2355!^ tl_bry_pgr=-g*(tl_zeta(i,Jstr ,know)- &
2356!^ & tl_zeta(i,Jstr-1,know))* &
2357!^ & 0.5_r8*(GRID(ng)%pn(i,Jstr-1)+ &
2358!^ & GRID(ng)%pn(i,Jstr ))
2359!^
2360 adfac=-g*0.5_r8*(grid(ng)%pn(i,jstr-1)+ &
2361 & grid(ng)%pn(i,jstr ))*ad_bry_pgr
2362 ad_zeta(i,jstr-1,know)=ad_zeta(i,jstr-1,know)-adfac
2363 ad_zeta(i,jstr ,know)=ad_zeta(i,jstr ,know)+adfac
2364 ad_bry_pgr=0.0_r8
2365 END IF
2366 END IF
2367 END DO
2368!
2369! Southern edge, closed boundary condition.
2370!
2371 ELSE IF (ad_lbc(isouth,isvbar,ng)%closed) THEN
2372 DO i=istr,iend
2373 IF (lbc_apply(ng)%south(i)) THEN
2374!^ tl_vbar(i,Jstr,kout)=0.0_r8
2375!^
2376 ad_vbar(i,jstr,kout)=0.0_r8
2377 END IF
2378 END DO
2379 END IF
2380 END IF
2381
2382 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::isvbar
integer isvbar
Definition mod_ncparam.F:505
mod_ncparam::isfsur
integer isfsur
Definition mod_ncparam.F:503
mod_param::ad_lbc
type(t_lbc), dimension(:,:,:), allocatable ad_lbc
Definition mod_param.F:378
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_param::ad_lbc, 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::isvbar, 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, and mod_scalars::rho0.

Referenced by ad_ini_fields_mod::ad_ini_fields_tile(), ad_ini_fields_mod::ad_out_fields_tile(), ad_step2d_mod::ad_step2d_tile(), ad_step2d_mod::ad_step2d_tile(), ad_step2d_mod::ad_step2d_tile(), and ad_v2dbc().

Here is the caller graph for this function: