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

main program update

parent ffe43032
No related branches found
No related tags found
No related merge requests found
......@@ -42,6 +42,15 @@ module sfx_config
character(len = 16), parameter :: dataset_toga_tag = 'toga'
character(len = 16), parameter :: dataset_user_tag = 'user'
type :: sfxDatasetType
integer :: id
character(len = 256) :: filename
integer :: nmax
integer :: surface_type
real :: h, z0_m, z0_h
end type
type :: sfxDriverType
integer :: model_id
integer :: dataset_id
......@@ -118,7 +127,7 @@ contains
function get_dataset_tag(id) result(tag)
implicit none
integer :: id
integer, intent(in) :: id
character(len=:), allocatable :: tag
tag = 'undefined'
......
!> @brief main run sfx subroutine
!> @brief main run sfx on dataset subroutine
! ----------------------------------------------------------------------------
subroutine sfx_run(args)
subroutine run_dataset(filename_out, dataset, model)
use sfx_phys_const
use sfx_common
......@@ -27,8 +27,9 @@ subroutine sfx_run(args)
implicit none
! --------------------------------------------------------------------------------
type(sfxDriverType), intent(in) :: args
character(len=*), intent(in) :: filename_out
type(sfxDatasetType), intent(in) :: dataset
integer, intent(in) :: model
! input/output model data
......@@ -53,18 +54,21 @@ subroutine sfx_run(args)
! --------------------------------------------------------------------------------
write(*, *) ' Running SFX model'
write(*, *) ' model = ', trim(get_model_tag(args%model_id))
write(*, *) ' dataset = ', trim(get_dataset_tag(args%dataset_id))
write(*, *) ' filename[IN-COMMON] = ', trim(args%filename_in_common)
write(*, *) ' filename[IN] = ', trim(args%filename_in)
write(*, *) ' filename[OUT] = ', trim(args%filename_out)
write(*, *) ' Running SFX:'
write(*, *) ' model = ', trim(get_model_tag(model))
write(*, *) ' dataset = ', trim(get_dataset_tag(dataset%id))
write(*, *) ' filename[IN] = ', trim(dataset%filename)
write(*, *) ' filename[OUT] = ', trim(filename_out)
write(*, *) ' surface type = ', dataset%surface_type
write(*, *) ' h = ', dataset%h
write(*, *) ' z0(m) = ', dataset%z0_m
write(*, *) ' z0(h) = ', dataset%z0_h
!< @brief define number of cells
open(32, file = args%filename_in, iostat = status, status ='old')
open(32, file = dataset%filename, iostat = status, status ='old')
if (status /= 0) then
write(*, *) ' FAILURE! > unable to open file: ', trim(args%filename_in)
write(*, *) ' FAILURE! > unable to open file: ', trim(dataset%filename)
return
end if
......@@ -80,9 +84,9 @@ subroutine sfx_run(args)
! --- print number of elements in dataset
write(*, *) ' size = ', num
if (args%nmax > 0) then
write(*, *) ' nmax = ', args%nmax
num = min(num, args%nmax)
if (dataset%nmax > 0) then
write(*, *) ' nmax = ', dataset%nmax
num = min(num, dataset%nmax)
end if
......@@ -91,20 +95,14 @@ subroutine sfx_run(args)
call allocate_sfx_vec(sfx, num)
!< @brief read input data common parameters
open(32, file = args%filename_in_common, iostat = status, status = 'old')
if (status /= 0) then
write(*, *) ' FAILURE! > unable to open file: ', trim(args%filename_in_common)
return
end if
read(32, *) meteo_cell%h, meteo_cell%z0_m
close(32)
!< @brief setting height & roughness
meteo_cell%h = dataset%h
meteo_cell%z0_m = dataset%z0_m
!< @brief read input data
open(32, file = args%filename_in, iostat = status, status = 'old')
open(32, file = dataset%filename, iostat = status, status = 'old')
if (status /= 0) then
write(*, *) ' FAILURE! > unable to open file: ', trim(args%filename_in)
write(*, *) ' FAILURE! > unable to open file: ', trim(dataset%filename)
return
end if
do i = 1, num
......@@ -121,19 +119,19 @@ subroutine sfx_run(args)
!< @brief calling flux module
if (args%model_id == model_esm) then
if (model == model_esm) then
call get_surface_fluxes_vec_esm(sfx, meteo, numerics_esm, num)
else if (args%model_id == model_log) then
else if (model == model_log) then
call get_surface_fluxes_vec_log(sfx, meteo, numerics_log, num)
else if (args%model_id == model_most) then
else if (model == model_most) then
call get_surface_fluxes_vec_most(sfx, meteo, numerics_most, num)
else if (args%model_id == model_sheba) then
else if (model == model_sheba) then
call get_surface_fluxes_vec_sheba(sfx, meteo, numerics_sheba, num)
end if
!< @brief write output data
call write_ascii_vec11(args%filename_out, &
call write_ascii_vec11(filename_out, &
sfx%zeta, sfx%Rib, &
sfx%Re, sfx%B, sfx%z0_m, sfx%z0_t, &
sfx%Rib_conv_lim, &
......@@ -169,6 +167,7 @@ program sfx_main
type(sfxDriverType) :: sfx_args
type(sfxDatasetType) :: dataset
! command line arguments
! --------------------------------------------------------------------------------
......@@ -333,7 +332,25 @@ program sfx_main
end if
!< @brief running main driver
call sfx_run(sfx_args)
dataset%id = sfx_args%dataset_id
dataset%filename = sfx_args%filename_in
dataset%surface_type = 1
dataset%h = 10.0
dataset%z0_m = -1.0
dataset%z0_h = -1.0
dataset%nmax = sfx_args%nmax
!< @brief read input data common parameters
open(32, file = sfx_args%filename_in_common, iostat = status, status = 'old')
if (status /= 0) then
write(*, *) ' FAILURE! > unable to open file: ', trim(sfx_args%filename_in_common)
return
end if
read(32, *) dataset%h, dataset%z0_m
close(32)
!< @brief running main driver
call run_dataset(sfx_args%filename_out, dataset, sfx_args%model_id)
stop
end program
\ No newline at end of file
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment