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