ROMS
Loading...
Searching...
No Matches
ad_bc_3d.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE ad_bc_3d_mod
3#if defined ADJOINT && defined SOLVE3D
4!
5!git $Id$
6!================================================== Hernan G. Arango ===
7! Copyright (c) 2002-2025 The ROMS Group !
8! Licensed under a MIT/X style license !
9! See License_ROMS.md !
10!=======================================================================
11! !
12! These routines apply close, gradient or periodic boundary !
13! conditions to generic 3D adjoint fields. !
14! !
15! On Input: !
16! !
17! ng Nested grid number. !
18! tile Domain partition. !
19! LBi I-dimension Lower bound. !
20! UBi I-dimension Upper bound. !
21! LBj J-dimension Lower bound. !
22! UBj J-dimension Upper bound. !
23! LBk K-dimension Lower bound. !
24! UBk K-dimension Upper bound. !
25! ad_A 3D adjoint field. !
26! !
27! On Output: !
28! !
29! ad_A Processed 3D adjoint field. !
30! !
31! Routines: !
32! !
33! ad_bc_r3d_tile Boundary conditions for field at RHO-points !
34! ad_bc_u3d_tile Boundary conditions for field at U-points !
35! ad_bc_v3d_tile Boundary conditions for field at V-points !
36! ad_bc_w3d_tile Boundary conditions for field at W-points !
37! !
38!=======================================================================
39!
40 implicit none
41!
42 CONTAINS
43!
44!***********************************************************************
45 SUBROUTINE ad_bc_r3d_tile (ng, tile, &
46 & LBi, UBi, LBj, UBj, LBk, UBk, &
47 & ad_A)
48!***********************************************************************
49!
50 USE mod_param
51 USE mod_boundary
52 USE mod_ncparam
53 USE mod_scalars
54!
55 USE ad_exchange_3d_mod, ONLY : ad_exchange_r3d_tile
56!
57! Imported variable declarations.
58!
59 integer, intent(in) :: ng, tile
60 integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
61!
62# ifdef ASSUMED_SHAPE
63 real(r8), intent(inout) :: ad_A(LBi:,LBj:,LBk:)
64# else
65 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj,LBk:UBk)
66# endif
67!
68! Local variable declarations.
69!
70 integer :: i, j, k
71
72 real(r8) :: adfac
73
74# include "set_bounds.h"
75!
76!-----------------------------------------------------------------------
77! Apply adjoint periodic boundary conditons.
78!-----------------------------------------------------------------------
79!
80 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
81 CALL ad_exchange_r3d_tile (ng, tile, &
82 & lbi, ubi, lbj, ubj, lbk, ubk, &
83 & ad_a)
84 END IF
85!
86!-----------------------------------------------------------------------
87! Boundary corners.
88!-----------------------------------------------------------------------
89!
90 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
91 IF (domain(ng)%NorthEast_Corner(tile)) THEN
92 IF (lbc_apply(ng)%north(iend+1).and. &
93 & lbc_apply(ng)%east (jend+1)) THEN
94 DO k=lbk,ubk
95!^ tl_A(Iend+1,Jend+1,k)=0.5_r8*(tl_A(Iend+1,Jend ,k)+ &
96!^ & tl_A(Iend ,Jend+1,k))
97!^
98 adfac=0.5_r8*ad_a(iend+1,jend+1,k)
99 ad_a(iend+1,jend ,k)=ad_a(iend+1,jend ,k)+adfac
100 ad_a(iend ,jend+1,k)=ad_a(iend ,jend+1,k)+adfac
101 ad_a(iend+1,jend+1,k)=0.0_r8
102 END DO
103 END IF
104 END IF
105 IF (domain(ng)%NorthWest_Corner(tile)) THEN
106 IF (lbc_apply(ng)%north(istr-1).and. &
107 & lbc_apply(ng)%west (jend+1)) THEN
108 DO k=lbk,ubk
109!^ tl_A(Istr-1,Jend+1,k)=0.5_r8*(tl_A(Istr-1,Jend ,k)+ &
110!^ & tl_A(Istr ,Jend+1,k))
111!^
112 adfac=0.5_r8*ad_a(istr-1,jend+1,k)
113 ad_a(istr-1,jend ,k)=ad_a(istr-1,jend ,k)+adfac
114 ad_a(istr ,jend+1,k)=ad_a(istr ,jend+1,k)+adfac
115 ad_a(istr-1,jend+1,k)=0.0_r8
116 END DO
117 END IF
118 END IF
119 IF (domain(ng)%SouthEast_Corner(tile)) THEN
120 IF (lbc_apply(ng)%south(iend+1).and. &
121 & lbc_apply(ng)%east (jstr-1)) THEN
122 DO k=lbk,ubk
123!^ tl_A(Iend+1,Jstr-1,k)=0.5_r8*(tl_A(Iend ,Jstr-1,k)+ &
124!^ & tl_A(Iend+1,Jstr ,k))
125!^
126 adfac=0.5_r8*ad_a(iend+1,jstr-1,k)
127 ad_a(iend ,jstr-1,k)=ad_a(iend ,jstr-1,k)+adfac
128 ad_a(iend+1,jstr ,k)=ad_a(iend+1,jstr ,k)+adfac
129 ad_a(iend+1,jstr-1,k)=0.0_r8
130 END DO
131 END IF
132 END IF
133 IF (domain(ng)%SouthWest_Corner(tile)) THEN
134 IF (lbc_apply(ng)%south(istr-1).and. &
135 & lbc_apply(ng)%west (jstr-1)) THEN
136 DO k=lbk,ubk
137!^ tl_A(Istr-1,Jstr-1,k)=0.5_r8*(tl_A(Istr ,Jstr-1,k)+ &
138!^ & tl_A(Istr-1,Jstr ,k))
139!^
140 adfac=0.5_r8*ad_a(istr-1,jstr-1,k)
141 ad_a(istr ,jstr-1,k)=ad_a(istr ,jstr-1,k)+adfac
142 ad_a(istr-1,jstr ,k)=ad_a(istr-1,jstr ,k)+adfac
143 ad_a(istr-1,jstr-1,k)=0.0_r8
144 END DO
145 END IF
146 END IF
147 END IF
148!
149!-----------------------------------------------------------------------
150! Adjoint North-South gradient boundary conditions.
151!-----------------------------------------------------------------------
152!
153 IF (.not.nsperiodic(ng)) THEN
154 IF (domain(ng)%Southern_Edge(tile)) THEN
155 DO k=lbk,ubk
156 DO i=istr,iend
157 IF (lbc_apply(ng)%south(i)) THEN
158!^ tl_A(i,Jstr-1,k)=tl_A(i,Jstr,k)
159!^
160 ad_a(i,jstr ,k)=ad_a(i,jstr,k)+ad_a(i,jstr-1,k)
161 ad_a(i,jstr-1,k)=0.0_r8
162 END IF
163 END DO
164 END DO
165 END IF
166
167 IF (domain(ng)%Northern_Edge(tile)) THEN
168 DO k=lbk,ubk
169 DO i=istr,iend
170 IF (lbc_apply(ng)%north(i)) THEN
171!^ tl_A(i,Jend+1,k)=tl_A(i,Jend,k)
172!^
173 ad_a(i,jend ,k)=ad_a(i,jend,k)+ad_a(i,jend+1,k)
174 ad_a(i,jend+1,k)=0.0_r8
175 END IF
176 END DO
177 END DO
178 END IF
179 END IF
180!
181!-----------------------------------------------------------------------
182! Adjoint East-West gradient boundary conditions.
183!-----------------------------------------------------------------------
184!
185 IF (.not.ewperiodic(ng)) THEN
186 IF (domain(ng)%Western_Edge(tile)) THEN
187 DO k=lbk,ubk
188 DO j=jstr,jend
189 IF (lbc_apply(ng)%west(j)) THEN
190!^ tl_A(Istr-1,j,k)=tl_A(Istr,j,k)
191!^
192 ad_a(istr ,j,k)=ad_a(istr,j,k)+ad_a(istr-1,j,k)
193 ad_a(istr-1,j,k)=0.0_r8
194 END IF
195 END DO
196 END DO
197 END IF
198
199 IF (domain(ng)%Eastern_Edge(tile)) THEN
200 DO k=lbk,ubk
201 DO j=jstr,jend
202 IF (lbc_apply(ng)%east(j)) THEN
203!^ tl_A(Iend+1,j,k)=tl_A(Iend,j,k)
204!^
205 ad_a(iend ,j,k)=ad_a(iend,j,k)+ad_a(iend+1,j,k)
206 ad_a(iend+1,j,k)=0.0_r8
207 END IF
208 END DO
209 END DO
210 END IF
211 END IF
212
213 RETURN
214 END SUBROUTINE ad_bc_r3d_tile
215
216!
217!***********************************************************************
218 SUBROUTINE ad_bc_u3d_tile (ng, tile, &
219 & LBi, UBi, LBj, UBj, LBk, UBk, &
220 & ad_A)
221!***********************************************************************
222!
223 USE mod_param
224 USE mod_boundary
225 USE mod_grid
226 USE mod_ncparam
227 USE mod_scalars
228!
229 USE ad_exchange_3d_mod, ONLY : ad_exchange_u3d_tile
230!
231! Imported variable declarations.
232!
233 integer, intent(in) :: ng, tile
234 integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
235!
236# ifdef ASSUMED_SHAPE
237 real(r8), intent(inout) :: ad_A(LBi:,LBj:,LBk:)
238# else
239 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj,LBk:UBk)
240# endif
241!
242! Local variable declarations.
243!
244 integer :: Imin, Imax
245 integer :: i, j, k
246
247 real(r8) :: adfac
248
249# include "set_bounds.h"
250!
251!-----------------------------------------------------------------------
252! Apply adjoint periodic boundary conditons.
253!-----------------------------------------------------------------------
254!
255 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
256 CALL ad_exchange_u3d_tile (ng, tile, &
257 & lbi, ubi, lbj, ubj, lbk, ubk, &
258 & ad_a)
259 END IF
260!
261!-----------------------------------------------------------------------
262! Boundary corners.
263!-----------------------------------------------------------------------
264!
265 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
266 IF (domain(ng)%NorthEast_Corner(tile)) THEN
267 IF (lbc_apply(ng)%north(iend+1).and. &
268 & lbc_apply(ng)%east (jend+1)) THEN
269 DO k=lbk,ubk
270!^ tl_A(Iend+1,Jend+1,k)=0.5_r8*(tl_A(Iend+1,Jend ,k)+ &
271!^ & tl_A(Iend ,Jend+1,k))
272!^
273 adfac=0.5_r8*ad_a(iend+1,jend+1,k)
274 ad_a(iend+1,jend ,k)=ad_a(iend+1,jend ,k)+adfac
275 ad_a(iend ,jend+1,k)=ad_a(iend ,jend+1,k)+adfac
276 ad_a(iend+1,jend+1,k)=0.0_r8
277 END DO
278 END IF
279 END IF
280 IF (domain(ng)%NorthWest_Corner(tile)) THEN
281 IF (lbc_apply(ng)%north(istr ).and. &
282 & lbc_apply(ng)%west (jend+1)) THEN
283 DO k=lbk,ubk
284!^ tl_A(Istr ,Jend+1,k)=0.5_r8*(tl_A(Istr ,Jend ,k)+ &
285!^ & tl_A(Istr+1,Jend+1,k))
286!^
287 adfac=0.5_r8*ad_a(istr ,jend+1,k)
288 ad_a(istr ,jend ,k)=ad_a(istr ,jend ,k)+adfac
289 ad_a(istr+1,jend+1,k)=ad_a(istr+1,jend+1,k)+adfac
290 ad_a(istr ,jend+1,k)=0.0_r8
291 END DO
292 END IF
293 END IF
294 IF (domain(ng)%SouthEast_Corner(tile)) THEN
295 IF (lbc_apply(ng)%south(iend+1).and. &
296 & lbc_apply(ng)%east (jstr-1)) THEN
297 DO k=lbk,ubk
298!^ tl_A(Iend+1,Jstr-1,k)=0.5_r8*(tl_A(Iend ,Jstr-1,k)+ &
299!^ & tl_A(Iend+1,Jstr ,k))
300!^
301 adfac=0.5_r8*ad_a(iend+1,jstr-1,k)
302 ad_a(iend ,jstr-1,k)=ad_a(iend ,jstr-1,k)+adfac
303 ad_a(iend+1,jstr ,k)=ad_a(iend+1,jstr ,k)+adfac
304 ad_a(iend+1,jstr-1,k)=0.0_r8
305 END DO
306 END IF
307 END IF
308 IF (domain(ng)%SouthWest_Corner(tile)) THEN
309 IF (lbc_apply(ng)%south(istr ).and. &
310 & lbc_apply(ng)%west (jstr-1)) THEN
311 DO k=lbk,ubk
312!^ tl_A(Istr ,Jstr-1,k)=0.5_r8*(tl_A(Istr+1,Jstr-1,k)+ &
313!^ & tl_A(Istr ,Jstr ,k))
314!^
315 adfac=0.5_r8*ad_a(istr ,jstr-1,k)
316 ad_a(istr+1,jstr-1,k)=ad_a(istr+1,jstr-1,k)+adfac
317 ad_a(istr ,jstr ,k)=ad_a(istr ,jstr ,k)+adfac
318 ad_a(istr ,jstr-1,k)=0.0_r8
319 END DO
320 END IF
321 END IF
322 END IF
323!
324!-----------------------------------------------------------------------
325! Adjoint North-South boundary conditions: Closed (free-slip/no-slip)
326! or gradient.
327!-----------------------------------------------------------------------
328!
329 IF (.not.nsperiodic(ng)) THEN
330 IF (domain(ng)%Southern_Edge(tile)) THEN
331 IF (ad_lbc(isouth,isbu3d,ng)%closed) THEN
332 IF (ewperiodic(ng)) THEN
333 imin=istru
334 imax=iend
335 ELSE
336 imin=istr
337 imax=iendr
338 END IF
339 DO k=lbk,ubk
340 DO i=imin,imax
341 IF (lbc_apply(ng)%south(i)) THEN
342# ifdef MASKING
343!^ tl_A(i,Jstr-1,k)=tl_A(i,Jstr-1,k)* &
344!^ & GRID(ng)%umask(i,Jstr-1)
345!^
346 ad_a(i,jstr-1,k)=ad_a(i,jstr-1,k)* &
347 & grid(ng)%umask(i,jstr-1)
348# endif
349!^ tl_A(i,Jstr-1,k)=gamma2(ng)*tl_A(i,Jstr,k)
350!^
351 ad_a(i,jstr ,k)=ad_a(i,jstr,k)+ &
352 & gamma2(ng)*ad_a(i,jstr-1,k)
353 ad_a(i,jstr-1,k)=0.0_r8
354 END IF
355 END DO
356 END DO
357 ELSE
358 DO k=lbk,ubk
359 DO i=istru,iend
360 IF (lbc_apply(ng)%south(i)) THEN
361!^ tl_A(i,Jstr-1,k)=tl_A(i,Jstr,k)
362!^
363 ad_a(i,jstr ,k)=ad_a(i,jstr,k)+ad_a(i,jstr-1,k)
364 ad_a(i,jstr-1,k)=0.0_r8
365 END IF
366 END DO
367 END DO
368 END IF
369 END IF
370
371 IF (domain(ng)%Northern_Edge(tile)) THEN
372 IF (ad_lbc(inorth,isbu3d,ng)%closed) THEN
373 IF (ewperiodic(ng)) THEN
374 imin=istru
375 imax=iend
376 ELSE
377 imin=istr
378 imax=iendr
379 END IF
380 DO k=lbk,ubk
381 DO i=imin,imax
382 IF (lbc_apply(ng)%north(i)) THEN
383# ifdef MASKING
384!^ tl_A(i,Jend+1,k)=tl_A(i,Jend+1,k)* &
385!^ & GRID(ng)%umask(i,Jend+1)
386!^
387 ad_a(i,jend+1,k)=ad_a(i,jend+1,k)* &
388 & grid(ng)%umask(i,jend+1)
389# endif
390!^ tl_A(i,Jend+1,k)=gamma2(ng)*tl_A(i,Jend,k)
391!^
392 ad_a(i,jend ,k)=ad_a(i,jend,k)+ &
393 & gamma2(ng)*ad_a(i,jend+1,k)
394 ad_a(i,jend+1,k)=0.0_r8
395 END IF
396 END DO
397 END DO
398 ELSE
399 DO k=lbk,ubk
400 DO i=istru,iend
401 IF (lbc_apply(ng)%north(i)) THEN
402!^ tl_A(i,Jend+1,k)=tl_A(i,Jend,k)
403!^
404 ad_a(i,jend ,k)=ad_a(i,jend,k)+ad_a(i,jend+1,k)
405 ad_a(i,jend+1,k)=0.0_r8
406 END IF
407 END DO
408 END DO
409 END IF
410 END IF
411 END IF
412!
413!-----------------------------------------------------------------------
414! Adjoint East-West gradient boundary conditions: Closed or gradient.
415!-----------------------------------------------------------------------
416!
417 IF (.not.ewperiodic(ng)) THEN
418 IF (domain(ng)%Western_Edge(tile)) THEN
419 IF (ad_lbc(iwest,isbu3d,ng)%closed) THEN
420 DO k=lbk,ubk
421 DO j=jstr,jend
422 IF (lbc_apply(ng)%west(j)) THEN
423!^ tl_A(Istr,j,k)=0.0_r8
424!^
425 ad_a(istr,j,k)=0.0_r8
426 END IF
427 END DO
428 END DO
429 ELSE
430 DO k=lbk,ubk
431 DO j=jstr,jend
432 IF (lbc_apply(ng)%west(j)) THEN
433!^ tl_A(Istr,j,k)=tl_A(Istr+1,j,k)
434!^
435 ad_a(istr+1,j,k)=ad_a(istr+1,j,k)+ad_a(istr,j,k)
436 ad_a(istr ,j,k)=0.0_r8
437 END IF
438 END DO
439 END DO
440 END IF
441 END IF
442
443 IF (domain(ng)%Eastern_Edge(tile)) THEN
444 IF (ad_lbc(ieast,isbu3d,ng)%closed) THEN
445 DO k=lbk,ubk
446 DO j=jstr,jend
447 IF (lbc_apply(ng)%east(j)) THEN
448!^ tl_A(Iend+1,j,k)=0.0_r8
449!^
450 ad_a(iend+1,j,k)=0.0_r8
451 END IF
452 END DO
453 END DO
454 ELSE
455 DO k=lbk,ubk
456 DO j=jstr,jend
457 IF (lbc_apply(ng)%east(j)) THEN
458!^ tl_A(Iend+1,j,k)=tl_A(Iend,j,k)
459!^
460 ad_a(iend ,j,k)=ad_a(iend,j,k)+ad_a(iend+1,j,k)
461 ad_a(iend+1,j,k)=0.0_r8
462 END IF
463 END DO
464 END DO
465 END IF
466 END IF
467 END IF
468
469 RETURN
470 END SUBROUTINE ad_bc_u3d_tile
471
472!
473!***********************************************************************
474 SUBROUTINE ad_bc_v3d_tile (ng, tile, &
475 & LBi, UBi, LBj, UBj, LBk, UBk, &
476 & ad_A)
477!***********************************************************************
478!
479 USE mod_param
480 USE mod_boundary
481 USE mod_grid
482 USE mod_ncparam
483 USE mod_scalars
484!
485 USE ad_exchange_3d_mod, ONLY : ad_exchange_v3d_tile
486!
487! Imported variable declarations.
488!
489 integer, intent(in) :: ng, tile
490 integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
491!
492# ifdef ASSUMED_SHAPE
493 real(r8), intent(inout) :: ad_A(LBi:,LBj:,LBk:)
494# else
495 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj,LBk:UBk)
496# endif
497!
498! Local variable declarations.
499!
500 integer :: Jmin, Jmax
501 integer :: i, j, k
502
503 real(r8) :: adfac
504
505# include "set_bounds.h"
506!
507!-----------------------------------------------------------------------
508! Apply adjoint periodic boundary conditons.
509!-----------------------------------------------------------------------
510!
511 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
512 CALL ad_exchange_v3d_tile (ng, tile, &
513 & lbi, ubi, lbj, ubj, lbk, ubk, &
514 & ad_a)
515 END IF
516!
517!-----------------------------------------------------------------------
518! Boundary corners.
519!-----------------------------------------------------------------------
520!
521 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
522 IF (domain(ng)%NorthEast_Corner(tile)) THEN
523 IF (lbc_apply(ng)%north(iend+1).and. &
524 & lbc_apply(ng)%east (jend+1)) THEN
525 DO k=lbk,ubk
526!^ tl_A(Iend+1,Jend+1,k)=0.5_r8*(tl_A(Iend+1,Jend ,k)+ &
527!^ & tl_A(Iend ,Jend+1,k))
528!^
529 adfac=0.5_r8*ad_a(iend+1,jend+1,k)
530 ad_a(iend+1,jend ,k)=ad_a(iend+1,jend ,k)+adfac
531 ad_a(iend ,jend+1,k)=ad_a(iend ,jend+1,k)+adfac
532 ad_a(iend+1,jend+1,k)=0.0_r8
533 END DO
534 END IF
535 END IF
536 IF (domain(ng)%NorthWest_Corner(tile)) THEN
537 IF (lbc_apply(ng)%north(istr-1).and. &
538 & lbc_apply(ng)%west (jend+1)) THEN
539 DO k=lbk,ubk
540!^ tl_A(Istr-1,Jend+1,k)=0.5_r8*(tl_A(Istr-1,Jend ,k)+ &
541!^ & tl_A(Istr ,Jend+1,k))
542!^
543 adfac=0.5_r8*ad_a(istr-1,jend+1,k)
544 ad_a(istr-1,jend ,k)=ad_a(istr-1,jend ,k)+adfac
545 ad_a(istr ,jend+1,k)=ad_a(istr ,jend+1,k)+adfac
546 ad_a(istr-1,jend+1,k)=0.0_r8
547 END DO
548 END IF
549 END IF
550 IF (domain(ng)%SouthEast_Corner(tile)) THEN
551 IF (lbc_apply(ng)%south(iend+1).and. &
552 & lbc_apply(ng)%east (jstr )) THEN
553 DO k=lbk,ubk
554!^ tl_A(Iend+1,Jstr ,k)=0.5_r8*(tl_A(Iend ,Jstr ,k)+ &
555!^ & tl_A(Iend+1,Jstr+1,k))
556!^
557 adfac=0.5_r8*ad_a(iend+1,jstr ,k)
558 ad_a(iend ,jstr ,k)=ad_a(iend ,jstr ,k)+adfac
559 ad_a(iend+1,jstr+1,k)=ad_a(iend+1,jstr+1,k)+adfac
560 ad_a(iend+1,jstr ,k)=0.0_r8
561 END DO
562 END IF
563 END IF
564 IF (domain(ng)%SouthWest_Corner(tile)) THEN
565 IF (lbc_apply(ng)%south(istr-1).and. &
566 & lbc_apply(ng)%west (jstr )) THEN
567 DO k=lbk,ubk
568!^ tl_A(Istr-1,Jstr ,k)=0.5_r8*(tl_A(Istr ,Jstr ,k)+ &
569!^ & tl_A(Istr-1,Jstr+1,k))
570!^
571 adfac=0.5_r8*ad_a(istr-1,jstr ,k)
572 ad_a(istr ,jstr ,k)=ad_a(istr ,jstr ,k)+adfac
573 ad_a(istr-1,jstr+1,k)=ad_a(istr-1,jstr+1,k)+adfac
574 ad_a(istr-1,jstr ,k)=0.0_r8
575 END DO
576 END IF
577 END IF
578 END IF
579!
580!-----------------------------------------------------------------------
581! Adjoint North-South boundary conditions: Closed or gradient.
582!-----------------------------------------------------------------------
583!
584 IF (.not.nsperiodic(ng)) THEN
585 IF (domain(ng)%Southern_Edge(tile)) THEN
586 IF (ad_lbc(isouth,isbv2d,ng)%closed) THEN
587 DO k=lbk,ubk
588 DO i=istr,iend
589 IF (lbc_apply(ng)%south(i)) THEN
590!^ tl_A(i,Jstr,k)=0.0_r8
591!^
592 ad_a(i,jstr,k)=0.0_r8
593 END IF
594 END DO
595 END DO
596 ELSE
597 DO k=lbk,ubk
598 DO i=istr,iend
599 IF (lbc_apply(ng)%south(i)) THEN
600!^ tl_A(i,Jstr,k)=tl_A(i,Jstr+1,k)
601!^
602 ad_a(i,jstr+1,k)=ad_a(i,jstr+1,k)+ad_a(i,jstr,k)
603 ad_a(i,jstr ,k)=0.0_r8
604 END IF
605 END DO
606 END DO
607 END IF
608 END IF
609
610 IF (domain(ng)%Northern_Edge(tile)) THEN
611 IF (ad_lbc(inorth,isbv2d,ng)%closed) THEN
612 DO k=lbk,ubk
613 DO i=istr,iend
614 IF (lbc_apply(ng)%north(i)) THEN
615!^ tl_A(i,Jend+1,k)=0.0_r8
616!^
617 ad_a(i,jend+1,k)=0.0_r8
618 END IF
619 END DO
620 END DO
621 ELSE
622 DO k=lbk,ubk
623 DO i=istr,iend
624 IF (lbc_apply(ng)%north(i)) THEN
625!^ tl_A(i,Jend+1,k)=tl_A(i,Jend,k)
626!^
627 ad_a(i,jend ,k)=ad_a(i,jend,k)+ad_a(i,jend+1,k)
628 ad_a(i,jend+1,k)=0.0_r8
629 END IF
630 END DO
631 END DO
632 END IF
633 END IF
634 END IF
635!
636!-----------------------------------------------------------------------
637! Adjoint East-West boundary conditions: Closed (free-slip/no-slip) or
638! gradient.
639!-----------------------------------------------------------------------
640!
641 IF (.not.ewperiodic(ng)) THEN
642 IF (domain(ng)%Western_Edge(tile)) THEN
643 IF (ad_lbc(iwest,isbv3d,ng)%closed) THEN
644 IF (nsperiodic(ng)) THEN
645 jmin=jstrv
646 jmax=jend
647 ELSE
648 jmin=jstr
649 jmax=jendr
650 END IF
651 DO k=lbk,ubk
652 DO j=jmin,jmax
653 IF (lbc_apply(ng)%west(j)) THEN
654# ifdef MASKING
655!^ tl_A(Istr-1,j,k)=tl_A(Istr-1,j,k)* &
656!^ & GRID(ng)%vmask(Istr-1,j)
657!^
658 ad_a(istr-1,j,k)=ad_a(istr-1,j,k)* &
659 & grid(ng)%vmask(istr-1,j)
660# endif
661!^ tl_A(Istr-1,j,k)=gamma2(ng)*tl_A(Istr,j,k)
662!^
663 ad_a(istr ,j,k)=ad_a(istr,j,k)+ &
664 & gamma2(ng)*ad_a(istr-1,j,k)
665 ad_a(istr-1,j,k)=0.0_r8
666 END IF
667 END DO
668 END DO
669 ELSE
670 DO k=lbk,ubk
671 DO j=jstrv,jend
672 IF (lbc_apply(ng)%west(j)) THEN
673!^ tl_A(Istr-1,j,k)=tl_A(Istr,j,k)
674!^
675 ad_a(istr ,j,k)=ad_a(istr,j,k)+ad_a(istr-1,j,k)
676 ad_a(istr-1,j,k)=0.0_r8
677 END IF
678 END DO
679 END DO
680 END IF
681 END IF
682
683 IF (domain(ng)%Eastern_Edge(tile)) THEN
684 IF (ad_lbc(ieast,isbv3d,ng)%closed) THEN
685 IF (nsperiodic(ng)) THEN
686 jmin=jstrv
687 jmax=jend
688 ELSE
689 jmin=jstr
690 jmax=jendr
691 END IF
692 DO k=lbk,ubk
693 DO j=jmin,jmax
694 IF (lbc_apply(ng)%east(j)) THEN
695# ifdef MASKING
696!^ tl_A(Iend+1,j,k)=tl_A(Iend+1,j,k)* &
697!^ & GRID(ng)%vmask(Iend+1,j)
698!^
699 ad_a(iend+1,j,k)=ad_a(iend+1,j,k)* &
700 & grid(ng)%vmask(iend+1,j)
701# endif
702!^ tl_A(Iend+1,j,k)=gamma2(ng)*tl_A(Iend,j,k)
703!^
704 ad_a(iend ,j,k)=ad_a(iend,j,k)+ &
705 & gamma2(ng)*ad_a(iend+1,j,k)
706 ad_a(iend+1,j,k)=0.0_r8
707 END IF
708 END DO
709 END DO
710 ELSE
711 DO k=lbk,ubk
712 DO j=jstrv,jend
713 IF (lbc_apply(ng)%east(j)) THEN
714!^ tl_A(Iend+1,j,k)=tl_A(Iend,j,k)
715!^
716 ad_a(iend ,j,k)=ad_a(iend,j,k)+ad_a(iend+1,j,k)
717 ad_a(iend+1,j,k)=0.0_r8
718 END IF
719 END DO
720 END DO
721 END IF
722 END IF
723 END IF
724
725 RETURN
726 END SUBROUTINE ad_bc_v3d_tile
727
728!
729!***********************************************************************
730 SUBROUTINE ad_bc_w3d_tile (ng, tile, &
731 & LBi, UBi, LBj, UBj, LBk, UBk, &
732 & ad_A)
733!***********************************************************************
734!
735 USE mod_param
736 USE mod_boundary
737 USE mod_ncparam
738 USE mod_scalars
739!
740 USE ad_exchange_3d_mod, ONLY : ad_exchange_w3d_tile
741!
742! Imported variable declarations.
743!
744 integer, intent(in) :: ng, tile
745 integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
746!
747# ifdef ASSUMED_SHAPE
748 real(r8), intent(inout) :: ad_A(LBi:,LBj:,LBk:)
749# else
750 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj,LBk:UBk)
751# endif
752!
753! Local variable declarations.
754!
755 integer :: i, j, k
756
757 real(r8) :: adfac
758
759# include "set_bounds.h"
760!
761!-----------------------------------------------------------------------
762! Apply adjoint periodic boundary conditons.
763!-----------------------------------------------------------------------
764!
765 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
766 CALL ad_exchange_w3d_tile (ng, tile, &
767 & lbi, ubi, lbj, ubj, lbk, ubk, &
768 & ad_a)
769 END IF
770!
771!-----------------------------------------------------------------------
772! Boundary corners.
773!-----------------------------------------------------------------------
774!
775 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
776 IF (domain(ng)%NorthEast_Corner(tile)) THEN
777 IF (lbc_apply(ng)%north(iend+1).and. &
778 & lbc_apply(ng)%east (jend+1)) THEN
779 DO k=lbk,ubk
780!^ tl_A(Iend+1,Jend+1,k)=0.5_r8*(tl_A(Iend+1,Jend ,k)+ &
781!^ & tl_A(Iend ,Jend+1,k))
782!^
783 adfac=0.5_r8*ad_a(iend+1,jend+1,k)
784 ad_a(iend+1,jend ,k)=ad_a(iend+1,jend ,k)+adfac
785 ad_a(iend ,jend+1,k)=ad_a(iend ,jend+1,k)+adfac
786 ad_a(iend+1,jend+1,k)=0.0_r8
787 END DO
788 END IF
789 END IF
790 IF (domain(ng)%NorthWest_Corner(tile)) THEN
791 IF (lbc_apply(ng)%north(istr-1).and. &
792 & lbc_apply(ng)%west (jend+1)) THEN
793 DO k=lbk,ubk
794!^ tl_A(Istr-1,Jend+1,k)=0.5_r8*(tl_A(Istr-1,Jend ,k)+ &
795!^ & tl_A(Istr ,Jend+1,k))
796!^
797 adfac=0.5_r8*ad_a(istr-1,jend+1,k)
798 ad_a(istr-1,jend ,k)=ad_a(istr-1,jend ,k)+adfac
799 ad_a(istr ,jend+1,k)=ad_a(istr ,jend+1,k)+adfac
800 ad_a(istr-1,jend+1,k)=0.0_r8
801 END DO
802 END IF
803 END IF
804 IF (domain(ng)%SouthEast_Corner(tile)) THEN
805 IF (lbc_apply(ng)%south(iend+1).and. &
806 & lbc_apply(ng)%east (jstr-1)) THEN
807 DO k=lbk,ubk
808!^ tl_A(Iend+1,Jstr-1,k)=0.5_r8*(tl_A(Iend+1,Jstr ,k)+ &
809!^ & tl_A(Iend ,Jstr-1,k))
810!^
811 adfac=0.5_r8*ad_a(iend+1,jstr-1,k)
812 ad_a(iend+1,jstr ,k)=ad_a(iend+1,jstr ,k)+adfac
813 ad_a(iend ,jstr-1,k)=ad_a(iend ,jstr-1,k)+adfac
814 ad_a(iend+1,jstr-1,k)=0.0_r8
815 END DO
816 END IF
817 END IF
818 IF (domain(ng)%SouthWest_Corner(tile)) THEN
819 IF (lbc_apply(ng)%south(istr-1).and. &
820 & lbc_apply(ng)%west (jstr-1)) THEN
821 DO k=lbk,ubk
822!^ tl_A(Istr-1,Jstr-1,k)=0.5_r8*(tl_A(Istr ,Jstr-1,k)+ &
823!^ & tl_A(Istr-1,Jstr ,k))
824!^
825 adfac=0.5_r8*ad_a(istr-1,jstr-1,k)
826 ad_a(istr ,jstr-1,k)=ad_a(istr ,jstr-1,k)+adfac
827 ad_a(istr-1,jstr ,k)=ad_a(istr-1,jstr ,k)+adfac
828 ad_a(istr-1,jstr-1,k)=0.0_r8
829 END DO
830 END IF
831 END IF
832 END IF
833!
834!-----------------------------------------------------------------------
835! Adjoint North-South gradient boundary conditions.
836!-----------------------------------------------------------------------
837!
838 IF (.not.nsperiodic(ng)) THEN
839 IF (domain(ng)%Southern_Edge(tile)) THEN
840 DO k=lbk,ubk
841 DO i=istr,iend
842 IF (lbc_apply(ng)%south(i)) THEN
843!^ tl_A(i,Jstr-1,k)=tl_A(i,Jstr,k)
844!^
845 ad_a(i,jstr ,k)=ad_a(i,jstr,k)+ad_a(i,jstr-1,k)
846 ad_a(i,jstr-1,k)=0.0_r8
847 END IF
848 END DO
849 END DO
850 END IF
851
852 IF (domain(ng)%Northern_Edge(tile)) THEN
853 DO k=lbk,ubk
854 DO i=istr,iend
855 IF (lbc_apply(ng)%north(i)) THEN
856!^ tl_A(i,Jend+1,k)=tl_A(i,Jend,k)
857!^
858 ad_a(i,jend ,k)=ad_a(i,jend,k)+ad_a(i,jend+1,k)
859 ad_a(i,jend+1,k)=0.0_r8
860 END IF
861 END DO
862 END DO
863 END IF
864 END IF
865!
866!-----------------------------------------------------------------------
867! Adjoint East-West gradient boundary conditions.
868!-----------------------------------------------------------------------
869!
870 IF (.not.ewperiodic(ng)) THEN
871 IF (domain(ng)%Western_Edge(tile)) THEN
872 DO k=lbk,ubk
873 DO j=jstr,jend
874 IF (lbc_apply(ng)%west(j)) THEN
875!^ tl_A(Istr-1,j,k)=tl_A(Istr,j,k)
876!^
877 ad_a(istr ,j,k)=ad_a(istr,j,k)+ad_a(istr-1,j,k)
878 ad_a(istr-1,j,k)=0.0_r8
879 END IF
880 END DO
881 END DO
882 END IF
883
884 IF (domain(ng)%Eastern_Edge(tile)) THEN
885 DO k=lbk,ubk
886 DO j=jstr,jend
887 IF (lbc_apply(ng)%east(j)) THEN
888!^ tl_A(Iend+1,j,k)=tl_A(Iend,j,k)
889!^
890 ad_a(iend ,j,k)=ad_a(iend,j,k)+ad_a(iend+1,j,k)
891 ad_a(iend+1,j,k)=0.0_r8
892 END IF
893 END DO
894 END DO
895 END IF
896 END IF
897
898 RETURN
899 END SUBROUTINE ad_bc_w3d_tile
900
901!
902!***********************************************************************
903 SUBROUTINE ad_dabc_r3d_tile (ng, tile, &
904 & LBi, UBi, LBj, UBj, LBk, UBk, &
905 & ad_A)
906!***********************************************************************
907!
908 USE mod_param
909 USE mod_boundary
910 USE mod_ncparam
911 USE mod_scalars
912!
913 USE ad_exchange_3d_mod, ONLY : ad_exchange_r3d_tile
914!
915! Imported variable declarations.
916!
917 integer, intent(in) :: ng, tile
918 integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
919!
920# ifdef ASSUMED_SHAPE
921 real(r8), intent(inout) :: ad_A(LBi:,LBj:,LBk:)
922# else
923 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj,LBk:UBk)
924# endif
925!
926! Local variable declarations.
927!
928 integer :: i, j, k
929
930 real(r8) :: adfac
931
932# include "set_bounds.h"
933!
934!-----------------------------------------------------------------------
935! Apply adjoint periodic boundary conditons.
936!-----------------------------------------------------------------------
937!
938 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
939 CALL ad_exchange_r3d_tile (ng, tile, &
940 & lbi, ubi, lbj, ubj, lbk, ubk, &
941 & ad_a)
942 END IF
943!
944!-----------------------------------------------------------------------
945! Boundary corners.
946!-----------------------------------------------------------------------
947!
948 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
949 IF (domain(ng)%NorthEast_Corner(tile)) THEN
950 IF (lbc_apply(ng)%north(iend+1).and. &
951 & lbc_apply(ng)%east (jend+1)) THEN
952 DO k=lbk,ubk
953!^ tl_A(Iend+1,Jend+1,k)=0.5_r8*(tl_A(Iend+1,Jend ,k)+ &
954!^ & tl_A(Iend ,Jend+1,k))
955!^
956 adfac=0.5_r8*ad_a(iend+1,jend+1,k)
957 ad_a(iend+1,jend ,k)=ad_a(iend+1,jend ,k)+adfac
958 ad_a(iend ,jend+1,k)=ad_a(iend ,jend+1,k)+adfac
959 ad_a(iend+1,jend+1,k)=0.0_r8
960 END DO
961 END IF
962 END IF
963 IF (domain(ng)%NorthWest_Corner(tile)) THEN
964 IF (lbc_apply(ng)%north(istr-1).and. &
965 & lbc_apply(ng)%west (jend+1)) THEN
966 DO k=lbk,ubk
967!^ tl_A(Istr-1,Jend+1,k)=0.5_r8*(tl_A(Istr-1,Jend ,k)+ &
968!^ & tl_A(Istr ,Jend+1,k))
969!^
970 adfac=0.5_r8*ad_a(istr-1,jend+1,k)
971 ad_a(istr-1,jend ,k)=ad_a(istr-1,jend ,k)+adfac
972 ad_a(istr ,jend+1,k)=ad_a(istr ,jend+1,k)+adfac
973 ad_a(istr-1,jend+1,k)=0.0_r8
974 END DO
975 END IF
976 END IF
977 IF (domain(ng)%SouthEast_Corner(tile)) THEN
978 IF (lbc_apply(ng)%south(iend+1).and. &
979 & lbc_apply(ng)%east (jstr-1)) THEN
980 DO k=lbk,ubk
981!^ tl_A(Iend+1,Jstr-1,k)=0.5_r8*(tl_A(Iend ,Jstr-1,k)+ &
982!^ & tl_A(Iend+1,Jstr ,k))
983!^
984 adfac=0.5_r8*ad_a(iend+1,jstr-1,k)
985 ad_a(iend ,jstr-1,k)=ad_a(iend ,jstr-1,k)+adfac
986 ad_a(iend+1,jstr ,k)=ad_a(iend+1,jstr ,k)+adfac
987 ad_a(iend+1,jstr-1,k)=0.0_r8
988 END DO
989 END IF
990 END IF
991 IF (domain(ng)%SouthWest_Corner(tile)) THEN
992 IF (lbc_apply(ng)%south(istr-1).and. &
993 & lbc_apply(ng)%west (jstr-1)) THEN
994 DO k=lbk,ubk
995!^ tl_A(Istr-1,Jstr-1,k)=0.5_r8*(tl_A(Istr ,Jstr-1,k)+ &
996!^ & tl_A(Istr-1,Jstr ,k))
997!^
998 adfac=0.5_r8*ad_a(istr-1,jstr-1,k)
999 ad_a(istr ,jstr-1,k)=ad_a(istr ,jstr-1,k)+adfac
1000 ad_a(istr-1,jstr ,k)=ad_a(istr-1,jstr ,k)+adfac
1001 ad_a(istr-1,jstr-1,k)=0.0_r8
1002 END DO
1003 END IF
1004 END IF
1005 END IF
1006!
1007!-----------------------------------------------------------------------
1008! Adjoint North-South gradient boundary conditions.
1009!-----------------------------------------------------------------------
1010!
1011 IF (.not.nsperiodic(ng)) THEN
1012 IF (domain(ng)%Southern_Edge(tile)) THEN
1013 DO k=lbk,ubk
1014 DO i=istr,iend
1015 IF (lbc_apply(ng)%south(i)) THEN
1016!^ tl_A(i,Jstr-1,k)=tl_A(i,Jstr,k)
1017!^
1018 ad_a(i,jstr ,k)=ad_a(i,jstr,k)+ad_a(i,jstr-1,k)
1019 ad_a(i,jstr-1,k)=0.0_r8
1020 END IF
1021 END DO
1022 END DO
1023 END IF
1024
1025 IF (domain(ng)%Northern_Edge(tile)) THEN
1026 DO k=lbk,ubk
1027 DO i=istr,iend
1028 IF (lbc_apply(ng)%north(i)) THEN
1029!^ tl_A(i,Jend+1,k)=tl_A(i,Jend,k)
1030!^
1031 ad_a(i,jend ,k)=ad_a(i,jend,k)+ad_a(i,jend+1,k)
1032 ad_a(i,jend+1,k)=0.0_r8
1033 END IF
1034 END DO
1035 END DO
1036 END IF
1037 END IF
1038!
1039!-----------------------------------------------------------------------
1040! Adjoint East-West gradient boundary conditions.
1041!-----------------------------------------------------------------------
1042!
1043 IF (.not.ewperiodic(ng)) THEN
1044 IF (domain(ng)%Western_Edge(tile)) THEN
1045 DO k=lbk,ubk
1046 DO j=jstr,jend
1047 IF (lbc_apply(ng)%west(j)) THEN
1048!^ tl_A(Istr-1,j,k)=tl_A(Istr,j,k)
1049!^
1050 ad_a(istr ,j,k)=ad_a(istr,j,k)+ad_a(istr-1,j,k)
1051 ad_a(istr-1,j,k)=0.0_r8
1052 END IF
1053 END DO
1054 END DO
1055 END IF
1056
1057 IF (domain(ng)%Eastern_Edge(tile)) THEN
1058 DO k=lbk,ubk
1059 DO j=jstr,jend
1060 IF (lbc_apply(ng)%east(j)) THEN
1061!^ tl_A(Iend+1,j,k)=tl_A(Iend,j,k)
1062!^
1063 ad_a(iend ,j,k)=ad_a(iend,j,k)+ad_a(iend+1,j,k)
1064 ad_a(iend+1,j,k)=0.0_r8
1065 END IF
1066 END DO
1067 END DO
1068 END IF
1069 END IF
1070
1071 RETURN
1072 END SUBROUTINE ad_dabc_r3d_tile
1073
1074!
1075!***********************************************************************
1076 SUBROUTINE ad_dabc_u3d_tile (ng, tile, &
1077 & LBi, UBi, LBj, UBj, LBk, UBk, &
1078 & ad_A)
1079!***********************************************************************
1080!
1081 USE mod_param
1082 USE mod_boundary
1083 USE mod_grid
1084 USE mod_ncparam
1085 USE mod_scalars
1086!
1087 USE ad_exchange_3d_mod, ONLY : ad_exchange_u3d_tile
1088!
1089! Imported variable declarations.
1090!
1091 integer, intent(in) :: ng, tile
1092 integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
1093!
1094# ifdef ASSUMED_SHAPE
1095 real(r8), intent(inout) :: ad_A(LBi:,LBj:,LBk:)
1096# else
1097 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj,LBk:UBk)
1098# endif
1099!
1100! Local variable declarations.
1101!
1102 integer :: Imin, Imax
1103 integer :: i, j, k
1104
1105 real(r8) :: adfac
1106
1107# include "set_bounds.h"
1108!
1109!-----------------------------------------------------------------------
1110! Apply adjoint periodic boundary conditons.
1111!-----------------------------------------------------------------------
1112!
1113 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1114 CALL ad_exchange_u3d_tile (ng, tile, &
1115 & lbi, ubi, lbj, ubj, lbk, ubk, &
1116 & ad_a)
1117 END IF
1118!
1119!-----------------------------------------------------------------------
1120! Boundary corners.
1121!-----------------------------------------------------------------------
1122!
1123 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
1124 IF (domain(ng)%NorthEast_Corner(tile)) THEN
1125 IF (lbc_apply(ng)%north(iend+1).and. &
1126 & lbc_apply(ng)%east (jend+1)) THEN
1127 DO k=lbk,ubk
1128!^ tl_A(Iend+1,Jend+1,k)=0.5_r8*(tl_A(Iend+1,Jend ,k)+ &
1129!^ & tl_A(Iend ,Jend+1,k))
1130!^
1131 adfac=0.5_r8*ad_a(iend+1,jend+1,k)
1132 ad_a(iend+1,jend ,k)=ad_a(iend+1,jend ,k)+adfac
1133 ad_a(iend ,jend+1,k)=ad_a(iend ,jend+1,k)+adfac
1134 ad_a(iend+1,jend+1,k)=0.0_r8
1135 END DO
1136 END IF
1137 END IF
1138 IF (domain(ng)%NorthWest_Corner(tile)) THEN
1139 IF (lbc_apply(ng)%north(istr ).and. &
1140 & lbc_apply(ng)%west (jend+1)) THEN
1141 DO k=lbk,ubk
1142!^ tl_A(Istr ,Jend+1,k)=0.5_r8*(tl_A(Istr ,Jend ,k)+ &
1143!^ & tl_A(Istr+1,Jend+1,k))
1144!^
1145 adfac=0.5_r8*ad_a(istr ,jend+1,k)
1146 ad_a(istr ,jend ,k)=ad_a(istr ,jend ,k)+adfac
1147 ad_a(istr+1,jend+1,k)=ad_a(istr+1,jend+1,k)+adfac
1148 ad_a(istr ,jend+1,k)=0.0_r8
1149 END DO
1150 END IF
1151 END IF
1152 IF (domain(ng)%SouthEast_Corner(tile)) THEN
1153 IF (lbc_apply(ng)%south(iend+1).and. &
1154 & lbc_apply(ng)%east (jstr-1)) THEN
1155 DO k=lbk,ubk
1156!^ tl_A(Iend+1,Jstr-1,k)=0.5_r8*(tl_A(Iend ,Jstr-1,k)+ &
1157!^ & tl_A(Iend+1,Jstr ,k))
1158!^
1159 adfac=0.5_r8*ad_a(iend+1,jstr-1,k)
1160 ad_a(iend ,jstr-1,k)=ad_a(iend ,jstr-1,k)+adfac
1161 ad_a(iend+1,jstr ,k)=ad_a(iend+1,jstr ,k)+adfac
1162 ad_a(iend+1,jstr-1,k)=0.0_r8
1163 END DO
1164 END IF
1165 END IF
1166 IF (domain(ng)%SouthWest_Corner(tile)) THEN
1167 IF (lbc_apply(ng)%south(istr ).and. &
1168 & lbc_apply(ng)%west (jstr-1)) THEN
1169 DO k=lbk,ubk
1170!^ tl_A(Istr ,Jstr-1,k)=0.5_r8*(tl_A(Istr+1,Jstr-1,k)+ &
1171!^ & tl_A(Istr ,Jstr ,k))
1172!^
1173 adfac=0.5_r8*ad_a(istr ,jstr-1,k)
1174 ad_a(istr+1,jstr-1,k)=ad_a(istr+1,jstr-1,k)+adfac
1175 ad_a(istr ,jstr ,k)=ad_a(istr ,jstr ,k)+adfac
1176 ad_a(istr ,jstr-1,k)=0.0_r8
1177 END DO
1178 END IF
1179 END IF
1180 END IF
1181!
1182!-----------------------------------------------------------------------
1183! Adjoint North-South gradient boundary conditions
1184!-----------------------------------------------------------------------
1185!
1186 IF (.not.nsperiodic(ng)) THEN
1187 IF (domain(ng)%Southern_Edge(tile)) THEN
1188 DO k=lbk,ubk
1189 DO i=istru,iend
1190 IF (lbc_apply(ng)%south(i)) THEN
1191!^ tl_A(i,Jstr-1,k)=tl_A(i,Jstr,k)
1192!^
1193 ad_a(i,jstr ,k)=ad_a(i,jstr,k)+ad_a(i,jstr-1,k)
1194 ad_a(i,jstr-1,k)=0.0_r8
1195 END IF
1196 END DO
1197 END DO
1198 END IF
1199
1200 IF (domain(ng)%Northern_Edge(tile)) THEN
1201 DO k=lbk,ubk
1202 DO i=istru,iend
1203 IF (lbc_apply(ng)%north(i)) THEN
1204!^ tl_A(i,Jend+1,k)=tl_A(i,Jend,k)
1205!^
1206 ad_a(i,jend ,k)=ad_a(i,jend,k)+ad_a(i,jend+1,k)
1207 ad_a(i,jend+1,k)=0.0_r8
1208 END IF
1209 END DO
1210 END DO
1211 END IF
1212 END IF
1213!
1214!-----------------------------------------------------------------------
1215! Adjoint East-West gradient boundary conditions
1216!-----------------------------------------------------------------------
1217!
1218 IF (.not.ewperiodic(ng)) THEN
1219 IF (domain(ng)%Western_Edge(tile)) THEN
1220 DO k=lbk,ubk
1221 DO j=jstr,jend
1222 IF (lbc_apply(ng)%west(j)) THEN
1223!^ tl_A(Istr,j,k)=tl_A(Istr+1,j,k)
1224!^
1225 ad_a(istr+1,j,k)=ad_a(istr+1,j,k)+ad_a(istr,j,k)
1226 ad_a(istr ,j,k)=0.0_r8
1227 END IF
1228 END DO
1229 END DO
1230 END IF
1231
1232 IF (domain(ng)%Eastern_Edge(tile)) THEN
1233 DO k=lbk,ubk
1234 DO j=jstr,jend
1235 IF (lbc_apply(ng)%east(j)) THEN
1236!^ tl_A(Iend+1,j,k)=tl_A(Iend,j,k)
1237!^
1238 ad_a(iend ,j,k)=ad_a(iend,j,k)+ad_a(iend+1,j,k)
1239 ad_a(iend+1,j,k)=0.0_r8
1240 END IF
1241 END DO
1242 END DO
1243 END IF
1244 END IF
1245
1246 RETURN
1247 END SUBROUTINE ad_dabc_u3d_tile
1248
1249!
1250!***********************************************************************
1251 SUBROUTINE ad_dabc_v3d_tile (ng, tile, &
1252 & LBi, UBi, LBj, UBj, LBk, UBk, &
1253 & ad_A)
1254!***********************************************************************
1255!
1256 USE mod_param
1257 USE mod_boundary
1258 USE mod_grid
1259 USE mod_ncparam
1260 USE mod_scalars
1261!
1262 USE ad_exchange_3d_mod, ONLY : ad_exchange_v3d_tile
1263!
1264! Imported variable declarations.
1265!
1266 integer, intent(in) :: ng, tile
1267 integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
1268!
1269# ifdef ASSUMED_SHAPE
1270 real(r8), intent(inout) :: ad_A(LBi:,LBj:,LBk:)
1271# else
1272 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj,LBk:UBk)
1273# endif
1274!
1275! Local variable declarations.
1276!
1277 integer :: Jmin, Jmax
1278 integer :: i, j, k
1279
1280 real(r8) :: adfac
1281
1282# include "set_bounds.h"
1283!
1284!-----------------------------------------------------------------------
1285! Apply adjoint periodic boundary conditons.
1286!-----------------------------------------------------------------------
1287!
1288 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1289 CALL ad_exchange_v3d_tile (ng, tile, &
1290 & lbi, ubi, lbj, ubj, lbk, ubk, &
1291 & ad_a)
1292 END IF
1293!
1294!-----------------------------------------------------------------------
1295! Boundary corners.
1296!-----------------------------------------------------------------------
1297!
1298 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
1299 IF (domain(ng)%NorthEast_Corner(tile)) THEN
1300 IF (lbc_apply(ng)%north(iend+1).and. &
1301 & lbc_apply(ng)%east (jend+1)) THEN
1302 DO k=lbk,ubk
1303!^ tl_A(Iend+1,Jend+1,k)=0.5_r8*(tl_A(Iend+1,Jend ,k)+ &
1304!^ & tl_A(Iend ,Jend+1,k))
1305!^
1306 adfac=0.5_r8*ad_a(iend+1,jend+1,k)
1307 ad_a(iend+1,jend ,k)=ad_a(iend+1,jend ,k)+adfac
1308 ad_a(iend ,jend+1,k)=ad_a(iend ,jend+1,k)+adfac
1309 ad_a(iend+1,jend+1,k)=0.0_r8
1310 END DO
1311 END IF
1312 END IF
1313 IF (domain(ng)%NorthWest_Corner(tile)) THEN
1314 IF (lbc_apply(ng)%north(istr-1).and. &
1315 & lbc_apply(ng)%west (jend+1)) THEN
1316 DO k=lbk,ubk
1317!^ tl_A(Istr-1,Jend+1,k)=0.5_r8*(tl_A(Istr-1,Jend ,k)+ &
1318!^ & tl_A(Istr ,Jend+1,k))
1319!^
1320 adfac=0.5_r8*ad_a(istr-1,jend+1,k)
1321 ad_a(istr-1,jend ,k)=ad_a(istr-1,jend ,k)+adfac
1322 ad_a(istr ,jend+1,k)=ad_a(istr ,jend+1,k)+adfac
1323 ad_a(istr-1,jend+1,k)=0.0_r8
1324 END DO
1325 END IF
1326 END IF
1327 IF (domain(ng)%SouthEast_Corner(tile)) THEN
1328 IF (lbc_apply(ng)%south(iend+1).and. &
1329 & lbc_apply(ng)%east (jstr )) THEN
1330 DO k=lbk,ubk
1331!^ tl_A(Iend+1,Jstr ,k)=0.5_r8*(tl_A(Iend ,Jstr ,k)+ &
1332!^ & tl_A(Iend+1,Jstr+1,k))
1333!^
1334 adfac=0.5_r8*ad_a(iend+1,jstr ,k)
1335 ad_a(iend ,jstr ,k)=ad_a(iend ,jstr ,k)+adfac
1336 ad_a(iend+1,jstr+1,k)=ad_a(iend+1,jstr+1,k)+adfac
1337 ad_a(iend+1,jstr ,k)=0.0_r8
1338 END DO
1339 END IF
1340 END IF
1341 IF (domain(ng)%SouthWest_Corner(tile)) THEN
1342 IF (lbc_apply(ng)%south(istr-1).and. &
1343 & lbc_apply(ng)%west (jstr )) THEN
1344 DO k=lbk,ubk
1345!^ tl_A(Istr-1,Jstr ,k)=0.5_r8*(tl_A(Istr ,Jstr ,k)+ &
1346!^ & tl_A(Istr-1,Jstr+1,k))
1347!^
1348 adfac=0.5_r8*ad_a(istr-1,jstr ,k)
1349 ad_a(istr ,jstr ,k)=ad_a(istr ,jstr ,k)+adfac
1350 ad_a(istr-1,jstr+1,k)=ad_a(istr-1,jstr+1,k)+adfac
1351 ad_a(istr-1,jstr ,k)=0.0_r8
1352 END DO
1353 END IF
1354 END IF
1355 END IF
1356!
1357!-----------------------------------------------------------------------
1358! Adjoint North-South gradient boundary conditions.
1359!-----------------------------------------------------------------------
1360!
1361 IF (.not.nsperiodic(ng)) THEN
1362 IF (domain(ng)%Southern_Edge(tile)) THEN
1363 DO k=lbk,ubk
1364 DO i=istr,iend
1365 IF (lbc_apply(ng)%south(i)) THEN
1366!^ tl_A(i,Jstr,k)=tl_A(i,Jstr+1,k)
1367!^
1368 ad_a(i,jstr+1,k)=ad_a(i,jstr+1,k)+ad_a(i,jstr,k)
1369 ad_a(i,jstr ,k)=0.0_r8
1370 END IF
1371 END DO
1372 END DO
1373 END IF
1374
1375 IF (domain(ng)%Northern_Edge(tile)) THEN
1376 DO k=lbk,ubk
1377 DO i=istr,iend
1378 IF (lbc_apply(ng)%north(i)) THEN
1379!^ tl_A(i,Jend+1,k)=tl_A(i,Jend,k)
1380!^
1381 ad_a(i,jend ,k)=ad_a(i,jend,k)+ad_a(i,jend+1,k)
1382 ad_a(i,jend+1,k)=0.0_r8
1383 END IF
1384 END DO
1385 END DO
1386 END IF
1387 END IF
1388!
1389!-----------------------------------------------------------------------
1390! Adjoint East-West gradient boundary conditions.
1391!-----------------------------------------------------------------------
1392!
1393 IF (.not.ewperiodic(ng)) THEN
1394 IF (domain(ng)%Western_Edge(tile)) THEN
1395 DO k=lbk,ubk
1396 DO j=jstrv,jend
1397 IF (lbc_apply(ng)%west(j)) THEN
1398!^ tl_A(Istr-1,j,k)=tl_A(Istr,j,k)
1399!^
1400 ad_a(istr ,j,k)=ad_a(istr,j,k)+ad_a(istr-1,j,k)
1401 ad_a(istr-1,j,k)=0.0_r8
1402 END IF
1403 END DO
1404 END DO
1405 END IF
1406
1407 IF (domain(ng)%Eastern_Edge(tile)) THEN
1408 DO k=lbk,ubk
1409 DO j=jstrv,jend
1410 IF (lbc_apply(ng)%east(j)) THEN
1411!^ tl_A(Iend+1,j,k)=tl_A(Iend,j,k)
1412!^
1413 ad_a(iend ,j,k)=ad_a(iend,j,k)+ad_a(iend+1,j,k)
1414 ad_a(iend+1,j,k)=0.0_r8
1415 END IF
1416 END DO
1417 END DO
1418 END IF
1419 END IF
1420
1421 RETURN
1422 END SUBROUTINE ad_dabc_v3d_tile
1423#endif
1424 END MODULE ad_bc_3d_mod
ad_bc_3d_mod
Definition ad_bc_3d.F:2
ad_bc_3d_mod::ad_bc_r3d_tile
subroutine ad_bc_r3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_bc_3d.F:48
ad_bc_3d_mod::ad_dabc_r3d_tile
subroutine ad_dabc_r3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_bc_3d.F:906
ad_bc_3d_mod::ad_bc_v3d_tile
subroutine ad_bc_v3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_bc_3d.F:477
ad_bc_3d_mod::ad_dabc_v3d_tile
subroutine ad_dabc_v3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_bc_3d.F:1254
ad_bc_3d_mod::ad_bc_w3d_tile
subroutine ad_bc_w3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_bc_3d.F:733
ad_bc_3d_mod::ad_bc_u3d_tile
subroutine ad_bc_u3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_bc_3d.F:221
ad_bc_3d_mod::ad_dabc_u3d_tile
subroutine ad_dabc_u3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_bc_3d.F:1079
ad_exchange_3d_mod
Definition ad_exchange_3d.F:2
ad_exchange_3d_mod::ad_exchange_v3d_tile
subroutine ad_exchange_v3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_exchange_3d.F:1283
ad_exchange_3d_mod::ad_exchange_w3d_tile
subroutine ad_exchange_w3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_exchange_3d.F:1693
ad_exchange_3d_mod::ad_exchange_r3d_tile
subroutine ad_exchange_r3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_exchange_3d.F:461
ad_exchange_3d_mod::ad_exchange_u3d_tile
subroutine ad_exchange_u3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_exchange_3d.F:872
mod_boundary
Definition mod_boundary.F:2
mod_boundary::lbc_apply
type(t_apply), dimension(:), allocatable lbc_apply
Definition mod_boundary.F:394
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::isbv2d
integer isbv2d
Definition mod_ncparam.F:530
mod_ncparam::isbu3d
integer isbu3d
Definition mod_ncparam.F:533
mod_ncparam::isbv3d
integer isbv3d
Definition mod_ncparam.F:534
mod_param
Definition mod_param.F:2
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::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::gamma2
real(r8), dimension(:), allocatable gamma2
Definition mod_scalars.F:743
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