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