fix: clean up string routines for fms_string_utils_mod (NOAA-GFDL#953)

Author: uramirez8707

CMakeLists.txt

@@ -183,7 +183,6 @@ list(APPEND fms_fortran_src_files
 # Collect FMS C source files
 list(APPEND fms_c_src_files
   affinity/affinity.c
-  fms/fms_c.c
   mosaic/create_xgrid.c
   mosaic/gradient_c2l.c
   mosaic/interp.c
@@ -198,7 +197,6 @@ list(APPEND fms_c_src_files
 list(APPEND fms_header_files
   include/file_version.h
   include/fms_platform.h
-  fms/fms_c.h
 )
 
 # Standard FMS compiler definitions

Makefile.am

@@ -39,11 +39,11 @@ SUBDIRS = \
   mpp \
   constants \
   memutils \
+  string_utils \
   fms2_io \
   mosaic2 \
   fms \
   parser \
-  string_utils \
   affinity \
   mosaic \
   time_manager \

fms/Makefile.am

@@ -31,8 +31,6 @@ noinst_LTLIBRARIES = libfms.la
 
 # Each convenience library depends on its source.
 libfms_la_SOURCES = \
-  fms_c.c \
-  fms_c.h \
   fms.F90 \
   fms_io.F90 \
   fms_io_unstructured_field_exist.inc \

fms/fms.F90

@@ -164,6 +164,7 @@ module fms_mod
 use fms2_io_mod, only: fms2_io_init
 use memutils_mod, only: print_memuse_stats, memutils_init
 use grid2_mod, only: grid_init, grid_end
+use fms_string_utils_mod, only: fms_c2f_string, fms_cstring2cpointer, string
 
 use, intrinsic :: iso_c_binding
 
@@ -294,40 +295,6 @@ module fms_mod
 
 !> @}
 
-!> Converts a number to a string
-!> @ingroup fms_mod
-interface string
-   module procedure string_from_integer
-   module procedure string_from_real
-end interface
-!> Converts a C string to a Fortran string
-!> @ingroup fms_mod
-interface fms_c2f_string
-   module procedure cstring_fortran_conversion
-   module procedure cpointer_fortran_conversion
-end interface
-!> C functions
-  interface
-    !> @brief converts a kind=c_char to type c_ptr
-    pure function fms_cstring2cpointer (cs) result (cp) bind(c, name="cstring2cpointer")
-      import c_char, c_ptr
-        character(kind=c_char), intent(in) :: cs(*) !< C string input
-        type (c_ptr) :: cp !< C pointer
-    end function fms_cstring2cpointer
-
-    !> @brief Finds the length of a C-string
-    integer(c_size_t) pure function c_strlen(s) bind(c,name="strlen")
-      import c_size_t, c_ptr
-      type(c_ptr), intent(in), value :: s !< A C-string whose size is desired
-    end function
-
-    !> @brief Frees a C pointer
-    subroutine c_free(ptr) bind(c,name="free")
-      import c_ptr
-      type(c_ptr), value :: ptr !< A C-pointer to free
-    end subroutine
-  end interface
-
 !> @addtogroup fms_mod
 !> @{
 contains
@@ -801,61 +768,6 @@ function monotonic_array ( array, direction )
 
 end function monotonic_array
 
-!! Functions from the old fms_io
-  !> @brief Converts an integer to a string
-  !!
-  !> This has been updated from the fms_io function.
-  function string_from_integer(i) result (res)
-    integer, intent(in) :: i !< Integer to be converted to a string
-    character(:),allocatable :: res !< String converted frominteger
-    character(range(i)+2) :: tmp !< Temp string that is set to correct size
-    write(tmp,'(i0)') i
-    res = trim(tmp)
-   return
-
-  end function string_from_integer
-
-  !#######################################################################
-  !> @brief Converts a real to a string
-  function string_from_real(a)
-    real, intent(in) :: a
-    character(len=32) :: string_from_real
-
-    write(string_from_real,*) a
-
-    return
-
-  end function string_from_real
-
-!> \brief Converts a C-string to a pointer and then to a Fortran string
-function cstring_fortran_conversion (cstring) result(fstring)
- character (kind=c_char), intent(in) :: cstring (*) !< Input C-string
- character(len=:), allocatable :: fstring    !< The fortran string returned
- fstring = cpointer_fortran_conversion(fms_cstring2cpointer(cstring))
-end function cstring_fortran_conversion
-
-!> \brief Converts a C-string returned from a TYPE(C_PTR) function to
-!! a fortran string with type character.
-function cpointer_fortran_conversion (cstring) result(fstring)
- type (c_ptr), intent(in) :: cstring !< Input C-pointer
- character(len=:), allocatable :: fstring    !< The fortran string returned
- character(len=:,kind=c_char), pointer :: string_buffer !< A temporary pointer to between C and Fortran
- integer(c_size_t) :: length !< The string length
-
-  length = c_strlen(cstring)
-  allocate (character(len=length, kind=c_char) :: string_buffer)
-    block
-      character(len=length,kind=c_char), pointer :: s
-      call c_f_pointer(cstring,s)  ! Recovers a view of the C string
-      string_buffer = s                   ! Copies the string contents
-    end block
-
- allocate(character(len=length) :: fstring) !> Set the length of fstring
-fstring = string_buffer
- deallocate(string_buffer)
-
-end function cpointer_fortran_conversion
-
 !#######################################################################
 !> @brief Prints to the log file (or a specified unit) the version id string and
 !!  tag name.

fms2_io/fms2_io.F90

@@ -103,7 +103,6 @@ module fms2_io_mod
 public :: set_filename_appendix
 public :: get_instance_filename
 public :: nullify_filename_appendix
-public :: string2
 public :: flush_file
 !> @}
 

fms2_io/fms_io_utils.F90

@@ -36,6 +36,7 @@ module fms_io_utils_mod
                            mpp_get_current_ntile, mpp_get_tile_id, &
                            mpp_get_UG_domain_ntiles, mpp_get_UG_domain_tile_id
 use platform_mod
+use fms_string_utils_mod, only: string_copy
 implicit none
 private
 
@@ -55,7 +56,6 @@ module fms_io_utils_mod
 public :: put_array_section
 public :: get_array_section
 public :: get_data_type_string
-public :: string2
 public :: open_check
 public :: string_compare
 public :: restart_filepath_mangle
@@ -76,14 +76,6 @@ module fms_io_utils_mod
   type(char_linked_list), pointer :: head => null()
 endtype char_linked_list
 
-!> @brief Converts a given integer or real into a character string
-!> @ingroup fms_io_utils_mod
-interface string2
-  module procedure string_from_integer2
-  module procedure string_from_real2
-end interface string2
-
-
 !> @ingroup fms_io_utils_mod
 interface parse_mask_table
   module procedure parse_mask_table_2d
@@ -227,36 +219,6 @@ subroutine openmp_thread_trap()
 #endif
 end subroutine openmp_thread_trap
 
-
-!> @brief Safely copy a string from one buffer to another.
-subroutine string_copy(dest, source, check_for_null)
-  character(len=*), intent(inout) :: dest !< Destination string.
-  character(len=*), intent(in) :: source !< Source string.
-  logical, intent(in), optional :: check_for_null !<Flag indicating to test for null character
-
-  integer :: i
-  logical :: check_null
-
-  check_null = .false.
-  if (present(check_for_null)) check_null = check_for_null
-
-  i = 0
-  if (check_null) then
-     i = index(source, char(0)) - 1
-  endif
-
-  if (i < 1 ) i = len_trim(source)
-
-  if (len_trim(source(1:i)) .gt. len(dest)) then
-    call error("The input destination string is not big enough to" &
-                 //" to hold the input source string.")
-  endif
-  dest = ""
-  dest = adjustl(trim(source(1:i)))
-
-end subroutine string_copy
-
-
 !> @brief Compare strings.
 !! @return Flag telling if the strings are the same.
 function string_compare(string1, string2, ignore_case) &
@@ -870,45 +832,6 @@ subroutine get_instance_filename(name_in,name_out)
 
 end subroutine get_instance_filename
 
-function string_from_integer2(n)
-    integer, intent(in) :: n
-    character(len=16) :: string_from_integer2
-    if(n<0) then
-       call mpp_error(FATAL, 'fms2_io_mod: n should be non-negative integer, contact developer')
-    else if( n<10 ) then
-       write(string_from_integer2,'(i1)') n
-    else if( n<100 ) then
-       write(string_from_integer2,'(i2)') n
-    else if( n<1000 ) then
-       write(string_from_integer2,'(i3)') n
-    else if( n<10000 ) then
-       write(string_from_integer2,'(i4)') n
-    else if( n<100000 ) then
-       write(string_from_integer2,'(i5)') n
-    else if( n<1000000 ) then
-       write(string_from_integer2,'(i6)') n
-    else if( n<10000000 ) then
-       write(string_from_integer2,'(i7)') n
-    else if( n<100000000 ) then
-       write(string_from_integer2,'(i8)') n
-    else
-       call mpp_error(FATAL, 'fms2_io_mod: n is greater than 1e8, contact developer')
-    end if
-
-    return
-
-end function string_from_integer2
-
-function string_from_real2(a)
-    real, intent(in) :: a
-    character(len=32) :: string_from_real2
-
-    write(string_from_real2,*) a
-
-    return
-
-end function string_from_real2
-
 include "array_utils.inc"
 include "array_utils_char.inc"
 include "get_data_type_string.inc"

mosaic2/grid2.F90

@@ -29,7 +29,8 @@ module grid2_mod
 use constants_mod, only : PI, radius
 use fms2_io_mod, only : get_global_attribute, read_data, global_att_exists, &
                         variable_exists, file_exists,  open_file, close_file, get_variable_size, &
-                        FmsNetcdfFile_t, string => string2
+                        FmsNetcdfFile_t
+use fms_string_utils_mod, only: string
 use mosaic2_mod, only : get_mosaic_ntiles, get_mosaic_xgrid_size, get_mosaic_grid_sizes, &
      get_mosaic_xgrid, calc_mosaic_grid_area, calc_mosaic_grid_great_circle_area
 

parser/yaml_parser.F90

@@ -30,7 +30,7 @@ module yaml_parser_mod
 
 #ifdef use_yaml
 use fms_mod, only: fms_c2f_string
-use fms_io_utils_mod, only: string_copy
+use fms_string_utils_mod, only: string_copy
 use platform_mod
 use mpp_mod
 use iso_c_binding