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