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

error handling update in main subroutine

parent aa5dee1f
No related branches found
No related tags found
No related merge requests found
...@@ -18,7 +18,6 @@ contains ...@@ -18,7 +18,6 @@ contains
! --- local variables ! --- local variables
integer i integer i
character(len = 7) str_stat
! ---------------------------------------------------------------------------- ! ----------------------------------------------------------------------------
open(1, FILE = trim(fname), iostat = stat) open(1, FILE = trim(fname), iostat = stat)
...@@ -28,7 +27,7 @@ contains ...@@ -28,7 +27,7 @@ contains
write(1, *, iostat = stat) var1(i), var2(i) write(1, *, iostat = stat) var1(i), var2(i)
if (stat /= 0) exit if (stat /= 0) exit
end do end do
close(1, iostat = stat, STATUS = str_stat) close(1, iostat = stat)
end subroutine write_ascii_vec2 end subroutine write_ascii_vec2
! ---------------------------------------------------------------------------- ! ----------------------------------------------------------------------------
...@@ -50,18 +49,17 @@ contains ...@@ -50,18 +49,17 @@ contains
! --- local variables ! --- local variables
integer i integer i
character(len = 7) str_stat
! ---------------------------------------------------------------------------- ! ----------------------------------------------------------------------------
open(1, FILE = trim(fname), iostat = stat) open(32, FILE = trim(fname), iostat = stat)
if (stat /= 0) return if (stat /= 0) return
do i = 1, n do i = 1, n
write(1, fmt, iostat = stat) var1(i), var2(i), var3(i), var4(i), var5(i), & write(32, fmt, iostat = stat) var1(i), var2(i), var3(i), var4(i), var5(i), &
var6(i), var7(i), var8(i), var9(i), var10(i), var11(i) var6(i), var7(i), var8(i), var9(i), var10(i), var11(i)
if (stat /= 0) exit if (stat /= 0) exit
end do end do
close(1, iostat = stat, STATUS = str_stat) close(32, iostat = stat)
end subroutine write_ascii_vec11 end subroutine write_ascii_vec11
! ---------------------------------------------------------------------------- ! ----------------------------------------------------------------------------
......
...@@ -379,7 +379,10 @@ contains ...@@ -379,7 +379,10 @@ contains
call c_config_is_varname("model.id"//C_NULL_CHAR, status) call c_config_is_varname("model.id"//C_NULL_CHAR, status)
if (status /= 0) then if (status /= 0) then
call c_config_get_string("model.id"//C_NULL_CHAR, config_field, status) call c_config_get_string("model.id"//C_NULL_CHAR, config_field, status)
! *: check status if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
model = get_model_id(char_array2str(config_field)) model = get_model_id(char_array2str(config_field))
if (model == -1) then if (model == -1) then
write(*, *) ' FAILURE! > unknown model [key]: ', trim(char_array2str(config_field)) write(*, *) ' FAILURE! > unknown model [key]: ', trim(char_array2str(config_field))
...@@ -391,7 +394,10 @@ contains ...@@ -391,7 +394,10 @@ contains
call c_config_is_varname("dataset.id"//C_NULL_CHAR, status) call c_config_is_varname("dataset.id"//C_NULL_CHAR, status)
if (status /= 0) then if (status /= 0) then
call c_config_get_string("dataset.id"//C_NULL_CHAR, config_field, status) call c_config_get_string("dataset.id"//C_NULL_CHAR, config_field, status)
! *: check status if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
id = get_dataset_id(char_array2str(config_field)) id = get_dataset_id(char_array2str(config_field))
if (id == -1) then if (id == -1) then
write(*, *) ' FAILURE! > unknown dataset [key]: ', trim(char_array2str(config_field)) write(*, *) ' FAILURE! > unknown dataset [key]: ', trim(char_array2str(config_field))
...@@ -407,7 +413,10 @@ contains ...@@ -407,7 +413,10 @@ contains
if ((status /= 0).or.(dataset%id == dataset_user)) then if ((status /= 0).or.(dataset%id == dataset_user)) then
!< mandatory in user dataset !< mandatory in user dataset
call c_config_get_string("dataset.filename"//C_NULL_CHAR, config_field, status) call c_config_get_string("dataset.filename"//C_NULL_CHAR, config_field, status)
! *: check status if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
dataset%filename = char_array2str(config_field) dataset%filename = char_array2str(config_field)
end if end if
...@@ -415,7 +424,10 @@ contains ...@@ -415,7 +424,10 @@ contains
if ((status /= 0).or.(dataset%id == dataset_user)) then if ((status /= 0).or.(dataset%id == dataset_user)) then
!< mandatory in user dataset !< mandatory in user dataset
call c_config_get_string("dataset.surface"//C_NULL_CHAR, config_field, status) call c_config_get_string("dataset.surface"//C_NULL_CHAR, config_field, status)
! *: check status if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
dataset%surface = get_surface_id(char_array2str(config_field)) dataset%surface = get_surface_id(char_array2str(config_field))
if (dataset%surface == -1) then if (dataset%surface == -1) then
write(*, *) ' FAILURE! > unknown surface [key]: ', trim(char_array2str(config_field)) write(*, *) ' FAILURE! > unknown surface [key]: ', trim(char_array2str(config_field))
...@@ -428,30 +440,49 @@ contains ...@@ -428,30 +440,49 @@ contains
if ((status /= 0).or.(dataset%id == dataset_user)) then if ((status /= 0).or.(dataset%id == dataset_user)) then
!< mandatory in user dataset !< mandatory in user dataset
call c_config_get_float("dataset.h"//C_NULL_CHAR, dataset%h, status) call c_config_get_float("dataset.h"//C_NULL_CHAR, dataset%h, status)
if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
end if end if
call c_config_is_varname("dataset.z0_m"//C_NULL_CHAR, status) call c_config_is_varname("dataset.z0_m"//C_NULL_CHAR, status)
if ((status /= 0).or.(dataset%id == dataset_user)) then if ((status /= 0).or.(dataset%id == dataset_user)) then
!< mandatory in user dataset !< mandatory in user dataset
call c_config_get_float("dataset.z0_m"//C_NULL_CHAR, dataset%z0_m, status) call c_config_get_float("dataset.z0_m"//C_NULL_CHAR, dataset%z0_m, status)
if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
end if end if
call c_config_is_varname("dataset.z0_h"//C_NULL_CHAR, status) call c_config_is_varname("dataset.z0_h"//C_NULL_CHAR, status)
if ((status /= 0).or.(dataset%id == dataset_user)) then if ((status /= 0).or.(dataset%id == dataset_user)) then
!< mandatory in user dataset !< mandatory in user dataset
call c_config_get_float("dataset.z0_h"//C_NULL_CHAR, dataset%z0_h, status) call c_config_get_float("dataset.z0_h"//C_NULL_CHAR, dataset%z0_h, status)
if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
end if end if
end if end if
call c_config_is_varname("dataset.nmax"//C_NULL_CHAR, status) call c_config_is_varname("dataset.nmax"//C_NULL_CHAR, status)
if (status /= 0) then if (status /= 0) then
call c_config_get_int("dataset.nmax"//C_NULL_CHAR, dataset%nmax, status) call c_config_get_int("dataset.nmax"//C_NULL_CHAR, dataset%nmax, status)
if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
end if end if
call c_config_is_varname("output.filename"//C_NULL_CHAR, status) call c_config_is_varname("output.filename"//C_NULL_CHAR, status)
if (status /= 0) then if (status /= 0) then
call c_config_get_string("output.filename"//C_NULL_CHAR, config_field, status) call c_config_get_string("output.filename"//C_NULL_CHAR, config_field, status)
! *: check status if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
filename_out = char_array2str(config_field) filename_out = char_array2str(config_field)
is_output_set = 1 is_output_set = 1
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment