!> @brief main run sfx subroutine
! ----------------------------------------------------------------------------
subroutine sfx_run(args)
use sfx_phys_const
use sfx_common
use sfx_config
use sfx_io
use sfx_data
use sfx_esm, only: &
get_surface_fluxes_vec_esm => get_surface_fluxes_vec, &
numericsType_esm => numericsType
use sfx_log, only: &
get_surface_fluxes_vec_log => get_surface_fluxes_vec, &
numericsType_log => numericsType
use sfx_most, only: &
get_surface_fluxes_vec_most => get_surface_fluxes_vec, &
numericsType_most => numericsType
use sfx_sheba, only: &
get_surface_fluxes_vec_sheba => get_surface_fluxes_vec, &
numericsType_sheba => numericsType
! --------------------------------------------------------------------------------
! directives list
! --------------------------------------------------------------------------------
implicit none
! --------------------------------------------------------------------------------
type(sfxDriverType), intent(in) :: args
! input/output model data
! --------------------------------------------------------------------------------
type(meteoDataVecType) :: meteo !< meteorological data (input)
type(meteoDataType) :: meteo_cell
type(sfxDataVecType) :: sfx !< surface fluxes (output)
type(numericsType_esm) :: numerics_esm !< surface flux module (ESM) numerics parameters
type(numericsType_log) :: numerics_log !< surface flux module (LOG) numerics parameters
type(numericsType_most) :: numerics_most !< surface flux module (MOST) numerics parameters
type(numericsType_sheba) :: numerics_sheba !< surface flux module (SHEBA) numerics parameters
integer :: num !< number of 'cells' in input
! --------------------------------------------------------------------------------
! local variables
! --------------------------------------------------------------------------------
integer :: i
integer :: status
! --------------------------------------------------------------------------------
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)
!< @brief define number of cells
open(32, file = args%filename_in, iostat = status, status ='old')
if (status /= 0) then
write(*, *) ' FAILURE! > unable to open file: ', trim(args%filename_in)
return
end if
num = 0
status = 0
do while (status.eq.0)
read (32, *, iostat = status) meteo_cell%U, meteo_cell%dT, meteo_cell%Tsemi, meteo_cell%dQ
num = num + 1
enddo
num = num - 1
close(32)
! --- print number of elements in dataset
write(*, *) ' size = ', num
if (args%nmax > 0) then
write(*, *) ' nmax = ', args%nmax
num = min(num, args%nmax)
end if
!< @brief allocate input & output data
call allocate_meteo_vec(meteo, num)
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 read input data
open(32, file = args%filename_in, iostat = status, status = 'old')
if (status /= 0) then
write(*, *) ' FAILURE! > unable to open file: ', trim(args%filename_in)
return
end if
do i = 1, num
read(32, *) meteo_cell%U, meteo_cell%dT, meteo_cell%Tsemi, meteo_cell%dQ
meteo%h(i) = meteo_cell%h
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(32)
!< @brief calling flux module
if (args%model_id == model_esm) then
call get_surface_fluxes_vec_esm(sfx, meteo, numerics_esm, num)
else if (args%model_id == model_log) then
call get_surface_fluxes_vec_log(sfx, meteo, numerics_log, num)
else if (args%model_id == model_most) then
call get_surface_fluxes_vec_most(sfx, meteo, numerics_most, num)
else if (args%model_id == 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, &
sfx%zeta, sfx%Rib, &
sfx%Re, sfx%B, sfx%z0_m, sfx%z0_t, &
sfx%Rib_conv_lim, &
sfx%Cm,sfx%Ct, sfx%Km, sfx%Pr_t_inv, num, '(11(f10.4,3x))', status)
!< @brief deallocate input & output data
call deallocate_meteo_vec(meteo)
call deallocate_sfx_vec(sfx)
end subroutine
program sfx_main
! modules used
! --------------------------------------------------------------------------------
#ifdef USE_CONFIG_PARSER
use parser_sub_f
use parser
use sfx_surface
use iso_c_binding, only: C_NULL_CHAR
#endif
use sfx_common
use sfx_config
! --------------------------------------------------------------------------------
! directives list
! --------------------------------------------------------------------------------
implicit none
! --------------------------------------------------------------------------------
type(sfxDriverType) :: sfx_args
! command line arguments
! --------------------------------------------------------------------------------
integer :: num_args
character(len = 128) :: arg
character(len = 128), parameter :: arg_key_model = '--model'
character(len = 128), parameter :: arg_key_dataset = '--dataset'
character(len = 128), parameter :: arg_key_output = '--output'
character(len = 128), parameter :: arg_key_nmax = '--nmax'
character(len = 128), parameter :: arg_key_help = '--help'
integer :: is_output_set
! --------------------------------------------------------------------------------
! local variables
! --------------------------------------------------------------------------------
integer :: i
integer :: status
! --------------------------------------------------------------------------------
#ifdef USE_CONFIG_PARSER
character, allocatable :: config_field(:)
#endif
!< @brief define default model & dataset
sfx_args%model_id = model_esm !< default = ESM
sfx_args%dataset_id = dataset_mosaic !< default = MOSAiC
sfx_args%nmax = 0
is_output_set = 0
num_args = command_argument_count()
do i = 1, num_args
call get_command_argument(i, arg)
if (trim(arg) == trim(arg_key_help)) then
write(*, *) ' sfx model, usage:'
write(*, *) ' --help '
write(*, *) ' print usage options '
write(*, *) ' --model [key]'
write(*, *) ' key = esm (default) || log || most || sheba'
write(*, *) ' --dataset [key]'
write(*, *) ' key = mosaic (default) || irgason || sheba'
write(*, *) ' = lake || papa || toga || user [files]'
write(*, *) ' files = in-common-file in-file'
write(*, *) ' --output [file]'
write(*, *) ' set output filename '
write(*, *) ' --nmax [value]'
write(*, *) ' max number of data points > 0 '
stop
end if
if (trim(arg) == trim(arg_key_model)) then
if (i == num_args) then
write(*, *) ' FAILURE! > missing model [key] argument'
stop
end if
call get_command_argument(i + 1, arg)
sfx_args%model_id = get_model_id(arg)
if (sfx_args%model_id == -1) then
write(*, *) ' FAILURE! > unknown model [key]: ', trim(arg)
stop
end if
end if
if (trim(arg) == trim(arg_key_dataset)) then
if (i == num_args) then
write(*, *) ' FAILURE! > missing dataset [key] argument'
stop
end if
call get_command_argument(i + 1, arg)
sfx_args%dataset_id = get_dataset_id(arg)
if (sfx_args%dataset_id == -1) then
write(*, *) ' FAILURE! > unknown dataset [key]: ', trim(arg)
stop
end if
if (sfx_args%dataset_id == dataset_user) then
if (i + 3 > num_args) then
write(*, *) ' FAILURE! > incorrect arguments for [user] dataset'
stop
end if
call get_command_argument(i + 2, sfx_args%filename_in_common)
call get_command_argument(i + 3, sfx_args%filename_in)
end if
end if
if (trim(arg) == trim(arg_key_output)) then
if (i == num_args) then
write(*, *) ' FAILURE! > missing output [key] argument'
stop
end if
call get_command_argument(i + 1, sfx_args%filename_out)
is_output_set = 1
end if
if (trim(arg) == trim(arg_key_nmax)) then
if (i == num_args) then
write(*, *) ' FAILURE! > missing nmax [key] argument'
stop
end if
call get_command_argument(i + 1, arg)
call str2int(sfx_args%nmax, arg, status)
if (status /= 0) then
write(*, *) ' FAILURE! > expecting int nmax [value]'
stop
end if
if (sfx_args%nmax <= 0) then
write(*, *) ' FAILURE! > nmax [value] should be positive'
stop
end if
end if
end do
#ifdef USE_CONFIG_PARSER
call run("config.txt"//C_NULL_CHAR)
call get_charf("model.id"//C_NULL_CHAR, config_field)
sfx_args%model_id = get_model_id(char_array2str(config_field))
if (sfx_args%model_id == -1) then
write(*, *) ' FAILURE! > unknown model [key]: ', trim(char_array2str(config_field))
stop
end if
call get_charf("dataset.id"//C_NULL_CHAR, config_field)
sfx_args%dataset_id = get_dataset_id(char_array2str(config_field))
if (sfx_args%dataset_id == -1) then
write(*, *) ' FAILURE! > unknown dataset [key]: ', trim(char_array2str(config_field))
stop
end if
if (sfx_args%dataset_id == dataset_user) then
call get_charf("dataset.filename"//C_NULL_CHAR, config_field)
sfx_args%filename_in = char_array2str(config_field)
call get_charf("dataset.filename_param"//C_NULL_CHAR, config_field)
sfx_args%filename_in_common = char_array2str(config_field)
end if
call is_varname("dataset.nmax"//C_NULL_CHAR, status)
if (status /= 0) then
call get_int("dataset.nmax"//C_NULL_CHAR, sfx_args%nmax)
end if
call is_varname("output.filename"//C_NULL_CHAR, status)
if (status /= 0) then
call get_charf("output.filename"//C_NULL_CHAR, config_field)
sfx_args%filename_out = char_array2str(config_field)
is_output_set = 1
end if
deallocate(config_field)
#endif
!< @brief set input (& output) filenames for specific dataset
if (sfx_args%dataset_id /= dataset_user) then
sfx_args%filename_in_common = get_dataset_param_filename(sfx_args%dataset_id)
sfx_args%filename_in = get_dataset_filename(sfx_args%dataset_id)
end if
if (is_output_set == 0) then
sfx_args%filename_out = 'output-' // trim(get_dataset_tag(sfx_args%dataset_id)) // '.txt'
end if
!< @brief running main driver
call sfx_run(sfx_args)
stop
end program