Skip to content
Snippets Groups Projects
Commit c9076a2c authored by Виктория Суязова's avatar Виктория Суязова Committed by Anna Shestakova
Browse files

added surf type, lai, depth in api_inmcm, run, dataset%

parent d33c2c55
Branches
No related tags found
No related merge requests found
......@@ -20,12 +20,16 @@ module sfx_api_inmcm
contains
! --------------------------------------------------------------------------------
subroutine inmcm_to_sfx_in_cell(meteo, arg)
subroutine inmcm_to_sfx_in_cell(meteo, arg, VEG, depth_inm, lai_inm)
!> @brief converts legacy arg [AR1 INMCM format] array to sfx meteo input
! ----------------------------------------------------------------------------
implicit none
type (meteoDataType), intent(inout) :: meteo
real, dimension(6), intent(in) :: arg
integer,intent(in) :: VEG
real,intent(in) :: depth_inm
real,intent(in) :: lai_inm
! ----------------------------------------------------------------------------
......@@ -35,6 +39,9 @@ contains
meteo%dQ = arg(4)
meteo%h = arg(5)
meteo%z0_m = arg(6)
meteo%depth = depth_inm
meteo%lai = lai_inm
meteo%surface_type = VEG
end subroutine inmcm_to_sfx_in_cell
! --------------------------------------------------------------------------------
......
......@@ -53,8 +53,8 @@
character(len = 256) :: filename
integer :: nmax
integer :: surface
real :: h, z0_m, z0_h
integer :: surface, surface_type
real :: h, z0_m, z0_h, lai, depth
end type
......@@ -168,7 +168,10 @@ contains
dataset%nmax = 0
dataset%surface = surface_land
dataset%surface_type = surface_land
dataset%z0_h = -1.0
dataset%lai = 1.0
dataset%depth = 10.0
if (id == dataset_mosaic) then
dataset%h = 3.8
......
......@@ -35,6 +35,9 @@ module sfx_data
real(C_FLOAT) :: Tsemi !< semi-sum of potential temperature at 'h' and at surface [K]
real(C_FLOAT) :: dQ !< difference between humidity at 'h' and at surface [g/g]
real(C_FLOAT) :: z0_m !< surface aerodynamic roughness (should be < 0 for water bodies surface)
real(C_FLOAT) :: depth
real(C_FLOAT) :: lai
integer(C_INT) :: surface_type
end type
!> @brief meteorological input for surface flux calculation
......@@ -46,6 +49,9 @@ module sfx_data
real, allocatable :: Tsemi(:) !< semi-sum of potential temperature at 'h' and at surface [K]
real, allocatable :: dQ(:) !< difference between humidity at 'h' and at surface [g/g]
real, allocatable :: z0_m(:) !< surface aerodynamic roughness (should be < 0 for water bodies surface)
real, allocatable :: depth(:)
real, allocatable :: lai(:)
integer, allocatable :: surface_type(:)
end type
#if defined(INCLUDE_CXX)
......@@ -57,6 +63,10 @@ module sfx_data
type(C_PTR) :: Tsemi !< semi-sum of potential temperature at 'h' and at surface [K]
type(C_PTR) :: dQ !< difference between humidity at 'h' and at surface [g/g]
type(C_PTR) :: z0_m !< surface aerodynamic roughness (should be < 0 for water bodies surface)
type(C_PTR) :: depth
type(C_PTR) :: lai
type(C_PTR) :: surface_type
end type
#endif
! --------------------------------------------------------------------------------
......@@ -157,6 +167,9 @@ contains
allocate(meteo%Tsemi(n))
allocate(meteo%dQ(n))
allocate(meteo%z0_m(n))
allocate(meteo%depth(n))
allocate(meteo%lai(n))
allocate(meteo%surface_type(n))
end subroutine allocate_meteo_vec
......@@ -173,6 +186,9 @@ contains
meteo_C%Tsemi = c_loc(meteo%Tsemi)
meteo_C%dQ = c_loc(meteo%dQ)
meteo_C%z0_m = c_loc(meteo%z0_m)
meteo_C%depth = c_loc(meteo%depth)
meteo_C%lai = c_loc(meteo%lai)
meteo_C%surface_type = c_loc(meteo%surface_type)
end subroutine set_meteo_vec_c
#endif
! --------------------------------------------------------------------------------
......@@ -190,6 +206,9 @@ contains
deallocate(meteo%Tsemi)
deallocate(meteo%dQ)
deallocate(meteo%z0_m)
deallocate(meteo%depth)
deallocate(meteo%lai)
deallocate(meteo%surface_type)
end subroutine deallocate_meteo_vec
! --------------------------------------------------------------------------------
......
......@@ -89,6 +89,9 @@ contains
write(*, '(a,g0)') ' h = ', dataset%h
write(*, '(a,g0)') ' z0(m) = ', dataset%z0_m
write(*, '(a,g0)') ' z0(h) = ', dataset%z0_h
write(*, '(a,g0)') ' z0(h) = ', dataset%lai
write(*, '(a,g0)') ' z0(h) = ', dataset%depth
write(*, '(a,g0)') ' z0(h) = ', dataset%surface_type
! --- define number of elements
......@@ -125,6 +128,9 @@ contains
! --- setting height & roughness
meteo_cell%h = dataset%h
meteo_cell%z0_m = dataset%z0_m
meteo_cell%depth = dataset%depth
meteo_cell%lai = dataset%lai
meteo_cell%surface_type = dataset%surface_type
! --- read input data
open(newunit = io, file = dataset%filename, iostat = status, status = 'old')
......@@ -137,11 +143,16 @@ contains
read(io, *) meteo_cell%U, meteo_cell%dT, meteo_cell%Tsemi, meteo_cell%dQ
meteo%h(i) = meteo_cell%h
meteo%depth(i)=meteo_cell%depth
meteo%lai(i)=meteo_cell%lai
meteo%surface_type(i)=meteo_cell%surface_type
meteo%U(i) = meteo_cell%U
meteo%dT(i) = meteo_cell%dT
meteo%Tsemi(i) = meteo_cell%Tsemi
meteo%dQ(i) = meteo_cell%dQ
meteo%z0_m(i) = meteo_cell%z0_m
enddo
close(io)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment