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_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
! --------------------------------------------------------------------------------
integer :: dataset_id !< dataset ID:
character(len = 256) :: dataset_name
integer :: model_id !< sfx model ID
character(len = 256) :: model_name
! input/output 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
! --- input/output filenames
character(len = 256) :: filename_in_common
character(len = 256) :: filename_in
character(len = 256) :: filename_out
! --------------------------------------------------------------------------------
! 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
integer :: nmax
! --------------------------------------------------------------------------------
! local variables
! --------------------------------------------------------------------------------
integer :: i
integer :: status
! --------------------------------------------------------------------------------
#ifdef USE_CONFIG_PARSER
character, allocatable :: config_model_name(:)
character, allocatable :: config_dataset_name(:)
character, allocatable :: fn_in_common(:), fn_in(:), fn_out(:)
integer :: sfx_type
real :: z0_m
#endif
!< @brief define model & dataset
model_id = model_esm !< default = ESM
dataset_id = dataset_mosaic !< default = MOSAiC
is_output_set = 0
nmax = 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)
model_id = get_model_id(arg)
if (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)
dataset_id = get_dataset_id(arg)
if (dataset_id == -1) then
write(*, *) ' FAILURE! > unknown dataset [key]: ', trim(arg)
stop
end if
if (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, filename_in_common)
call get_command_argument(i + 3, 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, 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(nmax, arg, status)
if (status /= 0) then
write(*, *) ' FAILURE! > expecting int nmax [value]'
stop
end if
if (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.type"//C_NULL_CHAR, config_model_name)
if (compare_char_arrays(config_model_name, trim(model_esm_tag))) then
model_id = model_esm
else if (compare_char_arrays(config_model_name, trim(model_log_tag))) then
model_id = model_log
else if (compare_char_arrays(config_model_name, trim(model_most_tag))) then
model_id = model_most
else if (compare_char_arrays(config_model_name, trim(model_sheba_tag))) then
model_id = model_sheba
else
write(*, *) ' FAILURE! > unknown model [key]: ', config_model_name
stop
end if
call get_charf("dataset.type"//C_NULL_CHAR, config_dataset_name)
if (compare_char_arrays(config_dataset_name, trim(dataset_mosaic_tag))) then
dataset_id = dataset_MOSAiC
else if (compare_char_arrays(config_dataset_name, trim(dataset_irgason_tag))) then
dataset_id = dataset_IRGASON
else if (compare_char_arrays(config_dataset_name, trim(dataset_sheba_tag))) then
dataset_id = dataset_SHEBA
else if (compare_char_arrays(config_dataset_name, trim(dataset_lake_tag))) then
dataset_id = dataset_LAKE
else if (compare_char_arrays(config_dataset_name, trim(dataset_papa_tag))) then
dataset_id = dataset_PAPA
else if (compare_char_arrays(config_dataset_name, trim(dataset_toga_tag))) then
dataset_id = dataset_TOGA
else if (compare_char_arrays(config_dataset_name, trim(dataset_user_tag))) then
dataset_id = dataset_USER
!call get_charf("dataset.filename"//C_NULL_CHAR, config_dataset_filename)
!call get_charf("dataset.filename_params"//C_NULL_CHAR, config_dataset_filename_params)
write(*, *) ' FAILURE! > user dataset is not supported: ', config_dataset_name
stop
!call get_command_argument(i + 2, filename_in_common)
!call get_command_argument(i + 3, filename_in)
!call get_command_argument(i + 4, filename_out)
else
write(*, *) ' FAILURE! > unknown dataset [key]: ', config_dataset_name
stop
end if
!call get_charf("input_files.filename_in_common"//C_NULL_CHAR, fn_in_common)
!call get_charf("input_files.filename_in"//C_NULL_CHAR, fn_in)
!if (is_output_set == 0) call get_charf("input_files.filename_out"//C_NULL_CHAR, fn_out)
!sfx_type = get_sfx_type("surface.surface_type"//C_NULL_CHAR)
!if ( (sfx_type == surface_ocean) .or. (sfx_type == surface_lake) ) then
! call get_float("surface.z0_m"//C_NULL_CHAR, z0_m)
!end if
!write(*, *) "fn_in_common: ", fn_in_common
!write(*, *) "fn_in: ", fn_in
!if (is_output_set == 0) write(*, *) "fn_out: ", fn_out
!write(*, *) "sfx_type: ", sfx_type
!if ( (sfx_type == surface_ocean) .or. (sfx_type == surface_lake) ) then
! write(*, *) "z0_m: ", z0_m
!end if
#endif
!< @brief set name for specific model
model_name = get_model_tag(model_id)
!< @brief set name & filenames for specific dataset
dataset_name = get_dataset_tag(dataset_id)
if (dataset_id /= dataset_user) then
filename_in_common = get_dataset_param_filename(dataset_id)
filename_in = get_dataset_filename(dataset_id)
end if
if (is_output_set == 0) filename_out = 'output-' // trim(dataset_name) // '.txt'
write(*, *) ' Running SFX model'
write(*, *) ' model = ', trim(model_name)
write(*, *) ' dataset = ', trim(dataset_name)
write(*, *) ' filename[IN-COMMON] = ', trim(filename_in_common)
write(*, *) ' filename[IN] = ', trim(filename_in)
write(*, *) ' filename[OUT] = ', trim(filename_out)
!< @brief define number of cells
open(1, file= filename_in, iostat = status, status ='old')
if (status /= 0) then
write(*, *) ' FAILURE! > unable to open file: ', trim(filename_in)
stop
end if
num = 0
status = 0
do while (status.eq.0)
read (1, *, iostat = status) meteo_cell%U, meteo_cell%dT, meteo_cell%Tsemi, meteo_cell%dQ
num = num + 1
enddo
num = num - 1
close(1)
! --- print number of elements in dataset
write(*, *) ' size = ', num
if (nmax > 0) then
write(*, *) ' nmax = ', nmax
num = min(num, nmax)
end if
!< @brief allocate input & output data
call allocate_meteo_vec(meteo, num)
call allocate_sfx_vec(sfx, num)
#ifdef USE_CONFIG_PARSER
call get_float("dataset.h"//C_NULL_CHAR, meteo_cell%h)
call get_float("dataset.z0_m"//C_NULL_CHAR, meteo_cell%z0_m)
#else
!< @brief read input data common parameters
open(1, file = filename_in_common, status = 'old')
read(1, *) meteo_cell%h, meteo_cell%z0_m
close(1)
#endif
!< @brief read input data
open(1, file = filename_in, status = 'old')
do i = 1, num
read(1, *) 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(1)
!< @brief calling flux module
if (model_id == model_esm) then
call get_surface_fluxes_vec_esm(sfx, meteo, numerics_esm, num)
else if (model_id == model_log) then
call get_surface_fluxes_vec_log(sfx, meteo, numerics_log, num)
else if (model_id == model_most) then
call get_surface_fluxes_vec_most(sfx, meteo, numerics_most, num)
else if (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(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)
#ifdef USE_CONFIG_PARSER
deallocate(config_model_name)
deallocate(config_dataset_name)
!deallocate( fn_in_common )
!deallocate( fn_in )
!if (is_output_set == 0) deallocate( fn_out )
#endif
! *: remove formats: not needed
10 format (f8.4,2x,f8.4)
20 format (11(f10.4,3x))
stop
end program