-
Notifications
You must be signed in to change notification settings - Fork 48
/
oce_adv_tra_ver.F90
547 lines (510 loc) · 24.5 KB
/
oce_adv_tra_ver.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
module oce_adv_tra_ver_interfaces
interface
! implicit 1st order upwind vertical advection with to solve for fct_LO
! updates the input tracer ttf
subroutine adv_tra_vert_impl(ttf, w, mesh)
use mod_mesh
use g_PARSUP
type(t_mesh), intent(in), target :: mesh
real(kind=WP), intent(inout) :: ttf(mesh%nl-1, myDim_nod2D+eDim_nod2D)
real(kind=WP), intent(in) :: W (mesh%nl, myDim_nod2D+eDim_nod2D)
end subroutine
!===============================================================================
! 1st order upwind (explicit)
! returns flux given at vertical interfaces of scalar volumes
! IF init_zero=.TRUE. : flux will be set to zero before computation
! IF init_zero=.FALSE. : flux=flux-input flux
! flux is not multiplied with dt
subroutine adv_tra_ver_upw1(ttf, w, do_Xmoment, mesh, flux, init_zero)
use MOD_MESH
use g_PARSUP
type(t_mesh), intent(in), target :: mesh
integer, intent(in) :: do_Xmoment !--> = [1,2] compute 1st & 2nd moment of tracer transport
real(kind=WP), intent(in) :: ttf(mesh%nl-1, myDim_nod2D+eDim_nod2D)
real(kind=WP), intent(in) :: W (mesh%nl, myDim_nod2D+eDim_nod2D)
real(kind=WP), intent(inout) :: flux(mesh%nl, myDim_nod2D)
logical, optional :: init_zero
end subroutine
!===============================================================================
! QR (4th order centerd)
! returns flux given at vertical interfaces of scalar volumes
! IF init_zero=.TRUE. : flux will be set to zero before computation
! IF init_zero=.FALSE. : flux=flux-input flux
! flux is not multiplied with dt
subroutine adv_tra_ver_qr4c(ttf, w, do_Xmoment, mesh, num_ord, flux, init_zero)
use MOD_MESH
use g_PARSUP
type(t_mesh), intent(in), target :: mesh
integer, intent(in) :: do_Xmoment !--> = [1,2] compute 1st & 2nd moment of tracer transport
real(kind=WP), intent(in) :: num_ord ! num_ord is the fraction of fourth-order contribution in the solution
real(kind=WP), intent(in) :: ttf(mesh%nl-1, myDim_nod2D+eDim_nod2D)
real(kind=WP), intent(in) :: W (mesh%nl, myDim_nod2D+eDim_nod2D)
real(kind=WP), intent(inout) :: flux(mesh%nl, myDim_nod2D)
logical, optional :: init_zero
end subroutine
!===============================================================================
! Vertical advection with PPM reconstruction (5th order)
! returns flux given at vertical interfaces of scalar volumes
! IF init_zero=.TRUE. : flux will be set to zero before computation
! IF init_zero=.FALSE. : flux=flux-input flux
! flux is not multiplied with dt
subroutine adv_tra_vert_ppm(ttf, w, do_Xmoment, mesh, flux, init_zero)
use MOD_MESH
use g_PARSUP
type(t_mesh), intent(in), target :: mesh
integer :: n, nz, nl1
integer, intent(in) :: do_Xmoment !--> = [1,2] compute 1st & 2nd moment of tracer transport
real(kind=WP) :: tvert(mesh%nl), tv
real(kind=WP), intent(in) :: ttf(mesh%nl-1, myDim_nod2D+eDim_nod2D)
real(kind=WP), intent(in) :: W (mesh%nl, myDim_nod2D+eDim_nod2D)
real(kind=WP), intent(inout) :: flux(mesh%nl, myDim_nod2D)
logical, optional :: init_zero
end subroutine
! central difference reconstruction (2nd order, use only with FCT)
! returns flux given at vertical interfaces of scalar volumes
! IF init_zero=.TRUE. : flux will be set to zero before computation
! IF init_zero=.FALSE. : flux=flux-input flux
! flux is not multiplied with dt
subroutine adv_tra_ver_cdiff(ttf, w, do_Xmoment, mesh, flux, init_zero)
use MOD_MESH
use g_PARSUP
type(t_mesh), intent(in), target :: mesh
integer :: n, nz, nl1
integer, intent(in) :: do_Xmoment !--> = [1,2] compute 1st & 2nd moment of tracer transport
real(kind=WP) :: tvert(mesh%nl), tv
real(kind=WP), intent(in) :: ttf(mesh%nl-1, myDim_nod2D+eDim_nod2D)
real(kind=WP), intent(in) :: W (mesh%nl, myDim_nod2D+eDim_nod2D)
real(kind=WP), intent(inout) :: flux(mesh%nl, myDim_nod2D)
logical, optional :: init_zero
end subroutine
end interface
end module
!===============================================================================
subroutine adv_tra_vert_impl(ttf, w, mesh)
use MOD_MESH
use O_MESH
use o_PARAM
use o_ARRAYS
use i_ARRAYS
use g_PARSUP
use g_CONFIG
use g_forcing_arrays
use o_mixing_KPP_mod !for ghats _GO_
implicit none
type(t_mesh), intent(in) , target :: mesh
real(kind=WP), intent(inout) :: ttf(mesh%nl-1, myDim_nod2D+eDim_nod2D)
real(kind=WP), intent(in) :: W (mesh%nl, myDim_nod2D+eDim_nod2D)
real(kind=WP) :: a(mesh%nl), b(mesh%nl), c(mesh%nl), tr(mesh%nl)
real(kind=WP) :: cp(mesh%nl), tp(mesh%nl)
integer :: nz, n, nzmax,tr_num
real(kind=WP) :: m, zinv, dt_inv, dz
real(kind=WP) :: c1, v_adv
#include "associate_mesh.h"
dt_inv=1.0_WP/dt
!___________________________________________________________________________
! loop over local nodes
do n=1,myDim_nod2D
! initialise
a = 0.0_WP
b = 0.0_WP
c = 0.0_WP
tr = 0.0_WP
tp = 0.0_WP
cp = 0.0_WP
! max. number of levels at node n
nzmax=nlevels_nod2D(n)
!___________________________________________________________________________
! Here can not exchange zbar_n & Z_n with zbar_3d_n & Z_3d_n because
! they be calculate from the actualized mesh with hnode_new
! calculate new zbar (depth of layers) and Z (mid depths of layers)
! depending on layer thinkness over depth at node n
! Be carefull here vertical operation have to be done on NEW vertical mesh !!!
zbar_n=0.0_WP
Z_n=0.0_WP
zbar_n(nzmax)=zbar_n_bot(n)
Z_n(nzmax-1) =zbar_n(nzmax) + hnode_new(nzmax-1,n)/2.0_WP
do nz=nzmax-1,2,-1
zbar_n(nz) = zbar_n(nz+1) + hnode_new(nz,n)
Z_n(nz-1) = zbar_n(nz) + hnode_new(nz-1,n)/2.0_WP
end do
zbar_n(1) = zbar_n(2) + hnode_new(1,n)
!_______________________________________________________________________
! Regular part of coefficients: --> surface layer
nz=1
! 1/dz(nz)
zinv=1.0_WP*dt ! no .../(zbar(1)-zbar(2)) because of ALE
a(1)=0.0_WP
v_adv=zinv*area(2,n)/area(1,n)
b(1)= hnode_new(1,n)+W(1, n)*zinv-min(0._WP, W(2, n))*v_adv
c(1)=-max(0._WP, W(2, n))*v_adv
!_______________________________________________________________________
! Regular part of coefficients: --> 2nd...nl-2 layer
do nz=2, nzmax-2
! update from the vertical advection
a(nz)=min(0._WP, W(nz, n))*zinv
b(nz)=hnode_new(nz,n)+max(0._WP, W(nz, n))*zinv
v_adv=zinv*area(nz+1,n)/area(nz,n)
b(nz)=b(nz)-min(0._WP, W(nz+1, n))*v_adv
c(nz)= -max(0._WP, W(nz+1, n))*v_adv
end do ! --> do nz=2, nzmax-2
!_______________________________________________________________________
! Regular part of coefficients: --> nl-1 layer
nz=nzmax-1
! update from the vertical advection
a(nz)= min(0._WP, W(nz, n))*zinv
b(nz)=hnode_new(nz,n)+max(0._WP, W(nz, n))*zinv
c(nz)=0.0_WP
nz=1
dz=hnode_new(nz,n) ! It would be (zbar(nz)-zbar(nz+1)) if not ALE
tr(nz)=-(b(nz)-dz)*ttf(nz,n)-c(nz)*ttf(nz+1,n)
do nz=2,nzmax-2
dz=hnode_new(nz,n)
tr(nz)=-a(nz)*ttf(nz-1,n)-(b(nz)-dz)*ttf(nz,n)-c(nz)*ttf(nz+1,n)
end do
nz=nzmax-1
dz=hnode_new(nz,n)
tr(nz)=-a(nz)*ttf(nz-1,n)-(b(nz)-dz)*ttf(nz,n)
cp(1) = c(1)/b(1)
tp(1) = tr(1)/b(1)
! solve for vectors c-prime and t, s-prime
do nz = 2,nzmax-1
m = b(nz)-cp(nz-1)*a(nz)
cp(nz) = c(nz)/m
tp(nz) = (tr(nz)-tp(nz-1)*a(nz))/m
end do
! start with back substitution
tr(nzmax-1) = tp(nzmax-1)
! solve for x from the vectors c-prime and d-prime
do nz = nzmax-2, 1, -1
tr(nz) = tp(nz)-cp(nz)*tr(nz+1)
end do
!_______________________________________________________________________
! update tracer
do nz=1,nzmax-1
ttf(nz,n)=ttf(nz,n)+tr(nz)
end do
end do ! --> do n=1,myDim_nod2D
end subroutine adv_tra_vert_impl
!===============================================================================
subroutine adv_tra_ver_upw1(ttf, w, do_Xmoment, mesh, flux, init_zero)
use g_config
use MOD_MESH
use o_ARRAYS
use o_PARAM
use g_PARSUP
use g_forcing_arrays
implicit none
type(t_mesh), intent(in), target :: mesh
integer, intent(in) :: do_Xmoment !--> = [1,2] compute 1st & 2nd moment of tracer transport
real(kind=WP) :: tvert(mesh%nl)
integer :: n, nz, nzmax
real(kind=WP), intent(in) :: ttf(mesh%nl-1, myDim_nod2D+eDim_nod2D)
real(kind=WP), intent(in) :: W (mesh%nl, myDim_nod2D+eDim_nod2D)
real(kind=WP), intent(inout) :: flux(mesh%nl, myDim_nod2D)
logical, optional :: init_zero
#include "associate_mesh.h"
if (present(init_zero))then
if (init_zero) flux=0.0_WP
else
flux=0.0_WP
end if
do n=1, myDim_nod2D
!_______________________________________________________________________
nzmax=nlevels_nod2D(n)
!_______________________________________________________________________
! vert. flux at surface layer
nz=1
flux(nz,n)=-W(nz,n)*ttf(nz,n)*area(nz,n)-flux(nz,n)
!_______________________________________________________________________
! vert. flux at bottom layer --> zero bottom flux
nz=nzmax
flux(nz,n)= 0.0_WP-flux(nz,n)
!_______________________________________________________________________
! Be carefull have to do vertical tracer advection here on old vertical grid
! also horizontal advection is done on old mesh (see helem contains old
! mesh information)
!_______________________________________________________________________
! vert. flux at remaining levels
do nz=2,nzmax-1
flux(nz,n)=-0.5*( &
(ttf(nz ,n)**do_Xmoment)*(W(nz,n)+abs(W(nz,n)))+ &
(ttf(nz-1,n)**do_Xmoment)*(W(nz,n)-abs(W(nz,n))))*area(nz,n)-flux(nz,n)
end do
end do
end subroutine adv_tra_ver_upw1
!
!===============================================================================
subroutine adv_tra_ver_qr4c(ttf, w, do_Xmoment, mesh, num_ord, flux, init_zero)
use g_config
use MOD_MESH
use o_ARRAYS
use o_PARAM
use g_PARSUP
use g_forcing_arrays
implicit none
type(t_mesh), intent(in), target :: mesh
integer, intent(in) :: do_Xmoment !--> = [1,2] compute 1st & 2nd moment of tracer transport
real(kind=WP), intent(in) :: num_ord ! num_ord is the fraction of fourth-order contribution in the solution
real(kind=WP), intent(in) :: ttf(mesh%nl-1, myDim_nod2D+eDim_nod2D)
real(kind=WP), intent(in) :: W (mesh%nl, myDim_nod2D+eDim_nod2D)
real(kind=WP), intent(inout) :: flux(mesh%nl, myDim_nod2D)
logical, optional :: init_zero
real(kind=WP) :: tvert(mesh%nl)
integer :: n, nz, nzmax
real(kind=WP) :: Tmean, Tmean1, Tmean2
real(kind=WP) :: qc, qu, qd
#include "associate_mesh.h"
if (present(init_zero))then
if (init_zero) flux=0.0_WP
else
flux=0.0_WP
end if
do n=1, myDim_nod2D
!_______________________________________________________________________
nzmax=nlevels_nod2D(n)
!_______________________________________________________________________
! vert. flux at surface layer
nz=1
flux(nz,n)=-ttf(nz,n)*W(nz,n)*area(nz,n)-flux(nz,n)
!_______________________________________________________________________
! vert. flux 2nd layer --> centered differences
nz=2
flux(nz,n)=-0.5_WP*(ttf(nz-1,n)+ttf(nz,n))*W(nz,n)*area(nz,n)-flux(nz,n)
!_______________________________________________________________________
! vert. flux at bottom - 1 layer --> centered differences
nz=nzmax-1
flux(nz,n)=-0.5_WP*(ttf(nz-1,n)+ttf(nz,n))*W(nz,n)*area(nz,n)-flux(nz,n)
!_______________________________________________________________________
! vert. flux at bottom layer --> zero bottom flux
nz=nzmax
flux(nz,n)= 0.0_WP-flux(nz,n)
!_______________________________________________________________________
! Be carefull have to do vertical tracer advection here on old vertical grid
! also horizontal advection is done on old mesh (see helem contains old
! mesh information)
!_______________________________________________________________________
! vert. flux at remaining levels
do nz=3,nzmax-2
!centered (4th order)
qc=(ttf(nz-1,n)-ttf(nz ,n))/(Z_3d_n(nz-1,n)-Z_3d_n(nz ,n))
qu=(ttf(nz ,n)-ttf(nz+1,n))/(Z_3d_n(nz ,n)-Z_3d_n(nz+1,n))
qd=(ttf(nz-2,n)-ttf(nz-1,n))/(Z_3d_n(nz-2,n)-Z_3d_n(nz-1,n))
Tmean1=ttf(nz ,n)+(2*qc+qu)*(zbar_3d_n(nz,n)-Z_3d_n(nz ,n))/3.0_WP
Tmean2=ttf(nz-1,n)+(2*qc+qd)*(zbar_3d_n(nz,n)-Z_3d_n(nz-1,n))/3.0_WP
Tmean =(W(nz,n)+abs(W(nz,n)))*(Tmean1**do_Xmoment)+(W(nz,n)-abs(W(nz,n)))*(Tmean2**do_Xmoment)
! flux(nz,n)=-0.5_WP*(num_ord*(Tmean1+Tmean2)*W(nz,n)+(1.0_WP-num_ord)*Tmean)*area(nz,n)-flux(nz,n)
flux(nz,n)=(-0.5_WP*(1.0_WP-num_ord)*Tmean - num_ord*((0.5_WP*(Tmean1+Tmean2))**do_Xmoment)*W(nz,n))*area(nz,n)-flux(nz,n)
end do
end do
end subroutine adv_tra_ver_qr4c
!
!===============================================================================
subroutine adv_tra_vert_ppm(ttf, w, do_Xmoment, mesh, flux, init_zero)
use g_config
use MOD_MESH
use o_ARRAYS
use o_PARAM
use g_PARSUP
use g_forcing_arrays
implicit none
type(t_mesh), intent(in) , target :: mesh
integer, intent(in) :: do_Xmoment !--> = [1,2] compute 1st & 2nd moment of tracer transport
real(kind=WP), intent(in) :: ttf (mesh%nl-1, myDim_nod2D+eDim_nod2D)
real(kind=WP), intent(in) :: W (mesh%nl, myDim_nod2D+eDim_nod2D)
real(kind=WP), intent(inout) :: flux(mesh%nl, myDim_nod2D)
logical, optional :: init_zero
real(kind=WP) :: tvert(mesh%nl), tv(mesh%nl), aL, aR, aj, x
real(kind=WP) :: dzjm1, dzj, dzjp1, dzjp2, deltaj, deltajp1
integer :: n, nz, nzmax
integer :: overshoot_counter, counter
#include "associate_mesh.h"
if (present(init_zero))then
if (init_zero) flux=0.0_WP
else
flux=0.0_WP
end if
! --------------------------------------------------------------------------
! Vertical advection
! --------------------------------------------------------------------------
! A piecewise parabolic scheme for uniformly-spaced layers.
! See Colella and Woodward, JCP, 1984, 174-201. It can be coded so as to to take
! non-uniformity into account, but this is more cumbersome. This is the version for AB
! time stepping
! --------------------------------------------------------------------------
overshoot_counter=0
counter =0
flux =0.0_WP
do n=1, myDim_nod2D
!_______________________________________________________________________
!Interpolate to zbar...depth levels --> all quantities (tracer ...) are
! calculated on mid depth levels
! nzmax ... number of depth levels at node n
nzmax=nlevels_nod2D(n)
! tracer at surface layer
tv(1)=ttf(1,n)
! tracer at surface+1 layer
! tv(2)=-ttf(1,n)*min(sign(1.0, W(2,n)), 0._WP)+ttf(2,n)*max(sign(1.0, W(2,n)), 0._WP)
tv(2)=0.5*(ttf(1,n)+ttf(2,n))
! tacer at bottom-1 layer
!tv(nzmax-1)=-ttf(nzmax-2,n)*min(sign(1.0, W(nzmax-1,n)), 0._WP)+ttf(nzmax-1,n)*max(sign(1.0, W(nzmax-1,n)), 0._WP)
tv(nzmax-1)=0.5_WP*(ttf(nzmax-2,n)+ttf(nzmax-1,n))
! tracer at bottom layer
tv(nzmax)=ttf(nzmax-1,n)
!_______________________________________________________________________
! calc tracer for surface+2 until depth-2 layer
! see Colella and Woodward, JCP, 1984, 174-201 --> equation (1.9)
! loop over layers (segments)
do nz=3, nzmax-3
!___________________________________________________________________
! for uniform spaced vertical grids --> piecewise parabolic method (ppm)
! equation (1.9)
! tv(nz)=(7.0_WP*(ttf(nz-1,n)+ttf(nz,n))-(ttf(nz-2,n)+ttf(nz+1,n)))/12.0_WP
!___________________________________________________________________
! for non-uniformity spaced vertical grids --> piecewise parabolic
! method (ppm) see see Colella and Woodward, JCP, 1984, 174-201
! --> full equation (1.6), (1.7) and (1.8)
dzjm1 = hnode_new(nz-2,n)
dzj = hnode_new(nz-1,n)
dzjp1 = hnode_new(nz,n)
dzjp2 = hnode_new(nz+1,n)
! Be carefull here vertical operation have to be done on NEW vertical mesh !!!
!___________________________________________________________________
! equation (1.7)
! --> Here deltaj is the average slope in the jth zone of the parabola
! with zone averages a_(j-1) and a_j, a_(j+1)
! --> a_j^n
deltaj = dzj/(dzjm1+dzj+dzjp1)* &
( &
(2._WP*dzjm1+dzj )/(dzjp1+dzj)*(ttf(nz+1,n)-ttf(nz ,n)) + &
(dzj +2._WP*dzjp1)/(dzjm1+dzj)*(ttf(nz ,n)-ttf(nz-1,n)) &
)
! --> a_(j+1)^n
deltajp1 = dzjp1/(dzj+dzjp1+dzjp2)* &
( &
(2._WP*dzj+dzjp1 )/(dzjp2+dzjp1)*(ttf(nz+2,n)-ttf(nz+1,n)) + &
(dzjp1+2._WP*dzjp2)/(dzj +dzjp1)*(ttf(nz+1,n)-ttf(nz ,n)) &
)
!___________________________________________________________________
! condition (1.8)
! --> This modification leads to a somewhat steeper representation of
! discontinuities in the solution. It also guarantees that a_(j+0.5)
! lies in the range of values defined by a_j; and a_(j+1);
if ( (ttf(nz+1,n)-ttf(nz ,n))*(ttf(nz ,n)-ttf(nz-1,n)) > 0._WP ) then
deltaj = min( abs(deltaj), &
2._WP*abs(ttf(nz+1,n)-ttf(nz ,n)),&
2._WP*abs(ttf(nz ,n)-ttf(nz-1,n)) &
)*sign(1.0_WP,deltaj)
else
deltaj = 0.0_WP
endif
if ( (ttf(nz+2,n)-ttf(nz+1,n))*(ttf(nz+1,n)-ttf(nz ,n)) > 0._WP ) then
deltajp1 = min( abs(deltajp1),&
2._WP*abs(ttf(nz+2,n)-ttf(nz+1,n)),&
2._WP*abs(ttf(nz+1,n)-ttf(nz,n)) &
)*sign(1.0_WP,deltajp1)
else
deltajp1 = 0.0_WP
endif
!___________________________________________________________________
! equation (1.6)
! --> calcualte a_(j+0.5)
! nz+1 is the interface betweel layers (segments) nz and nz+1
tv(nz+1)= ttf(nz,n) &
+ dzj/(dzj+dzjp1)*(ttf(nz+1,n)-ttf(nz,n)) &
+ 1._WP/(dzjm1+dzj+dzjp1+dzjp2) * &
( &
(2._WP*dzjp1*dzj)/(dzj+dzjp1)* &
((dzjm1+dzj)/(2._WP*dzj+dzjp1) - (dzjp2+dzjp1)/(2._WP*dzjp1+dzj))*(ttf(nz+1,n)-ttf(nz,n)) &
- dzj*(dzjm1+dzj)/(2._WP*dzj+dzjp1)*deltajp1 &
+ dzjp1*(dzjp1+dzjp2)/(dzj+2._WP*dzjp1)*deltaj &
)
!tv(nz+1)=max(min(ttf(nz, n), ttf(nz+1, n)), min(max(ttf(nz, n), ttf(nz+1, n)), tv(nz+1)))
end do ! --> do nz=2,nzmax-3
tvert(1:nzmax)=0._WP
! loop over layers (segments)
do nz=1, nzmax-1
if ((W(nz,n)<=0._WP) .AND. (W(nz+1,n)>=0._WP)) CYCLE
counter=counter+1
aL=tv(nz)
aR=tv(nz+1)
if ((aR-ttf(nz, n))*(ttf(nz, n)-aL)<=0._WP) then
! write(*,*) aL, ttf(nz, n), aR
overshoot_counter=overshoot_counter+1
aL =ttf(nz, n)
aR =ttf(nz, n)
end if
if ((aR-aL)*(ttf(nz, n)-0.5_WP*(aL+aR))> (aR-aL)**2/6._WP) then
aL =3._WP*ttf(nz, n)-2._WP*aR
end if
if ((aR-aL)*(ttf(nz, n)-0.5_WP*(aR+aL))<-(aR-aL)**2/6._WP) then
aR =3._WP*ttf(nz, n)-2._WP*aL
end if
dzj = hnode(nz,n)
aj=6.0_WP*(ttf(nz, n)-0.5_WP*(aL+aR))
if (W(nz,n)>0._WP) then
x=min(W(nz,n)*dt/dzj, 1._WP)
tvert(nz )=(-aL-0.5_WP*x*(aR-aL+(1._WP-2._WP/3._WP*x)*aj))
tvert(nz )=( tvert(nz)**do_Xmoment ) ! compute 2nd moment for DVD
tvert(nz )=tvert(nz)*area(nz,n)*W(nz,n)
end if
if (W(nz+1,n)<0._WP) then
x=min(-W(nz+1,n)*dt/dzj, 1._WP)
tvert(nz+1)=(-aR+0.5_WP*x*(aR-aL-(1._WP-2._WP/3._WP*x)*aj))
tvert(nz+1)=( tvert(nz+1)**do_Xmoment ) ! compute 2nd moment for DVD
tvert(nz+1)=tvert(nz+1)*area(nz+1,n)*W(nz+1,n)
end if
end do
!_______________________________________________________________________
! Surface flux
tvert(1)= -( tv(1)**do_Xmoment )*W(1,n)*area(1,n)
! Zero bottom flux
tvert(nzmax)=0.0_WP
flux(1:nzmax, n)=tvert(1:nzmax)-flux(1:nzmax, n)
end do ! --> do n=1, myDim_nod2D
! if (mype==0) write(*,*) 'PPM overshoot statistics:', real(overshoot_counter)/real(counter)
end subroutine adv_tra_vert_ppm
!
!
!===============================================================================
subroutine adv_tra_ver_cdiff(ttf, w, do_Xmoment, mesh, flux, init_zero)
use g_config
use MOD_MESH
use o_ARRAYS
use o_PARAM
use g_PARSUP
use g_forcing_arrays
implicit none
type(t_mesh), intent(in), target :: mesh
integer, intent(in) :: do_Xmoment !--> = [1,2] compute 1st & 2nd moment of tracer transport
real(kind=WP), intent(in) :: ttf(mesh%nl-1, myDim_nod2D+eDim_nod2D)
real(kind=WP), intent(in) :: W (mesh%nl, myDim_nod2D+eDim_nod2D)
real(kind=WP), intent(inout) :: flux(mesh%nl, myDim_nod2D)
logical, optional :: init_zero
integer :: n, nz, nl1
real(kind=WP) :: tvert(mesh%nl), tv
#include "associate_mesh.h"
if (present(init_zero))then
if (init_zero) flux=0.0_WP
else
flux=0.0_WP
end if
do n=1, myDim_nod2D
!_______________________________________________________________________
nl1=nlevels_nod2D(n)-1
!_______________________________________________________________________
! Surface flux
tvert(1)= -W(1,n)*(ttf(1,n)**do_Xmoment)*area(1,n)
!_______________________________________________________________________
! Zero bottom flux
tvert(nl1+1)=0.0_WP
!_______________________________________________________________________
! Other levels
do nz=2, nl1
tv=0.5_WP*(ttf(nz-1,n)+ttf(nz,n))
tv=tv**do_Xmoment
tvert(nz)= -tv*W(nz,n)*area(nz,n)
end do
!_______________________________________________________________________
flux(1:nl, n)=tvert(1:nl)-flux(1:nl, n)
end do ! --> do n=1, myDim_nod2D
end subroutine adv_tra_ver_cdiff