ROMS
Loading...
Searching...
No Matches
tl_conv_2d.F
Go to the documentation of this file.
1#include "cppdefs.h"
2
3 MODULE tl_conv_2d_mod
4
5#if defined TANGENT && defined FOUR_DVAR
6!
7!git $Id$
8!================================================== Hernan G. Arango ===
9! Copyright (c) 2002-2025 The ROMS Group Andrew M. Moore !
10! Licensed under a MIT/X style license !
11! See License_ROMS.md !
12!=======================================================================
13! !
14! These routines applies the background error covariance to data !
15! assimilation fields via the space convolution of the diffusion !
16! equation (filter) for 2D state variables. The diffusion filter !
17! is solved using an explicit (inefficient) algorithm. !
18! !
19! For Gaussian (bell-shaped) correlations, the space convolution !
20! of the diffusion operator is an efficient way to estimate the !
21! finite domain error covariances. !
22! !
23! On Input: !
24! !
25! ng Nested grid number. !
26! model Calling model identifier. !
27! Istr Starting tile index in the I-direction. !
28! Iend Ending tile index in the I-direction. !
29! Jstr Starting tile index in the J-direction. !
30! Jend Ending tile index in the J-direction. !
31! LBi I-dimension Lower bound. !
32! UBi I-dimension Upper bound. !
33! LBj J-dimension Lower bound. !
34! UBj J-dimension Upper bound. !
35! Nghost Number of ghost points. !
36! NHsteps Number of horizontal diffusion integration steps. !
37! DTsizeH Horizontal diffusion pseudo time-step size. !
38! Kh Horizontal diffusion coefficients. !
39! tl_A 2D tangent linear state variable to diffuse. !
40! !
41! On Output: !
42! !
43! tl_A Diffused 2D tangent linear state variable. !
44! !
45! Routines: !
46! !
47! tl_conv_r2d_tile Tangent linear 2D convolution at RHO-points !
48! tl_conv_u2d_tile Tangent linear 2D convolution at U-points !
49! tl_conv_v2d_tile Tangent linear 2D convolution at V-points !
50! !
51!=======================================================================
52!
53 implicit none
54!
55 PUBLIC
56!
57 CONTAINS
58!
59!***********************************************************************
60 SUBROUTINE tl_conv_r2d_tile (ng, tile, model, &
61 & LBi, UBi, LBj, UBj, &
62 & IminS, ImaxS, JminS, JmaxS, &
63 & Nghost, NHsteps, DTsizeH, &
64 & Kh, &
65 & pm, pn, pmon_u, pnom_v, &
66# ifdef MASKING
67 & rmask, umask, vmask, &
68# endif
69 & tl_A)
70!***********************************************************************
71!
72 USE mod_param
73 USE mod_scalars
74!
75 USE bc_2d_mod, ONLY: dabc_r2d_tile
76# ifdef DISTRIBUTE
77 USE mp_exchange_mod, ONLY : mp_exchange2d
78# endif
79!
80! Imported variable declarations.
81!
82 integer, intent(in) :: ng, tile, model
83 integer, intent(in) :: LBi, UBi, LBj, UBj
84 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
85 integer, intent(in) :: Nghost, NHsteps
86
87 real(r8), intent(in) :: DTsizeH
88!
89# ifdef ASSUMED_SHAPE
90 real(r8), intent(in) :: pm(LBi:,LBj:)
91 real(r8), intent(in) :: pn(LBi:,LBj:)
92 real(r8), intent(in) :: pmon_u(LBi:,LBj:)
93 real(r8), intent(in) :: pnom_v(LBi:,LBj:)
94# ifdef MASKING
95 real(r8), intent(in) :: rmask(LBi:,LBj:)
96 real(r8), intent(in) :: umask(LBi:,LBj:)
97 real(r8), intent(in) :: vmask(LBi:,LBj:)
98# endif
99 real(r8), intent(in) :: Kh(LBi:,LBj:)
100 real(r8), intent(inout) :: tl_A(LBi:,LBj:)
101# else
102 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
103 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
104 real(r8), intent(in) :: pmon_u(LBi:UBi,LBj:UBj)
105 real(r8), intent(in) :: pnom_v(LBi:UBi,LBj:UBj)
106# ifdef MASKING
107 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
108 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
109 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
110# endif
111 real(r8), intent(in) :: Kh(LBi:UBi,LBj:UBj)
112 real(r8), intent(inout) :: tl_A(LBi:UBi,LBj:UBj)
113# endif
114!
115! Local variable declarations.
116!
117 integer :: Nnew, Nold, Nsav, i, j, step
118
119 real(r8), dimension(LBi:UBi,LBj:UBj,2) :: tl_Awrk
120
121 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_FE
122 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_FX
123 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: Hfac
124
125# include "set_bounds.h"
126!
127!-----------------------------------------------------------------------
128! Space convolution of the diffusion equation for a 2D state variable
129! at RHO-points.
130!-----------------------------------------------------------------------
131!
132! Compute metrics factor.
133!
134 DO j=jstr,jend
135 DO i=istr,iend
136 hfac(i,j)=dtsizeh*pm(i,j)*pn(i,j)
137 END DO
138 END DO
139!
140! Set integration indices and initial conditions.
141!
142 nold=1
143 nnew=2
144!^ CALL dabc_r2d_tile (ng, tile, &
145!^ & LBi, UBi, LBj, UBj, &
146!^ & A)
147!^
148 CALL dabc_r2d_tile (ng, tile, &
149 & lbi, ubi, lbj, ubj, &
150 & tl_a)
151# ifdef DISTRIBUTE
152!^ CALL mp_exchange2d (ng, tile, model, 1, &
153!^ & LBi, UBi, LBj, UBj, &
154!^ & Nghost, &
155!^ & EWperiodic(ng), NSperiodic(ng), &
156!^ & A)
157!^
158 CALL mp_exchange2d (ng, tile, model, 1, &
159 & lbi, ubi, lbj, ubj, &
160 & nghost, &
161 & ewperiodic(ng), nsperiodic(ng), &
162 & tl_a)
163# endif
164 DO j=jstr-1,jend+1
165 DO i=istr-1,iend+1
166!^ Awrk(i,j,Nold)=A(i,j)
167!^
168 tl_awrk(i,j,nold)=tl_a(i,j)
169 END DO
170 END DO
171!
172!-----------------------------------------------------------------------
173! Integrate horizontal diffusion terms.
174!-----------------------------------------------------------------------
175!
176 DO step=1,nhsteps
177!
178! Compute XI- and ETA-components of diffusive flux.
179!
180 DO j=jstr,jend
181 DO i=istr,iend+1
182!^ FX(i,j)=pmon_u(i,j)*0.5_r8*(Kh(i-1,j)+Kh(i,j))* &
183!^ & (Awrk(i,j,Nold)-Awrk(i-1,j,Nold))
184!^
185 tl_fx(i,j)=pmon_u(i,j)*0.5_r8*(kh(i-1,j)+kh(i,j))* &
186 & (tl_awrk(i,j,nold)-tl_awrk(i-1,j,nold))
187# ifdef MASKING
188!^ FX(i,j)=FX(i,j)*umask(i,j)
189!^
190 tl_fx(i,j)=tl_fx(i,j)*umask(i,j)
191# endif
192 END DO
193 END DO
194 DO j=jstr,jend+1
195 DO i=istr,iend
196!^ FE(i,j)=pnom_v(i,j)*0.5_r8*(Kh(i,j-1)+Kh(i,j))* &
197!^ & (Awrk(i,j,Nold)-Awrk(i,j-1,Nold))
198!^
199 tl_fe(i,j)=pnom_v(i,j)*0.5_r8*(kh(i,j-1)+kh(i,j))* &
200 & (tl_awrk(i,j,nold)-tl_awrk(i,j-1,nold))
201# ifdef MASKING
202!^ FE(i,j)=FE(i,j)*vmask(i,j)
203!^
204 tl_fe(i,j)=tl_fe(i,j)*vmask(i,j)
205# endif
206 END DO
207 END DO
208!
209! Time-step horizontal diffusion terms.
210!
211 DO j=jstr,jend
212 DO i=istr,iend
213!^ Awrk(i,j,Nnew)=Awrk(i,j,Nold)+ &
214!^ & Hfac(i,j)* &
215!^ & (FX(i+1,j)-FX(i,j)+ &
216!^ & FE(i,j+1)-FE(i,j))
217!^
218 tl_awrk(i,j,nnew)=tl_awrk(i,j,nold)+ &
219 & hfac(i,j)* &
220 & (tl_fx(i+1,j)-tl_fx(i,j)+ &
221 & tl_fe(i,j+1)-tl_fe(i,j))
222 END DO
223 END DO
224!
225! Apply boundary conditions. If applicable, exchange boundary data.
226!
227!^ CALL dabc_r2d_tile (ng, tile, &
228!^ & LBi, UBi, LBj, UBj, &
229!^ & Awrk(:,:,Nnew))
230!^
231 CALL dabc_r2d_tile (ng, tile, &
232 & lbi, ubi, lbj, ubj, &
233 & tl_awrk(:,:,nnew))
234# ifdef DISTRIBUTE
235!^ CALL mp_exchange2d (ng, tile, model, 1, &
236!^ & LBi, UBi, LBj, UBj, &
237!^ & Nghost, &
238!^ & EWperiodic(ng), NSperiodic(ng), &
239!^ & Awrk(:,:,Nnew))
240!^
241 CALL mp_exchange2d (ng, tile, model, 1, &
242 & lbi, ubi, lbj, ubj, &
243 & nghost, &
244 & ewperiodic(ng), nsperiodic(ng), &
245 & tl_awrk(:,:,nnew))
246# endif
247!
248! Update integration indices.
249!
250 nsav=nold
251 nold=nnew
252 nnew=nsav
253 END DO
254!
255!-----------------------------------------------------------------------
256! Load convolved solution.
257!-----------------------------------------------------------------------
258!
259 DO j=jstr,jend
260 DO i=istr,iend
261!^ A(i,j)=Awrk(i,j,Nold)
262!^
263 tl_a(i,j)=tl_awrk(i,j,nold)
264 END DO
265 END DO
266!^ CALL dabc_r2d_tile (ng, tile, &
267!^ & LBi, UBi, LBj, UBj, &
268!^ & A)
269!^
270 CALL dabc_r2d_tile (ng, tile, &
271 & lbi, ubi, lbj, ubj, &
272 & tl_a)
273# ifdef DISTRIBUTE
274!^ CALL mp_exchange2d (ng, tile, model, 1, &
275!^ & LBi, UBi, LBj, UBj, &
276!^ & Nghost, &
277!^ & EWperiodic(ng), NSperiodic(ng), &
278!^ & A)
279!^
280 CALL mp_exchange2d (ng, tile, model, 1, &
281 & lbi, ubi, lbj, ubj, &
282 & nghost, &
283 & ewperiodic(ng), nsperiodic(ng), &
284 & tl_a)
285# endif
286
287 RETURN
288 END SUBROUTINE tl_conv_r2d_tile
289!
290!***********************************************************************
291 SUBROUTINE tl_conv_u2d_tile (ng, tile, model, &
292 & LBi, UBi, LBj, UBj, &
293 & IminS, ImaxS, JminS, JmaxS, &
294 & Nghost, NHsteps, DTsizeH, &
295 & Kh, &
296 & pm, pn, pmon_r, pnom_p, &
297# ifdef MASKING
298 & umask, pmask, &
299# endif
300 & tl_A)
301!***********************************************************************
302!
303 USE mod_param
304 USE mod_scalars
305!
306 USE bc_2d_mod, ONLY: dabc_u2d_tile
307# ifdef DISTRIBUTE
308 USE mp_exchange_mod, ONLY : mp_exchange2d
309# endif
310!
311! Imported variable declarations.
312!
313 integer, intent(in) :: ng, tile, model
314 integer, intent(in) :: LBi, UBi, LBj, UBj
315 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
316 integer, intent(in) :: Nghost, NHsteps
317
318 real(r8), intent(in) :: DTsizeH
319!
320# ifdef ASSUMED_SHAPE
321 real(r8), intent(in) :: pm(LBi:,LBj:)
322 real(r8), intent(in) :: pn(LBi:,LBj:)
323 real(r8), intent(in) :: pmon_r(LBi:,LBj:)
324 real(r8), intent(in) :: pnom_p(LBi:,LBj:)
325# ifdef MASKING
326 real(r8), intent(in) :: umask(LBi:,LBj:)
327 real(r8), intent(in) :: pmask(LBi:,LBj:)
328# endif
329 real(r8), intent(in) :: Kh(LBi:,LBj:)
330 real(r8), intent(inout) :: tl_A(LBi:,LBj:)
331# else
332 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
333 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
334 real(r8), intent(in) :: pmon_r(LBi:UBi,LBj:UBj)
335 real(r8), intent(in) :: pnom_p(LBi:UBi,LBj:UBj)
336# ifdef MASKING
337 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
338 real(r8), intent(in) :: pmask(LBi:UBi,LBj:UBj)
339# endif
340 real(r8), intent(in) :: Kh(LBi:UBi,LBj:UBj)
341 real(r8), intent(inout) :: tl_A(LBi:UBi,LBj:UBj)
342# endif
343!
344! Local variable declarations.
345!
346 integer :: Nnew, Nold, Nsav, i, j, step
347
348 real(r8) :: cff
349
350 real(r8), dimension(LBi:UBi,LBj:UBj,2) :: tl_Awrk
351
352 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_FE
353 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_FX
354 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: Hfac
355
356# include "set_bounds.h"
357!
358!-----------------------------------------------------------------------
359! Space convolution of the diffusion equation for a 2D state variable
360! at U-points.
361!-----------------------------------------------------------------------
362!
363! Compute metrics factor.
364!
365 cff=dtsizeh*0.25_r8
366 DO j=jstr,jend
367 DO i=istru,iend
368 hfac(i,j)=cff*(pm(i-1,j)+pm(i,j))*(pn(i-1,j)+pn(i,j))
369 END DO
370 END DO
371!
372! Set integration indices and initial conditions.
373!
374 nold=1
375 nnew=2
376!^ CALL dabc_u2d_tile (ng, tile, &
377!^ & LBi, UBi, LBj, UBj, &
378!^ & A)
379!^
380 CALL dabc_u2d_tile (ng, tile, &
381 & lbi, ubi, lbj, ubj, &
382 & tl_a)
383# ifdef DISTRIBUTE
384!^ CALL mp_exchange2d (ng, tile, model, 1, &
385!^ & LBi, UBi, LBj, UBj, &
386!^ & Nghost, &
387!^ & EWperiodic(ng), NSperiodic(ng), &
388!^ & A)
389!^
390 CALL mp_exchange2d (ng, tile, model, 1, &
391 & lbi, ubi, lbj, ubj, &
392 & nghost, &
393 & ewperiodic(ng), nsperiodic(ng), &
394 & tl_a)
395# endif
396 DO j=jstr-1,jend+1
397 DO i=istru-1,iend+1
398!^ Awrk(i,j,Nold)=A(i,j)
399!^
400 tl_awrk(i,j,nold)=tl_a(i,j)
401 END DO
402 END DO
403!
404!-----------------------------------------------------------------------
405! Integrate horizontal diffusion terms.
406!-----------------------------------------------------------------------
407!
408 DO step=1,nhsteps
409!
410! Compute XI- and ETA-components of diffusive flux.
411!
412 DO j=jstr,jend
413 DO i=istru-1,iend
414!^ FX(i,j)=pmon_r(i,j)*Kh(i,j)* &
415!^ & (Awrk(i+1,j,Nold)-Awrk(i,j,Nold))
416!^
417 tl_fx(i,j)=pmon_r(i,j)*kh(i,j)* &
418 & (tl_awrk(i+1,j,nold)-tl_awrk(i,j,nold))
419 END DO
420 END DO
421 DO j=jstr,jend+1
422 DO i=istru,iend
423!^ FE(i,j)=pnom_p(i,j)*0.25_r8*(Kh(i-1,j )+Kh(i,j )+ &
424!^ & Kh(i-1,j-1)+Kh(i,j-1))* &
425!^ & (Awrk(i,j,Nold)-Awrk(i,j-1,Nold))
426!^
427 tl_fe(i,j)=pnom_p(i,j)*0.25_r8*(kh(i-1,j )+kh(i,j )+ &
428 & kh(i-1,j-1)+kh(i,j-1))* &
429 & (tl_awrk(i,j,nold)-tl_awrk(i,j-1,nold))
430# ifdef MASKING
431!^ FE(i,j)=FE(i,j)*pmask(i,j)
432!^
433 tl_fe(i,j)=tl_fe(i,j)*pmask(i,j)
434# endif
435 END DO
436 END DO
437!
438! Time-step horizontal diffusion terms.
439!
440 DO j=jstr,jend
441 DO i=istru,iend
442!^ Awrk(i,j,Nnew)=Awrk(i,j,Nold)+ &
443!^ & Hfac(i,j)* &
444!^ & (FX(i,j)-FX(i-1,j)+ &
445!^ & FE(i,j+1)-FE(i,j))
446!^
447 tl_awrk(i,j,nnew)=tl_awrk(i,j,nold)+ &
448 & hfac(i,j)* &
449 & (tl_fx(i,j)-tl_fx(i-1,j)+ &
450 & tl_fe(i,j+1)-tl_fe(i,j))
451 END DO
452 END DO
453!
454! Apply boundary conditions. If applicable, exchange boundary data.
455!
456!^ CALL dabc_u2d_tile (ng, tile, &
457!^ & LBi, UBi, LBj, UBj, &
458!^ & Awrk(:,:,Nnew))
459!^
460 CALL dabc_u2d_tile (ng, tile, &
461 & lbi, ubi, lbj, ubj, &
462 & tl_awrk(:,:,nnew))
463# ifdef DISTRIBUTE
464!^ CALL mp_exchange2d (ng, tile, model, 1, &
465!^ & LBi, UBi, LBj, UBj, &
466!^ & Nghost, &
467!^ & EWperiodic(ng), NSperiodic(ng), &
468!^ & Awrk(:,:,Nnew))
469!^
470 CALL mp_exchange2d (ng, tile, model, 1, &
471 & lbi, ubi, lbj, ubj, &
472 & nghost, &
473 & ewperiodic(ng), nsperiodic(ng), &
474 & tl_awrk(:,:,nnew))
475# endif
476!
477! Update integration indices.
478!
479 nsav=nold
480 nold=nnew
481 nnew=nsav
482 END DO
483!
484!-----------------------------------------------------------------------
485! Load convolved solution.
486!-----------------------------------------------------------------------
487!
488 DO j=jstr,jend
489 DO i=istru,iend
490!^ A(i,j)=Awrk(i,j,Nold)
491!^
492 tl_a(i,j)=tl_awrk(i,j,nold)
493 END DO
494 END DO
495!^ CALL dabc_u2d_tile (ng, tile, &
496!^ & LBi, UBi, LBj, UBj, &
497!^ & A)
498!^
499 CALL dabc_u2d_tile (ng, tile, &
500 & lbi, ubi, lbj, ubj, &
501 & tl_a)
502# ifdef DISTRIBUTE
503!^ CALL mp_exchange2d (ng, tile, model, 1, &
504!^ & LBi, UBi, LBj, UBj, &
505!^ & Nghost, &
506!^ & EWperiodic(ng), NSperiodic(ng), &
507!^ & A)
508!^
509 CALL mp_exchange2d (ng, tile, model, 1, &
510 & lbi, ubi, lbj, ubj, &
511 & nghost, &
512 & ewperiodic(ng), nsperiodic(ng), &
513 & tl_a)
514# endif
515
516 RETURN
517 END SUBROUTINE tl_conv_u2d_tile
518!
519!***********************************************************************
520 SUBROUTINE tl_conv_v2d_tile (ng, tile, model, &
521 & LBi, UBi, LBj, UBj, &
522 & IminS, ImaxS, JminS, JmaxS, &
523 & Nghost, NHsteps, DTsizeH, &
524 & Kh, &
525 & pm, pn, pmon_p, pnom_r, &
526# ifdef MASKING
527 & vmask, pmask, &
528# endif
529 & tl_A)
530!***********************************************************************
531!
532 USE mod_param
533 USE mod_scalars
534!
535 USE bc_2d_mod, ONLY: dabc_v2d_tile
536# ifdef DISTRIBUTE
537 USE mp_exchange_mod, ONLY : mp_exchange2d
538# endif
539!
540! Imported variable declarations.
541!
542 integer, intent(in) :: ng, tile, model
543 integer, intent(in) :: LBi, UBi, LBj, UBj
544 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
545 integer, intent(in) :: Nghost, NHsteps
546
547 real(r8), intent(in) :: DTsizeH
548!
549# ifdef ASSUMED_SHAPE
550 real(r8), intent(in) :: pm(LBi:,LBj:)
551 real(r8), intent(in) :: pn(LBi:,LBj:)
552 real(r8), intent(in) :: pmon_p(LBi:,LBj:)
553 real(r8), intent(in) :: pnom_r(LBi:,LBj:)
554# ifdef MASKING
555 real(r8), intent(in) :: vmask(LBi:,LBj:)
556 real(r8), intent(in) :: pmask(LBi:,LBj:)
557# endif
558 real(r8), intent(in) :: Kh(LBi:,LBj:)
559 real(r8), intent(inout) :: tl_A(LBi:,LBj:)
560# else
561 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
562 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
563 real(r8), intent(in) :: pmon_p(LBi:UBi,LBj:UBj)
564 real(r8), intent(in) :: pnom_r(LBi:UBi,LBj:UBj)
565# ifdef MASKING
566 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
567 real(r8), intent(in) :: pmask(LBi:UBi,LBj:UBj)
568# endif
569 real(r8), intent(in) :: Kh(LBi:UBi,LBj:UBj)
570 real(r8), intent(inout) :: tl_A(LBi:UBi,LBj:UBj)
571# endif
572!
573! Local variable declarations.
574!
575 integer :: Nnew, Nold, Nsav, i, j, step
576
577 real(r8) :: cff
578
579 real(r8), dimension(LBi:UBi,LBj:UBj,2) :: tl_Awrk
580
581 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_FE
582 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_FX
583 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: Hfac
584
585# include "set_bounds.h"
586!
587!-----------------------------------------------------------------------
588! Space convolution of the diffusion equation for a 2D state variable
589! at V-points.
590!-----------------------------------------------------------------------
591!
592! Compute metrics factor.
593!
594 cff=dtsizeh*0.25_r8
595 DO j=jstrv,jend
596 DO i=istr,iend
597 hfac(i,j)=cff*(pm(i,j-1)+pm(i,j))*(pn(i,j-1)+pn(i,j))
598 END DO
599 END DO
600!
601! Set integration indices and initial conditions.
602!
603 nold=1
604 nnew=2
605!^ CALL dabc_v2d_tile (ng, tile, &
606!^ & LBi, UBi, LBj, UBj, &
607!^ & A)
608!^
609 CALL dabc_v2d_tile (ng, tile, &
610 & lbi, ubi, lbj, ubj, &
611 & tl_a)
612# ifdef DISTRIBUTE
613!^ CALL mp_exchange2d (ng, tile, model, 1, &
614!^ & LBi, UBi, LBj, UBj, &
615!^ & Nghost, &
616!^ & EWperiodic(ng), NSperiodic(ng), &
617!^ & A)
618!^
619 CALL mp_exchange2d (ng, tile, model, 1, &
620 & lbi, ubi, lbj, ubj, &
621 & nghost, &
622 & ewperiodic(ng), nsperiodic(ng), &
623 & tl_a)
624# endif
625 DO j=jstrv-1,jend+1
626 DO i=istr-1,iend+1
627!^ Awrk(i,j,Nold)=A(i,j)
628!^
629 tl_awrk(i,j,nold)=tl_a(i,j)
630 END DO
631 END DO
632!
633!-----------------------------------------------------------------------
634! Integrate horizontal diffusion terms.
635!-----------------------------------------------------------------------
636!
637 DO step=1,nhsteps
638!
639! Compute XI- and ETA-components of diffusive flux.
640!
641 DO j=jstrv,jend
642 DO i=istr,iend+1
643!^ FX(i,j)=pmon_p(i,j)*0.25_r8*(Kh(i-1,j )+Kh(i,j )+ &
644!^ & Kh(i-1,j-1)+Kh(i,j-1))* &
645!^ & (Awrk(i,j,Nold)-Awrk(i-1,j,Nold))
646!^
647 tl_fx(i,j)=pmon_p(i,j)*0.25_r8*(kh(i-1,j )+kh(i,j )+ &
648 & kh(i-1,j-1)+kh(i,j-1))* &
649 & (tl_awrk(i,j,nold)-tl_awrk(i-1,j,nold))
650
651# ifdef MASKING
652!^ FX(i,j)=FX(i,j)*pmask(i,j)
653!^
654 tl_fx(i,j)=tl_fx(i,j)*pmask(i,j)
655# endif
656 END DO
657 END DO
658 DO j=jstrv-1,jend
659 DO i=istr,iend
660!^ FE(i,j)=pnom_r(i,j)*Kh(i,j)* &
661!^ & (Awrk(i,j+1,Nold)-Awrk(i,j,Nold))
662!^
663 tl_fe(i,j)=pnom_r(i,j)*kh(i,j)* &
664 & (tl_awrk(i,j+1,nold)-tl_awrk(i,j,nold))
665 END DO
666 END DO
667!
668! Time-step horizontal diffusion terms.
669!
670 DO j=jstrv,jend
671 DO i=istr,iend
672!^ Awrk(i,j,Nnew)=Awrk(i,j,Nold)+ &
673!^ & Hfac(i,j)* &
674!^ & (FX(i+1,j)-FX(i,j)+ &
675!^ & FE(i,j)-FE(i,j-1))
676!^
677 tl_awrk(i,j,nnew)=tl_awrk(i,j,nold)+ &
678 & hfac(i,j)* &
679 & (tl_fx(i+1,j)-tl_fx(i,j)+ &
680 & tl_fe(i,j)-tl_fe(i,j-1))
681 END DO
682 END DO
683!
684! Apply boundary conditions. If applicable, exchange boundary data.
685!
686!^ CALL dabc_v2d_tile (ng, tile, &
687!^ & LBi, UBi, LBj, UBj, &
688!^ & Awrk(:,:,Nnew))
689!^
690 CALL dabc_v2d_tile (ng, tile, &
691 & lbi, ubi, lbj, ubj, &
692 & tl_awrk(:,:,nnew))
693# ifdef DISTRIBUTE
694!^ CALL mp_exchange2d (ng, tile, model, 1, &
695!^ & LBi, UBi, LBj, UBj, &
696!^ & Nghost, &
697!^ & EWperiodic(ng), NSperiodic(ng), &
698!^ & Awrk(:,:,Nnew))
699!^
700 CALL mp_exchange2d (ng, tile, model, 1, &
701 & lbi, ubi, lbj, ubj, &
702 & nghost, &
703 & ewperiodic(ng), nsperiodic(ng), &
704 & tl_awrk(:,:,nnew))
705# endif
706!
707! Update integration indices.
708!
709 nsav=nold
710 nold=nnew
711 nnew=nsav
712 END DO
713!
714!-----------------------------------------------------------------------
715! Load convolved solution.
716!-----------------------------------------------------------------------
717!
718 DO j=jstrv,jend
719 DO i=istr,iend
720!^ A(i,j)=Awrk(i,j,Nold)
721!^
722 tl_a(i,j)=tl_awrk(i,j,nold)
723 END DO
724 END DO
725!^ CALL dabc_v2d_tile (ng, tile, &
726!^ & LBi, UBi, LBj, UBj, &
727!^ & A)
728!^
729 CALL dabc_v2d_tile (ng, tile, &
730 & lbi, ubi, lbj, ubj, &
731 & tl_a)
732# ifdef DISTRIBUTE
733!^ CALL mp_exchange2d (ng, tile, model, 1, &
734!^ & LBi, UBi, LBj, UBj, &
735!^ & Nghost, &
736!^ & EWperiodic(ng), NSperiodic(ng), &
737!^ & A)
738!^
739 CALL mp_exchange2d (ng, tile, model, 1, &
740 & lbi, ubi, lbj, ubj, &
741 & nghost, &
742 & ewperiodic(ng), nsperiodic(ng), &
743 & tl_a)
744# endif
745
746 RETURN
747 END SUBROUTINE tl_conv_v2d_tile
748#endif
749 END MODULE tl_conv_2d_mod
bc_2d_mod
Definition bc_2d.F:2
bc_2d_mod::dabc_v2d_tile
subroutine dabc_v2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition bc_2d.F:771
bc_2d_mod::dabc_u2d_tile
subroutine dabc_u2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition bc_2d.F:646
bc_2d_mod::dabc_r2d_tile
subroutine dabc_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition bc_2d.F:523
mod_param
Definition mod_param.F:2
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
mp_exchange_mod
Definition mp_exchange.F:2
mp_exchange_mod::mp_exchange2d
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:294
tl_conv_2d_mod
Definition tl_conv_2d.F:3
tl_conv_2d_mod::tl_conv_u2d_tile
subroutine tl_conv_u2d_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nghost, nhsteps, dtsizeh, kh, pm, pn, pmon_r, pnom_p, umask, pmask, tl_a)
Definition tl_conv_2d.F:301
tl_conv_2d_mod::tl_conv_r2d_tile
subroutine tl_conv_r2d_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nghost, nhsteps, dtsizeh, kh, pm, pn, pmon_u, pnom_v, rmask, umask, vmask, tl_a)
Definition tl_conv_2d.F:70
tl_conv_2d_mod::tl_conv_v2d_tile
subroutine tl_conv_v2d_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nghost, nhsteps, dtsizeh, kh, pm, pn, pmon_p, pnom_r, vmask, pmask, tl_a)
Definition tl_conv_2d.F:530