Newer
Older
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
! Created by Andrey Debolskiy on 11.02.2025.
!> Collection of utilities for pbl_turb_data
module pbl_turb_common
use pbl_turb_data
implicit none
public get_s2, get_n2, get_rig
public get_coeffs_general
contains
subroutine get_n2(turb, bl, fluid, grid)
use pbl_turb_data, only: turbBLDataType
use scm_state_data, only: stateBLDataType
use pbl_grid, only: pblgridDataType
use phys_fluid, only: fluidParamsDataType
implicit none
type(fluidParamsDataType), intent(in):: fluid
type(stateBLDataType), intent(in):: bl
type(pblgridDataType), intent(in)::grid
type(turbBLDataType), intent(inout):: turb
real dtvir, buoyp
integer k
do k = 1,grid%kmax-1
dtvir = bl%theta_v(k) - bl%theta_v(k+1)
buoyp = fluid%g / ( (bl%theta_v(k+1) + bl%theta_v(k))/2.0e0 )
turb%n2 = buoyp*(grid%z_cell(k) - grid%z_cell(k+1))*dtvir
end do
end subroutine get_n2
subroutine get_s2(turb, bl, fluid, grid, du2min)
use pbl_turb_data, only: turbBLDataType
use scm_state_data, only: stateBLDataType
use pbl_grid, only: pblgridDataType
use phys_fluid, only: fluidParamsDataType
implicit none
type(fluidParamsDataType), intent(in):: fluid
type(stateBLDataType), intent(in):: bl
type(pblgridDataType), intent(in)::grid
type(turbBLDataType), intent(inout):: turb
real, intent(in) :: du2min
real du2
integer k
do k = 1,grid%kmax-1
du2 = amax1(du2min, &
& (bl%u(k)-bl%u(k+1))**2 + (bl%v(k)-bl%v(k+1))**2)
turb%s2 = du2 / ((grid%z_cell(k) - grid%z_cell(k+1)) &
* (grid%z_cell(k) - grid%z_cell(k+1)))
enddo
end subroutine get_s2
subroutine get_rig(turb, bl, fluid, grid, du2min, ricr)
use pbl_turb_data, only: turbBLDataType
use scm_state_data, only: stateBLDataType
use pbl_grid, only: pblgridDataType
use phys_fluid, only: fluidParamsDataType
implicit none
type(fluidParamsDataType), intent(in):: fluid
type(stateBLDataType), intent(in):: bl
type(pblgridDataType), intent(in)::grid
real, intent(in):: du2min, ricr
type(turbBLDataType), intent(inout):: turb
real dtvir, buoyp, du2, rinum
integer k
do k = 1,grid%kmax-1
du2 = amax1(du2min, &
& (bl%u(k)-bl%u(k+1))**2 + (bl%v(k)-bl%v(k+1))**2)
dtvir = bl%theta_v(k) - bl%theta_v(k+1)
buoyp = fluid%g / ( (bl%theta_v(k+1) + bl%theta_v(k))/2.0e0 )
rinum = buoyp*(grid%z_cell(k) - grid%z_cell(k+1))*dtvir/du2
rinum = amin1(ricr,rinum)
turb%rig(k) = rinum
end do
end subroutine get_rig
subroutine get_coeffs_general(turb, bl, fluid, hbl_option, grid)
use pbl_turb_data, only: turbBLDataType
use scm_state_data, only: stateBLDataType
use pbl_grid, only: pblgridDataType
use phys_fluid, only: fluidParamsDataType
use pbl_fo_turb, only: get_fo_coeffs, get_turb_length, du2min, ricr
implicit none
type(fluidParamsDataType), intent(in):: fluid
type(stateBLDataType), intent(inout):: bl
type(pblgridDataType), intent(in)::grid
type(turbBLDataType), intent(inout):: turb
integer, intent(in):: hbl_option
call get_n2(turb, bl, fluid, grid)
call get_turb_length(turb, bl, fluid, grid, hbl_option)
if (turb%cl_type == 1) then ! FOM closures
call get_fo_coeffs(turb, bl, fluid, grid)
end if
if (turb%cl_type == 2) then ! KL closures
!call get_kl_coeffs(turb, bl, fluid, grid)
end if
end subroutine get_coeffs_general
end module pbl_turb_common