104
105
109
111#ifdef DISTRIBUTE
113# ifdef SOLVE3D
115# endif
116#endif
117
118
119
120 integer, intent(in) :: ng, tile, model
121 integer, intent(in) :: LBi, UBi, LBj, UBj
122 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
123
124#ifdef SOLVE3D
125 real(r8), intent(out) :: diffusion2(MT), diffusion4(MT)
126#endif
127 real(r8), intent(out) :: viscosity2, viscosity4
128
129#ifdef ASSUMED_SHAPE
130 real(r8), intent(in) :: grdscl(LBi:,LBj:)
131# ifdef SOLVE3D
132# ifdef TS_DIF2
133 real(r8), intent(inout) :: diff2(LBi:,LBj:,:)
134# endif
135# ifdef TS_DIF4
136 real(r8), intent(inout) :: diff4(LBi:,LBj:,:)
137# endif
138# endif
139# if defined UV_VIS2
140 real(r8), intent(inout) :: visc2_p(LBi:,LBj:)
141 real(r8), intent(inout) :: visc2_r(LBi:,LBj:)
142# endif
143# ifdef UV_VIS4
144 real(r8), intent(inout) :: visc4_p(LBi:,LBj:)
145 real(r8), intent(inout) :: visc4_r(LBi:,LBj:)
146# endif
147#else
148 real(r8), intent(in) :: grdscl(LBi:UBi,LBj:UBj)
149# ifdef SOLVE3D
150# ifdef TS_DIF2
151 real(r8), intent(inout) :: diff2(LBi:UBi,LBj:UBj,NT(ng))
152# endif
153# ifdef TS_DIF4
154 real(r8), intent(inout) :: diff4(LBi:UBi,LBj:UBj,NT(ng))
155# endif
156# endif
157# if defined UV_VIS2
158 real(r8), intent(inout) :: visc2_p(LBi:UBi,LBj:UBj)
159 real(r8), intent(inout) :: visc2_r(LBi:UBi,LBj:UBj)
160# endif
161# ifdef UV_VIS4
162 real(r8), intent(inout) :: visc4_p(LBi:UBi,LBj:UBj)
163 real(r8), intent(inout) :: visc4_r(LBi:UBi,LBj:UBj)
164# endif
165#endif
166
167
168
169 integer :: Imin, Imax, Jmin, Jmax
170 integer :: i, j
171#ifdef SOLVE3D
172 integer :: itrc
173#endif
174 real(r8) :: cff
175
176#include "set_bounds.h"
177
178
179
180
181
182 IF (model.eq.
inlm)
THEN
185#ifdef SOLVE3D
187 diffusion2(itrc)=
nl_tnu2(itrc,ng)
188 diffusion4(itrc)=
nl_tnu4(itrc,ng)
189 END DO
190#endif
191#if defined TANGENT || defined TL_IOMS
192 ELSE IF ((model.eq.
itlm).or.(model.eq.
irpm))
THEN
195# ifdef SOLVE3D
197 diffusion2(itrc)=
tl_tnu2(itrc,ng)
198 diffusion4(itrc)=
tl_tnu4(itrc,ng)
199 END DO
200# endif
201#endif
202#ifdef ADJOINT
203 ELSE IF (model.eq.
iadm)
THEN
206# ifdef SOLVE3D
208 diffusion2(itrc)=
ad_tnu2(itrc,ng)
209 diffusion4(itrc)=
ad_tnu4(itrc,ng)
210 END DO
211# endif
212#endif
213 END IF
214
215
216
217 IF (
domain(ng)%SouthWest_Test(tile))
THEN
220#ifdef SOLVE3D
222 tnu2(itrc,ng)=diffusion2(itrc)
223 tnu4(itrc,ng)=diffusion4(itrc)
224 END DO
225#endif
226 END IF
227
228#if defined UV_VIS2 || defined UV_VIS4 || \
229 ((defined ts_dif2 || defined ts_dif4) && defined solve3d)
230
231
232
233
234
235# ifdef _OPENMP
236 IF (
domain(ng)%Western_Edge(tile))
THEN
238 ELSE
239 imin=istr
240 END IF
241 IF (
domain(ng)%Eastern_Edge(tile))
THEN
243 ELSE
244 imax=iend
245 END IF
246 IF (
domain(ng)%Southern_Edge(tile))
THEN
248 ELSE
249 jmin=jstr
250 END IF
251 IF (
domain(ng)%Northern_Edge(tile))
THEN
253 ELSE
254 jmax=jend
255 END IF
256# else
261# endif
262
263# if defined UV_VIS2
264 DO j=jmin,jmax
265 DO i=imin,imax
266 visc2_p(i,j)=viscosity2
267 visc2_r(i,j)=viscosity2
268 END DO
269 END DO
270# endif
271# ifdef UV_VIS4
272 DO j=jmin,jmax
273 DO i=imin,imax
274 visc4_p(i,j)=viscosity4
275 visc4_r(i,j)=viscosity4
276 END DO
277 END DO
278# endif
279# ifdef SOLVE3D
280# ifdef TS_DIF2
282 DO j=jmin,jmax
283 DO i=imin,imax
284 diff2(i,j,itrc)=diffusion2(itrc)
285 END DO
286 END DO
287 END DO
288# endif
289# ifdef TS_DIF4
291 DO j=jmin,jmax
292 DO i=imin,imax
293 diff4(i,j,itrc)=diffusion4(itrc)
294 END DO
295 END DO
296 END DO
297# endif
298# endif
299#endif
300
301#ifdef VISC_GRID
302
303
304
305
306
307
308# ifdef UV_VIS2
310 DO j=jstrt,jendt
311 DO i=istrt,iendt
312 visc2_r(i,j)=cff*grdscl(i,j)
313 END DO
314 END DO
315 cff=0.25_r8*cff
316 DO j=jstrp,jendt
317 DO i=istrp,iendt
318 visc2_p(i,j)=cff*(grdscl(i-1,j-1)+grdscl(i,j-1)+ &
319 & grdscl(i-1,j )+grdscl(i,j ))
320 END DO
321 END DO
322# endif
323# ifdef UV_VIS4
324 cff=viscosity4/(
grdmax(ng)**3)
325 DO j=jstrt,jendt
326 DO i=istrt,iendt
327 visc4_r(i,j)=cff*grdscl(i,j)**3
328 END DO
329 END DO
330 cff=0.25_r8*cff
331 DO j=jstrp,jendt
332 DO i=istrp,iendt
333 visc4_p(i,j)=cff*(grdscl(i,j )**3+grdscl(i-1,j )**3+ &
334 & grdscl(i,j-1)**3+grdscl(i-1,j-1)**3)
335 END DO
336 END DO
337# endif
338#endif
339
340#if defined DIFF_GRID && defined SOLVE3D
341
342
343
344
345
346# ifdef TS_DIF2
348 cff=diffusion2(itrc)/
grdmax(ng)
349 DO j=jstrt,jendt
350 DO i=istrt,iendt
351 diff2(i,j,itrc)=cff*grdscl(i,j)
352 END DO
353 END DO
354 END DO
355# endif
356# ifdef TS_DIF4
358 cff=diffusion4(itrc)/(
grdmax(ng)**3)
359 DO j=jstrt,jendt
360 DO i=istrt,iendt
361 diff4(i,j,itrc)=cff*grdscl(i,j)**3
362 END DO
363 END DO
364 END DO
365# endif
366#endif
367
368#if !defined ANA_SPONGE && \
369 ( defined uv_vis2 || defined uv_vis4 || \
370 ((defined ts_dif2 || defined ts_dif4) && defined solve3d))
371
372
373
374
375
376
378# ifdef UV_VIS2
379 DO i=istrt,iendt
380 DO j=jstrt,jendt
381 visc2_r(i,j)=abs(
mixing(ng)%visc_factor(i,j))* &
382 & visc2_r(i,j)
383 END DO
384 END DO
385 DO i=istrp,iendt
386 DO j=jstrp,jendt
387 visc2_p(i,j)=0.25_r8* &
388 & abs(
mixing(ng)%visc_factor(i-1,j-1)+ &
389 &
mixing(ng)%visc_factor(i ,j-1)+ &
390 &
mixing(ng)%visc_factor(i-1,j )+ &
391 &
mixing(ng)%visc_factor(i ,j ))* &
392 & visc2_p(i,j)
393 END DO
394 END DO
395# endif
396# ifdef UV_VIS4
397 DO i=istrt,iendt
398 DO j=jstrt,jendt
399 visc4_r(i,j)=abs(
mixing(ng)%visc_factor(i,j))* &
400 & visc4_r(i,j)
401 END DO
402 END DO
403 DO i=istrp,iendt
404 DO j=jstrp,jendt
405 visc4_p(i,j)=0.25_r8* &
406 & abs(
mixing(ng)%visc_factor(i-1,j-1)+ &
407 &
mixing(ng)%visc_factor(i ,j-1)+ &
408 &
mixing(ng)%visc_factor(i-1,j )+ &
409 &
mixing(ng)%visc_factor(i ,j ))* &
410 & visc4_p(i,j)
411 END DO
412 END DO
413# endif
414 END IF
415
416# ifdef SOLVE3D
417# ifdef TS_DIF2
420 DO j=jstrt,jendt
421 DO i=istrt,iendt
422 diff2(i,j,itrc)=abs(
mixing(ng)%diff_factor(i,j))* &
423 & diff2(i,j,itrc)
424 END DO
425 END DO
426 END IF
427 END DO
428# endif
429# ifdef TS_DIF4
432 DO j=jstrt,jendt
433 DO i=istrt,iendt
434 diff4(i,j,itrc)=abs(
mixing(ng)%diff_factor(i,j))* &
435 & diff4(i,j,itrc)
436 END DO
437 END DO
438 END IF
439 END DO
440# endif
441# endif
442#endif
443
444
445
446
447
448#ifdef UV_VIS2
451 & lbi, ubi, lbj, ubj, &
452 & visc2_r)
454 & lbi, ubi, lbj, ubj, &
455 & visc2_p)
456 END IF
457#endif
458#ifdef UV_VIS4
461 & lbi, ubi, lbj, ubj, &
462 & visc4_r)
464 & lbi, ubi, lbj, ubj, &
465 & visc4_p)
466 END IF
467#endif
468
469#ifdef SOLVE3D
470# ifdef TS_DIF2
474 & lbi, ubi, lbj, ubj, &
475 & diff2(:,:,itrc))
476 END DO
477 END IF
478# endif
479# ifdef TS_DIF4
483 & lbi, ubi, lbj, ubj, &
484 & diff4(:,:,itrc))
485 END DO
486 END IF
487# endif
488#endif
489
490#ifdef DISTRIBUTE
491# ifdef UV_VIS2
493 & lbi, ubi, lbj, ubj, &
496 & visc2_r, visc2_p)
497# endif
498# ifdef UV_VIS4
500 & lbi, ubi, lbj, ubj, &
503 & visc4_r, visc4_p)
504# endif
505# ifdef SOLVE3D
506# ifdef TS_DIF2
508 & lbi, ubi, lbj, ubj, 1,
nt(ng), &
511 & diff2)
512# endif
513# ifdef TS_DIF4
515 & lbi, ubi, lbj, ubj, 1,
nt(ng), &
518 & diff4)
519# endif
520# endif
521#endif
522
523 RETURN
subroutine exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
subroutine exchange_p2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
type(t_bounds), dimension(:), allocatable bounds
type(t_domain), dimension(:), allocatable domain
integer, dimension(:), allocatable nt
real(r8), dimension(:,:), allocatable tl_tnu2
real(r8), dimension(:,:), allocatable tnu2
logical, dimension(:), allocatable luvsponge
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
real(r8), dimension(:,:), allocatable nl_tnu2
logical, dimension(:,:), allocatable ltracersponge
real(r8), dimension(:,:), allocatable tl_tnu4
real(r8), dimension(:), allocatable visc2
real(r8), dimension(:), allocatable ad_visc4
real(r8), dimension(:), allocatable visc4
real(r8), dimension(:), allocatable tl_visc4
real(dp), dimension(:), allocatable grdmax
real(r8), dimension(:,:), allocatable ad_tnu2
real(r8), dimension(:), allocatable nl_visc4
real(r8), dimension(:), allocatable ad_visc2
real(r8), dimension(:,:), allocatable ad_tnu4
real(r8), dimension(:), allocatable tl_visc2
real(r8), dimension(:,:), allocatable nl_tnu4
real(r8), dimension(:), allocatable nl_visc2
real(r8), dimension(:,:), allocatable tnu4
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)