Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

fms_string_utils_mod updates #953

Merged
merged 6 commits into from
Apr 14, 2022
Merged

fms_string_utils_mod updates #953

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
6fac12a
move the string subroutines in fms to string_utils
uramirez8707 Apr 7, 2022
3a86b1b
Remove string2 from fms2
uramirez8707 Apr 7, 2022
0c69080
move string_copy to string_utils_mod
uramirez8707 Apr 7, 2022
cdb2090
corrects error in string_copy
uramirez8707 Apr 7, 2022
276e191
Adds documentation
uramirez8707 Apr 12, 2022
8bc886a
fix typo
uramirez8707 Apr 12, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 0 additions & 2 deletions CMakeLists.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
2 changes: 1 addition & 1 deletion Makefile.am
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -39,11 +39,11 @@ SUBDIRS = \
mpp \
constants \
memutils \
string_utils \
fms2_io \
mosaic2 \
fms \
parser \
string_utils \
affinity \
mosaic \
time_manager \
Expand Down
2 changes: 0 additions & 2 deletions fms/Makefile.am
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 \
Expand Down
90 changes: 1 addition & 89 deletions fms/fms.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand Down
1 change: 0 additions & 1 deletion fms2_io/fms2_io.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
!> @}

Expand Down
79 changes: 1 addition & 78 deletions fms2_io/fms_io_utils.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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) &
Expand Down Expand Up @@ -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"
Expand Down
3 changes: 2 additions & 1 deletion mosaic2/grid2.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
2 changes: 1 addition & 1 deletion parser/yaml_parser.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading