ROMS
Loading...
Searching...
No Matches
bc_2d.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE bc_2d_mod
3!
4!git $Id$
5!================================================== Hernan G. Arango ===
6! Copyright (c) 2002-2025 The ROMS Group !
7! Licensed under a MIT/X style license !
8! See License_ROMS.md !
9!=======================================================================
10! !
11! These routines apply close, gradient or periodic boundary !
12! conditions to generic 2D fields. !
13! !
14! On Input: !
15! !
16! ng Nested grid number. !
17! tile Domain partition. !
18! LBi I-dimension Lower bound. !
19! UBi I-dimension Upper bound. !
20! LBj J-dimension Lower bound. !
21! UBj J-dimension Upper bound. !
22! A 2D field. !
23! !
24! On Output: !
25! !
26! A Processed 2D field. !
27! !
28! Routines: !
29! !
30! bc_r2d_tile Boundary conditions for field at RHO-points !
31! bc_u2d_tile Boundary conditions for field at U-points !
32! bc_v2d_tile Boundary conditions for field at V-points !
33! !
34!=======================================================================
35!
36 implicit none
37!
38 CONTAINS
39!
40!***********************************************************************
41 SUBROUTINE bc_r2d_tile (ng, tile, &
42 & LBi, UBi, LBj, UBj, &
43 & A)
44!***********************************************************************
45!
46 USE mod_param
47 USE mod_boundary
48 USE mod_ncparam
49 USE mod_scalars
50!
51 USE exchange_2d_mod, ONLY : exchange_r2d_tile
52!
53! Imported variable declarations.
54!
55 integer, intent(in) :: ng, tile
56 integer, intent(in) :: LBi, UBi, LBj, UBj
57
58#ifdef ASSUMED_SHAPE
59 real(r8), intent(inout) :: A(LBi:,LBj:)
60#else
61 real(r8), intent(inout) :: A(LBi:UBi,LBj:UBj)
62#endif
63!
64! Local variable declarations.
65!
66 integer :: i, j
67
68#include "set_bounds.h"
69!
70!-----------------------------------------------------------------------
71! East-West gradient boundary conditions.
72!-----------------------------------------------------------------------
73!
74 IF (.not.ewperiodic(ng)) THEN
75 IF (domain(ng)%Eastern_Edge(tile)) THEN
76 DO j=jstr,jend
77 IF (lbc_apply(ng)%east(j)) THEN
78 a(iend+1,j)=a(iend,j)
79 END IF
80 END DO
81 END IF
82
83 IF (domain(ng)%Western_Edge(tile)) THEN
84 DO j=jstr,jend
85 IF (lbc_apply(ng)%west(j)) THEN
86 a(istr-1,j)=a(istr,j)
87 END IF
88 END DO
89 END IF
90 END IF
91!
92!-----------------------------------------------------------------------
93! North-South gradient boundary conditions.
94!-----------------------------------------------------------------------
95!
96 IF (.not.nsperiodic(ng)) THEN
97 IF (domain(ng)%Northern_Edge(tile)) THEN
98 DO i=istr,iend
99 IF (lbc_apply(ng)%north(i)) THEN
100 a(i,jend+1)=a(i,jend)
101 END IF
102 END DO
103 END IF
104
105 IF (domain(ng)%Southern_Edge(tile)) THEN
106 DO i=istr,iend
107 IF (lbc_apply(ng)%south(i)) THEN
108 a(i,jstr-1)=a(i,jstr)
109 END IF
110 END DO
111 END IF
112 END IF
113!
114!-----------------------------------------------------------------------
115! Boundary corners.
116!-----------------------------------------------------------------------
117!
118 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
119 IF (domain(ng)%SouthWest_Corner(tile)) THEN
120 IF (lbc_apply(ng)%south(istr-1).and. &
121 & lbc_apply(ng)%west (jstr-1)) THEN
122 a(istr-1,jstr-1)=0.5_r8*(a(istr ,jstr-1)+ &
123 & a(istr-1,jstr ))
124 END IF
125 END IF
126 IF (domain(ng)%SouthEast_Corner(tile)) THEN
127 IF (lbc_apply(ng)%south(iend+1).and. &
128 & lbc_apply(ng)%east (jstr-1)) THEN
129 a(iend+1,jstr-1)=0.5_r8*(a(iend ,jstr-1)+ &
130 & a(iend+1,jstr ))
131 END IF
132 END IF
133 IF (domain(ng)%NorthWest_Corner(tile)) THEN
134 IF (lbc_apply(ng)%north(istr-1).and. &
135 & lbc_apply(ng)%west (jend+1)) THEN
136 a(istr-1,jend+1)=0.5_r8*(a(istr-1,jend )+ &
137 & a(istr ,jend+1))
138 END IF
139 END IF
140 IF (domain(ng)%NorthEast_Corner(tile)) THEN
141 IF (lbc_apply(ng)%north(iend+1).and. &
142 & lbc_apply(ng)%east (jend+1)) THEN
143 a(iend+1,jend+1)=0.5_r8*(a(iend+1,jend )+ &
144 & a(iend ,jend+1))
145 END IF
146 END IF
147 END IF
148!
149!-----------------------------------------------------------------------
150! Apply periodic boundary conditions.
151!-----------------------------------------------------------------------
152!
153 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
154 CALL exchange_r2d_tile (ng, tile, &
155 & lbi, ubi, lbj, ubj, &
156 & a)
157 END IF
158
159 RETURN
160 END SUBROUTINE bc_r2d_tile
161
162!
163!***********************************************************************
164 SUBROUTINE bc_u2d_tile (ng, tile, &
165 & LBi, UBi, LBj, UBj, &
166 & A)
167!***********************************************************************
168!
169 USE mod_param
170 USE mod_boundary
171 USE mod_grid
172 USE mod_ncparam
173 USE mod_scalars
174!
175 USE exchange_2d_mod, ONLY : exchange_u2d_tile
176!
177! Imported variable declarations.
178!
179 integer, intent(in) :: ng, tile
180 integer, intent(in) :: LBi, UBi, LBj, UBj
181
182#ifdef ASSUMED_SHAPE
183 real(r8), intent(inout) :: A(LBi:,LBj:)
184#else
185 real(r8), intent(inout) :: A(LBi:UBi,LBj:UBj)
186#endif
187!
188! Local variable declarations.
189!
190 integer :: Imin, Imax
191 integer :: i, j
192
193#include "set_bounds.h"
194!
195!-----------------------------------------------------------------------
196! East-West boundary conditions: Closed or gradient
197!-----------------------------------------------------------------------
198!
199 IF (.not.ewperiodic(ng)) THEN
200 IF (domain(ng)%Eastern_Edge(tile)) THEN
201 IF (lbc(ieast,isbu2d,ng)%closed) THEN
202 DO j=jstr,jend
203 IF (lbc_apply(ng)%east(j)) THEN
204 a(iend+1,j)=0.0_r8
205 END IF
206 END DO
207 ELSE
208 DO j=jstr,jend
209 IF (lbc_apply(ng)%east(j)) THEN
210 a(iend+1,j)=a(iend,j)
211 END IF
212 END DO
213 END IF
214 END IF
215
216 IF (domain(ng)%Western_Edge(tile)) THEN
217 IF (lbc(iwest,isbu2d,ng)%closed) THEN
218 DO j=jstr,jend
219 IF (lbc_apply(ng)%west(j)) THEN
220 a(istr,j)=0.0_r8
221 END IF
222 END DO
223 ELSE
224 DO j=jstr,jend
225 IF (lbc_apply(ng)%west(j)) THEN
226 a(istr,j)=a(istr+1,j)
227 END IF
228 END DO
229 END IF
230 END IF
231 END IF
232!
233!-----------------------------------------------------------------------
234! North-South boundary conditions: Closed (free-slip/no-slip) or
235! gradient.
236!-----------------------------------------------------------------------
237!
238 IF (.not.nsperiodic(ng)) THEN
239 IF (domain(ng)%Northern_Edge(tile)) THEN
240 IF (lbc(inorth,isbu2d,ng)%closed) THEN
241 IF (ewperiodic(ng)) THEN
242 imin=istru
243 imax=iend
244 ELSE
245 imin=istr
246 imax=iendr
247 END IF
248 DO i=imin,imax
249 IF (lbc_apply(ng)%north(i)) THEN
250 a(i,jend+1)=gamma2(ng)*a(i,jend)
251#ifdef MASKING
252 a(i,jend+1)=a(i,jend+1)*grid(ng)%umask(i,jend+1)
253#endif
254 END IF
255 END DO
256 ELSE
257 DO i=istru,iend
258 IF (lbc_apply(ng)%north(i)) THEN
259 a(i,jend+1)=a(i,jend)
260 END IF
261 END DO
262 END IF
263 END IF
264
265 IF (domain(ng)%Southern_Edge(tile)) THEN
266 IF (lbc(isouth,isbu2d,ng)%closed) THEN
267 IF (ewperiodic(ng)) THEN
268 imin=istru
269 imax=iend
270 ELSE
271 imin=istr
272 imax=iendr
273 END IF
274 DO i=imin,imax
275 IF (lbc_apply(ng)%south(i)) THEN
276 a(i,jstr-1)=gamma2(ng)*a(i,jstr)
277#ifdef MASKING
278 a(i,jstr-1)=a(i,jstr-1)*grid(ng)%umask(i,jstr-1)
279#endif
280 END IF
281 END DO
282 ELSE
283 DO i=istru,iend
284 IF (lbc_apply(ng)%south(i)) THEN
285 a(i,jstr-1)=a(i,jstr)
286 END IF
287 END DO
288 END IF
289 END IF
290 END IF
291!
292!-----------------------------------------------------------------------
293! Boundary corners.
294!-----------------------------------------------------------------------
295!
296 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
297 IF (domain(ng)%SouthWest_Corner(tile)) THEN
298 IF (lbc_apply(ng)%south(istr ).and. &
299 & lbc_apply(ng)%west (jstr-1)) THEN
300 a(istr ,jstr-1)=0.5_r8*(a(istr+1,jstr-1)+ &
301 & a(istr ,jstr ))
302 END IF
303 END IF
304 IF (domain(ng)%SouthEast_Corner(tile)) THEN
305 IF (lbc_apply(ng)%south(iend+1).and. &
306 & lbc_apply(ng)%east (jstr-1)) THEN
307 a(iend+1,jstr-1)=0.5_r8*(a(iend ,jstr-1)+ &
308 & a(iend+1,jstr ))
309 END IF
310 END IF
311 IF (domain(ng)%NorthWest_Corner(tile)) THEN
312 IF (lbc_apply(ng)%north(istr ).and. &
313 & lbc_apply(ng)%west (jend+1)) THEN
314 a(istr ,jend+1)=0.5_r8*(a(istr ,jend )+ &
315 & a(istr+1,jend+1))
316 END IF
317 END IF
318 IF (domain(ng)%NorthEast_Corner(tile)) THEN
319 IF (lbc_apply(ng)%north(iend+1).and. &
320 & lbc_apply(ng)%east (jend+1)) THEN
321 a(iend+1,jend+1)=0.5_r8*(a(iend+1,jend )+ &
322 & a(iend ,jend+1))
323 END IF
324 END IF
325 END IF
326!
327!-----------------------------------------------------------------------
328! Apply periodic boundary conditions.
329!-----------------------------------------------------------------------
330!
331 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
332 CALL exchange_u2d_tile (ng, tile, &
333 & lbi, ubi, lbj, ubj, &
334 & a)
335 END IF
336
337 RETURN
338 END SUBROUTINE bc_u2d_tile
339
340!
341!***********************************************************************
342 SUBROUTINE bc_v2d_tile (ng, tile, &
343 & LBi, UBi, LBj, UBj, &
344 & A)
345!***********************************************************************
346!
347 USE mod_param
348 USE mod_boundary
349 USE mod_grid
350 USE mod_ncparam
351 USE mod_scalars
352!
353 USE exchange_2d_mod, ONLY : exchange_v2d_tile
354!
355! Imported variable declarations.
356!
357 integer, intent(in) :: ng, tile
358 integer, intent(in) :: LBi, UBi, LBj, UBj
359
360#ifdef ASSUMED_SHAPE
361 real(r8), intent(inout) :: A(LBi:,LBj:)
362#else
363 real(r8), intent(inout) :: A(LBi:UBi,LBj:UBj)
364#endif
365!
366! Local variable declarations.
367!
368 integer :: Jmin, Jmax
369 integer :: i, j
370
371#include "set_bounds.h"
372!
373!-----------------------------------------------------------------------
374! East-West boundary conditions: Closed (free-slip/no-slip) or
375! gradient.
376!-----------------------------------------------------------------------
377!
378 IF (.not.ewperiodic(ng)) THEN
379 IF (domain(ng)%Eastern_Edge(tile)) THEN
380 IF (lbc(ieast,isbv2d,ng)%closed) THEN
381 IF (nsperiodic(ng)) THEN
382 jmin=jstrv
383 jmax=jend
384 ELSE
385 jmin=jstr
386 jmax=jendr
387 END IF
388 DO j=jmin,jmax
389 IF (lbc_apply(ng)%east(j)) THEN
390 a(iend+1,j)=gamma2(ng)*a(iend,j)
391#ifdef MASKING
392 a(iend+1,j)=a(iend+1,j)*grid(ng)%vmask(iend+1,j)
393#endif
394 END IF
395 END DO
396 ELSE
397 DO j=jstrv,jend
398 IF (lbc_apply(ng)%east(j)) THEN
399 a(iend+1,j)=a(iend,j)
400 END IF
401 END DO
402 END IF
403 END IF
404
405 IF (domain(ng)%Western_Edge(tile)) THEN
406 IF (lbc(iwest,isbv2d,ng)%closed) THEN
407 IF (nsperiodic(ng)) THEN
408 jmin=jstrv
409 jmax=jend
410 ELSE
411 jmin=jstr
412 jmax=jendr
413 END IF
414 DO j=jmin,jmax
415 IF (lbc_apply(ng)%west(j)) THEN
416 a(istr-1,j)=gamma2(ng)*a(istr,j)
417#ifdef MASKING
418 a(istr-1,j)=a(istr-1,j)*grid(ng)%vmask(istr-1,j)
419#endif
420 END IF
421 END DO
422 ELSE
423 DO j=jstrv,jend
424 IF (lbc_apply(ng)%west(j)) THEN
425 a(istr-1,j)=a(istr,j)
426 END IF
427 END DO
428 END IF
429 END IF
430 END IF
431!
432!-----------------------------------------------------------------------
433! North-South boundary conditions: Closed or Gradient.
434!-----------------------------------------------------------------------
435!
436 IF (.not.nsperiodic(ng)) THEN
437 IF (domain(ng)%Northern_Edge(tile)) THEN
438 IF (lbc(inorth,isbv2d,ng)%closed) THEN
439 DO i=istr,iend
440 IF (lbc_apply(ng)%north(i)) THEN
441 a(i,jend+1)=0.0_r8
442 END IF
443 END DO
444 ELSE
445 DO i=istr,iend
446 IF (lbc_apply(ng)%north(i)) THEN
447 a(i,jend+1)=a(i,jend)
448 END IF
449 END DO
450 END IF
451 END IF
452
453 IF (domain(ng)%Southern_Edge(tile)) THEN
454 IF (lbc(isouth,isbv2d,ng)%closed) THEN
455 DO i=istr,iend
456 IF (lbc_apply(ng)%south(i)) THEN
457 a(i,jstr)=0.0_r8
458 END IF
459 END DO
460 ELSE
461 DO i=istr,iend
462 IF (lbc_apply(ng)%south(i)) THEN
463 a(i,jstr)=a(i,jstr+1)
464 END IF
465 END DO
466 END IF
467 END IF
468 END IF
469!
470!-----------------------------------------------------------------------
471! Boundary corners.
472!-----------------------------------------------------------------------
473!
474 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
475 IF (domain(ng)%SouthWest_Corner(tile)) THEN
476 IF (lbc_apply(ng)%south(istr-1).and. &
477 & lbc_apply(ng)%west (jstr )) THEN
478 a(istr-1,jstr )=0.5_r8*(a(istr ,jstr )+ &
479 & a(istr-1,jstr+1))
480 END IF
481 END IF
482 IF (domain(ng)%SouthEast_Corner(tile)) THEN
483 IF (lbc_apply(ng)%south(iend+1).and. &
484 & lbc_apply(ng)%east (jstr )) THEN
485 a(iend+1,jstr )=0.5_r8*(a(iend ,jstr )+ &
486 & a(iend+1,jstr+1))
487 END IF
488 END IF
489 IF (domain(ng)%NorthWest_Corner(tile)) THEN
490 IF (lbc_apply(ng)%north(istr-1).and. &
491 & lbc_apply(ng)%west (jend+1)) THEN
492 a(istr-1,jend+1)=0.5_r8*(a(istr-1,jend )+ &
493 & a(istr ,jend+1))
494 END IF
495 END IF
496 IF (domain(ng)%NorthEast_Corner(tile)) THEN
497 IF (lbc_apply(ng)%north(iend+1).and. &
498 & lbc_apply(ng)%east (jend+1)) THEN
499 a(iend+1,jend+1)=0.5_r8*(a(iend+1,jend )+ &
500 & a(iend ,jend+1))
501 END IF
502 END IF
503 END IF
504!
505!-----------------------------------------------------------------------
506! Apply periodic boundary conditions.
507!-----------------------------------------------------------------------
508!
509 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
510 CALL exchange_v2d_tile (ng, tile, &
511 & lbi, ubi, lbj, ubj, &
512 & a)
513 END IF
514
515 RETURN
516 END SUBROUTINE bc_v2d_tile
517
518!
519!***********************************************************************
520 SUBROUTINE dabc_r2d_tile (ng, tile, &
521 & LBi, UBi, LBj, UBj, &
522 & A)
523!***********************************************************************
524!
525 USE mod_param
526 USE mod_boundary
527 USE mod_ncparam
528 USE mod_scalars
529!
530 USE exchange_2d_mod, ONLY : exchange_r2d_tile
531!
532! Imported variable declarations.
533!
534 integer, intent(in) :: ng, tile
535 integer, intent(in) :: LBi, UBi, LBj, UBj
536
537#ifdef ASSUMED_SHAPE
538 real(r8), intent(inout) :: A(LBi:,LBj:)
539#else
540 real(r8), intent(inout) :: A(LBi:UBi,LBj:UBj)
541#endif
542!
543! Local variable declarations.
544!
545 integer :: i, j
546
547#include "set_bounds.h"
548!
549!-----------------------------------------------------------------------
550! East-West gradient boundary conditions.
551!-----------------------------------------------------------------------
552!
553 IF (.not.ewperiodic(ng)) THEN
554 IF (domain(ng)%Eastern_Edge(tile)) THEN
555 DO j=jstr,jend
556 IF (lbc_apply(ng)%east(j)) THEN
557 a(iend+1,j)=a(iend,j)
558 END IF
559 END DO
560 END IF
561
562 IF (domain(ng)%Western_Edge(tile)) THEN
563 DO j=jstr,jend
564 IF (lbc_apply(ng)%west(j)) THEN
565 a(istr-1,j)=a(istr,j)
566 END IF
567 END DO
568 END IF
569 END IF
570!
571!-----------------------------------------------------------------------
572! North-South gradient boundary conditions.
573!-----------------------------------------------------------------------
574!
575 IF (.not.nsperiodic(ng)) THEN
576 IF (domain(ng)%Northern_Edge(tile)) THEN
577 DO i=istr,iend
578 IF (lbc_apply(ng)%north(i)) THEN
579 a(i,jend+1)=a(i,jend)
580 END IF
581 END DO
582 END IF
583
584 IF (domain(ng)%Southern_Edge(tile)) THEN
585 DO i=istr,iend
586 IF (lbc_apply(ng)%south(i)) THEN
587 a(i,jstr-1)=a(i,jstr)
588 END IF
589 END DO
590 END IF
591 END IF
592!
593!-----------------------------------------------------------------------
594! Boundary corners.
595!-----------------------------------------------------------------------
596!
597 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
598 IF (domain(ng)%SouthWest_Corner(tile)) THEN
599 IF (lbc_apply(ng)%south(istr-1).and. &
600 & lbc_apply(ng)%west (jstr-1)) THEN
601 a(istr-1,jstr-1)=0.5_r8*(a(istr ,jstr-1)+ &
602 & a(istr-1,jstr ))
603 END IF
604 END IF
605 IF (domain(ng)%SouthEast_Corner(tile)) THEN
606 IF (lbc_apply(ng)%south(iend+1).and. &
607 & lbc_apply(ng)%east (jstr-1)) THEN
608 a(iend+1,jstr-1)=0.5_r8*(a(iend ,jstr-1)+ &
609 & a(iend+1,jstr ))
610 END IF
611 END IF
612 IF (domain(ng)%NorthWest_Corner(tile)) THEN
613 IF (lbc_apply(ng)%north(istr-1).and. &
614 & lbc_apply(ng)%west (jend+1)) THEN
615 a(istr-1,jend+1)=0.5_r8*(a(istr-1,jend )+ &
616 & a(istr ,jend+1))
617 END IF
618 END IF
619 IF (domain(ng)%NorthEast_Corner(tile)) THEN
620 IF (lbc_apply(ng)%north(iend+1).and. &
621 & lbc_apply(ng)%east (jend+1)) THEN
622 a(iend+1,jend+1)=0.5_r8*(a(iend+1,jend )+ &
623 & a(iend ,jend+1))
624 END IF
625 END IF
626 END IF
627!
628!-----------------------------------------------------------------------
629! Apply periodic boundary conditions.
630!-----------------------------------------------------------------------
631!
632 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
633 CALL exchange_r2d_tile (ng, tile, &
634 & lbi, ubi, lbj, ubj, &
635 & a)
636 END IF
637
638 RETURN
639 END SUBROUTINE dabc_r2d_tile
640
641!
642!***********************************************************************
643 SUBROUTINE dabc_u2d_tile (ng, tile, &
644 & LBi, UBi, LBj, UBj, &
645 & A)
646!***********************************************************************
647!
648 USE mod_param
649 USE mod_boundary
650 USE mod_grid
651 USE mod_ncparam
652 USE mod_scalars
653!
654 USE exchange_2d_mod, ONLY : exchange_u2d_tile
655!
656! Imported variable declarations.
657!
658 integer, intent(in) :: ng, tile
659 integer, intent(in) :: LBi, UBi, LBj, UBj
660
661#ifdef ASSUMED_SHAPE
662 real(r8), intent(inout) :: A(LBi:,LBj:)
663#else
664 real(r8), intent(inout) :: A(LBi:UBi,LBj:UBj)
665#endif
666!
667! Local variable declarations.
668!
669 integer :: Imin, Imax
670 integer :: i, j
671
672#include "set_bounds.h"
673!
674!-----------------------------------------------------------------------
675! East-West gradient boundary conditions
676!-----------------------------------------------------------------------
677!
678 IF (.not.ewperiodic(ng)) THEN
679 IF (domain(ng)%Eastern_Edge(tile)) THEN
680 DO j=jstr,jend
681 IF (lbc_apply(ng)%east(j)) THEN
682 a(iend+1,j)=a(iend,j)
683 END IF
684 END DO
685 END IF
686
687 IF (domain(ng)%Western_Edge(tile)) THEN
688 DO j=jstr,jend
689 IF (lbc_apply(ng)%west(j)) THEN
690 a(istr,j)=a(istr+1,j)
691 END IF
692 END DO
693 END IF
694 END IF
695!
696!-----------------------------------------------------------------------
697! North-South gradient boundary conditions.
698!-----------------------------------------------------------------------
699!
700 IF (.not.nsperiodic(ng)) THEN
701 IF (domain(ng)%Northern_Edge(tile)) THEN
702 DO i=istru,iend
703 IF (lbc_apply(ng)%north(i)) THEN
704 a(i,jend+1)=a(i,jend)
705 END IF
706 END DO
707 END IF
708
709 IF (domain(ng)%Southern_Edge(tile)) THEN
710 DO i=istru,iend
711 IF (lbc_apply(ng)%south(i)) THEN
712 a(i,jstr-1)=a(i,jstr)
713 END IF
714 END DO
715 END IF
716 END IF
717!
718!-----------------------------------------------------------------------
719! Boundary corners.
720!-----------------------------------------------------------------------
721!
722 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
723 IF (domain(ng)%SouthWest_Corner(tile)) THEN
724 IF (lbc_apply(ng)%south(istr ).and. &
725 & lbc_apply(ng)%west (jstr-1)) THEN
726 a(istr ,jstr-1)=0.5_r8*(a(istr+1,jstr-1)+ &
727 & a(istr ,jstr ))
728 END IF
729 END IF
730 IF (domain(ng)%SouthEast_Corner(tile)) THEN
731 IF (lbc_apply(ng)%south(iend+1).and. &
732 & lbc_apply(ng)%east (jstr-1)) THEN
733 a(iend+1,jstr-1)=0.5_r8*(a(iend ,jstr-1)+ &
734 & a(iend+1,jstr ))
735 END IF
736 END IF
737 IF (domain(ng)%NorthWest_Corner(tile)) THEN
738 IF (lbc_apply(ng)%north(istr ).and. &
739 & lbc_apply(ng)%west (jend+1)) THEN
740 a(istr ,jend+1)=0.5_r8*(a(istr ,jend )+ &
741 & a(istr+1,jend+1))
742 END IF
743 END IF
744 IF (domain(ng)%NorthEast_Corner(tile)) THEN
745 IF (lbc_apply(ng)%north(iend+1).and. &
746 & lbc_apply(ng)%east (jend+1)) THEN
747 a(iend+1,jend+1)=0.5_r8*(a(iend+1,jend )+ &
748 & a(iend ,jend+1))
749 END IF
750 END IF
751 END IF
752!
753!-----------------------------------------------------------------------
754! Apply periodic boundary conditions.
755!-----------------------------------------------------------------------
756!
757 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
758 CALL exchange_u2d_tile (ng, tile, &
759 & lbi, ubi, lbj, ubj, &
760 & a)
761 END IF
762
763 RETURN
764 END SUBROUTINE dabc_u2d_tile
765
766!
767!***********************************************************************
768 SUBROUTINE dabc_v2d_tile (ng, tile, &
769 & LBi, UBi, LBj, UBj, &
770 & A)
771!***********************************************************************
772!
773 USE mod_param
774 USE mod_boundary
775 USE mod_grid
776 USE mod_ncparam
777 USE mod_scalars
778!
779 USE exchange_2d_mod, ONLY : exchange_v2d_tile
780!
781! Imported variable declarations.
782!
783 integer, intent(in) :: ng, tile
784 integer, intent(in) :: LBi, UBi, LBj, UBj
785
786#ifdef ASSUMED_SHAPE
787 real(r8), intent(inout) :: A(LBi:,LBj:)
788#else
789 real(r8), intent(inout) :: A(LBi:UBi,LBj:UBj)
790#endif
791!
792! Local variable declarations.
793!
794 integer :: Jmin, Jmax
795 integer :: i, j
796
797#include "set_bounds.h"
798!
799!-----------------------------------------------------------------------
800! East-West gradient boundary conditions.
801!-----------------------------------------------------------------------
802!
803 IF (.not.ewperiodic(ng)) THEN
804 IF (domain(ng)%Eastern_Edge(tile)) THEN
805 DO j=jstrv,jend
806 IF (lbc_apply(ng)%east(j)) THEN
807 a(iend+1,j)=a(iend,j)
808 END IF
809 END DO
810 END IF
811
812 IF (domain(ng)%Western_Edge(tile)) THEN
813 DO j=jstrv,jend
814 IF (lbc_apply(ng)%west(j)) THEN
815 a(istr-1,j)=a(istr,j)
816 END IF
817 END DO
818 END IF
819 END IF
820!
821!-----------------------------------------------------------------------
822! North-South gradient boundary conditions.
823!-----------------------------------------------------------------------
824!
825 IF (.not.nsperiodic(ng)) THEN
826 IF (domain(ng)%Northern_Edge(tile)) THEN
827 DO i=istr,iend
828 IF (lbc_apply(ng)%north(i)) THEN
829 a(i,jend+1)=a(i,jend)
830 END IF
831 END DO
832 END IF
833
834 IF (domain(ng)%Southern_Edge(tile)) THEN
835 DO i=istr,iend
836 IF (lbc_apply(ng)%south(i)) THEN
837 a(i,jstr)=a(i,jstr+1)
838 END IF
839 END DO
840 END IF
841 END IF
842!
843!-----------------------------------------------------------------------
844! Boundary corners.
845!-----------------------------------------------------------------------
846!
847 IF (.not.(ewperiodic(ng).or.nsperiodic(ng))) THEN
848 IF (domain(ng)%SouthWest_Corner(tile)) THEN
849 IF (lbc_apply(ng)%south(istr-1).and. &
850 & lbc_apply(ng)%west (jstr )) THEN
851 a(istr-1,jstr )=0.5_r8*(a(istr ,jstr )+ &
852 & a(istr-1,jstr+1))
853 END IF
854 END IF
855 IF (domain(ng)%SouthEast_Corner(tile)) THEN
856 IF (lbc_apply(ng)%south(iend+1).and. &
857 & lbc_apply(ng)%east (jstr )) THEN
858 a(iend+1,jstr )=0.5_r8*(a(iend ,jstr )+ &
859 & a(iend+1,jstr+1))
860 END IF
861 END IF
862 IF (domain(ng)%NorthWest_Corner(tile)) THEN
863 IF (lbc_apply(ng)%north(istr-1).and. &
864 & lbc_apply(ng)%west (jend+1)) THEN
865 a(istr-1,jend+1)=0.5_r8*(a(istr-1,jend )+ &
866 & a(istr ,jend+1))
867 END IF
868 END IF
869 IF (domain(ng)%NorthEast_Corner(tile)) THEN
870 IF (lbc_apply(ng)%north(iend+1).and. &
871 & lbc_apply(ng)%east (jend+1)) THEN
872 a(iend+1,jend+1)=0.5_r8*(a(iend+1,jend )+ &
873 & a(iend ,jend+1))
874 END IF
875 END IF
876 END IF
877!
878!-----------------------------------------------------------------------
879! Apply periodic boundary conditions.
880!-----------------------------------------------------------------------
881!
882 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
883 CALL exchange_v2d_tile (ng, tile, &
884 & lbi, ubi, lbj, ubj, &
885 & a)
886 END IF
887
888 RETURN
889 END SUBROUTINE dabc_v2d_tile
890
891 END MODULE bc_2d_mod
bc_2d_mod
Definition bc_2d.F:2
bc_2d_mod::bc_r2d_tile
subroutine bc_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition bc_2d.F:44
bc_2d_mod::bc_v2d_tile
subroutine bc_v2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition bc_2d.F:345
bc_2d_mod::dabc_v2d_tile
subroutine dabc_v2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition bc_2d.F:771
bc_2d_mod::dabc_u2d_tile
subroutine dabc_u2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition bc_2d.F:646
bc_2d_mod::dabc_r2d_tile
subroutine dabc_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition bc_2d.F:523
bc_2d_mod::bc_u2d_tile
subroutine bc_u2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition bc_2d.F:167
exchange_2d_mod
Definition exchange_2d.F:2
exchange_2d_mod::exchange_r2d_tile
subroutine exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:253
exchange_2d_mod::exchange_u2d_tile
subroutine exchange_u2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:440
exchange_2d_mod::exchange_v2d_tile
subroutine exchange_v2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:627
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::isbu2d
integer isbu2d
Definition mod_ncparam.F:529
mod_ncparam::isbv2d
integer isbv2d
Definition mod_ncparam.F:530
mod_param
Definition mod_param.F:2
mod_param::lbc
type(t_lbc), dimension(:,:,:), allocatable lbc
Definition mod_param.F:375
mod_param::domain
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
mod_scalars
Definition mod_scalars.F:2
mod_scalars::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