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