Skip to content
Snippets Groups Projects
Commit 2b1349d7 authored by Evgeny Mortikov's avatar Evgeny Mortikov
Browse files

adding surface definitions

parent 34d1cad2
Branches
Tags
No related merge requests found
...@@ -17,8 +17,8 @@ module sfx_config ...@@ -17,8 +17,8 @@ module sfx_config
!> @brief model enum def. !> @brief model enum def.
integer, parameter :: model_esm = 0 !< ESM model integer, parameter :: model_esm = 0 !< ESM model
integer, parameter :: model_log = 1 !< LOG simplified model integer, parameter :: model_log = 1 !< LOG simplified model
integer, parameter :: model_most = 2 !< MOST simplified model integer, parameter :: model_most = 2 !< MOST model
integer, parameter :: model_sheba = 3 !< SHEBA simplified model integer, parameter :: model_sheba = 3 !< SHEBA model
character(len = 16), parameter :: model_esm_tag = 'esm' character(len = 16), parameter :: model_esm_tag = 'esm'
character(len = 16), parameter :: model_log_tag = 'log' character(len = 16), parameter :: model_log_tag = 'log'
...@@ -47,7 +47,7 @@ module sfx_config ...@@ -47,7 +47,7 @@ module sfx_config
character(len = 256) :: filename character(len = 256) :: filename
integer :: nmax integer :: nmax
integer :: surface_type integer :: surface
real :: h, z0_m, z0_h real :: h, z0_m, z0_h
end type end type
...@@ -139,6 +139,7 @@ contains ...@@ -139,6 +139,7 @@ contains
end function end function
subroutine set_dataset(dataset, id) subroutine set_dataset(dataset, id)
use sfx_surface
implicit none implicit none
type(sfxDatasetType), intent(out) :: dataset type(sfxDatasetType), intent(out) :: dataset
integer, intent(in) :: id integer, intent(in) :: id
...@@ -151,8 +152,8 @@ contains ...@@ -151,8 +152,8 @@ contains
dataset%id = id dataset%id = id
dataset%filename = get_dataset_filename(id) dataset%filename = get_dataset_filename(id)
dataset%nmax = 0 dataset%nmax = 0
! *: temporary surface type & z0(h) def.
dataset%surface_type = 1 dataset%surface = surface_land
dataset%z0_h = -1.0 dataset%z0_h = -1.0
if (id == dataset_mosaic) then if (id == dataset_mosaic) then
...@@ -167,13 +168,16 @@ contains ...@@ -167,13 +168,16 @@ contains
else if (id == dataset_lake) then else if (id == dataset_lake) then
! *: check & fix values ! *: check & fix values
dataset%h = 10.0 dataset%h = 10.0
dataset%surface = surface_lake
dataset%z0_m = -1.0 dataset%z0_m = -1.0
else if (id == dataset_papa) then else if (id == dataset_papa) then
dataset%h = 10.0 dataset%h = 10.0
dataset%surface = surface_ocean
dataset%z0_m = -1.0 dataset%z0_m = -1.0
else if (id == dataset_toga) then else if (id == dataset_toga) then
! *: check & fix values ! *: check & fix values
dataset%h = 15.0 dataset%h = 15.0
dataset%surface = surface_ocean
dataset%z0_m = -1.0 dataset%z0_m = -1.0
end if end if
......
...@@ -12,7 +12,6 @@ program sfx_main ...@@ -12,7 +12,6 @@ program sfx_main
implicit none implicit none
! -------------------------------------------------------------------------------- ! --------------------------------------------------------------------------------
type(sfxDatasetType) :: dataset type(sfxDatasetType) :: dataset
integer :: model integer :: model
......
...@@ -72,7 +72,7 @@ contains ...@@ -72,7 +72,7 @@ contains
write(*, '(a,a)') ' dataset = ', trim(get_dataset_tag(dataset%id)) write(*, '(a,a)') ' dataset = ', trim(get_dataset_tag(dataset%id))
write(*, '(a,a)') ' filename[IN] = ', trim(dataset%filename) write(*, '(a,a)') ' filename[IN] = ', trim(dataset%filename)
write(*, '(a,a)') ' filename[OUT] = ', trim(filename_out) write(*, '(a,a)') ' filename[OUT] = ', trim(filename_out)
write(*, '(a,g0)') ' surface type = ', dataset%surface_type write(*, '(a,g0)') ' surface type = ', dataset%surface
write(*, '(a,g0)') ' h = ', dataset%h write(*, '(a,g0)') ' h = ', dataset%h
write(*, '(a,g0)') ' z0(m) = ', dataset%z0_m write(*, '(a,g0)') ' z0(m) = ', dataset%z0_m
write(*, '(a,g0)') ' z0(h) = ', dataset%z0_h write(*, '(a,g0)') ' z0(h) = ', dataset%z0_h
......
...@@ -24,6 +24,12 @@ module sfx_surface ...@@ -24,6 +24,12 @@ module sfx_surface
integer, public, parameter :: surface_ocean = 0 !< ocean surface integer, public, parameter :: surface_ocean = 0 !< ocean surface
integer, public, parameter :: surface_land = 1 !< land surface integer, public, parameter :: surface_land = 1 !< land surface
integer, public, parameter :: surface_lake = 2 !< lake surface integer, public, parameter :: surface_lake = 2 !< lake surface
integer, public, parameter :: surface_snow = 3 !< snow covered surface
character(len = 16), parameter :: surface_ocean_tag = 'ocean'
character(len = 16), parameter :: surface_land_tag = 'land'
character(len = 16), parameter :: surface_lake_tag = 'lake'
character(len = 16), parameter :: surface_snow_tag = 'snow'
! -------------------------------------------------------------------------------- ! --------------------------------------------------------------------------------
real, parameter, private :: kappa = 0.40 !< von Karman constant [n/d] real, parameter, private :: kappa = 0.40 !< von Karman constant [n/d]
...@@ -60,6 +66,44 @@ module sfx_surface ...@@ -60,6 +66,44 @@ module sfx_surface
contains contains
! surface type definition
! --------------------------------------------------------------------------------
function get_surface_id(tag) result(id)
implicit none
character(len=*), intent(in) :: tag
integer :: id
id = - 1
if (trim(tag) == trim(surface_ocean_tag)) then
id = surface_ocean
else if (trim(tag) == trim(surface_land_tag)) then
id = surface_land
else if (trim(tag) == trim(surface_lake_tag)) then
id = surface_lake
else if (trim(tag) == trim(surface_snow_tag)) then
id = surface_snow
end if
end function
function get_surface_tag(id) result(tag)
implicit none
integer :: id
character(len=:), allocatable :: tag
tag = 'undefined'
if (id == surface_ocean) then
tag = surface_ocean_tag
else if (id == surface_land) then
tag = surface_land_tag
else if (id == surface_lake) then
tag = surface_lake_tag
else if (id == surface_snow) then
tag = surface_snow_tag
end if
end function
! charnock roughness definition ! charnock roughness definition
! -------------------------------------------------------------------------------- ! --------------------------------------------------------------------------------
subroutine get_charnock_roughness(z0_m, u_dyn0, U, h, maxiters) subroutine get_charnock_roughness(z0_m, u_dyn0, U, h, maxiters)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment