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

major update to main

parent a3d94a6b
Branches
Tags
No related merge requests found
...@@ -4,7 +4,7 @@ option(INCLUDE_CUDA "GPU build in mode" OFF) ...@@ -4,7 +4,7 @@ option(INCLUDE_CUDA "GPU build in mode" OFF)
option(INCLUDE_CXX "CXX build in mode" OFF) option(INCLUDE_CXX "CXX build in mode" OFF)
option(BUILD_DOC "Build documentation" OFF) option(BUILD_DOC "Build documentation" OFF)
option(SFX_CHECK_NAN "Build documentation" OFF) option(SFX_CHECK_NAN "Build documentation" OFF)
option(USE_CONFIG_PARSER "Build config parser" OFF) option(USE_CONFIG_PARSER "Build config parser" ON)
project(INMCM_sfx) project(INMCM_sfx)
enable_language(Fortran) enable_language(Fortran)
......
...@@ -42,6 +42,13 @@ module PARSER ...@@ -42,6 +42,13 @@ module PARSER
CHARACTER (KIND=C_CHAR), intent(out) :: value(*) CHARACTER (KIND=C_CHAR), intent(out) :: value(*)
END SUBROUTINE get_char_c END SUBROUTINE get_char_c
SUBROUTINE is_varname(name, status) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_CHAR, C_INT
IMPLICIT NONE
CHARACTER (KIND=C_CHAR), intent(in) :: name(*)
INTEGER (KIND=C_INT), intent(out) :: status
END SUBROUTINE is_varname
END INTERFACE END INTERFACE
contains contains
......
...@@ -32,6 +32,11 @@ void get_char_len(const char* name, int *len) ...@@ -32,6 +32,11 @@ void get_char_len(const char* name, int *len)
*len = get_char_lenCXX(name); *len = get_char_lenCXX(name);
} }
void is_varname(const char* name, int* status)
{
is_varnameCXX(name, status);
}
// int get_bool(const char* name, bool* value) // int get_bool(const char* name, bool* value)
// { // {
// return get_valueCXX(name, value); // return get_valueCXX(name, value);
......
...@@ -62,6 +62,12 @@ extern "C" { ...@@ -62,6 +62,12 @@ extern "C" {
return 1; return 1;
} }
void is_varnameCXX(const char* name, int* status)
{
bool flag = Parser.is_varname(name);
(*status) = (int)flag;
}
// bool get_valueCXX(const char* name, std::string& value) // bool get_valueCXX(const char* name, std::string& value)
// { // {
// return Parser.get_value(name, value); // return Parser.get_value(name, value);
......
...@@ -13,6 +13,8 @@ extern "C" { ...@@ -13,6 +13,8 @@ extern "C" {
int get_char_lenCXX(const char* name); int get_char_lenCXX(const char* name);
int get_charCXX(const char* name, char* value); int get_charCXX(const char* name, char* value);
void is_varnameCXX(const char* name, int* status);
// bool get_valueCXX(const char* name, bool* value); // bool get_valueCXX(const char* name, bool* value);
#ifdef __cplusplus #ifdef __cplusplus
......
...@@ -18,6 +18,20 @@ contains ...@@ -18,6 +18,20 @@ contains
end subroutine str2int end subroutine str2int
! ---------------------------------------------------------------------------- ! ----------------------------------------------------------------------------
!> @brief string to real conversion
elemental subroutine str2real(x, str, stat)
! ----------------------------------------------------------------------------
implicit none
real, intent(out) :: x
integer, intent(out) :: stat !> output status, /= 0 signals ERROR
character(len = *), intent(in) :: str
! ----------------------------------------------------------------------------
read(str, * , iostat = stat) x
end subroutine str2real
! ----------------------------------------------------------------------------
!> @brief character array to string conversion !> @brief character array to string conversion
function char_array2str(char_array) result(str) function char_array2str(char_array) result(str)
! ---------------------------------------------------------------------------- ! ----------------------------------------------------------------------------
......
!> @brief main run sfx subroutine !> @brief main run sfx subroutine
! ---------------------------------------------------------------------------- ! ----------------------------------------------------------------------------
subroutine run(args) subroutine sfx_run(args)
use sfx_phys_const use sfx_phys_const
use sfx_common use sfx_common
...@@ -152,9 +152,9 @@ program sfx_main ...@@ -152,9 +152,9 @@ program sfx_main
! modules used ! modules used
! -------------------------------------------------------------------------------- ! --------------------------------------------------------------------------------
#ifdef USE_CONFIG_PARSER #ifdef USE_CONFIG_PARSER
USE PARSER_SUB_F use parser_sub_f
USE PARSER use parser
USE sfx_surface use sfx_surface
use iso_c_binding, only: C_NULL_CHAR use iso_c_binding, only: C_NULL_CHAR
#endif #endif
...@@ -191,12 +191,7 @@ program sfx_main ...@@ -191,12 +191,7 @@ program sfx_main
! -------------------------------------------------------------------------------- ! --------------------------------------------------------------------------------
#ifdef USE_CONFIG_PARSER #ifdef USE_CONFIG_PARSER
character, allocatable :: config_model_name(:) character, allocatable :: config_field(:)
character, allocatable :: config_dataset_name(:)
character, allocatable :: fn_in_common(:), fn_in(:), fn_out(:)
integer :: sfx_type
real :: z0_m
#endif #endif
...@@ -287,94 +282,58 @@ program sfx_main ...@@ -287,94 +282,58 @@ program sfx_main
end if end if
end do end do
!< @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
#ifdef USE_CONFIG_PARSER #ifdef USE_CONFIG_PARSER
call run("config.txt"//C_NULL_CHAR) call run("config.txt"//C_NULL_CHAR)
call get_charf("model.type"//C_NULL_CHAR, config_model_name) call get_charf("model.id"//C_NULL_CHAR, config_field)
if (compare_char_arrays(config_model_name, trim(model_esm_tag))) then sfx_args%model_id = get_model_id(char_array2str(config_field))
model_id = model_esm if (sfx_args%model_id == -1) then
else if (compare_char_arrays(config_model_name, trim(model_log_tag))) then write(*, *) ' FAILURE! > unknown model [key]: ', trim(char_array2str(config_field))
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 stop
end if end if
call get_charf("dataset.type"//C_NULL_CHAR, config_dataset_name) call get_charf("dataset.id"//C_NULL_CHAR, config_field)
if (compare_char_arrays(config_dataset_name, trim(dataset_mosaic_tag))) then sfx_args%dataset_id = get_dataset_id(char_array2str(config_field))
dataset_id = dataset_MOSAiC if (sfx_args%dataset_id == -1) then
else if (compare_char_arrays(config_dataset_name, trim(dataset_irgason_tag))) then write(*, *) ' FAILURE! > unknown dataset [key]: ', trim(char_array2str(config_field))
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 stop
end if 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("input_files.filename_in_common"//C_NULL_CHAR, fn_in_common) call get_charf("dataset.filename_param"//C_NULL_CHAR, config_field)
!call get_charf("input_files.filename_in"//C_NULL_CHAR, fn_in) sfx_args%filename_in_common = char_array2str(config_field)
!if (is_output_set == 0) call get_charf("input_files.filename_out"//C_NULL_CHAR, fn_out) end if
!sfx_type = get_sfx_type("surface.surface_type"//C_NULL_CHAR) 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
!if ( (sfx_type == surface_ocean) .or. (sfx_type == surface_lake) ) then call is_varname("output.filename"//C_NULL_CHAR, status)
! call get_float("surface.z0_m"//C_NULL_CHAR, z0_m) if (status /= 0) then
!end if call get_charf("output.filename"//C_NULL_CHAR, config_field)
sfx_args%filename_out = char_array2str(config_field)
!write(*, *) "fn_in_common: ", fn_in_common is_output_set = 1
!write(*, *) "fn_in: ", fn_in end if
!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
!call get_float("dataset.h"//C_NULL_CHAR, meteo_cell%h) deallocate(config_field)
!call get_float("dataset.z0_m"//C_NULL_CHAR, meteo_cell%z0_m) #endif
deallocate(config_model_name) !< @brief set input (& output) filenames for specific dataset
deallocate(config_dataset_name) 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
!deallocate( fn_in_common ) if (is_output_set == 0) then
!deallocate( fn_in ) sfx_args%filename_out = 'output-' // trim(get_dataset_tag(sfx_args%dataset_id)) // '.txt'
!if (is_output_set == 0) deallocate( fn_out ) end if
#endif
!< @brief running main driver !< @brief running main driver
call run(sfx_args) call sfx_run(sfx_args)
stop stop
end program end program
\ No newline at end of file
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment