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

Functions/Subroutines

subroutine, public ad_u3dbc (ng, tile, nout)
 
subroutine, public ad_u3dbc_tile (ng, tile, lbi, ubi, lbj, ubj, ubk, imins, imaxs, jmins, jmaxs, nstp, nout, ad_u)
 

Function/Subroutine Documentation

◆ ad_u3dbc()

subroutine, public ad_u3dbc_mod::ad_u3dbc ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) nout )

Definition at line 27 of file ad_u3dbc_im.F.

28!***********************************************************************
29!
30 USE mod_param
31 USE mod_ocean
32 USE mod_stepping
33!
34! Imported variable declarations.
35!
36 integer, intent(in) :: ng, tile, nout
37!
38! Local variable declarations.
39!
40# include "tile.h"
41!
42 CALL ad_u3dbc_tile (ng, tile, &
43 & lbi, ubi, lbj, ubj, n(ng), &
44 & imins, imaxs, jmins, jmaxs, &
45 & nstp(ng), nout, &
46 & ocean(ng) % ad_u)
47 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_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479
mod_stepping
Definition mod_stepping.F:2
mod_stepping::nstp
integer, dimension(:), allocatable nstp
Definition mod_stepping.F:71

References ad_u3dbc_tile(), mod_param::n, mod_stepping::nstp, and mod_ocean::ocean.

Here is the call graph for this function:

◆ ad_u3dbc_tile()

subroutine, public ad_u3dbc_mod::ad_u3dbc_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) ubk,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) nstp,
integer, intent(in) nout,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) ad_u )

Definition at line 52 of file ad_u3dbc_im.F.

