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