diff --git a/CMakeLists.txt b/CMakeLists.txt index e7dc5b2815..718b5631ae 100644 --- a/CMakeLists.txt +++ b/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 diff --git a/Makefile.am b/Makefile.am index f29f3a4e4c..2b2a1e9dc8 100644 --- a/Makefile.am +++ b/Makefile.am @@ -39,11 +39,11 @@ SUBDIRS = \ mpp \ constants \ memutils \ + string_utils \ fms2_io \ mosaic2 \ fms \ parser \ - string_utils \ affinity \ mosaic \ time_manager \ diff --git a/fms/Makefile.am b/fms/Makefile.am index 5d0cf5b5c4..ea443f17e6 100644 --- a/fms/Makefile.am +++ b/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 \ diff --git a/fms/fms.F90 b/fms/fms.F90 index 0f60a85a88..c606bab21a 100644 --- a/fms/fms.F90 +++ b/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. diff --git a/fms2_io/fms2_io.F90 b/fms2_io/fms2_io.F90 index d82be39148..0d46a4498d 100644 --- a/fms2_io/fms2_io.F90 +++ b/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 !> @} diff --git a/fms2_io/fms_io_utils.F90 b/fms2_io/fms_io_utils.F90 index a89a07e7fa..92976564bb 100644 --- a/fms2_io/fms_io_utils.F90 +++ b/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 ! @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" diff --git a/mosaic2/grid2.F90 b/mosaic2/grid2.F90 index 4180cd3b2f..3c52faa656 100644 --- a/mosaic2/grid2.F90 +++ b/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 diff --git a/parser/yaml_parser.F90 b/parser/yaml_parser.F90 index 0e989a8ae4..47aadeb244 100644 --- a/parser/yaml_parser.F90 +++ b/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 diff --git a/string_utils/fms_string_utils.F90 b/string_utils/fms_string_utils.F90 index 03c4668a83..c872687563 100644 --- a/string_utils/fms_string_utils.F90 +++ b/string_utils/fms_string_utils.F90 @@ -28,7 +28,6 @@ !> @{ module fms_string_utils_mod use, intrinsic :: iso_c_binding - use fms_mod, only: fms_c2f_string use mpp_mod implicit none @@ -39,6 +38,10 @@ module fms_string_utils_mod public :: fms_sort_this public :: fms_find_my_string public :: fms_find_unique + public :: fms_c2f_string + public :: fms_cstring2cpointer + public :: string + public :: string_copy !> @} interface @@ -80,11 +83,44 @@ function fms_find_unique(my_pointer, p_size) bind(c)& end function fms_find_unique - end 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 - !> @addtogroup fms_string_utils_mod - !> @{ - contains + !> @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 + +!> 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 + +!> Converts a number to a string +!> @ingroup fms_mod +interface string + module procedure string_from_integer + module procedure string_from_real +end interface + +!> @addtogroup fms_string_utils_mod +!> @{ +contains !> @brief Converts a character array to an array of c pointers! !! @return An array of c pointers @@ -156,6 +192,86 @@ function fms_find_my_string(my_pointer, narray, string_to_find) & end function fms_find_my_string + !> \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 Converts an integer to a string + !> @return The integer as a string + 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 + !> @return The real number as a string + function string_from_real(r) + real, intent(in) :: r !< Real number to be converted to a string + character(len=32) :: string_from_real + + write(string_from_real,*) r + + return + + end function string_from_real + + !> @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 ! @} ! close documentation grouping diff --git a/string_utils/fms_string_utils_binding.c b/string_utils/fms_string_utils_binding.c index d1426172ae..da9a7dae6f 100644 --- a/string_utils/fms_string_utils_binding.c +++ b/string_utils/fms_string_utils_binding.c @@ -184,3 +184,13 @@ int fms_find_unique(char** arr, int *n) return nfind; } + +/*! + * @brief Returns a c string pointer + * @param[in] cs Input c string pointer + * @return c string pointer + */ +char * cstring2cpointer (char * cs) +{ + return cs; +}