From 166c9886fb201865d2b3fd71c6cba22fbe1cde0d Mon Sep 17 00:00:00 2001 From: Michael Duda Date: Sat, 30 Oct 2021 00:16:33 +0000 Subject: [PATCH 1/2] Fix incorrect argument rank in calls to ext_*_put_dom_ti_* in output_module.F In calls to ext_{int,ncd,gr1}_put_dom_ti_{integer,real} in output_module.F, the 'Data' dummy argument is an array, but a scalar actual argument was provided. This error was picked up by the GNU Fortran 11.1.0 compiler: output_module.f90:1733:41: 1733 | var_value, & | 1 ...... 1761 | var_value, & | 2 Error: Rank mismatch between actual argument at (1) and actual argument at (2) (rank-1 and scalar) output_module.f90:1678:41: 1678 | var_value, & | 1 ...... 1706 | var_value, & | 2 Error: Rank mismatch between actual argument at (1) and actual argument at (2) (rank-1 and scalar) The fix adopted by this commit is to simply make the scalar var_value into a temporary size-1 array with (/var_value/). --- geogrid/src/output_module.F | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/geogrid/src/output_module.F b/geogrid/src/output_module.F index 5eb0584f6..924c70328 100644 --- a/geogrid/src/output_module.F +++ b/geogrid/src/output_module.F @@ -1429,21 +1429,21 @@ subroutine ext_put_dom_ti_integer_scalar(var_name, var_value) #ifdef IO_BINARY if (io_form_output == BINARY) then call ext_int_put_dom_ti_integer(handle, trim(var_name), & - var_value, & + (/ var_value /), & 1, istatus) end if #endif #ifdef IO_NETCDF if (io_form_output == NETCDF) then call ext_ncd_put_dom_ti_integer(handle, trim(var_name), & - var_value, & + (/ var_value /), & 1, istatus) end if #endif #ifdef IO_GRIB1 if (io_form_output == GRIB1) then call ext_gr1_put_dom_ti_integer(handle, trim(var_name), & - var_value, & + (/ var_value /), & 1, istatus) end if #endif @@ -1516,21 +1516,21 @@ subroutine ext_put_dom_ti_real_scalar(var_name, var_value) #ifdef IO_BINARY if (io_form_output == BINARY) then call ext_int_put_dom_ti_real(handle, trim(var_name), & - var_value, & + (/ var_value /), & 1, istatus) end if #endif #ifdef IO_NETCDF if (io_form_output == NETCDF) then call ext_ncd_put_dom_ti_real(handle, trim(var_name), & - var_value, & + (/ var_value /), & 1, istatus) end if #endif #ifdef IO_GRIB1 if (io_form_output == GRIB1) then call ext_gr1_put_dom_ti_real(handle, trim(var_name), & - var_value, & + (/ var_value /), & 1, istatus) end if #endif From 03e35b60abbec9e06a2617313bcbdc52b14bb353 Mon Sep 17 00:00:00 2001 From: Michael Duda Date: Sat, 30 Oct 2021 00:17:35 +0000 Subject: [PATCH 2/2] Fix incorrect argument rank in calls to ext_*_get_dom_ti_* in input_module.F In calls to ext_{int,ncd,gr1}_get_dom_ti_{integer,real} in input_module.F, the 'Data' dummy argument is an array, but a scalar actual argument was provided. This error was picked up by the GNU Fortran 11.1.0 compiler: input_module.f90:881:41: 881 | var_value, & | 1 ...... 909 | var_value, & | 2 Error: Rank mismatch between actual argument at (1) and actual argument at (2) (rank-1 and scalar) input_module.f90:822:41: 822 | var_value, & | 1 ...... 854 | var_value, & | 2 Error: Rank mismatch between actual argument at (1) and actual argument at (2) (rank-1 and scalar) The fix adopted by this commit is to declare a local array for use as the actual argument, and to copy the first element of this array to var_value after a successful call to ext_{int,ncd,gr1}_get_dom_ti_{integer,real}. --- metgrid/src/input_module.F | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/metgrid/src/input_module.F b/metgrid/src/input_module.F index e691f4469..02c5fa6f6 100644 --- a/metgrid/src/input_module.F +++ b/metgrid/src/input_module.F @@ -633,25 +633,26 @@ subroutine ext_get_dom_ti_integer_scalar(var_name, var_value, suppress_errors) ! Local variables integer :: istatus, outcount + integer, dimension(1) :: var_value_arr #ifdef IO_BINARY if (io_form_input == BINARY) then call ext_int_get_dom_ti_integer(handle, trim(var_name), & - var_value, & + var_value_arr, & 1, outcount, istatus) end if #endif #ifdef IO_NETCDF if (io_form_input == NETCDF) then call ext_ncd_get_dom_ti_integer(handle, trim(var_name), & - var_value, & + var_value_arr, & 1, outcount, istatus) end if #endif #ifdef IO_GRIB1 if (io_form_input == GRIB1) then call ext_gr1_get_dom_ti_integer(handle, trim(var_name), & - var_value, & + var_value_arr, & 1, outcount, istatus) end if #endif @@ -662,6 +663,8 @@ subroutine ext_get_dom_ti_integer_scalar(var_name, var_value, suppress_errors) call mprintf((istatus /= 0),ERROR,'Error while reading domain time-independent attribute.') end if + var_value = var_value_arr(1) + end subroutine ext_get_dom_ti_integer_scalar @@ -724,31 +727,34 @@ subroutine ext_get_dom_ti_real_scalar(var_name, var_value) ! Local variables integer :: istatus, outcount + real, dimension(1) :: var_value_arr #ifdef IO_BINARY if (io_form_input == BINARY) then call ext_int_get_dom_ti_real(handle, trim(var_name), & - var_value, & + var_value_arr, & 1, outcount, istatus) end if #endif #ifdef IO_NETCDF if (io_form_input == NETCDF) then call ext_ncd_get_dom_ti_real(handle, trim(var_name), & - var_value, & + var_value_arr, & 1, outcount, istatus) end if #endif #ifdef IO_GRIB1 if (io_form_input == GRIB1) then call ext_gr1_get_dom_ti_real(handle, trim(var_name), & - var_value, & + var_value_arr, & 1, outcount, istatus) end if #endif call mprintf((istatus /= 0),ERROR,'Error while reading domain time-independent attribute.') + var_value = var_value_arr(1) + end subroutine ext_get_dom_ti_real_scalar