From a3d94a6b4fed9ff248ddf64be22543d564c07d05 Mon Sep 17 00:00:00 2001
From: Evgeny Mortikov <evgeny.mortikov@gmail.com>
Date: Wed, 18 Sep 2024 22:47:28 +0300
Subject: [PATCH] main driver update
---
.vscode/tasks.json | 2 +-
srcF/sfx_config.f90 | 13 +++-
srcF/sfx_main.f90 | 145 +++++++++++++++++---------------------------
3 files changed, 68 insertions(+), 92 deletions(-)
diff --git a/.vscode/tasks.json b/.vscode/tasks.json
index 748aab3..4edc48b 100644
--- a/.vscode/tasks.json
+++ b/.vscode/tasks.json
@@ -6,7 +6,7 @@
"label": "CMake: build",
"command": "build",
"targets": [
- "[N/A - Select Kit]"
+ "all"
],
"group": "build",
"problemMatcher": [],
diff --git a/srcF/sfx_config.f90 b/srcF/sfx_config.f90
index 142766a..cbcfb55 100644
--- a/srcF/sfx_config.f90
+++ b/srcF/sfx_config.f90
@@ -42,7 +42,18 @@ module sfx_config
character(len = 16), parameter :: dataset_toga_tag = 'toga'
character(len = 16), parameter :: dataset_user_tag = 'user'
-
+ type :: sfxDriverType
+ integer :: model_id
+ integer :: dataset_id
+
+ integer :: nmax
+
+ character(len = 256) :: filename_in_common
+ character(len = 256) :: filename_in
+ character(len = 256) :: filename_out
+ end type
+
+
contains
function get_model_id(tag) result(id)
diff --git a/srcF/sfx_main.f90 b/srcF/sfx_main.f90
index 5156269..abbea8a 100644
--- a/srcF/sfx_main.f90
+++ b/srcF/sfx_main.f90
@@ -1,6 +1,6 @@
!> @brief main run sfx subroutine
! ----------------------------------------------------------------------------
-subroutine run_sfx(dataset_id, model_id, filename_in_common, filename_in, filename_out, nmax)
+subroutine run(args)
use sfx_phys_const
use sfx_common
@@ -28,13 +28,10 @@ subroutine run_sfx(dataset_id, model_id, filename_in_common, filename_in, filena
! --------------------------------------------------------------------------------
- integer, intent(in) :: dataset_id !< dataset ID:
- character(len = 256) :: dataset_name
+ type(sfxDriverType), intent(in) :: args
- integer, intent(in) :: model_id !< sfx model ID
- character(len = 256) :: model_name
- ! input/output data
+ ! input/output model data
! --------------------------------------------------------------------------------
type(meteoDataVecType) :: meteo !< meteorological data (input)
type(meteoDataType) :: meteo_cell
@@ -47,17 +44,6 @@ subroutine run_sfx(dataset_id, model_id, filename_in_common, filename_in, filena
type(numericsType_sheba) :: numerics_sheba !< surface flux module (SHEBA) numerics parameters
integer :: num !< number of 'cells' in input
-
-
- ! --- input/output filenames
- character(len=*), intent(in) :: filename_in_common
- character(len=*), intent(in) :: filename_in
- character(len=*), intent(in) :: filename_out
- ! --------------------------------------------------------------------------------
-
- ! command line arguments
- ! --------------------------------------------------------------------------------
- integer, intent(in) :: nmax
! --------------------------------------------------------------------------------
! local variables
@@ -67,21 +53,18 @@ subroutine run_sfx(dataset_id, model_id, filename_in_common, filename_in, filena
! --------------------------------------------------------------------------------
- model_name = get_model_tag(model_id)
- dataset_name = get_dataset_tag(dataset_id)
-
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)
+ 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 = filename_in, iostat = status, status ='old')
+ open(32, file = args%filename_in, iostat = status, status ='old')
if (status /= 0) then
- write(*, *) ' FAILURE! > unable to open file: ', trim(filename_in)
+ write(*, *) ' FAILURE! > unable to open file: ', trim(args%filename_in)
return
end if
@@ -97,9 +80,9 @@ subroutine run_sfx(dataset_id, model_id, filename_in_common, filename_in, filena
! --- print number of elements in dataset
write(*, *) ' size = ', num
- if (nmax > 0) then
- write(*, *) ' nmax = ', nmax
- num = min(num, nmax)
+ if (args%nmax > 0) then
+ write(*, *) ' nmax = ', args%nmax
+ num = min(num, args%nmax)
end if
@@ -109,9 +92,9 @@ subroutine run_sfx(dataset_id, model_id, filename_in_common, filename_in, filena
!< @brief read input data common parameters
- open(32, file = filename_in_common, iostat = status, status = 'old')
+ open(32, file = args%filename_in_common, iostat = status, status = 'old')
if (status /= 0) then
- write(*, *) ' FAILURE! > unable to open file: ', trim(filename_in_common)
+ write(*, *) ' FAILURE! > unable to open file: ', trim(args%filename_in_common)
return
end if
read(32, *) meteo_cell%h, meteo_cell%z0_m
@@ -119,9 +102,9 @@ subroutine run_sfx(dataset_id, model_id, filename_in_common, filename_in, filena
!< @brief read input data
- open(32, file = filename_in, iostat = status, status = 'old')
+ open(32, file = args%filename_in, iostat = status, status = 'old')
if (status /= 0) then
- write(*, *) ' FAILURE! > unable to open file: ', trim(filename_in)
+ write(*, *) ' FAILURE! > unable to open file: ', trim(args%filename_in)
return
end if
do i = 1, num
@@ -138,19 +121,19 @@ subroutine run_sfx(dataset_id, model_id, filename_in_common, filename_in, filena
!< @brief calling flux module
- if (model_id == model_esm) then
+ if (args%model_id == model_esm) then
call get_surface_fluxes_vec_esm(sfx, meteo, numerics_esm, num)
- else if (model_id == model_log) then
+ else if (args%model_id == model_log) then
call get_surface_fluxes_vec_log(sfx, meteo, numerics_log, num)
- else if (model_id == model_most) then
+ else if (args%model_id == model_most) then
call get_surface_fluxes_vec_most(sfx, meteo, numerics_most, num)
- else if (model_id == model_sheba) then
+ 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(filename_out, &
+ 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, &
@@ -185,19 +168,7 @@ program sfx_main
! --------------------------------------------------------------------------------
- integer :: dataset_id !< dataset ID:
- character(len = 256) :: dataset_name
-
- integer :: model_id !< sfx model ID
- character(len = 256) :: model_name
-
- ! input/output data
- ! --------------------------------------------------------------------------------
- ! --- input/output filenames
- character(len = 256) :: filename_in_common
- character(len = 256) :: filename_in
- character(len = 256) :: filename_out
- ! --------------------------------------------------------------------------------
+ type(sfxDriverType) :: sfx_args
! command line arguments
! --------------------------------------------------------------------------------
@@ -211,7 +182,6 @@ program sfx_main
character(len = 128), parameter :: arg_key_help = '--help'
integer :: is_output_set
- integer :: nmax
! --------------------------------------------------------------------------------
! local variables
@@ -230,12 +200,13 @@ program sfx_main
#endif
- !< @brief define model & dataset
- model_id = model_esm !< default = ESM
- dataset_id = dataset_mosaic !< default = MOSAiC
-
+ !< @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
- nmax = 0
+
num_args = command_argument_count()
do i = 1, num_args
call get_command_argument(i, arg)
@@ -262,8 +233,8 @@ program sfx_main
end if
call get_command_argument(i + 1, arg)
- model_id = get_model_id(arg)
- if (model_id == -1) then
+ 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
@@ -275,19 +246,19 @@ program sfx_main
end if
call get_command_argument(i + 1, arg)
- dataset_id = get_dataset_id(arg)
- if (dataset_id == -1) then
+ 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 (dataset_id == dataset_user) then
+ 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, filename_in_common)
- call get_command_argument(i + 3, filename_in)
+ 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
@@ -295,7 +266,7 @@ program sfx_main
write(*, *) ' FAILURE! > missing output [key] argument'
stop
end if
- call get_command_argument(i + 1, filename_out)
+ call get_command_argument(i + 1, sfx_args%filename_out)
is_output_set = 1
end if
if (trim(arg) == trim(arg_key_nmax)) then
@@ -304,18 +275,29 @@ program sfx_main
stop
end if
call get_command_argument(i + 1, arg)
- call str2int(nmax, arg, status)
+ call str2int(sfx_args%nmax, arg, status)
if (status /= 0) then
write(*, *) ' FAILURE! > expecting int nmax [value]'
stop
end if
- if (nmax <= 0) then
+ if (sfx_args%nmax <= 0) then
write(*, *) ' FAILURE! > nmax [value] should be positive'
stop
end if
end if
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
call run("config.txt"//C_NULL_CHAR)
@@ -379,30 +361,10 @@ program sfx_main
!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'
+ !call get_float("dataset.h"//C_NULL_CHAR, meteo_cell%h)
+ !call get_float("dataset.z0_m"//C_NULL_CHAR, meteo_cell%z0_m)
- call run_sfx(dataset_id, model_id, filename_in_common, filename_in, filename_out, nmax)
-
-
-#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)
-#endif
-
-#ifdef USE_CONFIG_PARSER
deallocate(config_model_name)
deallocate(config_dataset_name)
@@ -411,5 +373,8 @@ program sfx_main
!if (is_output_set == 0) deallocate( fn_out )
#endif
+ !< @brief running main driver
+ call run(sfx_args)
stop
+
end program
\ No newline at end of file
--
GitLab