From 263e87a6b4157560eea34b01ba1625a54519f218 Mon Sep 17 00:00:00 2001 From: wpbonelli Date: Fri, 9 Aug 2024 13:59:47 -0400 Subject: [PATCH 1/3] refactor(mf6bmiutil): remove string_to_char_array function This function is evidently no longer necessary. The Fortran wiki claims it is (https://fortranwiki.org/fortran/show/Generating+C+Interfaces#strings), but the relevant section was added 14 years ago (https://fortranwiki.org/fortran/revision/diff/Generating+C+Interfaces/9), and more recently the consensus on the fortran-lang forum is that passing 'trim(str) // c_null_char' suffices (https://fortran-lang.discourse.group/t/best-practices-for-passing-c-strings) --- srcbmi/mf6bmi.f90 | 8 ++++---- srcbmi/mf6bmiGrid.f90 | 4 ++-- srcbmi/mf6bmiUtil.f90 | 17 ----------------- srcbmi/mf6xmi.F90 | 6 +++--- 4 files changed, 9 insertions(+), 26 deletions(-) diff --git a/srcbmi/mf6bmi.f90 b/srcbmi/mf6bmi.f90 index 35c4ffda775..62a396ddf3d 100644 --- a/srcbmi/mf6bmi.f90 +++ b/srcbmi/mf6bmi.f90 @@ -48,7 +48,7 @@ function bmi_get_component_name(name) result(bmi_status) & integer(kind=c_int) :: bmi_status !< BMI status code ! -- local variables - name = string_to_char_array('MODFLOW 6', 9) + name = 'MODFLOW 6'//c_null_char bmi_status = BMI_SUCCESS end function bmi_get_component_name @@ -612,7 +612,7 @@ function get_value_string(c_var_address, c_arr_ptr) result(bmi_status) & call mem_setptr(srcstr, var_name, mem_path) call get_mem_elem_size(var_name, mem_path, ilen) call c_f_pointer(c_arr_ptr, tgtstr, shape=[ilen + 1]) - tgtstr(1:len(srcstr) + 1) = string_to_char_array(srcstr, len(srcstr)) + tgtstr(1:len(srcstr) + 1) = trim(srcstr)//c_null_char else if (rank == 1) then ! an array of strings @@ -634,7 +634,7 @@ function get_value_string(c_var_address, c_arr_ptr) result(bmi_status) & allocate (character(ilen) :: tempstr) do i = 1, isize tempstr = srccharstr1d(i) - tgtstr1d(1:ilen + 1, i) = string_to_char_array(tempstr, ilen) + tgtstr1d(1:ilen + 1, i) = trim(tempstr)//c_null_char end do deallocate (tempstr) else @@ -1172,7 +1172,7 @@ function get_var_type(c_var_address, c_var_type) result(bmi_status) & call get_mem_type(var_name, mem_path, mem_type) c_var_type(1:len(trim(mem_type)) + 1) = & - string_to_char_array(trim(mem_type), len(trim(mem_type))) + trim(mem_type)//c_null_char if (mem_type == 'UNKNOWN') then write (bmi_last_error, fmt_general_err) 'unknown memory type' diff --git a/srcbmi/mf6bmiGrid.f90 b/srcbmi/mf6bmiGrid.f90 index 4af4d122e28..40594616a9a 100644 --- a/srcbmi/mf6bmiGrid.f90 +++ b/srcbmi/mf6bmiGrid.f90 @@ -8,7 +8,7 @@ module mf6bmiGrid use mf6bmiUtil use mf6bmiError - use iso_c_binding, only: c_double, c_ptr, c_loc + use iso_c_binding, only: c_double, c_ptr, c_loc, c_null_char use ConstantsModule, only: LENMODELNAME, LENMEMPATH use KindModule, only: DP, I4B use MemoryManagerModule, only: mem_setptr @@ -81,7 +81,7 @@ function get_grid_type(grid_id, grid_type) result(bmi_status) & else return end if - grid_type = string_to_char_array(trim(grid_type_f), len_trim(grid_type_f)) + grid_type = trim(grid_type_f)//c_null_char bmi_status = BMI_SUCCESS end function get_grid_type diff --git a/srcbmi/mf6bmiUtil.f90 b/srcbmi/mf6bmiUtil.f90 index b0ff1770aef..0ec6a243c7a 100644 --- a/srcbmi/mf6bmiUtil.f90 +++ b/srcbmi/mf6bmiUtil.f90 @@ -143,23 +143,6 @@ pure function char_array_to_string(char_array, length) result(f_string) end function char_array_to_string - !> @brief Convert Fortran string to C-style character string - !< - pure function string_to_char_array(string, length) result(c_array) - ! -- dummy variables - integer(c_int), intent(in) :: length !< Fortran string length - character(len=length), intent(in) :: string !< string to convert - character(kind=c_char, len=1) :: c_array(length + 1) !< C-style character string - ! -- local variables - integer(I4B) :: i - - do i = 1, length - c_array(i) = string(i:i) - end do - c_array(length + 1) = C_NULL_CHAR - - end function string_to_char_array - !> @brief Extract the model name from a memory address string !< function extract_model_name(var_address, success) result(model_name) diff --git a/srcbmi/mf6xmi.F90 b/srcbmi/mf6xmi.F90 index 9c476236054..b7297ef2175 100644 --- a/srcbmi/mf6xmi.F90 +++ b/srcbmi/mf6xmi.F90 @@ -90,7 +90,7 @@ module mf6xmi use mf6bmiError use Mf6CoreModule use KindModule - use iso_c_binding, only: c_int, c_char, c_double + use iso_c_binding, only: c_int, c_char, c_double, c_null_char implicit none integer(I4B), pointer :: iterationCounter => null() !< the counter for the outer iteration loop, initialized in xmi_prepare_iteration() @@ -357,7 +357,7 @@ function xmi_get_version(mf_version) result(bmi_status) & else vstr = VERSIONNUMBER end if - mf_version = string_to_char_array(vstr, len_trim(vstr)) + mf_version = trim(vstr)//c_null_char bmi_status = BMI_SUCCESS end function xmi_get_version @@ -412,7 +412,7 @@ function get_var_address(c_component_name, c_subcomponent_name, & ! convert to c string: c_var_address(1:len(trim(mem_address)) + 1) = & - string_to_char_array(trim(mem_address), len(trim(mem_address))) + trim(mem_address)//c_null_char bmi_status = BMI_SUCCESS From 11538831520b5de29708b18f2d21164fbb85718f Mon Sep 17 00:00:00 2001 From: wpbonelli Date: Fri, 9 Aug 2024 14:42:59 -0400 Subject: [PATCH 2/3] keep string_to_char_array around just to avoid character truncation warning... is there a better way around this? --- srcbmi/mf6bmi.f90 | 3 +-- srcbmi/mf6bmiUtil.f90 | 11 +++++++++++ 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/srcbmi/mf6bmi.f90 b/srcbmi/mf6bmi.f90 index 62a396ddf3d..eb64b13be5e 100644 --- a/srcbmi/mf6bmi.f90 +++ b/srcbmi/mf6bmi.f90 @@ -46,9 +46,8 @@ function bmi_get_component_name(name) result(bmi_status) & ! -- dummy variables character(kind=c_char), intent(out) :: name(BMI_LENCOMPONENTNAME) integer(kind=c_int) :: bmi_status !< BMI status code - ! -- local variables - name = 'MODFLOW 6'//c_null_char + name = string_to_char_array('MODFLOW 6') bmi_status = BMI_SUCCESS end function bmi_get_component_name diff --git a/srcbmi/mf6bmiUtil.f90 b/srcbmi/mf6bmiUtil.f90 index 0ec6a243c7a..b6420ee613e 100644 --- a/srcbmi/mf6bmiUtil.f90 +++ b/srcbmi/mf6bmiUtil.f90 @@ -143,6 +143,17 @@ pure function char_array_to_string(char_array, length) result(f_string) end function char_array_to_string + !> @brief Convert Fortran string to C-style character string + !< + pure function string_to_char_array(string) result(c_array) + ! -- dummy variables + character(len=*), intent(in) :: string !< string to convert + character(kind=c_char, len=1) :: c_array(len(string) + 1) !< C-style character string + + c_array = trim(string)//c_null_char + + end function string_to_char_array + !> @brief Extract the model name from a memory address string !< function extract_model_name(var_address, success) result(model_name) From 458510f8efe98db4d703f302d75ed378aa386a04 Mon Sep 17 00:00:00 2001 From: wpbonelli Date: Fri, 9 Aug 2024 15:03:45 -0400 Subject: [PATCH 3/3] we need the function after all --- srcbmi/mf6bmi.f90 | 6 +++--- srcbmi/mf6bmiGrid.f90 | 4 ++-- srcbmi/mf6xmi.F90 | 6 +++--- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/srcbmi/mf6bmi.f90 b/srcbmi/mf6bmi.f90 index eb64b13be5e..4f1ba11d200 100644 --- a/srcbmi/mf6bmi.f90 +++ b/srcbmi/mf6bmi.f90 @@ -611,7 +611,7 @@ function get_value_string(c_var_address, c_arr_ptr) result(bmi_status) & call mem_setptr(srcstr, var_name, mem_path) call get_mem_elem_size(var_name, mem_path, ilen) call c_f_pointer(c_arr_ptr, tgtstr, shape=[ilen + 1]) - tgtstr(1:len(srcstr) + 1) = trim(srcstr)//c_null_char + tgtstr(1:len(srcstr) + 1) = string_to_char_array(trim(srcstr)) else if (rank == 1) then ! an array of strings @@ -633,7 +633,7 @@ function get_value_string(c_var_address, c_arr_ptr) result(bmi_status) & allocate (character(ilen) :: tempstr) do i = 1, isize tempstr = srccharstr1d(i) - tgtstr1d(1:ilen + 1, i) = trim(tempstr)//c_null_char + tgtstr1d(1:ilen + 1, i) = string_to_char_array(trim(tempstr)) end do deallocate (tempstr) else @@ -1171,7 +1171,7 @@ function get_var_type(c_var_address, c_var_type) result(bmi_status) & call get_mem_type(var_name, mem_path, mem_type) c_var_type(1:len(trim(mem_type)) + 1) = & - trim(mem_type)//c_null_char + string_to_char_array(trim(mem_type)) if (mem_type == 'UNKNOWN') then write (bmi_last_error, fmt_general_err) 'unknown memory type' diff --git a/srcbmi/mf6bmiGrid.f90 b/srcbmi/mf6bmiGrid.f90 index 40594616a9a..8dc6a766bc2 100644 --- a/srcbmi/mf6bmiGrid.f90 +++ b/srcbmi/mf6bmiGrid.f90 @@ -8,7 +8,7 @@ module mf6bmiGrid use mf6bmiUtil use mf6bmiError - use iso_c_binding, only: c_double, c_ptr, c_loc, c_null_char + use iso_c_binding, only: c_double, c_ptr, c_loc use ConstantsModule, only: LENMODELNAME, LENMEMPATH use KindModule, only: DP, I4B use MemoryManagerModule, only: mem_setptr @@ -81,7 +81,7 @@ function get_grid_type(grid_id, grid_type) result(bmi_status) & else return end if - grid_type = trim(grid_type_f)//c_null_char + grid_type = string_to_char_array(trim(grid_type_f)) bmi_status = BMI_SUCCESS end function get_grid_type diff --git a/srcbmi/mf6xmi.F90 b/srcbmi/mf6xmi.F90 index b7297ef2175..f1048715ce7 100644 --- a/srcbmi/mf6xmi.F90 +++ b/srcbmi/mf6xmi.F90 @@ -90,7 +90,7 @@ module mf6xmi use mf6bmiError use Mf6CoreModule use KindModule - use iso_c_binding, only: c_int, c_char, c_double, c_null_char + use iso_c_binding, only: c_int, c_char, c_double implicit none integer(I4B), pointer :: iterationCounter => null() !< the counter for the outer iteration loop, initialized in xmi_prepare_iteration() @@ -357,7 +357,7 @@ function xmi_get_version(mf_version) result(bmi_status) & else vstr = VERSIONNUMBER end if - mf_version = trim(vstr)//c_null_char + mf_version = string_to_char_array(trim(vstr)) bmi_status = BMI_SUCCESS end function xmi_get_version @@ -412,7 +412,7 @@ function get_var_address(c_component_name, c_subcomponent_name, & ! convert to c string: c_var_address(1:len(trim(mem_address)) + 1) = & - trim(mem_address)//c_null_char + string_to_char_array(trim(mem_address)) bmi_status = BMI_SUCCESS