57!***********************************************************************
58!
59 USE mod_param
60 USE mod_boundary
61 USE mod_clima
62 USE mod_grid
63 USE mod_ncparam
64 USE mod_scalars
65!
66! Imported variable declarations.
67!
68 integer, intent(in) :: ng, tile
69 integer, intent(in) :: LBi, UBi, LBj, UBj, UBk
70 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
71 integer, intent(in) :: nstp, nout
72!
73# ifdef ASSUMED_SHAPE
74 real(r8), intent(inout) :: ad_u(LBi:,LBj:,:,:)
75# else
76 real(r8), intent(inout) :: ad_u(LBi:UBi,LBj:UBj,UBk,2)
77# endif
78!
79! Local variable declarations.
80!
81 integer :: Imin, Imax
82 integer :: i, j, k
83
84 real(r8) :: Ce, Cx, cff
85 real(r8) :: obc_in, obc_out, tau
86 real(r8) :: adfac
87
88 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ad_grad
89
90# include "set_bounds.h"
91!
92!-----------------------------------------------------------------------
93! Initialize adjoint private variables.
94!-----------------------------------------------------------------------
95!
96 ad_grad(lbi:ubi,lbj:ubj)=0.0_r8
97!
98!-----------------------------------------------------------------------
99! Boundary corners.
100!-----------------------------------------------------------------------
101!
102 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
103 IF (domain(ng)%NorthEast_Corner(tile)) THEN
104 IF (lbc_apply(ng)%north(iend+1).and. &
105 & lbc_apply(ng)%east (jend+1)) THEN
106 DO k=1,n(ng)
107!^ tl_u(Iend+1,Jend+1,k,nout)=0.5_r8* &
108!^ & (tl_u(Iend+1,Jend ,k,nout)+ &
109!^ & tl_u(Iend ,Jend+1,k,nout))
110!^
111 adfac=0.5_r8*ad_u(iend+1,jend+1,k,nout)
112 ad_u(iend+1,jend ,k,nout)=ad_u(iend+1,jend ,k,nout)+ &
113 & adfac
114 ad_u(iend ,jend+1,k,nout)=ad_u(iend ,jend+1,k,nout)+ &
115 & adfac
116 ad_u(iend+1,jend+1,k,nout)=0.0_r8
117 END DO
118 END IF
119 END IF
120 IF (domain(ng)%NorthWest_Corner(tile)) THEN
121 IF (lbc_apply(ng)%north(istr ).and. &
122 & lbc_apply(ng)%west (jend+1)) THEN
123 DO k=1,n(ng)
124!^ tl_u(Istr,Jend+1,k,nout)=0.5_r8* &
125!^ & (tl_u(Istr ,Jend ,k,nout)+ &
126!^ & tl_u(Istr+1,Jend+1,k,nout))
127!^
128 adfac=0.5_r8*ad_u(istr,jend+1,k,nout)
129 ad_u(istr ,jend ,k,nout)=ad_u(istr ,jend ,k,nout)+ &
130 & adfac
131 ad_u(istr+1,jend+1,k,nout)=ad_u(istr+1,jend+1,k,nout)+ &
132 & adfac
133 ad_u(istr ,jend+1,k,nout)=0.0_r8
134 END DO
135 END IF
136 END IF
137 IF (domain(ng)%SouthEast_Corner(tile)) THEN
138 IF (lbc_apply(ng)%south(iend+1).and. &
139 & lbc_apply(ng)%east (jstr-1)) THEN
140 DO k=1,n(ng)
141!^ tl_u(Iend+1,Jstr-1,k,nout)=0.5_r8* &
142!^ & (tl_u(Iend ,Jstr-1,k,nout)+ &
143!^ & tl_u(Iend+1,Jstr ,k,nout))
144!^
145 adfac=0.5_r8*ad_u(iend+1,jstr-1,k,nout)
146 ad_u(iend ,jstr-1,k,nout)=ad_u(iend ,jstr-1,k,nout)+ &
147 & adfac
148 ad_u(iend+1,jstr ,k,nout)=ad_u(iend+1,jstr ,k,nout)+ &
149 & adfac
150 ad_u(iend+1,jstr-1,k,nout)=0.0_r8
151 END DO
152 END IF
153 END IF
154 IF (domain(ng)%SouthWest_Corner(tile)) THEN
155 IF (lbc_apply(ng)%south(istr ).and. &
156 & lbc_apply(ng)%west (jstr-1)) THEN
157 DO k=1,n(ng)
158!^ tl_u(Istr,Jstr-1,k,nout)=0.5_r8* &
159!^ & (tl_u(Istr+1,Jstr-1,k,nout)+ &
160!^ & tl_u(Istr ,Jstr ,k,nout))
161!^
162 adfac=0.5_r8*ad_u(istr,jstr-1,k,nout)
163 ad_u(istr+1,jstr-1,k,nout)=ad_u(istr+1,jstr-1,k,nout)+ &
164 & adfac
165 ad_u(istr ,jstr ,k,nout)=ad_u(istr ,jstr ,k,nout)+ &
166 & adfac
167 ad_u(istr ,jstr-1,k,nout)=0.0_r8
168 END DO
169 END IF
170 END IF
171 END IF
172!
173!-----------------------------------------------------------------------
174! Lateral boundary conditions at the northern edge.
175!-----------------------------------------------------------------------
176!
177 IF (domain(ng)%Northern_Edge(tile)) THEN
178!
179! Northern edge, implicit upstream radiation condition.
180!
181 IF (ad_lbc(inorth,isuvel,ng)%radiation) THEN
182 IF (iic(ng).ne.0) THEN
183 DO k=1,n(ng)
184 DO i=istru,iend
185 IF (lbc_apply(ng)%north(i)) THEN
186# if defined CELERITY_READ && defined FORWARD_READ
187 IF (ad_lbc(inorth,isuvel,ng)%nudging) THEN
188 IF (lnudgem3clm(ng)) THEN
189 obc_out=0.5_r8* &
190 & (clima(ng)%M3nudgcof(i-1,jend+1,k)+ &
191 & clima(ng)%M3nudgcof(i ,jend+1,k))
192 obc_in =obcfac(ng)*obc_out
193 ELSE
194 obc_out=m3obc_out(ng,inorth)
195 obc_in =m3obc_in(ng,inorth)
196 END IF
197 IF (boundary(ng)%u_north_Ce(i,k).lt.0.0_r8) THEN
198 tau=obc_in
199 ELSE
200 tau=obc_out
201 END IF
202 tau=tau*dt(ng)
203 END IF
204# ifdef RADIATION_2D
205 cx=boundary(ng)%u_north_Cx(i,k)
206# else
207 cx=0.0_r8
208# endif
209 ce=boundary(ng)%u_north_Ce(i,k)
210 cff=boundary(ng)%u_north_C2(i,k)
211# endif
212# ifdef MASKING
213!^ tl_u(i,Jend+1,k,nout)=tl_u(i,Jend+1,k,nout)* &
214!^ & GRID(ng)%umask(i,Jend+1)
215!^
216 ad_u(i,jend+1,k,nout)=ad_u(i,jend+1,k,nout)* &
217 & grid(ng)%umask(i,jend+1)
218# endif
219 IF (ad_lbc(inorth,isuvel,ng)%nudging) THEN
220!^ tl_u(i,Jend+1,k,nout)=tl_u(i,Jend+1,k,nout)- &
221!^ & tau*tl_u(i,Jend+1,k,nstp)
222!^
223 ad_u(i,jend+1,k,nstp)=ad_u(i,jend+1,k,nstp)- &
224 & tau*ad_u(i,jend+1,k,nout)
225 END IF
226!^ tl_u(i,Jend+1,k,nout)=(cff*tl_u(i,Jend+1,k,nstp)+ &
227!^ & Ce *tl_u(i,Jend ,k,nout)- &
228!^ & MAX(Cx,0.0_r8)* &
229!^ & tl_grad(i-1,Jend+1)- &
230!^ & MIN(Cx,0.0_r8)* &
231!^ & tl_grad(i ,Jend+1))/ &
232!^ & (cff+Ce)
233!^
234 adfac=ad_u(i,jend+1,k,nout)/(cff+ce)
235 ad_grad(i-1,jend+1)=ad_grad(i-1,jend+1)- &
236 & max(cx,0.0_r8)*adfac
237 ad_grad(i ,jend+1)=ad_grad(i ,jend+1)- &
238 & min(cx,0.0_r8)*adfac
239 ad_u(i,jend ,k,nout)=ad_u(i,jend ,k,nout)+ce *adfac
240 ad_u(i,jend+1,k,nstp)=ad_u(i,jend+1,k,nstp)+cff*adfac
241 ad_u(i,jend+1,k,nout)=0.0_r8
242 END IF
243 END DO
244 END DO
245 END IF
246!
247! Northern edge, clamped boundary condition.
248!
249 ELSE IF (ad_lbc(inorth,isuvel,ng)%clamped) THEN
250 DO k=1,n(ng)
251 DO i=istru,iend
252 IF (lbc_apply(ng)%north(i)) THEN
253# ifdef MASKING
254!^ tl_u(i,Jend+1,k,nout)=tl_u(i,Jend+1,k,nout)* &
255!^ & GRID(ng)%umask(i,Jend+1)
256!^
257 ad_u(i,jend+1,k,nout)=ad_u(i,jend+1,k,nout)* &
258 & grid(ng)%umask(i,jend+1)
259# endif
260# ifdef ADJUST_BOUNDARY
261 IF (lobc(inorth,isuvel,ng)) THEN
262!^ tl_u(i,Jend+1,k,nout)=BOUNDARY(ng)%tl_u_north(i,k)
263!^
264 boundary(ng)%ad_u_north(i,k)=boundary(ng)% &
265 & ad_u_north(i,k)+ &
266 & ad_u(i,jend+1,k,nout)
267 ad_u(i,jend+1,k,nout)=0.0_r8
268 ELSE
269!^ tl_u(i,Jend+1,k,nout)=0.0_r8
270!^
271 ad_u(i,jend+1,k,nout)=0.0_r8
272 END IF
273# else
274!^ tl_u(i,Jend+1,k,nout)=0.0_r8
275!^
276 ad_u(i,jend+1,k,nout)=0.0_r8
277# endif
278 END IF
279 END DO
280 END DO
281!
282! Northern edge, gradient boundary condition.
283!
284 ELSE IF (ad_lbc(inorth,isuvel,ng)%gradient) THEN
285 DO k=1,n(ng)
286 DO i=istru,iend
287 IF (lbc_apply(ng)%north(i)) THEN
288# ifdef MASKING
289!^ tl_u(i,Jend+1,k,nout)=tl_u(i,Jend+1,k,nout)* &
290!^ & GRID(ng)%umask(i,Jend+1)
291!^
292 ad_u(i,jend+1,k,nout)=ad_u(i,jend+1,k,nout)* &
293 & grid(ng)%umask(i,jend+1)
294# endif
295!^ tl_u(i,Jend+1,k,nout)=tl_u(i,Jend,k,nout)
296!^
297 ad_u(i,jend ,k,nout)=ad_u(i,jend ,k,nout)+ &
298 & ad_u(i,jend+1,k,nout)
299 ad_u(i,jend+1,k,nout) = 0.0_r8
300 END IF
301 END DO
302 END DO
303!
304! Northern edge, closed boundary condition: free slip (gamma2=1) or
305! no slip (gamma2=-1).
306!
307 ELSE IF (ad_lbc(inorth,isuvel,ng)%closed) THEN
308 IF (ewperiodic(ng)) THEN
309 imin=istru
310 imax=iend
311 ELSE
312 imin=istr
313 imax=iendr
314 END IF
315 DO k=1,n(ng)
316 DO i=imin,imax
317 IF (lbc_apply(ng)%north(i)) THEN
318# ifdef MASKING
319!^ tl_u(i,Jend+1,k,nout)=tl_u(i,Jend+1,k,nout)* &
320!^ & GRID(ng)%umask(i,Jend+1)
321!^
322 ad_u(i,jend+1,k,nout)=ad_u(i,jend+1,k,nout)* &
323 & grid(ng)%umask(i,jend+1)
324# endif
325!^ tl_u(i,Jend+1,k,nout)=gamma2(ng)*tl_u(i,Jend,k,nout)
326!^
327 ad_u(i,jend ,k,nout)=ad_u(i,jend ,k,nout)+ &
328 & gamma2(ng)*ad_u(i,jend+1,k,nout)
329 ad_u(i,jend+1,k,nout)=0.0_r8
330 END IF
331 END DO
332 END DO
333 END IF
334 END IF
335!
336!-----------------------------------------------------------------------
337! Lateral boundary conditions at the southern edge.
338!-----------------------------------------------------------------------
339!
340 IF (domain(ng)%Southern_Edge(tile)) THEN
341!
342! Southern edge, implicit upstream radiation condition.
343!
344 IF (ad_lbc(isouth,isuvel,ng)%radiation) THEN
345 IF (iic(ng).ne.0) THEN
346 DO k=1,n(ng)
347 DO i=istru,iend
348 IF (lbc_apply(ng)%south(i)) THEN
349# if defined CELERITY_READ && defined FORWARD_READ
350 IF (ad_lbc(isouth,isuvel,ng)%nudging) THEN
351 IF (lnudgem3clm(ng)) THEN
352 obc_out=0.5_r8* &
353 & (clima(ng)%M3nudgcof(i-1,jstr-1,k)+ &
354 & clima(ng)%M3nudgcof(i ,jstr-1,k))
355 obc_in =obcfac(ng)*obc_out
356 ELSE
357 obc_out=m3obc_out(ng,isouth)
358 obc_in =m3obc_in(ng,isouth)
359 END IF
360 IF (boundary(ng)%u_south_Ce(i,k).lt.0.0_r8) THEN
361 tau=obc_in
362 ELSE
363 tau=obc_out
364 END IF
365 tau=tau*dt(ng)
366 END IF
367# ifdef RADIATION_2D
368 cx=boundary(ng)%u_south_Cx(i,k)
369# else
370 cx=0.0_r8
371# endif
372 ce=boundary(ng)%u_south_Ce(i,k)
373 cff=boundary(ng)%u_south_C2(i,k)
374# endif
375# ifdef MASKING
376!^ tl_u(i,Jstr-1,k,nout)=tl_u(i,Jstr-1,k,nout)* &
377!^ & GRID(ng)%umask(i,Jstr-1)
378!^
379 ad_u(i,jstr-1,k,nout)=ad_u(i,jstr-1,k,nout)* &
380 & grid(ng)%umask(i,jstr-1)
381# endif
382 IF (ad_lbc(isouth,isuvel,ng)%nudging) THEN
383!^ tl_u(i,Jstr-1,k,nout)=tl_u(i,Jstr-1,k,nout)- &
384!^ & tau*tl_u(i,Jstr-1,k,nstp)
385!^
386 ad_u(i,jstr-1,k,nstp)=ad_u(i,jstr-1,k,nstp)- &
387 & tau*ad_u(i,jstr-1,k,nout)
388 END IF
389!^ tl_u(i,Jstr-1,k,nout)=(cff*tl_u(i,Jstr-1,k,nstp)+ &
390!^ & Ce *tl_u(i,Jstr ,k,nout)- &
391!^ & MAX(Cx,0.0_r8)* &
392!^ & tl_grad(i-1,Jstr-1)- &
393!^ & MIN(Cx,0.0_r8)* &
394!^ & tl_grad(i ,Jstr-1))/ &
395!^ & (cff+Ce)
396!^
397 adfac=ad_u(i,jstr-1,k,nout)/(cff+ce)
398 ad_grad(i-1,jstr-1)=ad_grad(i-1,jstr-1)- &
399 & max(cx,0.0_r8)*adfac
400 ad_grad(i ,jstr-1)=ad_grad(i ,jstr-1)- &
401 & min(cx,0.0_r8)*adfac
402 ad_u(i,jstr-1,k,nstp)=ad_u(i,jstr-1,k,nstp)+cff*adfac
403 ad_u(i,jstr ,k,nout)=ad_u(i,jstr ,k,nout)+ce *adfac
404 ad_u(i,jstr-1,k,nout)=0.0_r8
405 END IF
406 END DO
407 END DO
408 END IF
409!
410! Southern edge, clamped boundary condition.
411!
412 ELSE IF (ad_lbc(isouth,isuvel,ng)%clamped) THEN
413 DO k=1,n(ng)
414 DO i=istru,iend
415 IF (lbc_apply(ng)%south(i)) THEN
416# ifdef MASKING
417!^ tl_u(i,Jstr-1,k,nout)=tl_u(i,Jstr-1,k,nout)* &
418!^ & GRID(ng)%umask(i,Jstr-1)
419!^
420 ad_u(i,jstr-1,k,nout)=ad_u(i,jstr-1,k,nout)* &
421 & grid(ng)%umask(i,jstr-1)
422# endif
423# ifdef ADJUST_BOUNDARY
424 IF (lobc(isouth,isuvel,ng)) THEN
425!^ tl_u(i,Jstr-1,k,nout)=BOUNDARY(ng)%tl_u_south(i,k)
426!^
427 boundary(ng)%ad_u_south(i,k)=boundary(ng)% &
428 & ad_u_south(i,k)+ &
429 & ad_u(i,jstr-1,k,nout)
430 ad_u(i,jstr-1,k,nout)=0.0_r8
431 ELSE
432!^ tl_u(i,Jstr-1,k,nout)=0.0_r8
433!^
434 ad_u(i,jstr-1,k,nout)=0.0_r8
435 END IF
436# else
437!^ tl_u(i,Jstr-1,k,nout)=0.0_r8
438!^
439 ad_u(i,jstr-1,k,nout)=0.0_r8
440# endif
441 END IF
442 END DO
443 END DO
444!
445! Southern edge, gradient boundary condition.
446!
447 ELSE IF (ad_lbc(isouth,isuvel,ng)%gradient) THEN
448 DO k=1,n(ng)
449 DO i=istru,iend
450 IF (lbc_apply(ng)%south(i)) THEN
451# ifdef MASKING
452!^ tl_u(i,Jstr-1,k,nout)=tl_u(i,Jstr-1,k,nout)* &
453!^ & GRID(ng)%umask(i,Jstr-1)
454!^
455 ad_u(i,jstr-1,k,nout)=ad_u(i,jstr-1,k,nout)* &
456 & grid(ng)%umask(i,jstr-1)
457# endif
458!^ tl_u(i,Jstr-1,k,nout)=tl_u(i,Jstr,k,nout)
459!^
460 ad_u(i,jstr ,k,nout)=ad_u(i,jstr ,k,nout)+ &
461 & ad_u(i,jstr-1,k,nout)
462 ad_u(i,jstr-1,k,nout)=0.0_r8
463 END IF
464 END DO
465 END DO
466!
467! Southern edge, closed boundary condition: free slip (gamma2=1) or
468! no slip (gamma2=-1).
469!
470 ELSE IF (ad_lbc(isouth,isuvel,ng)%closed) THEN
471 IF (ewperiodic(ng)) THEN
472 imin=istru
473 imax=iend
474 ELSE
475 imin=istr
476 imax=iendr
477 END IF
478 DO k=1,n(ng)
479 DO i=imin,imax
480 IF (lbc_apply(ng)%south(i)) THEN
481# ifdef MASKING
482!^ tl_u(i,Jstr-1,k,nout)=tl_u(i,Jstr-1,k,nout)* &
483!^ & GRID(ng)%umask(i,Jstr-1)
484!^
485 ad_u(i,jstr-1,k,nout)=ad_u(i,jstr-1,k,nout)* &
486 & grid(ng)%umask(i,jstr-1)
487# endif
488!^ tl_u(i,Jstr-1,k,nout)=gamma2(ng)*tl_u(i,Jstr,k,nout)
489!^
490 ad_u(i,jstr ,k,nout)=ad_u(i,jstr ,k,nout)+ &
491 & gamma2(ng)*ad_u(i,jstr-1,k,nout)
492 ad_u(i,jstr-1,k,nout)=0.0_r8
493 END IF
494 END DO
495 END DO
496 END IF
497 END IF
498!
499!-----------------------------------------------------------------------
500! Lateral boundary conditions at the eastern edge.
501!-----------------------------------------------------------------------
502!
503 IF (domain(ng)%Eastern_Edge(tile)) THEN
504!
505! Eastern edge, implicit upstream radiation condition.
506!
507 IF (ad_lbc(ieast,isuvel,ng)%radiation) THEN
508 IF (iic(ng).ne.0) THEN
509 DO k=1,n(ng)
510 DO j=jstr,jend
511 IF (lbc_apply(ng)%east(j)) THEN
512# if defined CELERITY_READ && defined FORWARD_READ
513 IF (ad_lbc(ieast,isuvel,ng)%nudging) THEN
514 IF (lnudgem3clm(ng)) THEN
515 obc_out=0.5_r8* &
516 & (clima(ng)%M3nudgcof(iend ,j,k)+ &
517 & clima(ng)%M3nudgcof(iend+1,j,k))
518 obc_in =obcfac(ng)*obc_out
519 ELSE
520 obc_out=m3obc_out(ng,ieast)
521 obc_in =m3obc_in(ng,ieast)
522 END IF
523 IF (boundary(ng)%u_east_Cx(j,k).lt.0.0_r8) THEN
524 tau=obc_in
525 ELSE
526 tau=obc_out
527 END IF
528 tau=tau*dt(ng)
529 END IF
530 cx=boundary(ng)%u_east_Cx(j,k)
531# ifdef RADIATION_2D
532 ce=boundary(ng)%u_east_Ce(j,k)
533# else
534 ce=0.0_r8
535# endif
536 cff=boundary(ng)%u_east_C2(j,k)
537# endif
538# ifdef MASKING
539!^ tl_u(Iend+1,j,k,nout)=tl_u(Iend+1,j,k,nout)* &
540!^ & GRID(ng)%umask(Iend+1,j)
541!^
542 ad_u(iend+1,j,k,nout)=ad_u(iend+1,j,k,nout)* &
543 & grid(ng)%umask(iend+1,j)
544# endif
545 IF (ad_lbc(ieast,isuvel,ng)%nudging) THEN
546!^ tl_u(Iend+1,j,k,nout)=tl_u(Iend+1,j,k,nout)- &
547!^ & tau*tl_u(Iend+1,j,k,nstp)
548!^
549 ad_u(iend+1,j,k,nstp)=ad_u(iend+1,j,k,nstp)- &
550 & tau*ad_u(iend+1,j,k,nout)
551 END IF
552!^ tl_u(Iend+1,j,k,nout)=(cff*tl_u(Iend+1,j,k,nstp)+ &
553!^ & Cx *tl_u(Iend ,j,k,nout)- &
554!^ & MAX(Ce,0.0_r8)* &
555!^ & tl_grad(Iend+1,j )- &
556!^ & MIN(Ce,0.0_r8)* &
557!^ & tl_grad(Iend+1,j+1))/ &
558!^ & (cff+Cx)
559!^
560 adfac=ad_u(iend+1,j,k,nout)/(cff+cx)
561 ad_grad(iend+1,j )=ad_grad(iend+1,j )- &
562 & max(ce,0.0_r8)*adfac
563 ad_grad(iend+1,j+1)=ad_grad(iend+1,j+1)- &
564 & min(ce,0.0_r8)*adfac
565 ad_u(iend ,j,k,nout)=ad_u(iend ,j,k,nout)+cx *adfac
566 ad_u(iend+1,j,k,nstp)=ad_u(iend+1,j,k,nstp)+cff*adfac
567 ad_u(iend+1,j,k,nout)=0.0_r8
568 END IF
569 END DO
570 END DO
571 END IF
572!
573! Eastern edge, clamped boundary condition.
574!
575 ELSE IF (ad_lbc(ieast,isuvel,ng)%clamped) THEN
576 DO k=1,n(ng)
577 DO j=jstr,jend
578 IF (lbc_apply(ng)%east(j)) THEN
579# ifdef MASKING
580!^ tl_u(Iend+1,j,k,nout)=tl_u(Iend+1,j,k,nout)* &
581!^ & GRID(ng)%umask(Iend+1,j)
582!^
583 ad_u(iend+1,j,k,nout)=ad_u(iend+1,j,k,nout)* &
584 & grid(ng)%umask(iend+1,j)
585# endif
586# ifdef ADJUST_BOUNDARY
587 IF (lobc(ieast,isuvel,ng)) THEN
588!^ tl_u(Iend+1,j,k,nout)=BOUNDARY(ng)%tl_u_east(j,k)
589!^
590 boundary(ng)%ad_u_east(j,k)= &
591 & boundary(ng)%ad_u_east(j,k)+ &
592 & ad_u(iend+1,j,k,nout)
593 ad_u(iend+1,j,k,nout)=0.0_r8
594 ELSE
595!^ tl_u(Iend+1,j,k,nout)=0.0_r8
596!^
597 ad_u(iend+1,j,k,nout)=0.0_r8
598 END IF
599# else
600!^ tl_u(Iend+1,j,k,nout)=0.0_r8
601!^
602 ad_u(iend+1,j,k,nout)=0.0_r8
603# endif
604 END IF
605 END DO
606 END DO
607!
608! Eastern edge, gradient boundary condition.
609!
610 ELSE IF (ad_lbc(ieast,isuvel,ng)%gradient) THEN
611 DO k=1,n(ng)
612 DO j=jstr,jend
613 IF (lbc_apply(ng)%east(j)) THEN
614# ifdef MASKING
615!^ tl_u(Iend+1,j,k,nout)=tl_u(Iend+1,j,k,nout)* &
616!^ & GRID(ng)%umask(Iend+1,j)
617!^
618 ad_u(iend+1,j,k,nout)=ad_u(iend+1,j,k,nout)* &
619 & grid(ng)%umask(iend+1,j)
620# endif
621!^ tl_u(Iend+1,j,k,nout)=tl_u(Iend,j,k,nout)
622!^
623 ad_u(iend ,j,k,nout)=ad_u(iend ,j,k,nout)+ &
624 & ad_u(iend+1,j,k,nout)
625 ad_u(iend+1,j,k,nout)=0.0_r8
626 END IF
627 END DO
628 END DO
629!
630! Eastern edge, closed boundary condition.
631!
632 ELSE IF (ad_lbc(ieast,isuvel,ng)%closed) THEN
633 DO k=1,n(ng)
634 DO j=jstr,jend
635 IF (lbc_apply(ng)%east(j)) THEN
636!^ tl_u(Iend+1,j,k,nout)=0.0_r8
637!^
638 ad_u(iend+1,j,k,nout)=0.0_r8
639 END IF
640 END DO
641 END DO
642 END IF
643 END IF
644!
645!-----------------------------------------------------------------------
646! Lateral boundary conditions at the western edge.
647!-----------------------------------------------------------------------
648!
649 IF (domain(ng)%Western_Edge(tile)) THEN
650!
651! Western edge, implicit upstream radiation condition.
652!
653 IF (ad_lbc(iwest,isuvel,ng)%radiation) THEN
654 IF (iic(ng).ne.0) THEN
655 DO k=1,n(ng)
656 DO j=jstr,jend
657 IF (lbc_apply(ng)%west(j)) THEN
658# if defined CELERITY_READ && defined FORWARD_READ
659 IF (ad_lbc(iwest,isuvel,ng)%nudging) THEN
660 IF (lnudgem3clm(ng)) THEN
661 obc_out=0.5_r8* &
662 & (clima(ng)%M3nudgcof(istr-1,j,k)+ &
663 & clima(ng)%M3nudgcof(istr ,j,k))
664 obc_in =obcfac(ng)*obc_out
665 ELSE
666 obc_out=m3obc_out(ng,iwest)
667 obc_in =m3obc_in(ng,iwest)
668 END IF
669 IF (boundary(ng)%u_west_Cx(j,k).lt.0.0_r8) THEN
670 tau=obc_in
671 ELSE
672 tau=obc_out
673 END IF
674 tau=tau*dt(ng)
675 END IF
676 cx=boundary(ng)%u_west_Cx(j,k)
677# ifdef RADIATION_2D
678 ce=boundary(ng)%u_west_Ce(j,k)
679# else
680 ce=0.0_r8
681# endif
682 cff=boundary(ng)%u_west_C2(j,k)
683# endif
684# ifdef MASKING
685!^ tl_u(Istr,j,k,nout)=tl_u(Istr,j,k,nout)* &
686!^ & GRID(ng)%umask(Istr,j)
687!^
688 ad_u(istr,j,k,nout)=ad_u(istr,j,k,nout)* &
689 & grid(ng)%umask(istr,j)
690# endif
691 IF (ad_lbc(iwest,isuvel,ng)%nudging) THEN
692!^ tl_u(Istr,j,k,nout)=tl_u(Istr,j,k,nout)- &
693!^ & tau*tl_u(Istr,j,k,nstp)
694!^
695 ad_u(istr,j,k,nstp)=ad_u(istr,j,k,nstp)- &
696 & tau*ad_u(istr,j,k,nout)
697 END IF
698!^ tl_u(Istr,j,k,nout)=(cff*tl_u(Istr ,j,k,nstp)+ &
699!^ & Cx *tl_u(Istr+1,j,k,nout)- &
700!^ & MAX(Ce,0.0_r8)* &
701!^ & tl_grad(Istr,j )- &
702!^ & MIN(Ce,0.0_r8)* &
703!^ & tl_grad(Istr,j+1))/ &
704!^ & (cff+Cx)
705!^
706 adfac=ad_u(istr,j,k,nout)/(cff+cx)
707 ad_grad(istr,j )=ad_grad(istr,j )- &
708 & max(ce,0.0_r8)*adfac
709 ad_grad(istr,j+1)=ad_grad(istr,j+1)- &
710 & min(ce,0.0_r8)*adfac
711 ad_u(istr ,j,k,nstp)=ad_u(istr ,j,k,nstp)+cff*adfac
712 ad_u(istr+1,j,k,nout)=ad_u(istr+1,j,k,nout)+cx *adfac
713 ad_u(istr ,j,k,nout)=0.0_r8
714 END IF
715 END DO
716 END DO
717 END IF
718!
719! Western edge, clamped boundary condition.
720!
721 ELSE IF (ad_lbc(iwest,isuvel,ng)%clamped) THEN
722 DO k=1,n(ng)
723 DO j=jstr,jend
724 IF (lbc_apply(ng)%west(j)) THEN
725# ifdef MASKING
726!^ tl_u(Istr,j,k,nout)=tl_u(Istr,j,k,nout)* &
727!^ & GRID(ng)%umask(Istr,j)
728!^
729 ad_u(istr,j,k,nout)=ad_u(istr,j,k,nout)* &
730 & grid(ng)%umask(istr,j)
731# endif
732# ifdef ADJUST_BOUNDARY
733 IF (lobc(iwest,isuvel,ng)) THEN
734!^ tl_u(Istr,j,k,nout)=BOUNDARY(ng)%tl_u_west(j,k)
735!^
736 boundary(ng)%ad_u_west(j,k)= &
737 & boundary(ng)%ad_u_west(j,k)+ &
738 & ad_u(istr,j,k,nout)
739 ad_u(istr,j,k,nout)=0.0_r8
740 ELSE
741!^ tl_u(Istr,j,k,nout)=0.0_r8
742!^
743 ad_u(istr,j,k,nout)=0.0_r8
744 END IF
745# else
746!^ tl_u(Istr,j,k,nout)=0.0_r8
747!^
748 ad_u(istr,j,k,nout)=0.0_r8
749# endif
750 END IF
751 END DO
752 END DO
753!
754! Western edge, gradient boundary condition.
755!
756 ELSE IF (ad_lbc(iwest,isuvel,ng)%gradient) THEN
757 DO k=1,n(ng)
758 DO j=jstr,jend
759 IF (lbc_apply(ng)%west(j)) THEN
760# ifdef MASKING
761!^ tl_u(Istr,j,k,nout)=tl_u(Istr,j,k,nout)* &
762!^ & GRID(ng)%umask(Istr,j)
763!^
764 ad_u(istr ,j,k,nout)=ad_u(istr ,j,k,nout)* &
765 & grid(ng)%umask(istr,j)
766# endif
767!^ tl_u(Istr,j,k,nout)=tl_u(Istr+1,j,k,nout)
768!^
769 ad_u(istr+1,j,k,nout)=ad_u(istr+1,j,k,nout)+ &
770 & ad_u(istr ,j,k,nout)
771 ad_u(istr ,j,k,nout)=0.0_r8
772 END IF
773 END DO
774 END DO
775!
776! Western edge, closed boundary condition.
777!
778 ELSE IF (ad_lbc(iwest,isuvel,ng)%closed) THEN
779 DO k=1,n(ng)
780 DO j=jstr,jend
781 IF (lbc_apply(ng)%west(j)) THEN
782!^ tl_u(Istr,j,k,nout)=0.0_r8
783!^
784 ad_u(istr,j,k,nout)=0.0_r8
785 END IF
786 END DO
787 END DO
788 END IF
789 END IF
790
791 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_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::isuvel
integer isuvel
Definition mod_ncparam.F:506
mod_param::ad_lbc
type(t_lbc), dimension(:,:,:), allocatable ad_lbc
Definition mod_param.F:378
mod_param::domain
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
mod_scalars
Definition mod_scalars.F:2
mod_scalars::m3obc_out
real(dp), dimension(:,:), allocatable m3obc_out
Definition mod_scalars.F:1444
mod_scalars::iic
integer, dimension(:), allocatable iic
Definition mod_scalars.F:249
mod_scalars::dt
real(dp), dimension(:), allocatable dt
Definition mod_scalars.F:269
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::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::lnudgem3clm
logical, dimension(:), allocatable lnudgem3clm
Definition mod_scalars.F:534
mod_scalars::isouth
integer, parameter isouth
Definition mod_scalars.F:1433
mod_scalars::ieast
integer, parameter ieast
Definition mod_scalars.F:1434
mod_scalars::inorth
integer, parameter inorth
Definition mod_scalars.F:1435
mod_scalars::m3obc_in
real(dp), dimension(:,:), allocatable m3obc_in
Definition mod_scalars.F:1443

References mod_param::ad_lbc, mod_boundary::boundary, mod_clima::clima, mod_param::domain, mod_scalars::dt, mod_scalars::ewperiodic, mod_scalars::gamma2, mod_grid::grid, mod_scalars::ieast, mod_scalars::iic, mod_scalars::inorth, mod_scalars::isouth, mod_ncparam::isuvel, mod_scalars::iwest, mod_boundary::lbc_apply, mod_scalars::lnudgem3clm, mod_scalars::lobc, mod_scalars::m3obc_in, mod_scalars::m3obc_out, mod_param::n, mod_scalars::nsperiodic, and mod_scalars::obcfac.

Referenced by ad_ini_fields_mod::ad_ini_fields_tile(), ad_ini_fields_mod::ad_out_fields_tile(), ad_step3d_uv_mod::ad_step3d_uv_tile(), and ad_u3dbc().

Here is the caller graph for this function: