ROMS
Loading...
Searching...
No Matches
ad_exchange_3d.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE ad_exchange_3d_mod
3#if defined ADJOINT && defined SOLVE3D
4!
5!git $Id$
6!================================================== Hernan G. Arango ===
7! Copyright (c) 2002-2025 The ROMS Group !
8! Licensed under a MIT/X style license !
9! See License_ROMS.md !
10!=======================================================================
11! !
12! These routines apply periodic boundary conditions to generic !
13! 3D adjoint 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! ad_A 3D adjoint field. !
26! !
27! On Output: !
28! !
29! ad_A Processed 3D adjoint field. !
30! !
31! Routines: !
32! !
33! ad_exchange_p3d_tile periodic conditions at PSI-points !
34! ad_exchange_r3d_tile periodic conditions at RHO-points !
35! ad_exchange_u3d_tile periodic conditions at U-points !
36! ad_exchange_v3d_tile periodic conditions at V-points !
37! ad_exchange_w3d_tile periodic conditions at W-points !
38! !
39!=======================================================================
40!
41 implicit none
42!
43 CONTAINS
44!
45!***********************************************************************
46 SUBROUTINE ad_exchange_p3d_tile (ng, tile, &
47 & LBi, UBi, LBj, UBj, LBk, UBk, &
48 & ad_A)
49!***********************************************************************
50!
51 USE mod_param
52 USE mod_scalars
53!
54! Imported variable declarations.
55!
56 integer, intent(in) :: ng, tile
57 integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
58!
59# ifdef ASSUMED_SHAPE
60 real(r8), intent(inout) :: ad_A(LBi:,LBj:,LBk:)
61# else
62 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj,LBk:UBk)
63# endif
64!
65! Local variable declarations.
66!
67 logical :: EW_exchange
68 logical :: NS_exchange
69
70 integer :: Imin, Imax, Jmin, Jmax
71 integer :: i, j, k
72
73# include "set_bounds.h"
74!
75!-----------------------------------------------------------------------
76! Determine processing switches.
77!-----------------------------------------------------------------------
78!
79 IF (ewperiodic(ng)) THEN
80# ifdef DISTRIBUTE
81 ew_exchange=ntilei(ng).eq.1
82# else
83 ew_exchange=.true.
84# endif
85 ELSE
86 ew_exchange=.false.
87 END IF
88
89 IF (nsperiodic(ng)) THEN
90# ifdef DISTRIBUTE
91 ns_exchange=ntilej(ng).eq.1
92# else
93 ns_exchange=.true.
94# endif
95 ELSE
96 ns_exchange=.false.
97 END IF
98!
99!-----------------------------------------------------------------------
100! Boundary corners.
101!-----------------------------------------------------------------------
102!
103 IF (ewperiodic(ng).and.nsperiodic(ng)) THEN
104 IF (ew_exchange.and.ns_exchange) THEN
105 IF (domain(ng)%NorthEast_Corner(tile)) THEN
106 DO k=lbk,ubk
107!^ tl_A(-2,-2,k)=tl_A(Lm(ng)-2,Mm(ng)-2,k)
108!^
109 ad_a(lm(ng)-2,mm(ng)-2,k)=ad_a(lm(ng)-2,mm(ng)-2,k)+ &
110 & ad_a(-2,-2,k)
111 ad_a(-2,-2,k)=0.0_r8
112!^ tl_A(-2,-1,k)=tl_A(Lm(ng)-2,Mm(ng)-1,k)
113!^
114 ad_a(lm(ng)-2,mm(ng)-1,k)=ad_a(lm(ng)-2,mm(ng)-1,k)+ &
115 & ad_a(-2,-1,k)
116 ad_a(-2,-1,k)=0.0_r8
117!^ tl_A(-2, 0,k)=tl_A(Lm(ng)-2,Mm(ng) ,k)
118!^
119 ad_a(lm(ng)-2,mm(ng) ,k)=ad_a(lm(ng)-2,mm(ng) ,k)+ &
120 & ad_a(-2, 0,k)
121 ad_a(-2, 0,k)=0.0_r8
122!^ tl_A(-1,-2,k)=tl_A(Lm(ng)-1,Mm(ng)-2,k)
123!^
124 ad_a(lm(ng)-1,mm(ng)-2,k)=ad_a(lm(ng)-1,mm(ng)-2,k)+ &
125 & ad_a(-1,-2,k)
126 ad_a(-1,-2,k)=0.0_r8
127!^ tl_A(-1,-1,k)=tl_A(Lm(ng)-1,Mm(ng)-1,k)
128!^
129 ad_a(lm(ng)-1,mm(ng)-1,k)=ad_a(lm(ng)-1,mm(ng)-1,k)+ &
130 & ad_a(-1,-1,k)
131 ad_a(-1,-1,k)=0.0_r8
132!^ tl_A(-1, 0,k)=tl_A(Lm(ng)-1,Mm(ng) ,k)
133!^
134 ad_a(lm(ng)-1,mm(ng) ,k)=ad_a(lm(ng)-1,mm(ng) ,k)+ &
135 & ad_a(-1, 0,k)
136 ad_a(-1, 0,k)=0.0_r8
137!^ tl_A( 0,-2,k)=tl_A(Lm(ng) ,Mm(ng)-2,k)
138!^
139 ad_a(lm(ng) ,mm(ng)-2,k)=ad_a(lm(ng) ,mm(ng)-2,k)+ &
140 & ad_a( 0,-2,k)
141 ad_a( 0,-2,k)=0.0_r8
142!^ tl_A( 0,-1,k)=tl_A(Lm(ng) ,Mm(ng)-1,k)
143!^
144 ad_a(lm(ng) ,mm(ng)-1,k)=ad_a(lm(ng) ,mm(ng)-1,k)+ &
145 & ad_a( 0,-1,k)
146 ad_a( 0,-1,k)=0.0_r8
147!^ tl_A( 0, 0,k)=tl_A(Lm(ng) ,Mm(ng) ,k)
148!^
149 ad_a(lm(ng) ,mm(ng) ,k)=ad_a(lm(ng) ,mm(ng) ,k)+ &
150 & ad_a( 0, 0,k)
151 ad_a( 0, 0,k)=0.0_r8
152 END DO
153 END IF
154
155 IF (domain(ng)%NorthWest_Corner(tile)) THEN
156 DO k=lbk,ubk
157!^ tl_A(Lm(ng)+1,-2,k)=tl_A( 1,Mm(ng)-2,k)
158!^
159 ad_a( 1,mm(ng)-2,k)=ad_a( 1,mm(ng)-2,k)+ &
160 & ad_a(lm(ng)+1,-2,k)
161 ad_a(lm(ng)+1,-2,k)=0.0_r8
162!^ tl_A(Lm(ng)+1,-1,k)=tl_A( 1,Mm(ng)-1,k)
163!^
164 ad_a( 1,mm(ng)-1,k)=ad_a( 1,mm(ng)-1,k)+ &
165 & ad_a(lm(ng)+1,-1,k)
166 ad_a(lm(ng)+1,-1,k)=0.0_r8
167!^ tl_A(Lm(ng)+1, 0,k)=tl_A( 1,Mm(ng) ,k)
168!^
169 ad_a( 1,mm(ng) ,k)=ad_a( 1,mm(ng) ,k)+ &
170 & ad_a(lm(ng)+1, 0,k)
171 ad_a(lm(ng)+1, 0,k)=0.0_r8
172!^ tl_A(Lm(ng)+2,-2,k)=tl_A( 2,Mm(ng)-2,k)
173!^
174 ad_a( 2,mm(ng)-2,k)=ad_a( 2,mm(ng)-2,k)+ &
175 & ad_a(lm(ng)+2,-2,k)
176 ad_a(lm(ng)+2,-2,k)=0.0_r8
177!^ tl_A(Lm(ng)+2,-1,k)=tl_A( 2,Mm(ng)-1,k)
178!^
179 ad_a( 2,mm(ng)-1,k)=ad_a( 2,mm(ng)-1,k)+ &
180 & ad_a(lm(ng)+2,-1,k)
181 ad_a(lm(ng)+2,-1,k)=0.0_r8
182!^ tl_A(Lm(ng)+2, 0,k)=tl_A( 2,Mm(ng) ,k)
183!^
184 ad_a( 2,mm(ng) ,k)=ad_a( 2,mm(ng) ,k)+ &
185 & ad_a(lm(ng)+2, 0,k)
186 ad_a(lm(ng)+2, 0,k)=0.0_r8
187 END DO
188 IF (nghostpoints.eq.3) THEN
189 DO k=lbk,ubk
190!^ tl_A(Lm(ng)+3,-2,k)=tl_A(3 ,Mm(ng)-2,k)
191!^
192 ad_a(3 ,mm(ng)-2,k)=ad_a(3 ,mm(ng)-2,k)+ &
193 & ad_a(lm(ng)+3,-2,k)
194 ad_a(lm(ng)+3,-2,k)=0.0_r8
195!^ tl_A(Lm(ng)+3,-1,k)=tl_A(3 ,Mm(ng)-1,k)
196!^
197 ad_a(3 ,mm(ng)-1,k)=ad_a(3 ,mm(ng)-1,k)+ &
198 & ad_a(lm(ng)+3,-1,k)
199 ad_a(lm(ng)+3,-1,k)=0.0_r8
200!^ tl_A(Lm(ng)+3, 0,k)=tl_A(3 ,Mm(ng) ,k)
201!^
202 ad_a(3 ,mm(ng) ,k)=ad_a(3 ,mm(ng) ,k)+ &
203 & ad_a(lm(ng)+3, 0,k)
204 ad_a(lm(ng)+3, 0,k)=0.0_r8
205 END DO
206 END IF
207 END IF
208
209 IF (domain(ng)%SouthEast_Corner(tile)) THEN
210 DO k=lbk,ubk
211!^ tl_A(-2,Mm(ng)+1,k)=tl_A(Lm(ng)-2, 1,k)
212!^
213 ad_a(lm(ng)-2, 1,k)=ad_a(lm(ng)-2, 1,k)+ &
214 & ad_a(-2,mm(ng)+1,k)
215 ad_a(-2,mm(ng)+1,k)=0.0_r8
216!^ tl_A(-1,Mm(ng)+1,k)=tl_A(Lm(ng)-1, 1,k)
217!^
218 ad_a(lm(ng)-1, 1,k)=ad_a(lm(ng)-1, 1,k)+ &
219 & ad_a(-1,mm(ng)+1,k)
220 ad_a(-1,mm(ng)+1,k)=0.0_r8
221!^ tl_A( 0,Mm(ng)+1,k)=tl_A(Lm(ng) , 1,k)
222!^
223 ad_a(lm(ng) , 1,k)=ad_a(lm(ng) , 1,k)+ &
224 & ad_a( 0,mm(ng)+1,k)
225 ad_a( 0,mm(ng)+1,k)=0.0_r8
226!^ tl_A(-2,Mm(ng)+2,k)=tl_A(Lm(ng)-2, 2,k)
227!^
228 ad_a(lm(ng)-2, 2,k)=ad_a(lm(ng)-2, 2,k)+ &
229 & ad_a(-2,mm(ng)+2,k)
230 ad_a(-2,mm(ng)+2,k)=0.0_r8
231!^ tl_A(-1,Mm(ng)+2,k)=tl_A(Lm(ng)-1, 2,k)
232!^
233 ad_a(lm(ng)-1, 2,k)=ad_a(lm(ng)-1, 2,k)+ &
234 & ad_a(-1,mm(ng)+2,k)
235 ad_a(-1,mm(ng)+2,k)=0.0_r8
236!^ tl_A( 0,Mm(ng)+2,k)=tl_A(Lm(ng) , 2,k)
237!^
238 ad_a(lm(ng) , 2,k)=ad_a(lm(ng) , 2,k)+ &
239 & ad_a( 0,mm(ng)+2,k)
240 ad_a( 0,mm(ng)+2,k)=0.0_r8
241 END DO
242 IF (nghostpoints.eq.3) THEN
243 DO k=lbk,ubk
244!^ tl_A(-2,Mm(ng)+3,k)=tl_A(Lm(ng)-2, 3,k)
245!^
246 ad_a(lm(ng)-2, 3,k)=ad_a(lm(ng)-2, 3,k)+ &
247 & ad_a(-2,mm(ng)+3,k)
248 ad_a(-2,mm(ng)+3,k)=0.0_r8
249!^ tl_A(-1,Mm(ng)+3,k)=tl_A(Lm(ng)-1, 3,k)
250!^
251 ad_a(lm(ng)-1, 3,k)=ad_a(lm(ng)-1, 3,k)+ &
252 & ad_a(-1,mm(ng)+3,k)
253 ad_a(-1,mm(ng)+3,k)=0.0_r8
254!^ tl_A( 0,Mm(ng)+3,k)=tl_A(Lm(ng) , 3,k)
255!^
256 ad_a(lm(ng) , 3,k)=ad_a(lm(ng) , 3,k)+ &
257 & ad_a( 0,mm(ng)+3,k)
258 ad_a( 0,mm(ng)+3,k)=0.0_r8
259 END DO
260 END IF
261 END IF
262
263 IF (domain(ng)%SouthWest_Corner(tile)) THEN
264 DO k=lbk,ubk
265!^ tl_A(Lm(ng)+1,Mm(ng)+1,k)=tl_A( 1, 1,k)
266!^
267 ad_a( 1, 1,k)=ad_a( 1, 1,k)+ &
268 & ad_a(lm(ng)+1,mm(ng)+1,k)
269 ad_a(lm(ng)+1,mm(ng)+1,k)=0.0_r8
270!^ tl_A(Lm(ng)+1,Mm(ng)+2,k)=tl_A( 1, 2,k)
271!^
272 ad_a( 1, 2,k)=ad_a( 1, 2,k)+ &
273 & ad_a(lm(ng)+1,mm(ng)+2,k)
274 ad_a(lm(ng)+1,mm(ng)+2,k)=0.0_r8
275!^ tl_A(Lm(ng)+2,Mm(ng)+1,k)=tl_A( 2, 1,k)
276!^
277 ad_a( 2, 1,k)=ad_a( 2, 1,k)+ &
278 & ad_a(lm(ng)+2,mm(ng)+1,k)
279 ad_a(lm(ng)+2,mm(ng)+1,k)=0.0_r8
280!^ tl_A(Lm(ng)+2,Mm(ng)+2,k)=tl_A(2, 2,k)
281!^
282 ad_a( 2, 2,k)=ad_a( 2, 2,k)+ &
283 & ad_a(lm(ng)+2,mm(ng)+2,k)
284 ad_a(lm(ng)+2,mm(ng)+2,k)=0.0_r8
285 END DO
286 IF (nghostpoints.eq.3) THEN
287 DO k=lbk,ubk
288!^ tl_A(Lm(ng)+1,Mm(ng)+3,k)=tl_A( 1, 3,k)
289!^
290 ad_a( 1, 3,k)=ad_a( 1, 3,k)+ &
291 & ad_a(lm(ng)+1,mm(ng)+3,k)
292 ad_a(lm(ng)+1,mm(ng)+3,k)=0.0_r8
293
294!^ tl_A(Lm(ng)+2,Mm(ng)+3,k)=tl_A( 2, 3,k)
295!^
296 ad_a( 2, 3,k)=ad_a( 2, 3,k)+ &
297 & ad_a(lm(ng)+2,mm(ng)+3,k)
298 ad_a(lm(ng)+2,mm(ng)+3,k)=0.0_r8
299!^ tl_A(Lm(ng)+3,Mm(ng)+1,k)=tl_A( 3, 1,k)
300!^
301 ad_a( 3, 1,k)=ad_a( 3, 1,k)+ &
302 & ad_a(lm(ng)+3,mm(ng)+1,k)
303 ad_a(lm(ng)+3,mm(ng)+1,k)=0.0_r8
304!^ tl_A(Lm(ng)+3,Mm(ng)+2,k)=tl_A( 3, 2,k)
305!^
306 ad_a( 3, 2,k)=ad_a( 3, 2,k)+ &
307 & ad_a(lm(ng)+3,mm(ng)+2,k)
308 ad_a(lm(ng)+3,mm(ng)+2,k)=0.0_r8
309!^ tl_A(Lm(ng)+3,Mm(ng)+3,k)=tl_A( 3, 3,k)
310!^
311 ad_a( 3, 3,k)=ad_a( 3, 3,k)+ &
312 & ad_a(lm(ng)+3,mm(ng)+3,k)
313 ad_a(lm(ng)+3,mm(ng)+3,k)=0.0_r8
314 END DO
315 END IF
316 END IF
317 END IF
318 END IF
319!
320!-----------------------------------------------------------------------
321! North-South periodic boundary conditions.
322!-----------------------------------------------------------------------
323!
324 IF (nsperiodic(ng)) THEN
325 IF (ewperiodic(ng)) THEN
326 imin=istr
327 imax=iend
328 ELSE
329 imin=istr
330 imax=iendr
331 END IF
332!
333 IF (ns_exchange) THEN
334 IF (domain(ng)%Northern_Edge(tile)) THEN
335 DO k=lbk,ubk
336 DO i=imin,imax
337!^ tl_A(i,-2,k)=tl_A(i,Mm(ng)-2,k)
338!^
339 ad_a(i,mm(ng)-2,k)=ad_a(i,mm(ng)-2,k)+ &
340 & ad_a(i,-2,k)
341 ad_a(i,-2,k)=0.0_r8
342!^ tl_A(i,-1,k)=tl_A(i,Mm(ng)-1,k)
343!^
344 ad_a(i,mm(ng)-1,k)=ad_a(i,mm(ng)-1,k)+ &
345 & ad_a(i,-1,k)
346 ad_a(i,-1,k)=0.0_r8
347!^ tl_A(i, 0,k)=tl_A(i,Mm(ng) ,k)
348!^
349 ad_a(i,mm(ng) ,k)=ad_a(i,mm(ng) ,k)+ &
350 & ad_a(i, 0,k)
351 ad_a(i, 0,k)=0.0_r8
352 END DO
353 END DO
354 END IF
355
356 IF (domain(ng)%Southern_Edge(tile)) THEN
357 DO k=lbk,ubk
358 DO i=imin,imax
359!^ tl_A(i,Mm(ng)+1,k)=tl_A(i,1,k)
360!^
361 ad_a(i,1,k)=ad_a(i,1,k)+ &
362 & ad_a(i,mm(ng)+1,k)
363 ad_a(i,mm(ng)+1,k)=0.0_r8
364!^ tl_A(i,Mm(ng)+2,k)=tl_A(i,2,k)
365!^
366 ad_a(i,2,k)=ad_a(i,2,k)+ &
367 & ad_a(i,mm(ng)+2,k)
368 ad_a(i,mm(ng)+2,k)=0.0_r8
369 END DO
370 END DO
371 IF (nghostpoints.eq.3) THEN
372 DO k=lbk,ubk
373 DO i=imin,imax
374
375!^ tl_A(i,Mm(ng)+3,k)=tl_A(i,3,k)
376!^
377 ad_a(i,3,k)=ad_a(i,3,k)+ &
378 & ad_a(i,mm(ng)+3,k)
379 ad_a(i,mm(ng)+3,k)=0.0_r8
380 END DO
381 END DO
382 END IF
383 END IF
384 END IF
385 END IF
386!
387!-----------------------------------------------------------------------
388! East-West periodic boundary conditions.
389!-----------------------------------------------------------------------
390!
391 IF (ewperiodic(ng)) THEN
392 IF (nsperiodic(ng)) THEN
393 jmin=jstr
394 jmax=jend
395 ELSE
396 jmin=jstr
397 jmax=jendr
398 END IF
399!
400 IF (ew_exchange) THEN
401 IF (domain(ng)%Eastern_Edge(tile)) THEN
402 DO k=lbk,ubk
403 DO j=jmin,jmax
404!^ tl_A(-2,j,k)=tl_A(Lm(ng)-2,j,k)
405!^
406 ad_a(lm(ng)-2,j,k)=ad_a(lm(ng)-2,j,k)+ &
407 & ad_a(-2,j,k)
408 ad_a(-2,j,k)=0.0_r8
409!^ tl_A(-1,j,k)=tl_A(Lm(ng)-1,j,k)
410!^
411 ad_a(lm(ng)-1,j,k)=ad_a(lm(ng)-1,j,k)+ &
412 & ad_a(-1,j,k)
413 ad_a(-1,j,k)=0.0_r8
414!^ tl_A( 0,j,k)=tl_A(Lm(ng) ,j,k)
415!^
416 ad_a(lm(ng) ,j,k)=ad_a(lm(ng) ,j,k)+ &
417 & ad_a( 0,j,k)
418 ad_a( 0,j,k)=0.0_r8
419 END DO
420 END DO
421 END IF
422
423 IF (domain(ng)%Western_Edge(tile)) THEN
424 DO k=lbk,ubk
425 DO j=jmin,jmax
426!^ tl_A(Lm(ng)+1,j,k)=tl_A(1,j,k)
427!^
428 ad_a(1,j,k)=ad_a(1,j,k)+ &
429 & ad_a(lm(ng)+1,j,k)
430 ad_a(lm(ng)+1,j,k)=0.0_r8
431!^ tl_A(Lm(ng)+2,j,k)=tl_A(2,j,k)
432!^
433 ad_a(2,j,k)=ad_a(2,j,k)+ &
434 & ad_a(lm(ng)+2,j,k)
435 ad_a(lm(ng)+2,j,k)=0.0_r8
436 END DO
437 END DO
438 IF (nghostpoints.eq.3) THEN
439 DO k=lbk,ubk
440 DO j=jmin,jmax
441!^ tl_A(Lm(ng)+3,j,k)=tl_A(3,j,k)
442!^
443 ad_a(3,j,k)=ad_a(3,j,k)+ &
444 & ad_a(lm(ng)+3,j,k)
445 ad_a(lm(ng)+3,j,k)=0.0_r8
446 END DO
447 END DO
448 END IF
449 END IF
450 END IF
451 END IF
452
453 RETURN
454 END SUBROUTINE ad_exchange_p3d_tile
455
456!
457!***********************************************************************
458 SUBROUTINE ad_exchange_r3d_tile (ng, tile, &
459 & LBi, UBi, LBj, UBj, LBk, UBk, &
460 & ad_A)
461!***********************************************************************
462!
463 USE mod_param
464 USE mod_scalars
465!
466! Imported variable declarations.
467!
468 integer, intent(in) :: ng, tile
469 integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
470!
471# ifdef ASSUMED_SHAPE
472 real(r8), intent(inout) :: ad_A(LBi:,LBj:,LBk:)
473# else
474 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj,LBk:UBk)
475# endif
476!
477! Local variable declarations.
478!
479 logical :: EW_exchange
480 logical :: NS_exchange
481
482 integer :: Imin, Imax, Jmin, Jmax
483 integer :: i, j, k
484
485# include "set_bounds.h"
486!
487!-----------------------------------------------------------------------
488! Determine processing switches.
489!-----------------------------------------------------------------------
490!
491 IF (ewperiodic(ng)) THEN
492# ifdef DISTRIBUTE
493 ew_exchange=ntilei(ng).eq.1
494# else
495 ew_exchange=.true.
496# endif
497 ELSE
498 ew_exchange=.false.
499 END IF
500
501 IF (nsperiodic(ng)) THEN
502# ifdef DISTRIBUTE
503 ns_exchange=ntilej(ng).eq.1
504# else
505 ns_exchange=.true.
506# endif
507 ELSE
508 ns_exchange=.false.
509 END IF
510!
511!-----------------------------------------------------------------------
512! Boundary corners.
513!-----------------------------------------------------------------------
514!
515 IF (ewperiodic(ng).and.nsperiodic(ng)) THEN
516 IF (ew_exchange.and.ns_exchange) THEN
517 IF (domain(ng)%NorthEast_Corner(tile)) THEN
518 DO k=lbk,ubk
519!^ tl_A(-2,-2,k)=tl_A(Lm(ng)-2,Mm(ng)-2,k)
520!^
521 ad_a(lm(ng)-2,mm(ng)-2,k)=ad_a(lm(ng)-2,mm(ng)-2,k)+ &
522 & ad_a(-2,-2,k)
523 ad_a(-2,-2,k)=0.0_r8
524!^ tl_A(-2,-1,k)=tl_A(Lm(ng)-2,Mm(ng)-1,k)
525!^
526 ad_a(lm(ng)-2,mm(ng)-1,k)=ad_a(lm(ng)-2,mm(ng)-1,k)+ &
527 & ad_a(-2,-1,k)
528 ad_a(-2,-1,k)=0.0_r8
529!^ tl_A(-2, 0,k)=tl_A(Lm(ng)-2,Mm(ng) ,k)
530!^
531 ad_a(lm(ng)-2,mm(ng) ,k)=ad_a(lm(ng)-2,mm(ng) ,k)+ &
532 & ad_a(-2, 0,k)
533 ad_a(-2, 0,k)=0.0_r8
534!^ tl_A(-1,-2,k)=tl_A(Lm(ng)-1,Mm(ng)-2,k)
535!^
536 ad_a(lm(ng)-1,mm(ng)-2,k)=ad_a(lm(ng)-1,mm(ng)-2,k)+ &
537 & ad_a(-1,-2,k)
538 ad_a(-1,-2,k)=0.0_r8
539!^ tl_A(-1,-1,k)=tl_A(Lm(ng)-1,Mm(ng)-1,k)
540!^
541 ad_a(lm(ng)-1,mm(ng)-1,k)=ad_a(lm(ng)-1,mm(ng)-1,k)+ &
542 & ad_a(-1,-1,k)
543 ad_a(-1,-1,k)=0.0_r8
544!^ tl_A(-1, 0,k)=tl_A(Lm(ng)-1,Mm(ng) ,k)
545!^
546 ad_a(lm(ng)-1,mm(ng) ,k)=ad_a(lm(ng)-1,mm(ng) ,k)+ &
547 & ad_a(-1, 0,k)
548 ad_a(-1, 0,k)=0.0_r8
549!^ tl_A( 0,-2,k)=tl_A(Lm(ng) ,Mm(ng)-2,k)
550!^
551 ad_a(lm(ng) ,mm(ng)-2,k)=ad_a(lm(ng) ,mm(ng)-2,k)+ &
552 & ad_a( 0,-2,k)
553 ad_a( 0,-2,k)=0.0_r8
554!^ tl_A( 0,-1,k)=tl_A(Lm(ng) ,Mm(ng)-1,k)
555!^
556 ad_a(lm(ng) ,mm(ng)-1,k)=ad_a(lm(ng) ,mm(ng)-1,k)+ &
557 & ad_a( 0,-1,k)
558 ad_a( 0,-1,k)=0.0_r8
559!^ tl_A( 0, 0,k)=tl_A(Lm(ng) ,Mm(ng) ,k)
560!^
561 ad_a(lm(ng) ,mm(ng) ,k)=ad_a(lm(ng) ,mm(ng) ,k)+ &
562 & ad_a( 0, 0,k)
563 ad_a( 0, 0,k)=0.0_r8
564 END DO
565 END IF
566
567 IF (domain(ng)%NorthWest_Corner(tile)) THEN
568 DO k=lbk,ubk
569!^ tl_A(Lm(ng)+1,-2,k)=tl_A( 1,Mm(ng)-2,k)
570!^
571 ad_a( 1,mm(ng)-2,k)=ad_a( 1,mm(ng)-2,k)+ &
572 & ad_a(lm(ng)+1,-2,k)
573 ad_a(lm(ng)+1,-2,k)=0.0_r8
574!^ tl_A(Lm(ng)+1,-1,k)=tl_A( 1,Mm(ng)-1,k)
575!^
576 ad_a( 1,mm(ng)-1,k)=ad_a( 1,mm(ng)-1,k)+ &
577 & ad_a(lm(ng)+1,-1,k)
578 ad_a(lm(ng)+1,-1,k)=0.0_r8
579!^ tl_A(Lm(ng)+1, 0,k)=tl_A( 1,Mm(ng) ,k)
580!^
581 ad_a( 1,mm(ng) ,k)=ad_a( 1,mm(ng) ,k)+ &
582 & ad_a(lm(ng)+1, 0,k)
583 ad_a(lm(ng)+1, 0,k)=0.0_r8
584!^ tl_A(Lm(ng)+2,-2,k)=tl_A( 2,Mm(ng)-2,k)
585!^
586 ad_a( 2,mm(ng)-2,k)=ad_a( 2,mm(ng)-2,k)+ &
587 & ad_a(lm(ng)+2,-2,k)
588 ad_a(lm(ng)+2,-2,k)=0.0_r8
589!^ tl_A(Lm(ng)+2,-1,k)=tl_A( 2,Mm(ng)-1,k)
590!^
591 ad_a( 2,mm(ng)-1,k)=ad_a( 2,mm(ng)-1,k)+ &
592 & ad_a(lm(ng)+2,-1,k)
593 ad_a(lm(ng)+2,-1,k)=0.0_r8
594!^ tl_A(Lm(ng)+2, 0,k)=tl_A( 2,Mm(ng) ,k)
595!^
596 ad_a( 2,mm(ng) ,k)=ad_a( 2,mm(ng) ,k)+ &
597 & ad_a(lm(ng)+2, 0,k)
598 ad_a(lm(ng)+2, 0,k)=0.0_r8
599 END DO
600 IF (nghostpoints.eq.3) THEN
601 DO k=lbk,ubk
602!^ tl_A(Lm(ng)+3,-2,k)=tl_A(3 ,Mm(ng)-2,k)
603!^
604 ad_a(3 ,mm(ng)-2,k)=ad_a(3 ,mm(ng)-2,k)+ &
605 & ad_a(lm(ng)+3,-2,k)
606 ad_a(lm(ng)+3,-2,k)=0.0_r8
607!^ tl_A(Lm(ng)+3,-1,k)=tl_A(3 ,Mm(ng)-1,k)
608!^
609 ad_a(3 ,mm(ng)-1,k)=ad_a(3 ,mm(ng)-1,k)+ &
610 & ad_a(lm(ng)+3,-1,k)
611 ad_a(lm(ng)+3,-1,k)=0.0_r8
612!^ tl_A(Lm(ng)+3, 0,k)=tl_A(3 ,Mm(ng) ,k)
613!^
614 ad_a(3 ,mm(ng) ,k)=ad_a(3 ,mm(ng) ,k)+ &
615 & ad_a(lm(ng)+3, 0,k)
616 ad_a(lm(ng)+3, 0,k)=0.0_r8
617 END DO
618 END IF
619 END IF
620
621 IF (domain(ng)%SouthEast_Corner(tile)) THEN
622 DO k=lbk,ubk
623!^ tl_A(-2,Mm(ng)+1,k)=tl_A(Lm(ng)-2, 1,k)
624!^
625 ad_a(lm(ng)-2, 1,k)=ad_a(lm(ng)-2, 1,k)+ &
626 & ad_a(-2,mm(ng)+1,k)
627 ad_a(-2,mm(ng)+1,k)=0.0_r8
628!^ tl_A(-1,Mm(ng)+1,k)=tl_A(Lm(ng)-1, 1,k)
629!^
630 ad_a(lm(ng)-1, 1,k)=ad_a(lm(ng)-1, 1,k)+ &
631 & ad_a(-1,mm(ng)+1,k)
632 ad_a(-1,mm(ng)+1,k)=0.0_r8
633!^ tl_A( 0,Mm(ng)+1,k)=tl_A(Lm(ng) , 1,k)
634!^
635 ad_a(lm(ng) , 1,k)=ad_a(lm(ng) , 1,k)+ &
636 & ad_a( 0,mm(ng)+1,k)
637 ad_a( 0,mm(ng)+1,k)=0.0_r8
638!^ tl_A(-2,Mm(ng)+2,k)=tl_A(Lm(ng)-2, 2,k)
639!^
640 ad_a(lm(ng)-2, 2,k)=ad_a(lm(ng)-2, 2,k)+ &
641 & ad_a(-2,mm(ng)+2,k)
642 ad_a(-2,mm(ng)+2,k)=0.0_r8
643!^ tl_A(-1,Mm(ng)+2,k)=tl_A(Lm(ng)-1, 2,k)
644!^
645 ad_a(lm(ng)-1, 2,k)=ad_a(lm(ng)-1, 2,k)+ &
646 & ad_a(-1,mm(ng)+2,k)
647 ad_a(-1,mm(ng)+2,k)=0.0_r8
648!^ tl_A( 0,Mm(ng)+2,k)=tl_A(Lm(ng) , 2,k)
649!^
650 ad_a(lm(ng) , 2,k)=ad_a(lm(ng) , 2,k)+ &
651 & ad_a( 0,mm(ng)+2,k)
652 ad_a( 0,mm(ng)+2,k)=0.0_r8
653 END DO
654 IF (nghostpoints.eq.3) THEN
655 DO k=lbk,ubk
656!^ tl_A(-2,Mm(ng)+3,k)=tl_A(Lm(ng)-2, 3,k)
657!^
658 ad_a(lm(ng)-2, 3,k)=ad_a(lm(ng)-2, 3,k)+ &
659 & ad_a(-2,mm(ng)+3,k)
660 ad_a(-2,mm(ng)+3,k)=0.0_r8
661!^ tl_A(-1,Mm(ng)+3,k)=tl_A(Lm(ng)-1, 3,k)
662!^
663 ad_a(lm(ng)-1, 3,k)=ad_a(lm(ng)-1, 3,k)+ &
664 & ad_a(-1,mm(ng)+3,k)
665 ad_a(-1,mm(ng)+3,k)=0.0_r8
666!^ tl_A( 0,Mm(ng)+3,k)=tl_A(Lm(ng) , 3,k)
667!^
668 ad_a(lm(ng) , 3,k)=ad_a(lm(ng) , 3,k)+ &
669 & ad_a( 0,mm(ng)+3,k)
670 ad_a( 0,mm(ng)+3,k)=0.0_r8
671 END DO
672 END IF
673 END IF
674
675 IF (domain(ng)%SouthWest_Corner(tile)) THEN
676 DO k=lbk,ubk
677!^ tl_A(Lm(ng)+1,Mm(ng)+1,k)=tl_A( 1, 1,k)
678!^
679 ad_a( 1, 1,k)=ad_a( 1, 1,k)+ &
680 & ad_a(lm(ng)+1,mm(ng)+1,k)
681 ad_a(lm(ng)+1,mm(ng)+1,k)=0.0_r8
682!^ tl_A(Lm(ng)+1,Mm(ng)+2,k)=tl_A( 1, 2,k)
683!^
684 ad_a( 1, 2,k)=ad_a( 1, 2,k)+ &
685 & ad_a(lm(ng)+1,mm(ng)+2,k)
686 ad_a(lm(ng)+1,mm(ng)+2,k)=0.0_r8
687!^ tl_A(Lm(ng)+2,Mm(ng)+1,k)=tl_A( 2, 1,k)
688!^
689 ad_a( 2, 1,k)=ad_a( 2, 1,k)+ &
690 & ad_a(lm(ng)+2,mm(ng)+1,k)
691 ad_a(lm(ng)+2,mm(ng)+1,k)=0.0_r8
692!^ tl_A(Lm(ng)+2,Mm(ng)+2,k)=tl_A( 2, 2,k)
693!^
694 ad_a( 2, 2,k)=ad_a( 2, 2,k)+ &
695 & ad_a(lm(ng)+2,mm(ng)+2,k)
696 ad_a(lm(ng)+2,mm(ng)+2,k)=0.0_r8
697 END DO
698 IF (nghostpoints.eq.3) THEN
699 DO k=lbk,ubk
700!^ tl_A(Lm(ng)+1,Mm(ng)+3,k)=tl_A( 1, 3,k)
701!^
702 ad_a( 1, 3,k)=ad_a( 1, 3,k)+ &
703 & ad_a(lm(ng)+1,mm(ng)+3,k)
704 ad_a(lm(ng)+1,mm(ng)+3,k)=0.0_r8
705
706!^ tl_A(Lm(ng)+2,Mm(ng)+3,k)=tl_A( 2, 3,k)
707!^
708 ad_a( 2, 3,k)=ad_a( 2, 3,k)+ &
709 & ad_a(lm(ng)+2,mm(ng)+3,k)
710 ad_a(lm(ng)+2,mm(ng)+3,k)=0.0_r8
711!^ tl_A(Lm(ng)+3,Mm(ng)+1,k)=tl_A( 3, 1,k)
712!^
713 ad_a( 3, 1,k)=ad_a( 3, 1,k)+ &
714 & ad_a(lm(ng)+3,mm(ng)+1,k)
715 ad_a(lm(ng)+3,mm(ng)+1,k)=0.0_r8
716!^ tl_A(Lm(ng)+3,Mm(ng)+2,k)=tl_A( 3, 2,k)
717!^
718 ad_a( 3, 2,k)=ad_a( 3, 2,k)+ &
719 & ad_a(lm(ng)+3,mm(ng)+2,k)
720 ad_a(lm(ng)+3,mm(ng)+2,k)=0.0_r8
721!^ tl_A(Lm(ng)+3,Mm(ng)+3,k)=tl_A( 3, 3,k)
722!^
723 ad_a( 3, 3,k)=ad_a( 3, 3,k)+ &
724 & ad_a(lm(ng)+3,mm(ng)+3,k)
725 ad_a(lm(ng)+3,mm(ng)+3,k)=0.0_r8
726 END DO
727 END IF
728 END IF
729 END IF
730 END IF
731!
732!-----------------------------------------------------------------------
733! North-South periodic boundary conditions.
734!-----------------------------------------------------------------------
735!
736 IF (nsperiodic(ng)) THEN
737 IF (ewperiodic(ng)) THEN
738 imin=istr
739 imax=iend
740 ELSE
741 imin=istrr
742 imax=iendr
743 END IF
744!
745 IF (ns_exchange) THEN
746 IF (domain(ng)%Northern_Edge(tile)) THEN
747 DO k=lbk,ubk
748 DO i=imin,imax
749!^ tl_A(i,-2,k)=tl_A(i,Mm(ng)-2,k)
750!^
751 ad_a(i,mm(ng)-2,k)=ad_a(i,mm(ng)-2,k)+ &
752 & ad_a(i,-2,k)
753 ad_a(i,-2,k)=0.0_r8
754!^ tl_A(i,-1,k)=tl_A(i,Mm(ng)-1,k)
755!^
756 ad_a(i,mm(ng)-1,k)=ad_a(i,mm(ng)-1,k)+ &
757 & ad_a(i,-1,k)
758 ad_a(i,-1,k)=0.0_r8
759!^ tl_A(i, 0,k)=tl_A(i,Mm(ng) ,k)
760!^
761 ad_a(i,mm(ng) ,k)=ad_a(i,mm(ng) ,k)+ &
762 & ad_a(i, 0,k)
763 ad_a(i, 0,k)=0.0_r8
764 END DO
765 END DO
766 END IF
767
768 IF (domain(ng)%Southern_Edge(tile)) THEN
769 DO k=lbk,ubk
770 DO i=imin,imax
771!^ tl_A(i,Mm(ng)+1,k)=tl_A(i, 1,k)
772!^
773 ad_a(i, 1,k)=ad_a(i, 1,k)+ &
774 & ad_a(i,mm(ng)+1,k)
775 ad_a(i,mm(ng)+1,k)=0.0_r8
776!^ tl_A(i,Mm(ng)+2,k)=tl_A(i, 2,k)
777!^
778 ad_a(i, 2,k)=ad_a(i, 2,k)+ &
779 & ad_a(i,mm(ng)+2,k)
780 ad_a(i,mm(ng)+2,k)=0.0_r8
781 END DO
782 END DO
783 IF (nghostpoints.eq.3) THEN
784 DO k=lbk,ubk
785 DO i=imin,imax
786!^ tl_A(i,Mm(ng)+3,k)=tl_A(i,3,k)
787!^
788 ad_a(i,3,k)=ad_a(i,3,k)+ &
789 & ad_a(i,mm(ng)+3,k)
790 ad_a(i,mm(ng)+3,k)=0.0_r8
791 END DO
792 END DO
793 END IF
794 END IF
795 END IF
796 END IF
797!
798!-----------------------------------------------------------------------
799! East-West periodic boundary conditions.
800!-----------------------------------------------------------------------
801!
802 IF (ewperiodic(ng)) THEN
803 IF (nsperiodic(ng)) THEN
804 jmin=jstr
805 jmax=jend
806 ELSE
807 jmin=jstrr
808 jmax=jendr
809 END IF
810!
811 IF (ew_exchange) THEN
812 IF (domain(ng)%Eastern_Edge(tile)) THEN
813 DO k=lbk,ubk
814 DO j=jmin,jmax
815!^ tl_A(-2,j,k)=tl_A(Lm(ng)-2,j,k)
816!^
817 ad_a(lm(ng)-2,j,k)=ad_a(lm(ng)-2,j,k)+ &
818 & ad_a(-2,j,k)
819 ad_a(-2,j,k)=0.0_r8
820!^ tl_A(-1,j,k)=tl_A(Lm(ng)-1,j,k)
821!^
822 ad_a(lm(ng)-1,j,k)=ad_a(lm(ng)-1,j,k)+ &
823 & ad_a(-1,j,k)
824 ad_a(-1,j,k)=0.0_r8
825!^ tl_A( 0,j,k)=tl_A(Lm(ng) ,j,k)
826!^
827 ad_a(lm(ng) ,j,k)=ad_a(lm(ng) ,j,k)+ &
828 & ad_a( 0,j,k)
829 ad_a( 0,j,k)=0.0_r8
830 END DO
831 END DO
832 END IF
833
834 IF (domain(ng)%Western_Edge(tile)) THEN
835 DO k=lbk,ubk
836 DO j=jmin,jmax
837!^ tl_A(Lm(ng)+1,j,k)=tl_A(1,j,k)
838!^
839 ad_a(1,j,k)=ad_a(1,j,k)+ &
840 & ad_a(lm(ng)+1,j,k)
841 ad_a(lm(ng)+1,j,k)=0.0_r8
842!^ tl_A(Lm(ng)+2,j,k)=tl_A( 2,j,k)
843!^
844 ad_a(2,j,k)=ad_a(2,j,k)+ &
845 & ad_a(lm(ng)+2,j,k)
846 ad_a(lm(ng)+2,j,k)=0.0_r8
847 END DO
848 END DO
849 IF (nghostpoints.eq.3) THEN
850 DO k=lbk,ubk
851 DO j=jmin,jmax
852!^ tl_A(Lm(ng)+3,j,k)=tl_A(3,j,k)
853!^
854 ad_a(3,j,k)=ad_a(3,j,k)+ &
855 & ad_a(lm(ng)+3,j,k)
856 ad_a(lm(ng)+3,j,k)=0.0_r8
857 END DO
858 END DO
859 END IF
860 END IF
861 END IF
862 END IF
863
864 RETURN
865 END SUBROUTINE ad_exchange_r3d_tile
866
867!
868!***********************************************************************
869 SUBROUTINE ad_exchange_u3d_tile (ng, tile, &
870 & LBi, UBi, LBj, UBj, LBk, UBk, &
871 & ad_A)
872!***********************************************************************
873!
874 USE mod_param
875 USE mod_scalars
876!
877! Imported variable declarations.
878!
879 integer, intent(in) :: ng, tile
880 integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
881!
882# ifdef ASSUMED_SHAPE
883 real(r8), intent(inout) :: ad_A(LBi:,LBj:,LBk:)
884# else
885 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj,LBk:UBk)
886# endif
887!
888! Local variable declarations.
889!
890 logical :: EW_exchange
891 logical :: NS_exchange
892
893 integer :: Imin, Imax, Jmin, Jmax
894 integer :: i, j, k
895
896# include "set_bounds.h"
897!
898!-----------------------------------------------------------------------
899! Determine processing switches.
900!-----------------------------------------------------------------------
901!
902 IF (ewperiodic(ng)) THEN
903# ifdef DISTRIBUTE
904 ew_exchange=ntilei(ng).eq.1
905# else
906 ew_exchange=.true.
907# endif
908 ELSE
909 ew_exchange=.false.
910 END IF
911
912 IF (nsperiodic(ng)) THEN
913# ifdef DISTRIBUTE
914 ns_exchange=ntilej(ng).eq.1
915# else
916 ns_exchange=.true.
917# endif
918 ELSE
919 ns_exchange=.false.
920 END IF
921!
922!-----------------------------------------------------------------------
923! Boundary corners.
924!-----------------------------------------------------------------------
925!
926 IF (ewperiodic(ng).and.nsperiodic(ng)) THEN
927 IF (ew_exchange.and.ns_exchange) THEN
928 IF (domain(ng)%NorthEast_Corner(tile)) THEN
929 DO k=lbk,ubk
930!^ tl_A(-2,-2,k)=tl_A(Lm(ng)-2,Mm(ng)-2,k)
931!^
932 ad_a(lm(ng)-2,mm(ng)-2,k)=ad_a(lm(ng)-2,mm(ng)-2,k)+ &
933 & ad_a(-2,-2,k)
934 ad_a(-2,-2,k)=0.0_r8
935!^ tl_A(-2,-1,k)=tl_A(Lm(ng)-2,Mm(ng)-1,k)
936!^
937 ad_a(lm(ng)-2,mm(ng)-1,k)=ad_a(lm(ng)-2,mm(ng)-1,k)+ &
938 & ad_a(-2,-1,k)
939 ad_a(-2,-1,k)=0.0_r8
940!^ tl_A(-2, 0,k)=tl_A(Lm(ng)-2,Mm(ng) ,k)
941!^
942 ad_a(lm(ng)-2,mm(ng) ,k)=ad_a(lm(ng)-2,mm(ng) ,k)+ &
943 & ad_a(-2, 0,k)
944 ad_a(-2, 0,k)=0.0_r8
945!^ tl_A(-1,-2,k)=tl_A(Lm(ng)-1,Mm(ng)-2,k)
946!^
947 ad_a(lm(ng)-1,mm(ng)-2,k)=ad_a(lm(ng)-1,mm(ng)-2,k)+ &
948 & ad_a(-1,-2,k)
949 ad_a(-1,-2,k)=0.0_r8
950!^ tl_A(-1,-1,k)=tl_A(Lm(ng)-1,Mm(ng)-1,k)
951!^
952 ad_a(lm(ng)-1,mm(ng)-1,k)=ad_a(lm(ng)-1,mm(ng)-1,k)+ &
953 & ad_a(-1,-1,k)
954 ad_a(-1,-1,k)=0.0_r8
955!^ tl_A(-1, 0,k)=tl_A(Lm(ng)-1,Mm(ng) ,k)
956!^
957 ad_a(lm(ng)-1,mm(ng) ,k)=ad_a(lm(ng)-1,mm(ng) ,k)+ &
958 & ad_a(-1, 0,k)
959 ad_a(-1, 0,k)=0.0_r8
960!^ tl_A( 0,-2,k)=tl_A(Lm(ng) ,Mm(ng)-2,k)
961!^
962 ad_a(lm(ng) ,mm(ng)-2,k)=ad_a(lm(ng) ,mm(ng)-2,k)+ &
963 & ad_a( 0,-2,k)
964 ad_a( 0,-2,k)=0.0_r8
965!^ tl_A( 0,-1,k)=tl_A(Lm(ng) ,Mm(ng)-1,k)
966!^
967 ad_a(lm(ng) ,mm(ng)-1,k)=ad_a(lm(ng) ,mm(ng)-1,k)+ &
968 & ad_a( 0,-1,k)
969 ad_a( 0,-1,k)=0.0_r8
970!^ tl_A( 0, 0,k)=tl_A(Lm(ng) ,Mm(ng) ,k)
971!^
972 ad_a(lm(ng) ,mm(ng) ,k)=ad_a(lm(ng) ,mm(ng) ,k)+ &
973 & ad_a( 0, 0,k)
974 ad_a( 0, 0,k)=0.0_r8
975 END DO
976 END IF
977
978 IF (domain(ng)%NorthWest_Corner(tile)) THEN
979 DO k=lbk,ubk
980!^ tl_A(Lm(ng)+1,-2,k)=tl_A( 1,Mm(ng)-2,k)
981!^
982 ad_a( 1,mm(ng)-2,k)=ad_a( 1,mm(ng)-2,k)+ &
983 & ad_a(lm(ng)+1,-2,k)
984 ad_a(lm(ng)+1,-2,k)=0.0_r8
985!^ tl_A(Lm(ng)+1,-1,k)=tl_A( 1,Mm(ng)-1,k)
986!^
987 ad_a( 1,mm(ng)-1,k)=ad_a( 1,mm(ng)-1,k)+ &
988 & ad_a(lm(ng)+1,-1,k)
989 ad_a(lm(ng)+1,-1,k)=0.0_r8
990!^ tl_A(Lm(ng)+1, 0,k)=tl_A( 1,Mm(ng) ,k)
991!^
992 ad_a( 1,mm(ng) ,k)=ad_a( 1,mm(ng) ,k)+ &
993 & ad_a(lm(ng)+1, 0,k)
994 ad_a(lm(ng)+1, 0,k)=0.0_r8
995!^ tl_A(Lm(ng)+2,-2,k)=tl_A( 2,Mm(ng)-2,k)
996!^
997 ad_a( 2,mm(ng)-2,k)=ad_a( 2,mm(ng)-2,k)+ &
998 & ad_a(lm(ng)+2,-2,k)
999 ad_a(lm(ng)+2,-2,k)=0.0_r8
1000!^ tl_A(Lm(ng)+2,-1,k)=tl_A( 2,Mm(ng)-1,k)
1001!^
1002 ad_a( 2,mm(ng)-1,k)=ad_a( 2,mm(ng)-1,k)+ &
1003 & ad_a(lm(ng)+2,-1,k)
1004 ad_a(lm(ng)+2,-1,k)=0.0_r8
1005!^ tl_A(Lm(ng)+2, 0,k)=tl_A( 2,Mm(ng) ,k)
1006!^
1007 ad_a( 2,mm(ng) ,k)=ad_a( 2,mm(ng) ,k)+ &
1008 & ad_a(lm(ng)+2, 0,k)
1009 ad_a(lm(ng)+2, 0,k)=0.0_r8
1010 END DO
1011 IF (nghostpoints.eq.3) THEN
1012 DO k=lbk,ubk
1013!^ tl_A(Lm(ng)+3,-2,k)=tl_A(3 ,Mm(ng)-2,k)
1014!^
1015 ad_a(3 ,mm(ng)-2,k)=ad_a(3 ,mm(ng)-2,k)+ &
1016 & ad_a(lm(ng)+3,-2,k)
1017 ad_a(lm(ng)+3,-2,k)=0.0_r8
1018!^ tl_A(Lm(ng)+3,-1,k)=tl_A(3 ,Mm(ng)-1,k)
1019!^
1020 ad_a(3 ,mm(ng)-1,k)=ad_a(3 ,mm(ng)-1,k)+ &
1021 & ad_a(lm(ng)+3,-1,k)
1022 ad_a(lm(ng)+3,-1,k)=0.0_r8
1023!^ tl_A(Lm(ng)+3, 0,k)=tl_A(3 ,Mm(ng) ,k)
1024!^
1025 ad_a(3 ,mm(ng) ,k)=ad_a(3 ,mm(ng) ,k)+ &
1026 & ad_a(lm(ng)+3, 0,k)
1027 ad_a(lm(ng)+3, 0,k)=0.0_r8
1028 END DO
1029 END IF
1030 END IF
1031
1032 IF (domain(ng)%SouthEast_Corner(tile)) THEN
1033 DO k=lbk,ubk
1034!^ tl_A(-2,Mm(ng)+1,k)=tl_A(Lm(ng)-2, 1,k)
1035!^
1036 ad_a(lm(ng)-2, 1,k)=ad_a(lm(ng)-2, 1,k)+ &
1037 & ad_a(-2,mm(ng)+1,k)
1038 ad_a(-2,mm(ng)+1,k)=0.0_r8
1039!^ tl_A(-1,Mm(ng)+1,k)=tl_A(Lm(ng)-1, 1,k)
1040!^
1041 ad_a(lm(ng)-1, 1,k)=ad_a(lm(ng)-1, 1,k)+ &
1042 & ad_a(-1,mm(ng)+1,k)
1043 ad_a(-1,mm(ng)+1,k)=0.0_r8
1044!^ tl_A( 0,Mm(ng)+1,k)=tl_A(Lm(ng) , 1,k)
1045!^
1046 ad_a(lm(ng) , 1,k)=ad_a(lm(ng) , 1,k)+ &
1047 & ad_a( 0,mm(ng)+1,k)
1048 ad_a( 0,mm(ng)+1,k)=0.0_r8
1049!^ tl_A(-2,Mm(ng)+2,k)=tl_A(Lm(ng)-2, 2,k)
1050!^
1051 ad_a(lm(ng)-2, 2,k)=ad_a(lm(ng)-2, 2,k)+ &
1052 & ad_a(-2,mm(ng)+2,k)
1053 ad_a(-2,mm(ng)+2,k)=0.0_r8
1054!^ tl_A(-1,Mm(ng)+2,k)=tl_A(Lm(ng)-1, 2,k)
1055!^
1056 ad_a(lm(ng)-1, 2,k)=ad_a(lm(ng)-1, 2,k)+ &
1057 & ad_a(-1,mm(ng)+2,k)
1058 ad_a(-1,mm(ng)+2,k)=0.0_r8
1059!^ tl_A( 0,Mm(ng)+2,k)=tl_A(Lm(ng) , 2,k)
1060!^
1061 ad_a(lm(ng) , 2,k)=ad_a(lm(ng) , 2,k)+ &
1062 & ad_a( 0,mm(ng)+2,k)
1063 ad_a( 0,mm(ng)+2,k)=0.0_r8
1064 END DO
1065 IF (nghostpoints.eq.3) THEN
1066 DO k=lbk,ubk
1067!^ tl_A(-2,Mm(ng)+3,k)=tl_A(Lm(ng)-2, 3,k)
1068!^
1069 ad_a(lm(ng)-2, 3,k)=ad_a(lm(ng)-2, 3,k)+ &
1070 & ad_a(-2,mm(ng)+3,k)
1071 ad_a(-2,mm(ng)+3,k)=0.0_r8
1072!^ tl_A(-1,Mm(ng)+3,k)=tl_A(Lm(ng)-1, 3,k)
1073!^
1074 ad_a(lm(ng)-1, 3,k)=ad_a(lm(ng)-1, 3,k)+ &
1075 & ad_a(-1,mm(ng)+3,k)
1076 ad_a(-1,mm(ng)+3,k)=0.0_r8
1077!^ tl_A( 0,Mm(ng)+3,k)=tl_A(Lm(ng) , 3,k)
1078!^
1079 ad_a(lm(ng) , 3,k)=ad_a(lm(ng) , 3,k)+ &
1080 & ad_a( 0,mm(ng)+3,k)
1081 ad_a( 0,mm(ng)+3,k)=0.0_r8
1082 END DO
1083 END IF
1084 END IF
1085
1086 IF (domain(ng)%SouthWest_Corner(tile)) THEN
1087 DO k=lbk,ubk
1088!^ tl_A(Lm(ng)+1,Mm(ng)+1,k)=tl_A( 1 , 1 ,k)
1089!^
1090 ad_a( 1, 1,k)=ad_a( 1, 1,k)+ &
1091 & ad_a(lm(ng)+1,mm(ng)+1,k)
1092 ad_a(lm(ng)+1,mm(ng)+1,k)=0.0_r8
1093!^ tl_A(Lm(ng)+1,Mm(ng)+2,k)=tl_A( 1 , 2,k)
1094!^
1095 ad_a( 1, 2,k)=ad_a( 1, 2,k)+ &
1096 & ad_a(lm(ng)+1,mm(ng)+2,k)
1097 ad_a(lm(ng)+1,mm(ng)+2,k)=0.0_r8
1098!^ tl_A(Lm(ng)+2,Mm(ng)+1,k)=tl_A( 2, 1 ,k)
1099!^
1100 ad_a( 2, 1,k)=ad_a( 2, 1,k)+ &
1101 & ad_a(lm(ng)+2,mm(ng)+1,k)
1102 ad_a(lm(ng)+2,mm(ng)+1,k)=0.0_r8
1103!^ tl_A(Lm(ng)+2,Mm(ng)+2,k)=tl_A( 2, 2,k)
1104!^
1105 ad_a( 2, 2,k)=ad_a( 2, 2,k)+ &
1106 & ad_a(lm(ng)+2,mm(ng)+2,k)
1107 ad_a(lm(ng)+2,mm(ng)+2,k)=0.0_r8
1108 END DO
1109 IF (nghostpoints.eq.3) THEN
1110 DO k=lbk,ubk
1111!^ tl_A(Lm(ng)+1,Mm(ng)+3,k)=tl_A( 1, 3,k)
1112!^
1113 ad_a( 1, 3,k)=ad_a( 1, 3,k)+ &
1114 & ad_a(lm(ng)+1,mm(ng)+3,k)
1115 ad_a(lm(ng)+1,mm(ng)+3,k)=0.0_r8
1116
1117!^ tl_A(Lm(ng)+2,Mm(ng)+3,k)=tl_A( 2, 3,k)
1118!^
1119 ad_a( 2, 3,k)=ad_a( 2, 3,k)+ &
1120 & ad_a(lm(ng)+2,mm(ng)+3,k)
1121 ad_a(lm(ng)+2,mm(ng)+3,k)=0.0_r8
1122!^ tl_A(Lm(ng)+3,Mm(ng)+1,k)=tl_A( 3, 1,k)
1123!^
1124 ad_a( 3, 1,k)=ad_a( 3, 1,k)+ &
1125 & ad_a(lm(ng)+3,mm(ng)+1,k)
1126 ad_a(lm(ng)+3,mm(ng)+1,k)=0.0_r8
1127!^ tl_A(Lm(ng)+3,Mm(ng)+2,k)=tl_A( 3, 2,k)
1128!^
1129 ad_a( 3, 2,k)=ad_a( 3, 2,k)+ &
1130 & ad_a(lm(ng)+3,mm(ng)+2,k)
1131 ad_a(lm(ng)+3,mm(ng)+2,k)=0.0_r8
1132!^ tl_A(Lm(ng)+3,Mm(ng)+3,k)=tl_A( 3, 3,k)
1133!^
1134 ad_a( 3, 3,k)=ad_a( 3, 3,k)+ &
1135 & ad_a(lm(ng)+3,mm(ng)+3,k)
1136 ad_a(lm(ng)+3,mm(ng)+3,k)=0.0_r8
1137 END DO
1138 END IF
1139 END IF
1140 END IF
1141 END IF
1142!
1143!-----------------------------------------------------------------------
1144! North-South periodic boundary conditions.
1145!-----------------------------------------------------------------------
1146!
1147 IF (nsperiodic(ng)) THEN
1148 IF (ewperiodic(ng)) THEN
1149 imin=istr
1150 imax=iend
1151 ELSE
1152 imin=istr
1153 imax=iendr
1154 END IF
1155!
1156 IF (ns_exchange) THEN
1157 IF (domain(ng)%Northern_Edge(tile)) THEN
1158 DO k=lbk,ubk
1159 DO i=imin,imax
1160!^ tl_A(i,-2,k)=tl_A(i,Mm(ng)-2,k)
1161!^
1162 ad_a(i,mm(ng)-2,k)=ad_a(i,mm(ng)-2,k)+ &
1163 & ad_a(i,-2,k)
1164 ad_a(i,-2,k)=0.0_r8
1165!^ tl_A(i,-1,k)=tl_A(i,Mm(ng)-1,k)
1166!^
1167 ad_a(i,mm(ng)-1,k)=ad_a(i,mm(ng)-1,k)+ &
1168 & ad_a(i,-1,k)
1169 ad_a(i,-1,k)=0.0_r8
1170!^ tl_A(i, 0,k)=tl_A(i,Mm(ng) ,k)
1171!^
1172 ad_a(i,mm(ng) ,k)=ad_a(i,mm(ng) ,k)+ &
1173 & ad_a(i, 0,k)
1174 ad_a(i, 0,k)=0.0_r8
1175 END DO
1176 END DO
1177 END IF
1178
1179 IF (domain(ng)%Southern_Edge(tile)) THEN
1180 DO k=lbk,ubk
1181 DO i=imin,imax
1182!^ tl_A(i,Mm(ng)+1,k)=tl_A(i,1,k)
1183!^
1184 ad_a(i,1,k)=ad_a(i,1,k)+ &
1185 & ad_a(i,mm(ng)+1,k)
1186 ad_a(i,mm(ng)+1,k)=0.0_r8
1187!^ tl_A(i,Mm(ng)+2,k)=tl_A(i, 2,k)
1188!^
1189 ad_a(i,2,k)=ad_a(i,2,k)+ &
1190 & ad_a(i,mm(ng)+2,k)
1191 ad_a(i,mm(ng)+2,k)=0.0_r8
1192 END DO
1193 END DO
1194 IF (nghostpoints.eq.3) THEN
1195 DO k=lbk,ubk
1196 DO i=imin,imax
1197!^ tl_A(i,Mm(ng)+3,k)=tl_A(i,3,k)
1198!^
1199 ad_a(i,3,k)=ad_a(i,3,k)+ &
1200 & ad_a(i,mm(ng)+3,k)
1201 ad_a(i,mm(ng)+3,k)=0.0_r8
1202 END DO
1203 END DO
1204 END IF
1205 END IF
1206 END IF
1207 END IF
1208!
1209!-----------------------------------------------------------------------
1210! East-West periodic boundary conditions.
1211!-----------------------------------------------------------------------
1212!
1213 IF (ewperiodic(ng)) THEN
1214 IF (nsperiodic(ng)) THEN
1215 jmin=jstr
1216 jmax=jend
1217 ELSE
1218 jmin=jstrr
1219 jmax=jendr
1220 END IF
1221!
1222 IF (ew_exchange) THEN
1223 IF (domain(ng)%Eastern_Edge(tile)) THEN
1224 DO k=lbk,ubk
1225 DO j=jmin,jmax
1226!^ tl_A(-2,j,k)=tl_A(Lm(ng)-2,j,k)
1227!^
1228 ad_a(lm(ng)-2,j,k)=ad_a(lm(ng)-2,j,k)+ &
1229 & ad_a(-2,j,k)
1230 ad_a(-2,j,k)=0.0_r8
1231!^ tl_A(-1,j,k)=tl_A(Lm(ng)-1,j,k)
1232!^
1233 ad_a(lm(ng)-1,j,k)=ad_a(lm(ng)-1,j,k)+ &
1234 & ad_a(-1,j,k)
1235 ad_a(-1,j,k)=0.0_r8
1236!^ tl_A( 0,j,k)=tl_A(Lm(ng) ,j,k)
1237!^
1238 ad_a(lm(ng) ,j,k)=ad_a(lm(ng) ,j,k)+ &
1239 & ad_a( 0,j,k)
1240 ad_a( 0,j,k)=0.0_r8
1241 END DO
1242 END DO
1243 END IF
1244
1245 IF (domain(ng)%Western_Edge(tile)) THEN
1246 DO k=lbk,ubk
1247 DO j=jmin,jmax
1248!^ tl_A(Lm(ng)+1,j,k)=tl_A(1,j,k)
1249!^
1250 ad_a(1,j,k)=ad_a(1,j,k)+ &
1251 & ad_a(lm(ng)+1,j,k)
1252 ad_a(lm(ng)+1,j,k)=0.0_r8
1253!^ tl_A(Lm(ng)+2,j,k)=tl_A( 2,j,k)
1254!^
1255 ad_a(2,j,k)=ad_a(2,j,k)+ &
1256 & ad_a(lm(ng)+2,j,k)
1257 ad_a(lm(ng)+2,j,k)=0.0_r8
1258 END DO
1259 END DO
1260 IF (nghostpoints.eq.3) THEN
1261 DO k=lbk,ubk
1262 DO j=jmin,jmax
1263!^ tl_A(Lm(ng)+3,j,k)=tl_A(3,j,k)
1264!^
1265 ad_a(3,j,k)=ad_a(3,j,k)+ &
1266 & ad_a(lm(ng)+3,j,k)
1267 ad_a(lm(ng)+3,j,k)=0.0_r8
1268 END DO
1269 END DO
1270 END IF
1271 END IF
1272 END IF
1273 END IF
1274
1275 RETURN
1276 END SUBROUTINE ad_exchange_u3d_tile
1277
1278!
1279!***********************************************************************
1280 SUBROUTINE ad_exchange_v3d_tile (ng, tile, &
1281 & LBi, UBi, LBj, UBj, LBk, UBk, &
1282 & ad_A)
1283!***********************************************************************
1284!
1285 USE mod_param
1286 USE mod_scalars
1287!
1288! Imported variable declarations.
1289!
1290 integer, intent(in) :: ng, tile
1291 integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
1292!
1293# ifdef ASSUMED_SHAPE
1294 real(r8), intent(inout) :: ad_A(LBi:,LBj:,LBk:)
1295# else
1296 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj,LBk:UBk)
1297# endif
1298!
1299! Local variable declarations.
1300!
1301 logical :: EW_exchange
1302 logical :: NS_exchange
1303
1304 integer :: Imin, Imax, Jmin, Jmax
1305 integer :: i, j, k
1306
1307# include "set_bounds.h"
1308!
1309!-----------------------------------------------------------------------
1310! Determine processing switches.
1311!-----------------------------------------------------------------------
1312!
1313 IF (ewperiodic(ng)) THEN
1314# ifdef DISTRIBUTE
1315 ew_exchange=ntilei(ng).eq.1
1316# else
1317 ew_exchange=.true.
1318# endif
1319 ELSE
1320 ew_exchange=.false.
1321 END IF
1322
1323 IF (nsperiodic(ng)) THEN
1324# ifdef DISTRIBUTE
1325 ns_exchange=ntilej(ng).eq.1
1326# else
1327 ns_exchange=.true.
1328# endif
1329 ELSE
1330 ns_exchange=.false.
1331 END IF
1332!
1333!-----------------------------------------------------------------------
1334! Boundary corners.
1335!-----------------------------------------------------------------------
1336!
1337 IF (ewperiodic(ng).and.nsperiodic(ng)) THEN
1338 IF (ew_exchange.and.ns_exchange) THEN
1339 IF (domain(ng)%NorthEast_Corner(tile)) THEN
1340 DO k=lbk,ubk
1341!^ tl_A(-2,-2,k)=tl_A(Lm(ng)-2,Mm(ng)-2,k)
1342!^
1343 ad_a(lm(ng)-2,mm(ng)-2,k)=ad_a(lm(ng)-2,mm(ng)-2,k)+ &
1344 & ad_a(-2,-2,k)
1345 ad_a(-2,-2,k)=0.0_r8
1346!^ tl_A(-2,-1,k)=tl_A(Lm(ng)-2,Mm(ng)-1,k)
1347!^
1348 ad_a(lm(ng)-2,mm(ng)-1,k)=ad_a(lm(ng)-2,mm(ng)-1,k)+ &
1349 & ad_a(-2,-1,k)
1350 ad_a(-2,-1,k)=0.0_r8
1351!^ tl_A(-2, 0,k)=tl_A(Lm(ng)-2,Mm(ng) ,k)
1352!^
1353 ad_a(lm(ng)-2,mm(ng) ,k)=ad_a(lm(ng)-2,mm(ng) ,k)+ &
1354 & ad_a(-2, 0,k)
1355 ad_a(-2, 0,k)=0.0_r8
1356!^ tl_A(-1,-2,k)=tl_A(Lm(ng)-1,Mm(ng)-2,k)
1357!^
1358 ad_a(lm(ng)-1,mm(ng)-2,k)=ad_a(lm(ng)-1,mm(ng)-2,k)+ &
1359 & ad_a(-1,-2,k)
1360 ad_a(-1,-2,k)=0.0_r8
1361!^ tl_A(-1,-1,k)=tl_A(Lm(ng)-1,Mm(ng)-1,k)
1362!^
1363 ad_a(lm(ng)-1,mm(ng)-1,k)=ad_a(lm(ng)-1,mm(ng)-1,k)+ &
1364 & ad_a(-1,-1,k)
1365 ad_a(-1,-1,k)=0.0_r8
1366!^ tl_A(-1, 0,k)=tl_A(Lm(ng)-1,Mm(ng) ,k)
1367!^
1368 ad_a(lm(ng)-1,mm(ng) ,k)=ad_a(lm(ng)-1,mm(ng) ,k)+ &
1369 & ad_a(-1, 0,k)
1370 ad_a(-1, 0,k)=0.0_r8
1371!^ tl_A( 0,-2,k)=tl_A(Lm(ng) ,Mm(ng)-2,k)
1372!^
1373 ad_a(lm(ng) ,mm(ng)-2,k)=ad_a(lm(ng) ,mm(ng)-2,k)+ &
1374 & ad_a( 0,-2,k)
1375 ad_a( 0,-2,k)=0.0_r8
1376!^ tl_A( 0,-1,k)=tl_A(Lm(ng) ,Mm(ng)-1,k)
1377!^
1378 ad_a(lm(ng) ,mm(ng)-1,k)=ad_a(lm(ng) ,mm(ng)-1,k)+ &
1379 & ad_a( 0,-1,k)
1380 ad_a( 0,-1,k)=0.0_r8
1381!^ tl_A( 0, 0,k)=tl_A(Lm(ng) ,Mm(ng) ,k)
1382!^
1383 ad_a(lm(ng) ,mm(ng) ,k)=ad_a(lm(ng) ,mm(ng) ,k)+ &
1384 & ad_a( 0, 0,k)
1385 ad_a( 0, 0,k)=0.0_r8
1386 END DO
1387 END IF
1388
1389 IF (domain(ng)%NorthWest_Corner(tile)) THEN
1390 DO k=lbk,ubk
1391!^ tl_A(Lm(ng)+1,-2,k)=tl_A( 1,Mm(ng)-2,k)
1392!^
1393 ad_a( 1,mm(ng)-2,k)=ad_a( 1,mm(ng)-2,k)+ &
1394 & ad_a(lm(ng)+1,-2,k)
1395 ad_a(lm(ng)+1,-2,k)=0.0_r8
1396!^ tl_A(Lm(ng)+1,-1,k)=tl_A( 1,Mm(ng)-1,k)
1397!^
1398 ad_a( 1,mm(ng)-1,k)=ad_a( 1,mm(ng)-1,k)+ &
1399 & ad_a(lm(ng)+1,-1,k)
1400 ad_a(lm(ng)+1,-1,k)=0.0_r8
1401!^ tl_A(Lm(ng)+1, 0,k)=tl_A( 1,Mm(ng) ,k)
1402!^
1403 ad_a( 1,mm(ng) ,k)=ad_a( 1,mm(ng) ,k)+ &
1404 & ad_a(lm(ng)+1, 0,k)
1405 ad_a(lm(ng)+1, 0,k)=0.0_r8
1406!^ tl_A(Lm(ng)+2,-2,k)=tl_A( 2,Mm(ng)-2,k)
1407!^
1408 ad_a( 2,mm(ng)-2,k)=ad_a( 2,mm(ng)-2,k)+ &
1409 & ad_a(lm(ng)+2,-2,k)
1410 ad_a(lm(ng)+2,-2,k)=0.0_r8
1411!^ tl_A(Lm(ng)+2,-1,k)=tl_A( 2,Mm(ng)-1,k)
1412!^
1413 ad_a( 2,mm(ng)-1,k)=ad_a( 2,mm(ng)-1,k)+ &
1414 & ad_a(lm(ng)+2,-1,k)
1415 ad_a(lm(ng)+2,-1,k)=0.0_r8
1416!^ tl_A(Lm(ng)+2, 0,k)=tl_A( 2,Mm(ng) ,k)
1417!^
1418 ad_a( 2,mm(ng) ,k)=ad_a( 2,mm(ng) ,k)+ &
1419 & ad_a(lm(ng)+2, 0,k)
1420 ad_a(lm(ng)+2, 0,k)=0.0_r8
1421 END DO
1422 IF (nghostpoints.eq.3) THEN
1423 DO k=lbk,ubk
1424!^ tl_A(Lm(ng)+3,-2,k)=tl_A(3 ,Mm(ng)-2,k)
1425!^
1426 ad_a(3 ,mm(ng)-2,k)=ad_a(3 ,mm(ng)-2,k)+ &
1427 & ad_a(lm(ng)+3,-2,k)
1428 ad_a(lm(ng)+3,-2,k)=0.0_r8
1429!^ tl_A(Lm(ng)+3,-1,k)=tl_A(3 ,Mm(ng)-1,k)
1430!^
1431 ad_a(3 ,mm(ng)-1,k)=ad_a(3 ,mm(ng)-1,k)+ &
1432 & ad_a(lm(ng)+3,-1,k)
1433 ad_a(lm(ng)+3,-1,k)=0.0_r8
1434!^ tl_A(Lm(ng)+3, 0,k)=tl_A(3 ,Mm(ng) ,k)
1435!^
1436 ad_a(3 ,mm(ng) ,k)=ad_a(3 ,mm(ng) ,k)+ &
1437 & ad_a(lm(ng)+3, 0,k)
1438 ad_a(lm(ng)+3, 0,k)=0.0_r8
1439 END DO
1440 END IF
1441 END IF
1442
1443 IF (domain(ng)%SouthEast_Corner(tile)) THEN
1444 DO k=lbk,ubk
1445!^ tl_A(-2,Mm(ng)+1,k)=tl_A(Lm(ng)-2, 1,k)
1446!^
1447 ad_a(lm(ng)-2, 1,k)=ad_a(lm(ng)-2, 1,k)+ &
1448 & ad_a(-2,mm(ng)+1,k)
1449 ad_a(-2,mm(ng)+1,k)=0.0_r8
1450!^ tl_A(-1,Mm(ng)+1,k)=tl_A(Lm(ng)-1, 1,k)
1451!^
1452 ad_a(lm(ng)-1, 1,k)=ad_a(lm(ng)-1, 1,k)+ &
1453 & ad_a(-1,mm(ng)+1,k)
1454 ad_a(-1,mm(ng)+1,k)=0.0_r8
1455!^ tl_A( 0,Mm(ng)+1,k)=tl_A(Lm(ng) , 1,k)
1456!^
1457 ad_a(lm(ng) , 1,k)=ad_a(lm(ng) , 1,k)+ &
1458 & ad_a( 0,mm(ng)+1,k)
1459 ad_a( 0,mm(ng)+1,k)=0.0_r8
1460!^ tl_A(-2,Mm(ng)+2,k)=tl_A(Lm(ng)-2, 2,k)
1461!^
1462 ad_a(lm(ng)-2, 2,k)=ad_a(lm(ng)-2, 2,k)+ &
1463 & ad_a(-2,mm(ng)+2,k)
1464 ad_a(-2,mm(ng)+2,k)=0.0_r8
1465!^ tl_A(-1,Mm(ng)+2,k)=tl_A(Lm(ng)-1, 2,k)
1466!^
1467 ad_a(lm(ng)-1, 2,k)=ad_a(lm(ng)-1, 2,k)+ &
1468 & ad_a(-1,mm(ng)+2,k)
1469 ad_a(-1,mm(ng)+2,k)=0.0_r8
1470!^ tl_A( 0,Mm(ng)+2,k)=tl_A(Lm(ng) , 2,k)
1471!^
1472 ad_a(lm(ng) , 2,k)=ad_a(lm(ng) , 2,k)+ &
1473 & ad_a( 0,mm(ng)+2,k)
1474 ad_a( 0,mm(ng)+2,k)=0.0_r8
1475 END DO
1476 IF (nghostpoints.eq.3) THEN
1477 DO k=lbk,ubk
1478!^ tl_A(-2,Mm(ng)+3,k)=tl_A(Lm(ng)-2, 3,k)
1479!^
1480 ad_a(lm(ng)-2, 3,k)=ad_a(lm(ng)-2, 3,k)+ &
1481 & ad_a(-2,mm(ng)+3,k)
1482 ad_a(-2,mm(ng)+3,k)=0.0_r8
1483!^ tl_A(-1,Mm(ng)+3,k)=tl_A(Lm(ng)-1, 3,k)
1484!^
1485 ad_a(lm(ng)-1, 3,k)=ad_a(lm(ng)-1, 3,k)+ &
1486 & ad_a(-1,mm(ng)+3,k)
1487 ad_a(-1,mm(ng)+3,k)=0.0_r8
1488!^ tl_A( 0,Mm(ng)+3,k)=tl_A(Lm(ng) , 3,k)
1489!^
1490 ad_a(lm(ng) , 3,k)=ad_a(lm(ng) , 3,k)+ &
1491 & ad_a( 0,mm(ng)+3,k)
1492 ad_a( 0,mm(ng)+3,k)=0.0_r8
1493 END DO
1494 END IF
1495 END IF
1496
1497 IF (domain(ng)%SouthWest_Corner(tile)) THEN
1498 DO k=lbk,ubk
1499!^ tl_A(Lm(ng)+1,Mm(ng)+1,k)=tl_A( 1, 1,k)
1500!^
1501 ad_a( 1, 1,k)=ad_a( 1, 1,k)+ &
1502 & ad_a(lm(ng)+1,mm(ng)+1,k)
1503 ad_a(lm(ng)+1,mm(ng)+1,k)=0.0_r8
1504!^ tl_A(Lm(ng)+1,Mm(ng)+2,k)=tl_A( 1, 2,k)
1505!^
1506 ad_a( 1, 2,k)=ad_a( 1, 2,k)+ &
1507 & ad_a(lm(ng)+1,mm(ng)+2,k)
1508 ad_a(lm(ng)+1,mm(ng)+2,k)=0.0_r8
1509!^ tl_A(Lm(ng)+2,Mm(ng)+1,k)=tl_A( 2, 1,k)
1510!^
1511 ad_a( 2, 1,k)=ad_a( 2, 1,k)+ &
1512 & ad_a(lm(ng)+2,mm(ng)+1,k)
1513 ad_a(lm(ng)+2,mm(ng)+1,k)=0.0_r8
1514!^ tl_A(Lm(ng)+2,Mm(ng)+2,k)=tl_A( 2, 2,k)
1515!^
1516 ad_a( 2, 2,k)=ad_a( 2, 2,k)+ &
1517 & ad_a(lm(ng)+2,mm(ng)+2,k)
1518 ad_a(lm(ng)+2,mm(ng)+2,k)=0.0_r8
1519 END DO
1520 IF (nghostpoints.eq.3) THEN
1521 DO k=lbk,ubk
1522!^ tl_A(Lm(ng)+1,Mm(ng)+3,k)=tl_A( 1, 3,k)
1523!^
1524 ad_a( 1, 3,k)=ad_a( 1, 3,k)+ &
1525 & ad_a(lm(ng)+1,mm(ng)+3,k)
1526 ad_a(lm(ng)+1,mm(ng)+3,k)=0.0_r8
1527!^ tl_A(Lm(ng)+2,Mm(ng)+3,k)=tl_A( 2, 3,k)
1528!^
1529 ad_a( 2, 3,k)=ad_a( 2, 3,k)+ &
1530 & ad_a(lm(ng)+2,mm(ng)+3,k)
1531 ad_a(lm(ng)+2,mm(ng)+3,k)=0.0_r8
1532!^ tl_A(Lm(ng)+3,Mm(ng)+1,k)=tl_A( 3, 1,k)
1533!^
1534 ad_a( 3, 1,k)=ad_a( 3, 1,k)+ &
1535 & ad_a(lm(ng)+3,mm(ng)+1,k)
1536 ad_a(lm(ng)+3,mm(ng)+1,k)=0.0_r8
1537!^ tl_A(Lm(ng)+3,Mm(ng)+2,k)=tl_A( 3, 2,k)
1538!^
1539 ad_a( 3, 2,k)=ad_a( 3, 2,k)+ &
1540 & ad_a(lm(ng)+3,mm(ng)+2,k)
1541 ad_a(lm(ng)+3,mm(ng)+2,k)=0.0_r8
1542!^ tl_A(Lm(ng)+3,Mm(ng)+3,k)=tl_A( 3, 3,k)
1543!^
1544 ad_a( 3, 3,k)=ad_a( 3, 3,k)+ &
1545 & ad_a(lm(ng)+3,mm(ng)+3,k)
1546 ad_a(lm(ng)+3,mm(ng)+3,k)=0.0_r8
1547 END DO
1548 END IF
1549 END IF
1550 END IF
1551 END IF
1552!
1553!-----------------------------------------------------------------------
1554! North-South periodic boundary conditions.
1555!-----------------------------------------------------------------------
1556!
1557 IF (nsperiodic(ng)) THEN
1558 IF (ewperiodic(ng)) THEN
1559 imin=istr
1560 imax=iend
1561 ELSE
1562 imin=istrr
1563 imax=iendr
1564 END IF
1565!
1566 IF (ns_exchange) THEN
1567 IF (domain(ng)%Northern_Edge(tile)) THEN
1568 DO k=lbk,ubk
1569 DO i=imin,imax
1570!^ tl_A(i,-2,k)=tl_A(i,Mm(ng)-2,k)
1571!^
1572 ad_a(i,mm(ng)-2,k)=ad_a(i,mm(ng)-2,k)+ &
1573 & ad_a(i,-2,k)
1574 ad_a(i,-2,k)=0.0_r8
1575!^ tl_A(i,-1,k)=tl_A(i,Mm(ng)-1,k)
1576!^
1577 ad_a(i,mm(ng)-1,k)=ad_a(i,mm(ng)-1,k)+ &
1578 & ad_a(i,-1,k)
1579 ad_a(i,-1,k)=0.0_r8
1580!^ tl_A(i, 0,k)=tl_A(i,Mm(ng) ,k)
1581!^
1582 ad_a(i,mm(ng) ,k)=ad_a(i,mm(ng) ,k)+ &
1583 & ad_a(i, 0,k)
1584 ad_a(i, 0,k)=0.0_r8
1585 END DO
1586 END DO
1587 END IF
1588
1589 IF (domain(ng)%Southern_Edge(tile)) THEN
1590 DO k=lbk,ubk
1591 DO i=imin,imax
1592!^ tl_A(i,Mm(ng)+1,k)=tl_A(i,1,k)
1593!^
1594 ad_a(i,1,k)=ad_a(i,1,k)+ &
1595 & ad_a(i,mm(ng)+1,k)
1596 ad_a(i,mm(ng)+1,k)=0.0_r8
1597!^ tl_A(i,Mm(ng)+2,k)=tl_A(i, 2,k)
1598!^
1599 ad_a(i,2,k)=ad_a(i,2,k)+ &
1600 & ad_a(i,mm(ng)+2,k)
1601 ad_a(i,mm(ng)+2,k)=0.0_r8
1602 END DO
1603 END DO
1604 IF (nghostpoints.eq.3) THEN
1605 DO k=lbk,ubk
1606 DO i=imin,imax
1607!^ tl_A(i,Mm(ng)+3,k)=tl_A(i,3,k)
1608!^
1609 ad_a(i,3,k)=ad_a(i,3,k)+ &
1610 & ad_a(i,mm(ng)+3,k)
1611 ad_a(i,mm(ng)+3,k)=0.0_r8
1612 END DO
1613 END DO
1614 END IF
1615 END IF
1616 END IF
1617 END IF
1618!
1619!-----------------------------------------------------------------------
1620! East-West periodic boundary conditions.
1621!-----------------------------------------------------------------------
1622!
1623 IF (ewperiodic(ng)) THEN
1624 IF (nsperiodic(ng)) THEN
1625 jmin=jstr
1626 jmax=jend
1627 ELSE
1628 jmin=jstr
1629 jmax=jendr
1630 END IF
1631!
1632 IF (ew_exchange) THEN
1633 IF (domain(ng)%Eastern_Edge(tile)) THEN
1634 DO k=lbk,ubk
1635 DO j=jmin,jmax
1636!^ tl_A(-2,j,k)=tl_A(Lm(ng)-2,j,k)
1637!^
1638 ad_a(lm(ng)-2,j,k)=ad_a(lm(ng)-2,j,k)+ &
1639 & ad_a(-2,j,k)
1640 ad_a(-2,j,k)=0.0_r8
1641!^ tl_A(-1,j,k)=tl_A(Lm(ng)-1,j,k)
1642!^
1643 ad_a(lm(ng)-1,j,k)=ad_a(lm(ng)-1,j,k)+ &
1644 & ad_a(-1,j,k)
1645 ad_a(-1,j,k)=0.0_r8
1646!^ tl_A( 0,j,k)=tl_A(Lm(ng) ,j,k)
1647!^
1648 ad_a(lm(ng) ,j,k)=ad_a(lm(ng) ,j,k)+ &
1649 & ad_a( 0,j,k)
1650 ad_a( 0,j,k)=0.0_r8
1651 END DO
1652 END DO
1653 END IF
1654
1655 IF (domain(ng)%Western_Edge(tile)) THEN
1656 DO k=lbk,ubk
1657 DO j=jmin,jmax
1658!^ tl_A(Lm(ng)+1,j,k)=tl_A(1,j,k)
1659!^
1660 ad_a(1,j,k)=ad_a(1,j,k)+ &
1661 & ad_a(lm(ng)+1,j,k)
1662 ad_a(lm(ng)+1,j,k)=0.0_r8
1663!^ tl_A(Lm(ng)+2,j,k)=tl_A( 2,j,k)
1664!^
1665 ad_a(2,j,k)=ad_a(2,j,k)+ &
1666 & ad_a(lm(ng)+2,j,k)
1667 ad_a(lm(ng)+2,j,k)=0.0_r8
1668 END DO
1669 END DO
1670 IF (nghostpoints.eq.3) THEN
1671 DO k=lbk,ubk
1672 DO j=jmin,jmax
1673!^ tl_A(Lm(ng)+3,j,k)=tl_A(3,j,k)
1674!^
1675 ad_a(3,j,k)=ad_a(3,j,k)+ &
1676 & ad_a(lm(ng)+3,j,k)
1677 ad_a(lm(ng)+3,j,k)=0.0_r8
1678 END DO
1679 END DO
1680 END IF
1681 END IF
1682 END IF
1683 END IF
1684
1685 RETURN
1686 END SUBROUTINE ad_exchange_v3d_tile
1687
1688!
1689!***********************************************************************
1690 SUBROUTINE ad_exchange_w3d_tile (ng, tile, &
1691 & LBi, UBi, LBj, UBj, LBk, UBk, &
1692 & ad_A)
1693!***********************************************************************
1694!
1695 USE mod_param
1696 USE mod_scalars
1697!
1698! Imported variable declarations.
1699!
1700 integer, intent(in) :: ng, tile
1701 integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
1702!
1703# ifdef ASSUMED_SHAPE
1704 real(r8), intent(inout) :: ad_A(LBi:,LBj:,LBk:)
1705# else
1706 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj,LBk:UBk)
1707# endif
1708!
1709! Local variable declarations.
1710!
1711 logical :: EW_exchange
1712 logical :: NS_exchange
1713
1714 integer :: Imin, Imax, Jmin, Jmax
1715 integer :: i, j, k
1716
1717# include "set_bounds.h"
1718!
1719!-----------------------------------------------------------------------
1720! Determine processing switches.
1721!-----------------------------------------------------------------------
1722!
1723 IF (ewperiodic(ng)) THEN
1724# ifdef DISTRIBUTE
1725 ew_exchange=ntilei(ng).eq.1
1726# else
1727 ew_exchange=.true.
1728# endif
1729 ELSE
1730 ew_exchange=.false.
1731 END IF
1732
1733 IF (nsperiodic(ng)) THEN
1734# ifdef DISTRIBUTE
1735 ns_exchange=ntilej(ng).eq.1
1736# else
1737 ns_exchange=.true.
1738# endif
1739 ELSE
1740 ns_exchange=.false.
1741 END IF
1742!
1743!-----------------------------------------------------------------------
1744! Boundary corners.
1745!-----------------------------------------------------------------------
1746!
1747 IF (ewperiodic(ng).and.nsperiodic(ng)) THEN
1748 IF (ew_exchange.and.ns_exchange) THEN
1749 IF (domain(ng)%NorthEast_Corner(tile)) THEN
1750 DO k=lbk,ubk
1751!^ tl_A(-2,-2,k)=tl_A(Lm(ng)-2,Mm(ng)-2,k)
1752!^
1753 ad_a(lm(ng)-2,mm(ng)-2,k)=ad_a(lm(ng)-2,mm(ng)-2,k)+ &
1754 & ad_a(-2,-2,k)
1755 ad_a(-2,-2,k)=0.0_r8
1756!^ tl_A(-2,-1,k)=tl_A(Lm(ng)-2,Mm(ng)-1,k)
1757!^
1758 ad_a(lm(ng)-2,mm(ng)-1,k)=ad_a(lm(ng)-2,mm(ng)-1,k)+ &
1759 & ad_a(-2,-1,k)
1760 ad_a(-2,-1,k)=0.0_r8
1761!^ tl_A(-2, 0,k)=tl_A(Lm(ng)-2,Mm(ng) ,k)
1762!^
1763 ad_a(lm(ng)-2,mm(ng) ,k)=ad_a(lm(ng)-2,mm(ng) ,k)+ &
1764 & ad_a(-2, 0,k)
1765 ad_a(-2, 0,k)=0.0_r8
1766!^ tl_A(-1,-2,k)=tl_A(Lm(ng)-1,Mm(ng)-2,k)
1767!^
1768 ad_a(lm(ng)-1,mm(ng)-2,k)=ad_a(lm(ng)-1,mm(ng)-2,k)+ &
1769 & ad_a(-1,-2,k)
1770 ad_a(-1,-2,k)=0.0_r8
1771!^ tl_A(-1,-1,k)=tl_A(Lm(ng)-1,Mm(ng)-1,k)
1772!^
1773 ad_a(lm(ng)-1,mm(ng)-1,k)=ad_a(lm(ng)-1,mm(ng)-1,k)+ &
1774 & ad_a(-1,-1,k)
1775 ad_a(-1,-1,k)=0.0_r8
1776!^ tl_A(-1, 0,k)=tl_A(Lm(ng)-1,Mm(ng) ,k)
1777!^
1778 ad_a(lm(ng)-1,mm(ng) ,k)=ad_a(lm(ng)-1,mm(ng) ,k)+ &
1779 & ad_a(-1, 0,k)
1780 ad_a(-1, 0,k)=0.0_r8
1781!^ tl_A( 0,-2,k)=tl_A(Lm(ng) ,Mm(ng)-2,k)
1782!^
1783 ad_a(lm(ng) ,mm(ng)-2,k)=ad_a(lm(ng) ,mm(ng)-2,k)+ &
1784 & ad_a( 0,-2,k)
1785 ad_a( 0,-2,k)=0.0_r8
1786!^ tl_A( 0,-1,k)=tl_A(Lm(ng) ,Mm(ng)-1,k)
1787!^
1788 ad_a(lm(ng) ,mm(ng)-1,k)=ad_a(lm(ng) ,mm(ng)-1,k)+ &
1789 & ad_a( 0,-1,k)
1790 ad_a( 0,-1,k)=0.0_r8
1791!^ tl_A( 0, 0,k)=tl_A(Lm(ng) ,Mm(ng) ,k)
1792!^
1793 ad_a(lm(ng) ,mm(ng) ,k)=ad_a(lm(ng) ,mm(ng) ,k)+ &
1794 & ad_a( 0, 0,k)
1795 ad_a( 0, 0,k)=0.0_r8
1796 END DO
1797 END IF
1798
1799 IF (domain(ng)%NorthWest_Corner(tile)) THEN
1800 DO k=lbk,ubk
1801!^ tl_A(Lm(ng)+1,-2,k)=tl_A( 1,Mm(ng)-2,k)
1802!^
1803 ad_a( 1,mm(ng)-2,k)=ad_a( 1,mm(ng)-2,k)+ &
1804 & ad_a(lm(ng)+1,-2,k)
1805 ad_a(lm(ng)+1,-2,k)=0.0_r8
1806!^ tl_A(Lm(ng)+1,-1,k)=tl_A( 1,Mm(ng)-1,k)
1807!^
1808 ad_a( 1,mm(ng)-1,k)=ad_a( 1,mm(ng)-1,k)+ &
1809 & ad_a(lm(ng)+1,-1,k)
1810 ad_a(lm(ng)+1,-1,k)=0.0_r8
1811!^ tl_A(Lm(ng)+1, 0,k)=tl_A( 1,Mm(ng) ,k)
1812!^
1813 ad_a( 1,mm(ng) ,k)=ad_a( 1,mm(ng) ,k)+ &
1814 & ad_a(lm(ng)+1, 0,k)
1815 ad_a(lm(ng)+1, 0,k)=0.0_r8
1816!^ tl_A(Lm(ng)+2,-2,k)=tl_A( 2,Mm(ng)-2,k)
1817!^
1818 ad_a( 2,mm(ng)-2,k)=ad_a( 2,mm(ng)-2,k)+ &
1819 & ad_a(lm(ng)+2,-2,k)
1820 ad_a(lm(ng)+2,-2,k)=0.0_r8
1821!^ tl_A(Lm(ng)+2,-1,k)=tl_A( 2,Mm(ng)-1,k)
1822!^
1823 ad_a( 2,mm(ng)-1,k)=ad_a( 2,mm(ng)-1,k)+ &
1824 & ad_a(lm(ng)+2,-1,k)
1825 ad_a(lm(ng)+2,-1,k)=0.0_r8
1826!^ tl_A(Lm(ng)+2, 0,k)=tl_A( 2,Mm(ng) ,k)
1827!^
1828 ad_a( 2,mm(ng) ,k)=ad_a( 2,mm(ng) ,k)+ &
1829 & ad_a(lm(ng)+2, 0,k)
1830 ad_a(lm(ng)+2, 0,k)=0.0_r8
1831 END DO
1832 IF (nghostpoints.eq.3) THEN
1833 DO k=lbk,ubk
1834!^ tl_A(Lm(ng)+3,-2,k)=tl_A(3 ,Mm(ng)-2,k)
1835!^
1836 ad_a(3 ,mm(ng)-2,k)=ad_a(3 ,mm(ng)-2,k)+ &
1837 & ad_a(lm(ng)+3,-2,k)
1838 ad_a(lm(ng)+3,-2,k)=0.0_r8
1839!^ tl_A(Lm(ng)+3,-1,k)=tl_A(3 ,Mm(ng)-1,k)
1840!^
1841 ad_a(3 ,mm(ng)-1,k)=ad_a(3 ,mm(ng)-1,k)+ &
1842 & ad_a(lm(ng)+3,-1,k)
1843 ad_a(lm(ng)+3,-1,k)=0.0_r8
1844!^ tl_A(Lm(ng)+3, 0,k)=tl_A(3 ,Mm(ng) ,k)
1845!^
1846 ad_a(3 ,mm(ng) ,k)=ad_a(3 ,mm(ng) ,k)+ &
1847 & ad_a(lm(ng)+3, 0,k)
1848 ad_a(lm(ng)+3, 0,k)=0.0_r8
1849 END DO
1850 END IF
1851 END IF
1852
1853 IF (domain(ng)%SouthEast_Corner(tile)) THEN
1854 DO k=lbk,ubk
1855!^ tl_A(-2,Mm(ng)+1,k)=tl_A(Lm(ng)-2, 1,k)
1856!^
1857 ad_a(lm(ng)-2, 1,k)=ad_a(lm(ng)-2, 1,k)+ &
1858 & ad_a(-2,mm(ng)+1,k)
1859 ad_a(-2,mm(ng)+1,k)=0.0_r8
1860!^ tl_A(-1,Mm(ng)+1,k)=tl_A(Lm(ng)-1, 1,k)
1861!^
1862 ad_a(lm(ng)-1, 1,k)=ad_a(lm(ng)-1, 1,k)+ &
1863 & ad_a(-1,mm(ng)+1,k)
1864 ad_a(-1,mm(ng)+1,k)=0.0_r8
1865!^ tl_A( 0,Mm(ng)+1,k)=tl_A(Lm(ng) , 1,k)
1866!^
1867 ad_a(lm(ng) , 1,k)=ad_a(lm(ng) , 1,k)+ &
1868 & ad_a( 0,mm(ng)+1,k)
1869 ad_a( 0,mm(ng)+1,k)=0.0_r8
1870!^ tl_A(-2,Mm(ng)+2,k)=tl_A(Lm(ng)-2, 2,k)
1871!^
1872 ad_a(lm(ng)-2, 2,k)=ad_a(lm(ng)-2, 2,k)+ &
1873 & ad_a(-2,mm(ng)+2,k)
1874 ad_a(-2,mm(ng)+2,k)=0.0_r8
1875!^ tl_A(-1,Mm(ng)+2,k)=tl_A(Lm(ng)-1, 2,k)
1876!^
1877 ad_a(lm(ng)-1, 2,k)=ad_a(lm(ng)-1, 2,k)+ &
1878 & ad_a(-1,mm(ng)+2,k)
1879 ad_a(-1,mm(ng)+2,k)=0.0_r8
1880!^ tl_A( 0,Mm(ng)+2,k)=tl_A(Lm(ng) , 2,k)
1881!^
1882 ad_a(lm(ng) , 2,k)=ad_a(lm(ng) , 2,k)+ &
1883 & ad_a( 0,mm(ng)+2,k)
1884 ad_a( 0,mm(ng)+2,k)=0.0_r8
1885 END DO
1886 IF (nghostpoints.eq.3) THEN
1887 DO k=lbk,ubk
1888!^ tl_A(-2,Mm(ng)+3,k)=tl_A(Lm(ng)-2, 3,k)
1889!^
1890 ad_a(lm(ng)-2, 3,k)=ad_a(lm(ng)-2, 3,k)+ &
1891 & ad_a(-2,mm(ng)+3,k)
1892 ad_a(-2,mm(ng)+3,k)=0.0_r8
1893!^ tl_A(-1,Mm(ng)+3,k)=tl_A(Lm(ng)-1, 3,k)
1894!^
1895 ad_a(lm(ng)-1, 3,k)=ad_a(lm(ng)-1, 3,k)+ &
1896 & ad_a(-1,mm(ng)+3,k)
1897 ad_a(-1,mm(ng)+3,k)=0.0_r8
1898!^ tl_A( 0,Mm(ng)+3,k)=tl_A(Lm(ng) , 3,k)
1899!^
1900 ad_a(lm(ng) , 3,k)=ad_a(lm(ng) , 3,k)+ &
1901 & ad_a( 0,mm(ng)+3,k)
1902 ad_a( 0,mm(ng)+3,k)=0.0_r8
1903 END DO
1904 END IF
1905 END IF
1906
1907 IF (domain(ng)%SouthWest_Corner(tile)) THEN
1908 DO k=lbk,ubk
1909!^ tl_A(Lm(ng)+1,Mm(ng)+1,k)=tl_A( 1, 1,k)
1910!^
1911 ad_a( 1, 1,k)=ad_a( 1, 1,k)+ &
1912 & ad_a(lm(ng)+1,mm(ng)+1,k)
1913 ad_a(lm(ng)+1,mm(ng)+1,k)=0.0_r8
1914!^ tl_A(Lm(ng)+1,Mm(ng)+2,k)=tl_A( 1, 2,k)
1915!^
1916 ad_a( 1, 2,k)=ad_a( 1, 2,k)+ &
1917 & ad_a(lm(ng)+1,mm(ng)+2,k)
1918 ad_a(lm(ng)+1,mm(ng)+2,k)=0.0_r8
1919!^ tl_A(Lm(ng)+2,Mm(ng)+1,k)=tl_A( 2, 1,k)
1920!^
1921 ad_a( 2, 1,k)=ad_a( 2, 1,k)+ &
1922 & ad_a(lm(ng)+2,mm(ng)+1,k)
1923 ad_a(lm(ng)+2,mm(ng)+1,k)=0.0_r8
1924!^ tl_A(Lm(ng)+2,Mm(ng)+2,k)=tl_A( 2, 2,k)
1925!^
1926 ad_a( 2, 2,k)=ad_a( 2, 2,k)+ &
1927 & ad_a(lm(ng)+2,mm(ng)+2,k)
1928 ad_a(lm(ng)+2,mm(ng)+2,k)=0.0_r8
1929 END DO
1930 IF (nghostpoints.eq.3) THEN
1931 DO k=lbk,ubk
1932!^ tl_A(Lm(ng)+1,Mm(ng)+3,k)=tl_A( 1, 3,k)
1933!^
1934 ad_a( 1, 3,k)=ad_a( 1, 3,k)+ &
1935 & ad_a(lm(ng)+1,mm(ng)+3,k)
1936 ad_a(lm(ng)+1,mm(ng)+3,k)=0.0_r8
1937!^ tl_A(Lm(ng)+2,Mm(ng)+3,k)=tl_A( 2, 3,k)
1938!^
1939 ad_a( 2, 3,k)=ad_a( 2, 3,k)+ &
1940 & ad_a(lm(ng)+2,mm(ng)+3,k)
1941 ad_a(lm(ng)+2,mm(ng)+3,k)=0.0_r8
1942!^ tl_A(Lm(ng)+3,Mm(ng)+1,k)=tl_A( 3, 1,k)
1943!^
1944 ad_a( 3, 1,k)=ad_a( 3, 1,k)+ &
1945 & ad_a(lm(ng)+3,mm(ng)+1,k)
1946 ad_a(lm(ng)+3,mm(ng)+1,k)=0.0_r8
1947!^ tl_A(Lm(ng)+3,Mm(ng)+2,k)=tl_A( 3, 2,k)
1948!^
1949 ad_a( 3, 2,k)=ad_a( 3, 2,k)+ &
1950 & ad_a(lm(ng)+3,mm(ng)+2,k)
1951 ad_a(lm(ng)+3,mm(ng)+2,k)=0.0_r8
1952!^ tl_A(Lm(ng)+3,Mm(ng)+3,k)=tl_A( 3, 3,k)
1953!^
1954 ad_a( 3, 3,k)=ad_a( 3, 3,k)+ &
1955 & ad_a(lm(ng)+3,mm(ng)+3,k)
1956 ad_a(lm(ng)+3,mm(ng)+3,k)=0.0_r8
1957 END DO
1958 END IF
1959 END IF
1960 END IF
1961 END IF
1962!
1963!-----------------------------------------------------------------------
1964! North-South periodic boundary conditions.
1965!-----------------------------------------------------------------------
1966!
1967 IF (nsperiodic(ng)) THEN
1968 IF (ewperiodic(ng)) THEN
1969 imin=istr
1970 imax=iend
1971 ELSE
1972 imin=istrr
1973 imax=iendr
1974 END IF
1975!
1976 IF (ns_exchange) THEN
1977 IF (domain(ng)%Northern_Edge(tile)) THEN
1978 DO k=lbk,ubk
1979 DO i=imin,imax
1980!^ tl_A(i,-2,k)=tl_A(i,Mm(ng)-2,k)
1981!^
1982 ad_a(i,mm(ng)-2,k)=ad_a(i,mm(ng)-2,k)+ &
1983 & ad_a(i,-2,k)
1984 ad_a(i,-2,k)=0.0_r8
1985!^ tl_A(i,-1,k)=tl_A(i,Mm(ng)-1,k)
1986!^
1987 ad_a(i,mm(ng)-1,k)=ad_a(i,mm(ng)-1,k)+ &
1988 & ad_a(i,-1,k)
1989 ad_a(i,-1,k)=0.0_r8
1990!^ tl_A(i, 0,k)=tl_A(i,Mm(ng) ,k)
1991!^
1992 ad_a(i,mm(ng) ,k)=ad_a(i,mm(ng) ,k)+ &
1993 & ad_a(i, 0,k)
1994 ad_a(i, 0,k)=0.0_r8
1995 END DO
1996 END DO
1997 END IF
1998
1999 IF (domain(ng)%Southern_Edge(tile)) THEN
2000 DO k=lbk,ubk
2001 DO i=imin,imax
2002!^ tl_A(i,Mm(ng)+1,k)=tl_A(i,1,k)
2003!^
2004 ad_a(i,1,k)=ad_a(i,1 ,k)+ &
2005 & ad_a(i,mm(ng)+1,k)
2006 ad_a(i,mm(ng)+1,k)=0.0_r8
2007!^ tl_A(i,Mm(ng)+2,k)=tl_A(i,2,k)
2008!^
2009 ad_a(i,2,k)=ad_a(i,2,k)+ &
2010 & ad_a(i,mm(ng)+2,k)
2011 ad_a(i,mm(ng)+2,k)=0.0_r8
2012 END DO
2013 END DO
2014 IF (nghostpoints.eq.3) THEN
2015 DO k=lbk,ubk
2016 DO i=imin,imax
2017!^ tl_A(i,Mm(ng)+3,k)=tl_A(i,3,k)
2018!^
2019 ad_a(i,3,k)=ad_a(i,3,k)+ &
2020 & ad_a(i,mm(ng)+3,k)
2021 ad_a(i,mm(ng)+3,k)=0.0_r8
2022 END DO
2023 END DO
2024 END IF
2025 END IF
2026 END IF
2027 END IF
2028!
2029!-----------------------------------------------------------------------
2030! East-West periodic boundary conditions.
2031!-----------------------------------------------------------------------
2032!
2033 IF (ewperiodic(ng)) THEN
2034 IF (nsperiodic(ng)) THEN
2035 jmin=jstr
2036 jmax=jend
2037 ELSE
2038 jmin=jstrr
2039 jmax=jendr
2040 END IF
2041!
2042 IF (ew_exchange) THEN
2043 IF (domain(ng)%Eastern_Edge(tile)) THEN
2044 DO k=lbk,ubk
2045 DO j=jmin,jmax
2046!^ tl_A(-2,j,k)=tl_A(Lm(ng)-2,j,k)
2047!^
2048 ad_a(lm(ng)-2,j,k)=ad_a(lm(ng)-2,j,k)+ &
2049 & ad_a(-2,j,k)
2050 ad_a(-2,j,k)=0.0_r8
2051!^ tl_A(-1,j,k)=tl_A(Lm(ng)-1,j,k)
2052!^
2053 ad_a(lm(ng)-1,j,k)=ad_a(lm(ng)-1,j,k)+ &
2054 & ad_a(-1,j,k)
2055 ad_a(-1,j,k)=0.0_r8
2056!^ tl_A( 0,j,k)=tl_A(Lm(ng) ,j,k)
2057!^
2058 ad_a(lm(ng) ,j,k)=ad_a(lm(ng) ,j,k)+ &
2059 & ad_a( 0,j,k)
2060 ad_a( 0,j,k)=0.0_r8
2061 END DO
2062 END DO
2063 END IF
2064
2065 IF (domain(ng)%Western_Edge(tile)) THEN
2066 DO k=lbk,ubk
2067 DO j=jmin,jmax
2068!^ tl_A(Lm(ng)+1,j,k)=tl_A(1,j,k)
2069!^
2070 ad_a(1,j,k)=ad_a(1,j,k)+ &
2071 & ad_a(lm(ng)+1,j,k)
2072 ad_a(lm(ng)+1,j,k)=0.0_r8
2073!^ tl_A(Lm(ng)+2,j,k)=tl_A( 2,j,k)
2074!^
2075 ad_a(2,j,k)=ad_a(2,j,k)+ &
2076 & ad_a(lm(ng)+2,j,k)
2077 ad_a(lm(ng)+2,j,k)=0.0_r8
2078 END DO
2079 END DO
2080 IF (nghostpoints.eq.3) THEN
2081 DO k=lbk,ubk
2082 DO j=jmin,jmax
2083!^ tl_A(Lm(ng)+3,j,k)=tl_A(3,j,k)
2084!^
2085 ad_a(3,j,k)=ad_a(3,j,k)+ &
2086 & ad_a(lm(ng)+3,j,k)
2087 ad_a(lm(ng)+3,j,k)=0.0_r8
2088 END DO
2089 END DO
2090 END IF
2091 END IF
2092 END IF
2093 END IF
2094
2095 RETURN
2096 END SUBROUTINE ad_exchange_w3d_tile
2097#endif
2098 END MODULE ad_exchange_3d_mod
ad_exchange_3d_mod
Definition ad_exchange_3d.F:2
ad_exchange_3d_mod::ad_exchange_v3d_tile
subroutine ad_exchange_v3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_exchange_3d.F:1283
ad_exchange_3d_mod::ad_exchange_w3d_tile
subroutine ad_exchange_w3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_exchange_3d.F:1693
ad_exchange_3d_mod::ad_exchange_p3d_tile
subroutine ad_exchange_p3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_exchange_3d.F:49
ad_exchange_3d_mod::ad_exchange_r3d_tile
subroutine ad_exchange_r3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_exchange_3d.F:461
ad_exchange_3d_mod::ad_exchange_u3d_tile
subroutine ad_exchange_u3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, ad_a)
Definition ad_exchange_3d.F:872
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