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