Merge branch 'fix_ioapi_put_get_args' into release-v4.3.1 (PR #184)

This merge corrects the actual argument rank in several calls to WRF I/O API routines for reading and writing domain time-independent attributes. For more details, see the commit messages of the two commits in this merge. * fix_ioapi_put_get_args: Fix incorrect argument rank in calls to ext_*_get_dom_ti_* in input_module.F Fix incorrect argument rank in calls to ext_*_put_dom_ti_* in output_module.F
wrf-model · Nov 2, 2021 · 244279e · 244279e
2 parents bdd1bca + 03e35b6
commit 244279e
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 12 deletions.
diff --git 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

diff --git a/metgrid/src/input_module.F b/metgrid/src/input_module.F
@@ -635,25 +635,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
@@ -664,6 +665,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
 
 
@@ -726,31 +729,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