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

adding error handling in main run subroutine

parent 113fb8f3
Branches
Tags
No related merge requests found
......@@ -12,19 +12,21 @@ program sfx_main
implicit none
! --------------------------------------------------------------------------------
character(len=:), allocatable :: filename_out
type(sfxDatasetType) :: dataset
integer :: model
character(len=:), allocatable :: filename_out
integer :: status
! --------------------------------------------------------------------------------
! *: explicit call to stop to print exceptions raised
! --- setting run
call set_run(filename_out, dataset, model)
call set_run(filename_out, dataset, model, status)
if (status /= 0) stop
! --- running main driver
call run_dataset(filename_out, dataset, model)
! *: explicit call to stop to print exceptions raised
call run_dataset(filename_out, dataset, model, status)
stop
end program
......@@ -17,7 +17,7 @@ contains
!> @brief run sfx on dataset
! ----------------------------------------------------------------------------
subroutine run_dataset(filename_out, dataset, model)
subroutine run_dataset(filename_out, dataset, model, ierr)
! modules used
! --------------------------------------------------------------------------------
......@@ -46,6 +46,8 @@ contains
type(sfxDatasetType), intent(in) :: dataset
integer, intent(in) :: model
integer, intent(out) :: ierr
! input/output model data
! --------------------------------------------------------------------------------
type(meteoDataVecType) :: meteo !< meteorological data (input)
......@@ -68,6 +70,8 @@ contains
! --------------------------------------------------------------------------------
ierr = 0 ! = OK
write(*, *) ' Running SFX:'
write(*, '(a,a)') ' model = ', trim(get_model_tag(model))
write(*, '(a,a)') ' dataset = ', trim(get_dataset_tag(dataset%id))
......@@ -83,6 +87,7 @@ contains
open(newunit = io, file = dataset%filename, iostat = status, status ='old')
if (status /= 0) then
write(*, *) ' FAILURE! > unable to open file: ', trim(dataset%filename)
ierr = status
return
end if
......@@ -117,6 +122,7 @@ contains
open(newunit = io, file = dataset%filename, iostat = status, status = 'old')
if (status /= 0) then
write(*, *) ' FAILURE! > unable to open file: ', trim(dataset%filename)
ierr = status
return
end if
do i = 1, num
......@@ -150,6 +156,11 @@ contains
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)
if (status /= 0) then
write(*, *) ' FAILURE! > unable to write to file: ', trim(filename_out)
ierr = status
return
end if
! --- deallocate input & output data
......@@ -160,7 +171,7 @@ contains
!> @brief set sfx run on dataset
! ----------------------------------------------------------------------------
subroutine set_run(filename_out, dataset, model)
subroutine set_run(filename_out, dataset, model, ierr)
! modules used
! --------------------------------------------------------------------------------
......@@ -178,6 +189,8 @@ contains
type(sfxDatasetType), intent(out) :: dataset
integer, intent(out) :: model
integer, intent(out) :: ierr
! command line arguments
! --------------------------------------------------------------------------------
integer :: num_args
......@@ -204,6 +217,8 @@ contains
! --------------------------------------------------------------------------------
ierr = 0 ! = OK
! --- default model & dataset
model = model_esm ! default = ESM
call set_dataset(dataset, dataset_mosaic) ! default = MOSAiC
......@@ -230,31 +245,35 @@ contains
write(*, *) ' use configuration file'
write(*, *) ' --nmax [value]'
write(*, *) ' max number of data points > 0'
stop
return
end if
if (trim(arg) == trim(arg_key_model)) then
if (i == num_args) then
write(*, *) ' FAILURE! > missing model [key] argument'
stop
ierr = 1 ! signal ERROR
return
end if
call get_command_argument(i + 1, arg)
model = get_model_id(arg)
if (model == -1) then
write(*, *) ' FAILURE! > unknown model [key]: ', trim(arg)
stop
ierr = 1 ! signal ERROR
return
end if
else if (trim(arg) == trim(arg_key_dataset)) then
if (i == num_args) then
write(*, *) ' FAILURE! > missing dataset [key] argument'
stop
ierr = 1 ! signal ERROR
return
end if
call get_command_argument(i + 1, arg)
id = get_dataset_id(arg)
if (id == -1) then
write(*, *) ' FAILURE! > unknown dataset [key]: ', trim(arg)
stop
ierr = 1 ! signal ERROR
return
end if
!< save nmax if previously set
nmax = dataset%nmax
......@@ -265,7 +284,8 @@ contains
!< @brief user-defined dataset
if (i + 6 > num_args) then
write(*, *) ' FAILURE! > incorrect arguments for [user] dataset'
stop
ierr = 1 ! signal ERROR
return
end if
!< filename
......@@ -276,7 +296,8 @@ contains
dataset%surface = get_surface_id(arg)
if (dataset%surface == -1) then
write(*, *) ' FAILURE! > unknown surface [key]: ', trim(arg)
stop
ierr = 1 ! signal ERROR
return
end if
!< reading 'h'
......@@ -284,11 +305,13 @@ contains
call str2real(dataset%h, arg, status)
if (status /= 0) then
write(*, *) ' FAILURE! > expecting real h [value]'
stop
ierr = 1 ! signal ERROR
return
end if
if (dataset%h <= 0) then
write(*, *) ' FAILURE! > h [value] should be positive'
stop
ierr = 1 ! signal ERROR
return
end if
!< reading 'z0(m)'
......@@ -296,7 +319,8 @@ contains
call str2real(dataset%z0_m, arg, status)
if (status /= 0) then
write(*, *) ' FAILURE! > expecting real z0(m) [value]'
stop
ierr = 1 ! signal ERROR
return
end if
!< reading 'z0(h)'
......@@ -304,14 +328,16 @@ contains
call str2real(dataset%z0_h, arg, status)
if (status /= 0) then
write(*, *) ' FAILURE! > expecting real z0(h) [value]'
stop
ierr = 1 ! signal ERROR
return
end if
end if
else if (trim(arg) == trim(arg_key_output)) then
if (i == num_args) then
write(*, *) ' FAILURE! > missing output [key] argument'
stop
ierr = 1 ! signal ERROR
return
end if
call get_command_argument(i + 1, arg)
filename_out = trim(arg)
......@@ -319,22 +345,26 @@ contains
else if (trim(arg) == trim(arg_key_nmax)) then
if (i == num_args) then
write(*, *) ' FAILURE! > missing nmax [key] argument'
stop
ierr = 1 ! signal ERROR
return
end if
call get_command_argument(i + 1, arg)
call str2int(dataset%nmax, arg, status)
if (status /= 0) then
write(*, *) ' FAILURE! > expecting int nmax [value]'
stop
ierr = 1 ! signal ERROR
return
end if
if (dataset%nmax <= 0) then
write(*, *) ' FAILURE! > nmax [value] should be positive'
stop
ierr = 1 ! signal ERROR
return
end if
else if (trim(arg) == trim(arg_key_config)) then
if (i == num_args) then
write(*, *) ' FAILURE! > missing configuration file [key] argument'
stop
ierr = 1 ! signal ERROR
return
end if
call get_command_argument(i + 1, arg)
......@@ -342,7 +372,8 @@ contains
call c_config_run(trim(arg)//C_NULL_CHAR, status)
if (status == 0) then
write(*, *) ' FAILURE! > unable to parse configuration file: ', trim(arg)
stop
ierr = 1 ! signal ERROR
return
end if
call c_config_is_varname("model.id"//C_NULL_CHAR, status)
......@@ -352,7 +383,8 @@ contains
model = get_model_id(char_array2str(config_field))
if (model == -1) then
write(*, *) ' FAILURE! > unknown model [key]: ', trim(char_array2str(config_field))
stop
ierr = 1 ! signal ERROR
return
end if
end if
......@@ -363,7 +395,8 @@ contains
id = get_dataset_id(char_array2str(config_field))
if (id == -1) then
write(*, *) ' FAILURE! > unknown dataset [key]: ', trim(char_array2str(config_field))
stop
ierr = 1 ! signal ERROR
return
end if
!< save nmax if previously set
nmax = dataset%nmax
......@@ -386,7 +419,8 @@ contains
dataset%surface = get_surface_id(char_array2str(config_field))
if (dataset%surface == -1) then
write(*, *) ' FAILURE! > unknown surface [key]: ', trim(char_array2str(config_field))
stop
ierr = 1 ! signal ERROR
return
end if
endif
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment