FMS 2025.01.02-dev
Flexible Modeling System
Loading...
Searching...
No Matches
fms_string_utils.F90
1!***********************************************************************
2!* GNU Lesser General Public License
3!*
4!* This file is part of the GFDL Flexible Modeling System (FMS).
5!*
6!* FMS is free software: you can redistribute it and/or modify it under
7!* the terms of the GNU Lesser General Public License as published by
8!* the Free Software Foundation, either version 3 of the License, or (at
9!* your option) any later version.
10!*
11!* FMS is distributed in the hope that it will be useful, but WITHOUT
12!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14!* for more details.
15!*
16!* You should have received a copy of the GNU Lesser General Public
17!* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18!***********************************************************************
19
20!> @defgroup fms_string_utils_mod fms_string_utils_mod
21!> @ingroup string_utils
22!> @brief Routines to use for string manipulation
23
24!> @file
25!> @brief File for @ref fms_string_utils_mod
26
27!> @addtogroup fms_string_utils_mod
28!> @{
29module fms_string_utils_mod
30 use, intrinsic :: iso_c_binding
31 use platform_mod, only: r4_kind, r8_kind, i4_kind, i8_kind
32 use mpp_mod
33
34 implicit none
35 private
36
37 public :: fms_array_to_pointer
38 public :: fms_pointer_to_array
39 public :: fms_sort_this
40 public :: fms_find_my_string
41 public :: fms_find_unique
42 public :: fms_c2f_string
43 public :: fms_f2c_string
44 public :: fms_cstring2cpointer
45 public :: string
46 public :: string_copy
47 public :: stringify
48!> @}
49
50 interface
51 !> @brief Sorts an array of pointers (my pointer) of size (p_size) in
52 !! alphabetical order.
53 subroutine fms_sort_this(my_pointer, p_size, indices) bind(c)
54 use iso_c_binding
55
56 type(c_ptr), intent(inout) :: my_pointer(*) !< IN: Array of c pointers to sort
57 !! OUT: Sorted array of c pointers
58 integer(kind=c_int), intent(in) :: p_size !< Size of the array
59 integer(kind=c_int), intent(inout) :: indices(*) !< IN: Array of the indices of my_pointer
60 !! OUT: Sorted array of indices
61 end subroutine fms_sort_this
62
63 !> @brief Private c function that finds a string in a SORTED array of c pointers
64 !! @return Indices of my_pointer where the string was found as a string!!!
65 function fms_find_my_string_binding(my_pointer, p_size, string_to_find, nfound) bind(c) &
66 result(indices)
67 use iso_c_binding
68
69 type(c_ptr), intent(in) :: my_pointer(*) !< Array of sorted c pointer
70 integer(kind=c_int), intent(in) :: p_size !< Size of the array
71 character(kind=c_char), intent(in) :: string_to_find(*) !< String to find
72 integer(kind=c_int), intent(inout) :: nfound !< Number of times the array was found
73
74 type(c_ptr) :: indices
76
77 !> @brief c function that finds the number of unique strings in an array of c pointers
78 !! @return number of unique strings
79 function fms_find_unique(my_pointer, p_size) bind(c)&
80 result(ntimes)
81 use iso_c_binding
82
83 type(c_ptr), intent(in) :: my_pointer(*) !< Array of sorted c pointer
84 integer(kind=c_int), intent(in) :: p_size !< Size of the array
85 integer(kind=c_int) :: ntimes
86
87 end function fms_find_unique
88
89 !> @brief converts a kind=c_char to type c_ptr
90 pure function fms_cstring2cpointer (cs) result (cp) bind(c, name="cstring2cpointer")
91 import c_char, c_ptr
92 character(kind=c_char), intent(in) :: cs(*) !< C string input
93 type (c_ptr) :: cp !< C pointer
94 end function fms_cstring2cpointer
95
96 !> @brief Finds the length of a C-string
97 integer(c_size_t) pure function c_strlen(s) bind(c,name="strlen")
98 import c_size_t, c_ptr
99 type(c_ptr), intent(in), value :: s !< A C-string whose size is desired
100 end function
101
102 !> @brief Frees a C pointer
103 subroutine c_free(ptr) bind(c,name="free")
104 import c_ptr
105 type(c_ptr), value :: ptr !< A C-pointer to free
106 end subroutine
107
108end interface
109
110!> Converts a C string to a Fortran string
111!> @ingroup fms_mod
113 module procedure cstring_fortran_conversion
114 module procedure cpointer_fortran_conversion
115end interface
116
117!> Converts an array of real numbers to a string
118!> @ingroup fms_mod
119interface stringify
120 module procedure stringify_1d_r4, stringify_1d_r8
121 module procedure stringify_2d_r4, stringify_2d_r8
122 module procedure stringify_3d_r4, stringify_3d_r8
123end interface
124
125!> @addtogroup fms_string_utils_mod
126!> @{
127contains
128
129 !> @brief Converts a character array to an array of c pointers!
130 !! @return An array of c pointers
131 function fms_array_to_pointer(my_array) &
132 result(my_pointer)
133 character(len=*), target :: my_array(:) !!< Array of strings to convert
134 type(c_ptr), allocatable :: my_pointer(:)
135
136 integer :: i !< For do loops
137
138 if (allocated(my_pointer)) call mpp_error(fatal, "The c pointer array is &
139 already allocated. Deallocated before calling fms_array_to_pointer")
140 allocate(my_pointer(size(my_array)))
141
142 do i = 1, size(my_array)
143 my_pointer(i) = c_loc(my_array(i))
144 enddo
145 end function fms_array_to_pointer
146
147 !> @brief Convert an array of c pointers back to a character array
148 !! @return A character array
149 function fms_pointer_to_array(my_pointer, narray) &
150 result(my_array)
151 type(c_ptr), intent(in) :: my_pointer(*) !< Array of c pointer
152 integer, intent(in) :: narray !< Length of the array
153 character(len=:), allocatable :: my_array(:)
154
155 character(len=:), allocatable :: buffer !< Buffer to store a string
156 integer :: i !< For do loops
157
158 allocate(character(len=255) :: my_array(narray))
159 do i = 1, narray
160 buffer = fms_c2f_string(my_pointer(i))
161 my_array(i) = buffer
162 deallocate(buffer)
163 enddo
164 end function fms_pointer_to_array
165
166 !> @brief Searches through a SORTED array of pointers for a string
167 !! @return the indices where the array was found
168 !! If the string was not found, indices will be indices(1) = -999
169 !> <br>Example usage:
170 !! my_pointer = fms_array_to_pointer(my_array)
171 !! call fms_sort_this(my_pointer, n_array, indices)
172 !! ifind = fms_find_my_string(my_pointer, n_array, string_to_find)
173 function fms_find_my_string(my_pointer, narray, string_to_find) &
174 result(ifind)
175 type(c_ptr), intent(in) :: my_pointer(*) !< Array of c pointer
176 integer, intent(in) :: narray !< Length of the array
177 character(len=*), intent(in) :: string_to_find !< string to find
178 integer, allocatable :: ifind(:)
179
180 integer :: nfind !< number of times the string was found
181 character(len=:), allocatable :: buffer !< buffer to read the indices into
182
183 buffer = fms_c2f_string(&
184 fms_find_my_string_binding(my_pointer, narray, trim(string_to_find)//c_null_char, nfind))
185
186 if (allocated(ifind)) call mpp_error(fatal, "The indices array is already allocated. &
187 Deallocate it before calling fms_find_my_string")
188
189 if (nfind .gt. 0) then
190 allocate(ifind(nfind))
191 read(buffer,*) ifind
192 else
193 allocate(ifind(1))
194 ifind = -999
195 endif
196
197 end function fms_find_my_string
198
199 !> \brief Converts a C-string to a pointer and then to a Fortran string
200 function cstring_fortran_conversion (cstring) result(fstring)
201 character (kind=c_char), intent(in) :: cstring (*) !< Input C-string
202 character(len=:), allocatable :: fstring !< The fortran string returned
204 end function cstring_fortran_conversion
205
206 !> \brief Converts a C-string returned from a TYPE(C_PTR) function to
207 !! a fortran string with type character.
208 function cpointer_fortran_conversion (cstring) result(fstring)
209 type (c_ptr), intent(in) :: cstring !< Input C-pointer
210 character(len=:), allocatable :: fstring !< The fortran string returned
211 character(len=:,kind=c_char), pointer :: string_buffer !< A temporary pointer to between C and Fortran
212 integer(c_size_t) :: length !< The string length
213
214 length = c_strlen(cstring)
215 allocate (character(len=length, kind=c_char) :: string_buffer)
216 block
217 character(len=length,kind=c_char), pointer :: s
218 call c_f_pointer(cstring,s) ! Recovers a view of the C string
219 string_buffer = s ! Copies the string contents
220 end block
221
222 allocate(character(len=length) :: fstring) !> Set the length of fstring
223 fstring = string_buffer
224 deallocate(string_buffer)
225 end function cpointer_fortran_conversion
226
227!> @brief Copies a Fortran string into a C string and puts c_null_char in any trailing spaces
228 subroutine fms_f2c_string (dest, str_in)
229 character (c_char), intent (out) :: dest (:) !< C String to be copied into
230 character (len=*), intent (in) :: str_in !< Fortran string to copy to C string
231 integer :: i !< for looping
232!> Drop an error if the C string is not large enough to hold the input and the c_null_char at the end.
233 if (len(trim(str_in)) .ge. size(dest)) call mpp_error(fatal, &
234 "The string "//trim(str_in)//" is larger than the destination C string")
235!> Copy c_null_char into each spot in dest
236 dest = c_null_char
237!> Loop though and put each character of the Fortran string into the C string array
238 do i = 1, len(trim(str_in))
239 dest(i) = str_in(i:i)
240 enddo
241end subroutine fms_f2c_string
242
243 !> @brief Converts a number or a Boolean value to a string
244 !> @return The argument as a string
245 function string(v, fmt)
246 class(*), intent(in) :: v !< Value to be converted to a string
247 character(*), intent(in), optional :: fmt !< Optional format string for a real or integral argument
248 character(:), allocatable :: string
249
250 select type(v)
251 type is (logical)
252 if (present(fmt)) then
253 call mpp_error(warning, "string(): Ignoring `fmt` argument for type `logical`")
254 endif
255 if (v) then
256 string = "True"
257 else
258 string = "False"
259 endif
260
261 type is (integer(i4_kind))
262 allocate(character(32) :: string)
263 if (present(fmt)) then
264 write(string, "(" // fmt // ")") v
265 else
266 write(string, '(i0)') v
267 endif
268 string = trim(adjustl(string))
269
270 type is (integer(i8_kind))
271 allocate(character(32) :: string)
272 if (present(fmt)) then
273 write(string, "(" // fmt // ")") v
274 else
275 write(string, '(i0)') v
276 endif
277 string = trim(adjustl(string))
278
279 type is (real(r4_kind))
280 allocate(character(32) :: string)
281 if (present(fmt)) then
282 write(string, "(" // fmt // ")") v
283 else
284 write(string, *) v
285 endif
286 string = trim(adjustl(string))
287
288 type is (real(r8_kind))
289 allocate(character(32) :: string)
290 if (present(fmt)) then
291 write(string, "(" // fmt // ")") v
292 else
293 write(string, *) v
294 endif
295 string = trim(adjustl(string))
296
297 class default
298 call mpp_error(fatal, "string(): Called with incompatible argument type. Possible types &
299 &include integer(4), integer(8), real(4), real(8), or logical.")
300 end select
301 end function string
302
303 !> @brief Safely copy a string from one buffer to another.
304 subroutine string_copy(dest, source, check_for_null)
305 character(len=*), intent(inout) :: dest !< Destination string.
306 character(len=*), intent(in) :: source !< Source string.
307 logical, intent(in), optional :: check_for_null !<Flag indicating to test for null character
308
309 integer :: i
310 logical :: check_null
311
312 check_null = .false.
313 if (present(check_for_null)) check_null = check_for_null
314
315 i = 0
316 if (check_null) then
317 i = index(source, char(0)) - 1
318 endif
319
320 if (i < 1 ) i = len_trim(source)
321
322 if (len_trim(source(1:i)) .gt. len(dest)) then
323 call mpp_error(fatal, "The input destination string is not big enough to" &
324 //" to hold the input source string.")
325 endif
326 dest = ""
327 dest = adjustl(trim(source(1:i)))
328 end subroutine string_copy
329
330#include "fms_string_utils_r4.fh"
331#include "fms_string_utils_r8.fh"
332
333end module fms_string_utils_mod
334!> @}
335! close documentation grouping
character(:) function, allocatable, public string(v, fmt)
Converts a number or a Boolean value to a string.
character(len=:) function, allocatable cstring_fortran_conversion(cstring)
Converts a C-string to a pointer and then to a Fortran string.
character(len=:) function, dimension(:), allocatable, public fms_pointer_to_array(my_pointer, narray)
Convert an array of c pointers back to a character array.
integer function, dimension(:), allocatable, public fms_find_my_string(my_pointer, narray, string_to_find)
Searches through a SORTED array of pointers for a string.
type(c_ptr) function, dimension(:), allocatable, public fms_array_to_pointer(my_array)
Converts a character array to an array of c pointers!
subroutine, public string_copy(dest, source, check_for_null)
Safely copy a string from one buffer to another.
character(len=:) function, allocatable cpointer_fortran_conversion(cstring)
Converts a C-string returned from a TYPE(C_PTR) function to a fortran string with type character.
subroutine, public fms_f2c_string(dest, str_in)
Copies a Fortran string into a C string and puts c_null_char in any trailing spaces.
Finds the length of a C-string.
Converts a C string to a Fortran string.
converts a kind=c_char to type c_ptr
Private c function that finds a string in a SORTED array of c pointers.
c function that finds the number of unique strings in an array of c pointers
Sorts an array of pointers (my pointer) of size (p_size) in alphabetical order.
Converts an array of real numbers to a string.