ROMS
Loading...
Searching...
No Matches
ad_bc_2d.F
Go to the documentation of this file.
1#include "cppdefs.h"
3#ifdef ADJOINT
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 2D 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! ad_A 2D adjoint field. !
24! !
25! On Output: !
26! !
27! ad_A Processed 2D adjoint field. !
28! !
29! Routines: !
30! !
31! ad_bc_r2d_tile Boundary conditions for field at RHO-points !
32! ad_bc_u2d_tile Boundary conditions for field at U-points !
33! ad_bc_v2d_tile Boundary conditions for field at V-points !
34! !
35!=======================================================================
36!
37 implicit none
38!
39 CONTAINS
40!
41!***********************************************************************
42 SUBROUTINE ad_bc_r2d_tile (ng, tile, &
43 & LBi, UBi, LBj, UBj, &
44 & ad_A)
45!***********************************************************************
46!
47 USE mod_param
48 USE mod_boundary
49 USE mod_ncparam
50 USE mod_scalars
51!
53!
54! Imported variable declarations.
55!
56 integer, intent(in) :: ng, tile
57 integer, intent(in) :: LBi, UBi, LBj, UBj
58!
59# ifdef ASSUMED_SHAPE
60 real(r8), intent(inout) :: ad_A(LBi:,LBj:)
61# else
62 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj)
63# endif
64!
65! Local variable declarations.
66!
67 integer :: i, j
68
69 real(r8) :: adfac
70
71# include "set_bounds.h"
72!
73!-----------------------------------------------------------------------
74! Apply adjoint periodic boundary conditons.
75!-----------------------------------------------------------------------
76!
77 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
78 CALL ad_exchange_r2d_tile (ng, tile, &
79 & lbi, ubi, lbj, ubj, &
80 & ad_a)
81 END IF
82!
83!-----------------------------------------------------------------------
84! Boundary corners.
85!-----------------------------------------------------------------------
86!
87 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
88 IF (domain(ng)%NorthEast_Corner(tile)) THEN
89 IF (lbc_apply(ng)%north(iend+1).and. &
90 & lbc_apply(ng)%east (jend+1)) THEN
91!^ tl_A(Iend+1,Jend+1)=0.5_r8*(tl_A(Iend+1,Jend )+ &
92!^ & tl_A(Iend ,Jend+1))
93!^
94 adfac=0.5_r8*ad_a(iend+1,jend+1)
95 ad_a(iend+1,jend )=ad_a(iend+1,jend )+adfac
96 ad_a(iend ,jend+1)=ad_a(iend ,jend+1)+adfac
97 ad_a(iend+1,jend+1)=0.0_r8
98 END IF
99 END IF
100 IF (domain(ng)%NorthWest_Corner(tile)) THEN
101 IF (lbc_apply(ng)%north(istr-1).and. &
102 & lbc_apply(ng)%west (jend+1)) THEN
103!^ tl_A(Istr-1,Jend+1)=0.5_r8*(tl_A(Istr-1,Jend )+ &
104!^ & tl_A(Istr ,Jend+1))
105!^
106 adfac=0.5_r8*ad_a(istr-1,jend+1)
107 ad_a(istr-1,jend )=ad_a(istr-1,jend )+adfac
108 ad_a(istr ,jend+1)=ad_a(istr ,jend+1)+adfac
109 ad_a(istr-1,jend+1)=0.0_r8
110 END IF
111 END IF
112 IF (domain(ng)%SouthEast_Corner(tile)) THEN
113 IF (lbc_apply(ng)%south(iend+1).and. &
114 & lbc_apply(ng)%east (jstr-1)) THEN
115!^ tl_A(Iend+1,Jstr-1)=0.5_r8*(tl_A(Iend ,Jstr-1)+ &
116!^ & tl_A(Iend+1,Jstr ))
117!^
118 adfac=0.5_r8*ad_a(iend+1,jstr-1)
119 ad_a(iend ,jstr-1)=ad_a(iend ,jstr-1)+adfac
120 ad_a(iend+1,jstr )=ad_a(iend+1,jstr )+adfac
121 ad_a(iend+1,jstr-1)=0.0_r8
122 END IF
123 END IF
124 IF (domain(ng)%SouthWest_Corner(tile)) THEN
125 IF (lbc_apply(ng)%south(istr-1).and. &
126 & lbc_apply(ng)%west (jstr-1)) THEN
127!^ tl_A(Istr-1,Jstr-1)=0.5_r8*(tl_A(Istr ,Jstr-1)+ &
128!^ & tl_A(Istr-1,Jstr ))
129!^
130 adfac=0.5_r8*ad_a(istr-1,jstr-1)
131 ad_a(istr ,jstr-1)=ad_a(istr ,jstr-1)+adfac
132 ad_a(istr-1,jstr )=ad_a(istr-1,jstr )+adfac
133 ad_a(istr-1,jstr-1)=0.0_r8
134 END IF
135 END IF
136 END IF
137!
138!-----------------------------------------------------------------------
139! Adjoint North-South gradient boundary conditions.
140!-----------------------------------------------------------------------
141!
142 IF (.not.nsperiodic(ng)) THEN
143 IF (domain(ng)%Southern_Edge(tile)) THEN
144 DO i=istr,iend
145 IF (lbc_apply(ng)%south(i)) THEN
146!^ tl_A(i,Jstr-1)=tl_A(i,Jstr)
147!^
148 ad_a(i,jstr )=ad_a(i,jstr)+ad_a(i,jstr-1)
149 ad_a(i,jstr-1)=0.0_r8
150 END IF
151 END DO
152 END IF
153
154 IF (domain(ng)%Northern_Edge(tile)) THEN
155 DO i=istr,iend
156 IF (lbc_apply(ng)%north(i)) THEN
157!^ tl_A(i,Jend+1)=tl_A(i,Jend)
158!^
159 ad_a(i,jend )=ad_a(i,jend)+ad_a(i,jend+1)
160 ad_a(i,jend+1)=0.0_r8
161 END IF
162 END DO
163 END IF
164 END IF
165!
166!-----------------------------------------------------------------------
167! Adjoint East-West gradient boundary conditions.
168!-----------------------------------------------------------------------
169!
170 IF (.not.ewperiodic(ng)) THEN
171 IF (domain(ng)%Western_Edge(tile)) THEN
172 DO j=jstr,jend
173 IF (lbc_apply(ng)%west(j)) THEN
174!^ tl_A(Istr-1,j)=tl_A(Istr,j)
175!^
176 ad_a(istr ,j)=ad_a(istr,j)+ad_a(istr-1,j)
177 ad_a(istr-1,j)=0.0_r8
178 END IF
179 END DO
180 END IF
181
182 IF (domain(ng)%Eastern_Edge(tile)) THEN
183 DO j=jstr,jend
184 IF (lbc_apply(ng)%east(j)) THEN
185!^ tl_A(Iend+1,j)=tl_A(Iend,j)
186!^
187 ad_a(iend ,j)=ad_a(iend,j)+ad_a(iend+1,j)
188 ad_a(iend+1,j)=0.0_r8
189 END IF
190 END DO
191 END IF
192 END IF
193
194 RETURN
195 END SUBROUTINE ad_bc_r2d_tile
196
197!
198!***********************************************************************
199 SUBROUTINE ad_bc_u2d_tile (ng, tile, &
200 & LBi, UBi, LBj, UBj, &
201 & ad_A)
202!***********************************************************************
203!
204 USE mod_param
205 USE mod_boundary
206 USE mod_grid
207 USE mod_ncparam
208 USE mod_scalars
209!
211!
212! Imported variable declarations.
213!
214 integer, intent(in) :: ng, tile
215 integer, intent(in) :: LBi, UBi, LBj, UBj
216!
217# ifdef ASSUMED_SHAPE
218 real(r8), intent(inout) :: ad_A(LBi:,LBj:)
219# else
220 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj)
221# endif
222!
223! Local variable declarations.
224!
225 integer :: Imin, Imax
226 integer :: i, j
227
228 real(r8) :: adfac
229
230# include "set_bounds.h"
231!
232!-----------------------------------------------------------------------
233! Apply adjoint periodic boundary conditons.
234!-----------------------------------------------------------------------
235!
236 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
237 CALL ad_exchange_u2d_tile (ng, tile, &
238 & lbi, ubi, lbj, ubj, &
239 & ad_a)
240 END IF
241!
242!-----------------------------------------------------------------------
243! Boundary corners.
244!-----------------------------------------------------------------------
245!
246 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
247 IF (domain(ng)%NorthEast_Corner(tile)) THEN
248 IF (lbc_apply(ng)%north(iend+1).and. &
249 & lbc_apply(ng)%east (jend+1)) THEN
250!^ tl_A(Iend+1,Jend+1)=0.5_r8*(tl_A(Iend+1,Jend )+ &
251!^ & tl_A(Iend ,Jend+1))
252!^
253 adfac=0.5_r8*ad_a(iend+1,jend+1)
254 ad_a(iend+1,jend )=ad_a(iend+1,jend )+adfac
255 ad_a(iend ,jend+1)=ad_a(iend ,jend+1)+adfac
256 ad_a(iend+1,jend+1)=0.0_r8
257 END IF
258 END IF
259 IF (domain(ng)%NorthWest_Corner(tile)) THEN
260 IF (lbc_apply(ng)%north(istr ).and. &
261 & lbc_apply(ng)%west (jend+1)) THEN
262!^ tl_A(Istr ,Jend+1)=0.5_r8*(tl_A(Istr ,Jend )+ &
263!^ & tl_A(Istr+1,Jend+1))
264!^
265 adfac=0.5_r8*ad_a(istr,jend+1)
266 ad_a(istr ,jend )=ad_a(istr ,jend )+adfac
267 ad_a(istr+1,jend+1)=ad_a(istr+1,jend+1)+adfac
268 ad_a(istr ,jend+1)=0.0_r8
269 END IF
270 END IF
271 IF (domain(ng)%SouthEast_Corner(tile)) THEN
272 IF (lbc_apply(ng)%south(iend+1).and. &
273 & lbc_apply(ng)%east (jstr-1)) THEN
274!^ tl_A(Iend+1,Jstr-1)=0.5_r8*(tl_A(Iend ,Jstr-1)+ &
275!^ & tl_A(Iend+1,Jstr ))
276!^
277 adfac=0.5_r8*ad_a(iend+1,jstr-1)
278 ad_a(iend ,jstr-1)=ad_a(iend ,jstr-1)+adfac
279 ad_a(iend+1,jstr )=ad_a(iend+1,jstr )+adfac
280 ad_a(iend+1,jstr-1)=0.0_r8
281 END IF
282 END IF
283 IF (domain(ng)%SouthWest_Corner(tile)) THEN
284 IF (lbc_apply(ng)%south(istr ).and. &
285 & lbc_apply(ng)%west (jstr-1)) THEN
286!^ tl_A(Istr ,Jstr-1)=0.5_r8*(tl_A(Istr+1,Jstr-1)+ &
287!^ & tl_A(Istr ,Jstr ))
288!^
289 adfac=0.5_r8*ad_a(istr,jstr-1)
290 ad_a(istr+1,jstr-1)=ad_a(istr+1,jstr-1)+adfac
291 ad_a(istr ,jstr )=ad_a(istr ,jstr )+adfac
292 ad_a(istr ,jstr-1)=0.0_r8
293 END IF
294 END IF
295 END IF
296!
297!-----------------------------------------------------------------------
298! Adjoint North-South boundary conditions: Closed (free-slip/no-slip)
299! or gradient.
300!-----------------------------------------------------------------------
301!
302 IF (.not.nsperiodic(ng)) THEN
303 IF (domain(ng)%Southern_Edge(tile)) THEN
304 IF (ad_lbc(isouth,isbu2d,ng)%closed) THEN
305 IF (ewperiodic(ng)) THEN
306 imin=istru
307 imax=iend
308 ELSE
309 imin=istr
310 imax=iendr
311 END IF
312 DO i=imin,imax
313 IF (lbc_apply(ng)%south(i)) THEN
314# ifdef MASKING
315!^ tl_A(i,Jstr-1)=tl_A(i,Jstr-1)*GRID(ng)%umask(i,Jstr-1)
316!^
317 ad_a(i,jstr-1)=ad_a(i,jstr-1)*grid(ng)%umask(i,jstr-1)
318# endif
319!^ tl_A(i,Jstr-1)=gamma2(ng)*tl_A(i,Jstr)
320!^
321 ad_a(i,jstr)=ad_a(i,jstr)+gamma2(ng)*ad_a(i,jstr-1)
322 ad_a(i,jstr-1)=0.0_r8
323 END IF
324 END DO
325 ELSE
326 DO i=istru,iend
327 IF (lbc_apply(ng)%south(i)) THEN
328!^ tl_A(i,Jstr-1)=tl_A(i,Jstr)
329!^
330 ad_a(i,jstr )=ad_a(i,jstr)+ad_a(i,jstr-1)
331 ad_a(i,jstr-1)=0.0_r8
332 END IF
333 END DO
334 END IF
335 END IF
336
337 IF (domain(ng)%Northern_Edge(tile)) THEN
338 IF (ad_lbc(inorth,isbu2d,ng)%closed) THEN
339 IF (ewperiodic(ng)) THEN
340 imin=istru
341 imax=iend
342 ELSE
343 imin=istr
344 imax=iendr
345 END IF
346 DO i=imin,imax
347 IF (lbc_apply(ng)%north(i)) THEN
348# ifdef MASKING
349!^ tl_A(i,Jend+1)=tl_A(i,Jend+1)*GRID(ng)%umask(i,Jend+1)
350!^
351 ad_a(i,jend+1)=ad_a(i,jend+1)*grid(ng)%umask(i,jend+1)
352# endif
353!^ tl_A(i,Jend+1)=gamma2(ng)*tl_A(i,Jend)
354!^
355 ad_a(i,jend)=ad_a(i,jend)+gamma2(ng)*ad_a(i,jend+1)
356 ad_a(i,jend+1)=0.0_r8
357 END IF
358 END DO
359 ELSE
360 DO i=istru,iend
361 IF (lbc_apply(ng)%north(i)) THEN
362!^ tl_A(i,Jend+1)=tl_A(i,Jend)
363!^
364 ad_a(i,jend )=ad_a(i,jend)+ad_a(i,jend+1)
365 ad_a(i,jend+1)=0.0_r8
366 END IF
367 END DO
368 END IF
369 END IF
370 END IF
371!
372!-----------------------------------------------------------------------
373! Adjoint East-West boundary conditions: Closed or gradient.
374!-----------------------------------------------------------------------
375!
376 IF (.not.ewperiodic(ng)) THEN
377 IF (domain(ng)%Western_Edge(tile)) THEN
378 IF (ad_lbc(iwest,isbu2d,ng)%closed) THEN
379 DO j=jstr,jend
380 IF (lbc_apply(ng)%west(j)) THEN
381!^ tl_A(Istr,j)=0.0_r8
382!^
383 ad_a(istr,j)=0.0_r8
384 END IF
385 END DO
386 ELSE
387 DO j=jstr,jend
388 IF (lbc_apply(ng)%west(j)) THEN
389!^ tl_A(Istr,j)=tl_A(Istr+1,j)
390!^
391 ad_a(istr+1,j)=ad_a(istr+1,j)+ad_a(istr,j)
392 ad_a(istr ,j)=0.0_r8
393 END IF
394 END DO
395 END IF
396 END IF
397
398 IF (domain(ng)%Eastern_Edge(tile)) THEN
399 IF (ad_lbc(ieast,isbu2d,ng)%closed) THEN
400 DO j=jstr,jend
401 IF (lbc_apply(ng)%east(j)) THEN
402!^ A(Iend+1,j)=0.0_r8
403!^
404 ad_a(iend+1,j)=0.0_r8
405 END IF
406 END DO
407 ELSE
408 DO j=jstr,jend
409 IF (lbc_apply(ng)%east(j)) THEN
410!^ tl_A(Iend+1,j)=tl_A(Iend,j)
411!^
412 ad_a(iend ,j)=ad_a(iend,j)+ad_a(iend+1,j)
413 ad_a(iend+1,j)=0.0_r8
414 END IF
415 END DO
416 END IF
417 END IF
418 END IF
419
420 RETURN
421 END SUBROUTINE ad_bc_u2d_tile
422
423!
424!***********************************************************************
425 SUBROUTINE ad_bc_v2d_tile (ng, tile, &
426 & LBi, UBi, LBj, UBj, &
427 & ad_A)
428!***********************************************************************
429!
430 USE mod_param
431 USE mod_boundary
432 USE mod_grid
433 USE mod_ncparam
434 USE mod_scalars
435!
437!
438! Imported variable declarations.
439!
440 integer, intent(in) :: ng, tile
441 integer, intent(in) :: LBi, UBi, LBj, UBj
442!
443# ifdef ASSUMED_SHAPE
444 real(r8), intent(inout) :: ad_A(LBi:,LBj:)
445# else
446 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj)
447# endif
448!
449! Local variable declarations.
450!
451 integer :: Jmin, Jmax
452 integer :: i, j
453
454 real(r8) :: adfac
455
456# include "set_bounds.h"
457!
458!-----------------------------------------------------------------------
459! Apply adjoint periodic boundary conditons.
460!-----------------------------------------------------------------------
461!
462 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
463 CALL ad_exchange_v2d_tile (ng, tile, &
464 & lbi, ubi, lbj, ubj, &
465 & ad_a)
466 END IF
467!
468!-----------------------------------------------------------------------
469! Boundary corners.
470!-----------------------------------------------------------------------
471!
472 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
473 IF (domain(ng)%NorthEast_Corner(tile)) THEN
474 IF (lbc_apply(ng)%north(iend+1).and. &
475 & lbc_apply(ng)%east (jend+1)) THEN
476!^ tl_A(Iend+1,Jend+1)=0.5_r8*(tl_A(Iend+1,Jend )+ &
477!^ & tl_A(Iend ,Jend+1))
478!^
479 adfac=0.5_r8*ad_a(iend+1,jend+1)
480 ad_a(iend+1,jend )=ad_a(iend+1,jend )+adfac
481 ad_a(iend ,jend+1)=ad_a(iend ,jend+1)+adfac
482 ad_a(iend+1,jend+1)=0.0_r8
483 END IF
484 END IF
485 IF (domain(ng)%NorthWest_Corner(tile)) THEN
486 IF (lbc_apply(ng)%north(istr-1).and. &
487 & lbc_apply(ng)%west (jend+1)) THEN
488!^ tl_A(Istr-1,Jend+1)=0.5_r8*(tl_A(Istr-1,Jend )+ &
489!^ & tl_A(Istr ,Jend+1))
490!^
491 adfac=0.5_r8*ad_a(istr-1,jend+1)
492 ad_a(istr-1,jend )=ad_a(istr-1,jend )+adfac
493 ad_a(istr ,jend+1)=ad_a(istr ,jend+1)+adfac
494 ad_a(istr-1,jend+1)=0.0_r8
495 END IF
496 END IF
497 IF (domain(ng)%SouthEast_Corner(tile)) THEN
498 IF (lbc_apply(ng)%south(iend+1).and. &
499 & lbc_apply(ng)%east (jstr )) THEN
500!^ tl_A(Iend+1,Jstr )=0.5_r8*(tl_A(Iend ,Jstr )+ &
501!^ & tl_A(Iend+1,Jstr+1))
502!^
503 adfac=0.5_r8*ad_a(iend+1,jstr )
504 ad_a(iend ,jstr )=ad_a(iend ,jstr )+adfac
505 ad_a(iend+1,jstr+1)=ad_a(iend+1,jstr+1)+adfac
506 ad_a(iend+1,jstr )=0.0_r8
507 END IF
508 END IF
509 IF (domain(ng)%SouthWest_Corner(tile)) THEN
510 IF (lbc_apply(ng)%south(istr-1).and. &
511 & lbc_apply(ng)%west (jstr )) THEN
512!^ tl_A(Istr-1,Jstr )=0.5_r8*(tl_A(Istr ,Jstr )+ &
513!^ & tl_A(Istr-1,Jstr+1))
514!^
515 adfac=0.5_r8*ad_a(istr-1,jstr )
516 ad_a(istr ,jstr )=ad_a(istr ,jstr )+adfac
517 ad_a(istr-1,jstr+1)=ad_a(istr-1,jstr+1)+adfac
518 ad_a(istr-1,jstr )=0.0_r8
519 END IF
520 END IF
521 END IF
522!
523!-----------------------------------------------------------------------
524! Adjoint North-South boundary conditions: Closed or Gradient.
525!-----------------------------------------------------------------------
526!
527 IF (.not.nsperiodic(ng)) THEN
528 IF (domain(ng)%Southern_Edge(tile)) THEN
529 IF (ad_lbc(isouth,isbv2d,ng)%closed) THEN
530 DO i=istr,iend
531 IF (lbc_apply(ng)%south(i)) THEN
532!^ tl_A(i,Jstr)=0.0_r8
533!^
534 ad_a(i,jstr)=0.0_r8
535 END IF
536 END DO
537 ELSE
538 DO i=istr,iend
539 IF (lbc_apply(ng)%south(i)) THEN
540!^ tl_A(i,Jstr)=tl_A(i,Jstr+1)
541!^
542 ad_a(i,jstr+1)=ad_a(i,jstr+1)+ad_a(i,jstr)
543 ad_a(i,jstr)=0.0_r8
544 END IF
545 END DO
546 END IF
547 END IF
548
549 IF (domain(ng)%Northern_Edge(tile)) THEN
550 IF (ad_lbc(inorth,isbv2d,ng)%closed) THEN
551 DO i=istr,iend
552 IF (lbc_apply(ng)%north(i)) THEN
553!^ tl_A(i,Jend+1)=0.0_r8
554!^
555 ad_a(i,jend+1)=0.0_r8
556 END IF
557 END DO
558 ELSE
559 DO i=istr,iend
560 IF (lbc_apply(ng)%north(i)) THEN
561!^ tl_A(i,Jend+1)=tl_A(i,Jend)
562!^
563 ad_a(i,jend)=ad_a(i,jend)+ad_a(i,jend+1)
564 ad_a(i,jend+1)=0.0_r8
565 END IF
566 END DO
567 END IF
568 END IF
569 END IF
570!
571!-----------------------------------------------------------------------
572! Adjoint East-West boundary conditions.
573!-----------------------------------------------------------------------
574!
575 IF (.not.ewperiodic(ng)) THEN
576 IF (domain(ng)%Western_Edge(tile)) THEN
577 IF (ad_lbc(iwest,isbv2d,ng)%closed) THEN
578 IF (nsperiodic(ng)) THEN
579 jmin=jstrv
580 jmax=jend
581 ELSE
582 jmin=jstr
583 jmax=jendr
584 END IF
585 DO j=jmin,jmax
586 IF (lbc_apply(ng)%west(j)) THEN
587# ifdef MASKING
588!^ tl_A(Istr-1,j)=tl_A(Istr-1,j)*GRID(ng)%vmask(Istr-1,j)
589!^
590 ad_a(istr-1,j)=ad_a(istr-1,j)*grid(ng)%vmask(istr-1,j)
591# endif
592!^ tl_A(Istr-1,j)=gamma2(ng)*tl_A(Istr,j)
593!^
594 ad_a(istr ,j)=ad_a(istr,j)+gamma2(ng)*ad_a(istr-1,j)
595 ad_a(istr-1,j)=0.0_r8
596 END IF
597 END DO
598 ELSE
599 DO j=jstrv,jend
600 IF (lbc_apply(ng)%west(j)) THEN
601!^ tl_A(Istr-1,j)=tl_A(Istr,j)
602!^
603 ad_a(istr ,j)=ad_a(istr,j)+ad_a(istr-1,j)
604 ad_a(istr-1,j)=0.0_r8
605 END IF
606 END DO
607 END IF
608 END IF
609
610 IF (domain(ng)%Eastern_Edge(tile)) THEN
611 IF (ad_lbc(ieast,isbv2d,ng)%closed) THEN
612 IF (nsperiodic(ng)) THEN
613 jmin=jstrv
614 jmax=jend
615 ELSE
616 jmin=jstr
617 jmax=jendr
618 END IF
619 DO j=jmin,jmax
620 IF (lbc_apply(ng)%east(j)) THEN
621# ifdef MASKING
622!^ tl_A(Iend+1,j)=tl_A(Iend+1,j)*GRID(ng)%vmask(Iend+1,j)
623!^
624 ad_a(iend+1,j)=ad_a(iend+1,j)*grid(ng)%vmask(iend+1,j)
625# endif
626!^ tl_A(Iend+1,j)=gamma2(ng)*tl_A(Iend,j)
627!^
628 ad_a(iend ,j)=ad_a(iend,j)+ad_a(iend+1,j)
629 ad_a(iend+1,j)=0.0_r8
630 END IF
631 END DO
632 ELSE
633 DO j=jstrv,jend
634 IF (lbc_apply(ng)%east(j)) THEN
635!^ tl_A(Iend+1,j)=tl_A(Iend,j)
636!^
637 ad_a(iend ,j)=ad_a(iend,j)+ad_a(iend+1,j)
638 ad_a(iend+1,j)=0.0_r8
639 END IF
640 END DO
641 END IF
642 END IF
643 END IF
644
645 RETURN
646 END SUBROUTINE ad_bc_v2d_tile
647
648!
649!***********************************************************************
650 SUBROUTINE ad_dabc_r2d_tile (ng, tile, &
651 & LBi, UBi, LBj, UBj, &
652 & ad_A)
653!***********************************************************************
654!
655 USE mod_param
656 USE mod_boundary
657 USE mod_ncparam
658 USE mod_scalars
659!
661!
662! Imported variable declarations.
663!
664 integer, intent(in) :: ng, tile
665 integer, intent(in) :: LBi, UBi, LBj, UBj
666!
667# ifdef ASSUMED_SHAPE
668 real(r8), intent(inout) :: ad_A(LBi:,LBj:)
669# else
670 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj)
671# endif
672!
673! Local variable declarations.
674!
675 integer :: i, j
676
677 real(r8) :: adfac
678
679# include "set_bounds.h"
680!
681!-----------------------------------------------------------------------
682! Apply adjoint periodic boundary conditons.
683!-----------------------------------------------------------------------
684!
685 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
686 CALL ad_exchange_r2d_tile (ng, tile, &
687 & lbi, ubi, lbj, ubj, &
688 & ad_a)
689 END IF
690!
691!-----------------------------------------------------------------------
692! Boundary corners.
693!-----------------------------------------------------------------------
694!
695 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
696 IF (domain(ng)%NorthEast_Corner(tile)) THEN
697 IF (lbc_apply(ng)%north(iend+1).and. &
698 & lbc_apply(ng)%east (jend+1)) THEN
699!^ tl_A(Iend+1,Jend+1)=0.5_r8*(tl_A(Iend+1,Jend )+ &
700!^ & tl_A(Iend ,Jend+1))
701!^
702 adfac=0.5_r8*ad_a(iend+1,jend+1)
703 ad_a(iend+1,jend )=ad_a(iend+1,jend )+adfac
704 ad_a(iend ,jend+1)=ad_a(iend ,jend+1)+adfac
705 ad_a(iend+1,jend+1)=0.0_r8
706 END IF
707 END IF
708 IF (domain(ng)%NorthWest_Corner(tile)) THEN
709 IF (lbc_apply(ng)%north(istr-1).and. &
710 & lbc_apply(ng)%west (jend+1)) THEN
711!^ tl_A(Istr-1,Jend+1)=0.5_r8*(tl_A(Istr-1,Jend )+ &
712!^ & tl_A(Istr ,Jend+1))
713!^
714 adfac=0.5_r8*ad_a(istr-1,jend+1)
715 ad_a(istr-1,jend )=ad_a(istr-1,jend )+adfac
716 ad_a(istr ,jend+1)=ad_a(istr ,jend+1)+adfac
717 ad_a(istr-1,jend+1)=0.0_r8
718 END IF
719 END IF
720 IF (domain(ng)%SouthEast_Corner(tile)) THEN
721 IF (lbc_apply(ng)%south(iend+1).and. &
722 & lbc_apply(ng)%east (jstr-1)) THEN
723!^ tl_A(Iend+1,Jstr-1)=0.5_r8*(tl_A(Iend ,Jstr-1)+ &
724!^ & tl_A(Iend+1,Jstr ))
725!^
726 adfac=0.5_r8*ad_a(iend+1,jstr-1)
727 ad_a(iend ,jstr-1)=ad_a(iend ,jstr-1)+adfac
728 ad_a(iend+1,jstr )=ad_a(iend+1,jstr )+adfac
729 ad_a(iend+1,jstr-1)=0.0_r8
730 END IF
731 END IF
732 IF (domain(ng)%SouthWest_Corner(tile)) THEN
733 IF (lbc_apply(ng)%south(istr-1).and. &
734 & lbc_apply(ng)%west (jstr-1)) THEN
735!^ tl_A(Istr-1,Jstr-1)=0.5_r8*(tl_A(Istr ,Jstr-1)+ &
736!^ & tl_A(Istr-1,Jstr ))
737!^
738 adfac=0.5_r8*ad_a(istr-1,jstr-1)
739 ad_a(istr ,jstr-1)=ad_a(istr ,jstr-1)+adfac
740 ad_a(istr-1,jstr )=ad_a(istr-1,jstr )+adfac
741 ad_a(istr-1,jstr-1)=0.0_r8
742 END IF
743 END IF
744 END IF
745!
746!-----------------------------------------------------------------------
747! Adjoint North-South gradient boundary conditions.
748!-----------------------------------------------------------------------
749!
750 IF (.not.nsperiodic(ng)) THEN
751 IF (domain(ng)%Southern_Edge(tile)) THEN
752 DO i=istr,iend
753 IF (lbc_apply(ng)%south(i)) THEN
754!^ tl_A(i,Jstr-1)=tl_A(i,Jstr)
755!^
756 ad_a(i,jstr )=ad_a(i,jstr)+ad_a(i,jstr-1)
757 ad_a(i,jstr-1)=0.0_r8
758 END IF
759 END DO
760 END IF
761
762 IF (domain(ng)%Northern_Edge(tile)) THEN
763 DO i=istr,iend
764 IF (lbc_apply(ng)%north(i)) THEN
765!^ tl_A(i,Jend+1)=tl_A(i,Jend)
766!^
767 ad_a(i,jend )=ad_a(i,jend)+ad_a(i,jend+1)
768 ad_a(i,jend+1)=0.0_r8
769 END IF
770 END DO
771 END IF
772 END IF
773!
774!-----------------------------------------------------------------------
775! Adjoint East-West gradient boundary conditions.
776!-----------------------------------------------------------------------
777!
778 IF (.not.ewperiodic(ng)) THEN
779 IF (domain(ng)%Western_Edge(tile)) THEN
780 DO j=jstr,jend
781 IF (lbc_apply(ng)%west(j)) THEN
782!^ tl_A(Istr-1,j)=tl_A(Istr,j)
783!^
784 ad_a(istr ,j)=ad_a(istr,j)+ad_a(istr-1,j)
785 ad_a(istr-1,j)=0.0_r8
786 END IF
787 END DO
788 END IF
789
790 IF (domain(ng)%Eastern_Edge(tile)) THEN
791 DO j=jstr,jend
792 IF (lbc_apply(ng)%east(j)) THEN
793!^ tl_A(Iend+1,j)=tl_A(Iend,j)
794!^
795 ad_a(iend ,j)=ad_a(iend,j)+ad_a(iend+1,j)
796 ad_a(iend+1,j)=0.0_r8
797 END IF
798 END DO
799 END IF
800 END IF
801
802 RETURN
803 END SUBROUTINE ad_dabc_r2d_tile
804
805!
806!***********************************************************************
807 SUBROUTINE ad_dabc_u2d_tile (ng, tile, &
808 & LBi, UBi, LBj, UBj, &
809 & ad_A)
810!***********************************************************************
811!
812 USE mod_param
813 USE mod_boundary
814 USE mod_grid
815 USE mod_ncparam
816 USE mod_scalars
817!
819!
820! Imported variable declarations.
821!
822 integer, intent(in) :: ng, tile
823 integer, intent(in) :: LBi, UBi, LBj, UBj
824!
825# ifdef ASSUMED_SHAPE
826 real(r8), intent(inout) :: ad_A(LBi:,LBj:)
827# else
828 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj)
829# endif
830!
831! Local variable declarations.
832!
833 integer :: Imin, Imax
834 integer :: i, j
835
836 real(r8) :: adfac
837
838# include "set_bounds.h"
839!
840!-----------------------------------------------------------------------
841! Apply adjoint periodic boundary conditons.
842!-----------------------------------------------------------------------
843!
844 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
845 CALL ad_exchange_u2d_tile (ng, tile, &
846 & lbi, ubi, lbj, ubj, &
847 & ad_a)
848 END IF
849!
850!-----------------------------------------------------------------------
851! Boundary corners.
852!-----------------------------------------------------------------------
853!
854 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
855 IF (domain(ng)%NorthEast_Corner(tile)) THEN
856 IF (lbc_apply(ng)%north(iend+1).and. &
857 & lbc_apply(ng)%east (jend+1)) THEN
858!^ tl_A(Iend+1,Jend+1)=0.5_r8*(tl_A(Iend+1,Jend )+ &
859!^ & tl_A(Iend ,Jend+1))
860!^
861 adfac=0.5_r8*ad_a(iend+1,jend+1)
862 ad_a(iend+1,jend )=ad_a(iend+1,jend )+adfac
863 ad_a(iend ,jend+1)=ad_a(iend ,jend+1)+adfac
864 ad_a(iend+1,jend+1)=0.0_r8
865 END IF
866 END IF
867 IF (domain(ng)%NorthWest_Corner(tile)) THEN
868 IF (lbc_apply(ng)%north(istr ).and. &
869 & lbc_apply(ng)%west (jend+1)) THEN
870!^ tl_A(Istr ,Jend+1)=0.5_r8*(tl_A(Istr ,Jend )+ &
871!^ & tl_A(Istr+1,Jend+1))
872!^
873 adfac=0.5_r8*ad_a(istr,jend+1)
874 ad_a(istr ,jend )=ad_a(istr ,jend )+adfac
875 ad_a(istr+1,jend+1)=ad_a(istr+1,jend+1)+adfac
876 ad_a(istr ,jend+1)=0.0_r8
877 END IF
878 END IF
879 IF (domain(ng)%SouthEast_Corner(tile)) THEN
880 IF (lbc_apply(ng)%south(iend+1).and. &
881 & lbc_apply(ng)%east (jstr-1)) THEN
882!^ tl_A(Iend+1,Jstr-1)=0.5_r8*(tl_A(Iend ,Jstr-1)+ &
883!^ & tl_A(Iend+1,Jstr ))
884!^
885 adfac=0.5_r8*ad_a(iend+1,jstr-1)
886 ad_a(iend ,jstr-1)=ad_a(iend ,jstr-1)+adfac
887 ad_a(iend+1,jstr )=ad_a(iend+1,jstr )+adfac
888 ad_a(iend+1,jstr-1)=0.0_r8
889 END IF
890 END IF
891 IF (domain(ng)%SouthWest_Corner(tile)) THEN
892 IF (lbc_apply(ng)%south(istr ).and. &
893 & lbc_apply(ng)%west (jstr-1)) THEN
894!^ tl_A(Istr ,Jstr-1)=0.5_r8*(tl_A(Istr+1,Jstr-1)+ &
895!^ & tl_A(Istr ,Jstr ))
896!^
897 adfac=0.5_r8*ad_a(istr,jstr-1)
898 ad_a(istr+1,jstr-1)=ad_a(istr+1,jstr-1)+adfac
899 ad_a(istr ,jstr )=ad_a(istr ,jstr )+adfac
900 ad_a(istr ,jstr-1)=0.0_r8
901 END IF
902 END IF
903 END IF
904!
905!-----------------------------------------------------------------------
906! Adjoint North-South gradient boundary conditions.
907!-----------------------------------------------------------------------
908!
909 IF (.not.nsperiodic(ng)) THEN
910 IF (domain(ng)%Southern_Edge(tile)) THEN
911 DO i=istru,iend
912 IF (lbc_apply(ng)%south(i)) THEN
913!^ tl_A(i,Jstr-1)=tl_A(i,Jstr)
914!^
915 ad_a(i,jstr )=ad_a(i,jstr)+ad_a(i,jstr-1)
916 ad_a(i,jstr-1)=0.0_r8
917 END IF
918 END DO
919 END IF
920
921 IF (domain(ng)%Northern_Edge(tile)) THEN
922 DO i=istru,iend
923 IF (lbc_apply(ng)%north(i)) THEN
924!^ tl_A(i,Jend+1)=tl_A(i,Jend)
925!^
926 ad_a(i,jend )=ad_a(i,jend)+ad_a(i,jend+1)
927 ad_a(i,jend+1)=0.0_r8
928 END IF
929 END DO
930 END IF
931 END IF
932!
933!-----------------------------------------------------------------------
934! Adjoint East-West gradient boundary conditions.
935!-----------------------------------------------------------------------
936!
937 IF (.not.ewperiodic(ng)) THEN
938 IF (domain(ng)%Western_Edge(tile)) THEN
939 DO j=jstr,jend
940 IF (lbc_apply(ng)%west(j)) THEN
941!^ tl_A(Istr,j)=tl_A(Istr+1,j)
942!^
943 ad_a(istr+1,j)=ad_a(istr+1,j)+ad_a(istr,j)
944 ad_a(istr ,j)=0.0_r8
945 END IF
946 END DO
947 END IF
948
949 IF (domain(ng)%Eastern_Edge(tile)) THEN
950 DO j=jstr,jend
951 IF (lbc_apply(ng)%east(j)) THEN
952!^ tl_A(Iend+1,j)=tl_A(Iend,j)
953!^
954 ad_a(iend ,j)=ad_a(iend,j)+ad_a(iend+1,j)
955 ad_a(iend+1,j)=0.0_r8
956 END IF
957 END DO
958 END IF
959 END IF
960
961 RETURN
962 END SUBROUTINE ad_dabc_u2d_tile
963
964!
965!***********************************************************************
966 SUBROUTINE ad_dabc_v2d_tile (ng, tile, &
967 & LBi, UBi, LBj, UBj, &
968 & ad_A)
969!***********************************************************************
970!
971 USE mod_param
972 USE mod_boundary
973 USE mod_grid
974 USE mod_ncparam
975 USE mod_scalars
976!
978!
979! Imported variable declarations.
980!
981 integer, intent(in) :: ng, tile
982 integer, intent(in) :: LBi, UBi, LBj, UBj
983!
984# ifdef ASSUMED_SHAPE
985 real(r8), intent(inout) :: ad_A(LBi:,LBj:)
986# else
987 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj)
988# endif
989!
990! Local variable declarations.
991!
992 integer :: Jmin, Jmax
993 integer :: i, j
994
995 real(r8) :: adfac
996
997# include "set_bounds.h"
998!
999!-----------------------------------------------------------------------
1000! Apply adjoint periodic boundary conditons.
1001!-----------------------------------------------------------------------
1002!
1003 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1004 CALL ad_exchange_v2d_tile (ng, tile, &
1005 & lbi, ubi, lbj, ubj, &
1006 & ad_a)
1007 END IF
1008!
1009!-----------------------------------------------------------------------
1010! Boundary corners.
1011!-----------------------------------------------------------------------
1012!
1013 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
1014 IF (domain(ng)%NorthEast_Corner(tile)) THEN
1015 IF (lbc_apply(ng)%north(iend+1).and. &
1016 & lbc_apply(ng)%east (jend+1)) THEN
1017!^ tl_A(Iend+1,Jend+1)=0.5_r8*(tl_A(Iend+1,Jend )+ &
1018!^ & tl_A(Iend ,Jend+1))
1019!^
1020 adfac=0.5_r8*ad_a(iend+1,jend+1)
1021 ad_a(iend+1,jend )=ad_a(iend+1,jend )+adfac
1022 ad_a(iend ,jend+1)=ad_a(iend ,jend+1)+adfac
1023 ad_a(iend+1,jend+1)=0.0_r8
1024 END IF
1025 END IF
1026 IF (domain(ng)%NorthWest_Corner(tile)) THEN
1027 IF (lbc_apply(ng)%north(istr-1).and. &
1028 & lbc_apply(ng)%west (jend+1)) THEN
1029!^ tl_A(Istr-1,Jend+1)=0.5_r8*(tl_A(Istr-1,Jend )+ &
1030!^ & tl_A(Istr ,Jend+1))
1031!^
1032 adfac=0.5_r8*ad_a(istr-1,jend+1)
1033 ad_a(istr-1,jend )=ad_a(istr-1,jend )+adfac
1034 ad_a(istr ,jend+1)=ad_a(istr ,jend+1)+adfac
1035 ad_a(istr-1,jend+1)=0.0_r8
1036 END IF
1037 END IF
1038 IF (domain(ng)%SouthEast_Corner(tile)) THEN
1039 IF (lbc_apply(ng)%south(iend+1).and. &
1040 & lbc_apply(ng)%east (jstr )) THEN
1041!^ tl_A(Iend+1,Jstr )=0.5_r8*(tl_A(Iend ,Jstr )+ &
1042!^ & tl_A(Iend+1,Jstr+1))
1043!^
1044 adfac=0.5_r8*ad_a(iend+1,jstr )
1045 ad_a(iend ,jstr )=ad_a(iend ,jstr )+adfac
1046 ad_a(iend+1,jstr+1)=ad_a(iend+1,jstr+1)+adfac
1047 ad_a(iend+1,jstr )=0.0_r8
1048 END IF
1049 END IF
1050 IF (domain(ng)%SouthWest_Corner(tile)) THEN
1051 IF (lbc_apply(ng)%south(istr-1).and. &
1052 & lbc_apply(ng)%west (jstr )) THEN
1053!^ tl_A(Istr-1,Jstr )=0.5_r8*(tl_A(Istr ,Jstr )+ &
1054!^ & tl_A(Istr-1,Jstr+1))
1055!^
1056 adfac=0.5_r8*ad_a(istr-1,jstr )
1057 ad_a(istr ,jstr )=ad_a(istr ,jstr )+adfac
1058 ad_a(istr-1,jstr+1)=ad_a(istr-1,jstr+1)+adfac
1059 ad_a(istr-1,jstr )=0.0_r8
1060 END IF
1061 END IF
1062 END IF
1063!
1064!-----------------------------------------------------------------------
1065! Adjoint North-South gradient boundary conditions.
1066!-----------------------------------------------------------------------
1067!
1068 IF (.not.nsperiodic(ng)) THEN
1069 IF (domain(ng)%Southern_Edge(tile)) THEN
1070 DO i=istr,iend
1071 IF (lbc_apply(ng)%south(i)) THEN
1072!^ tl_A(i,Jstr)=tl_A(i,Jstr+1)
1073!^
1074 ad_a(i,jstr+1)=ad_a(i,jstr+1)+ad_a(i,jstr)
1075 ad_a(i,jstr)=0.0_r8
1076 END IF
1077 END DO
1078 END IF
1079
1080 IF (domain(ng)%Northern_Edge(tile)) THEN
1081 DO i=istr,iend
1082 IF (lbc_apply(ng)%north(i)) THEN
1083!^ tl_A(i,Jend+1)=tl_A(i,Jend)
1084!^
1085 ad_a(i,jend)=ad_a(i,jend)+ad_a(i,jend+1)
1086 ad_a(i,jend+1)=0.0_r8
1087 END IF
1088 END DO
1089 END IF
1090 END IF
1091!
1092!-----------------------------------------------------------------------
1093! Adjoint East-West gradient boundary conditions.
1094!-----------------------------------------------------------------------
1095!
1096 IF (.not.ewperiodic(ng)) THEN
1097 IF (domain(ng)%Western_Edge(tile)) THEN
1098 DO j=jstrv,jend
1099 IF (lbc_apply(ng)%west(j)) THEN
1100!^ tl_A(Istr-1,j)=tl_A(Istr,j)
1101!^
1102 ad_a(istr ,j)=ad_a(istr,j)+ad_a(istr-1,j)
1103 ad_a(istr-1,j)=0.0_r8
1104 END IF
1105 END DO
1106 END IF
1107
1108 IF (domain(ng)%Eastern_Edge(tile)) THEN
1109 DO j=jstrv,jend
1110 IF (lbc_apply(ng)%east(j)) THEN
1111!^ tl_A(Iend+1,j)=tl_A(Iend,j)
1112!^
1113 ad_a(iend ,j)=ad_a(iend,j)+ad_a(iend+1,j)
1114 ad_a(iend+1,j)=0.0_r8
1115 END IF
1116 END DO
1117 END IF
1118 END IF
1119
1120 RETURN
1121 END SUBROUTINE ad_dabc_v2d_tile
1122#endif
1123 END MODULE ad_bc_2d_mod
subroutine ad_bc_v2d_tile(ng, tile, lbi, ubi, lbj, ubj, ad_a)
Definition ad_bc_2d.F:428
subroutine ad_dabc_v2d_tile(ng, tile, lbi, ubi, lbj, ubj, ad_a)
Definition ad_bc_2d.F:969
subroutine ad_dabc_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, ad_a)
Definition ad_bc_2d.F:653
subroutine ad_bc_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, ad_a)
Definition ad_bc_2d.F:45
subroutine ad_dabc_u2d_tile(ng, tile, lbi, ubi, lbj, ubj, ad_a)
Definition ad_bc_2d.F:810
subroutine ad_bc_u2d_tile(ng, tile, lbi, ubi, lbj, ubj, ad_a)
Definition ad_bc_2d.F:202
subroutine ad_exchange_u2d_tile(ng, tile, lbi, ubi, lbj, ubj, ad_a)
subroutine ad_exchange_v2d_tile(ng, tile, lbi, ubi, lbj, ubj, ad_a)
subroutine ad_exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, ad_a)
type(t_apply), dimension(:), allocatable lbc_apply
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
integer isbu2d
integer isbv2d
type(t_lbc), dimension(:,:,:), allocatable ad_lbc
Definition mod_param.F:378
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
logical, dimension(:), allocatable ewperiodic
integer, parameter iwest
logical, dimension(:), allocatable nsperiodic
real(r8), dimension(:), allocatable gamma2
integer, parameter isouth
integer, parameter ieast
integer, parameter inorth