Skip to content

Commit 9339b88

Browse files
J-LentzJ-Lentz
authored
feat: extend string interface in fms_string_utils_mod (NOAA-GFDL#1142)
1 parent 9b83c8c commit 9339b88

7 files changed

+315
-30
lines changed

‎CMakeLists.txt

+2
Original file line numberDiff line numberDiff line change
@@ -296,6 +296,7 @@ foreach(kind ${kinds})
296296
target_include_directories(${libTgt}_f PRIVATE include
297297
fms
298298
fms2_io/include
299+
string_utils/include
299300
mpp/include
300301
diag_manager/include
301302
constants4
@@ -334,6 +335,7 @@ foreach(kind ${kinds})
334335
$<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/include>
335336
$<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/fms>
336337
$<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/fms2_io/include>
338+
$<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/string_utils/include>
337339
$<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/mpp/include>
338340
$<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/diag_manager/include>)
339341

‎string_utils/Makefile.am

+4-1
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,7 @@
2121
# package.
2222

2323
# Include .h and .mod files.
24-
AM_CPPFLAGS = -I$(top_srcdir)/include
24+
AM_CPPFLAGS = -I$(top_srcdir)/include -I$(top_srcdir)/string_utils/include
2525
AM_FCFLAGS = $(FC_MODINC). $(FC_MODOUT)$(MODDIR)
2626

2727
# Build this uninstalled convenience library.
@@ -30,6 +30,9 @@ noinst_LTLIBRARIES = libstring_utils.la
3030
# The convenience library depends on its source.
3131
libstring_utils_la_SOURCES = \
3232
fms_string_utils.F90 \
33+
include/fms_string_utils.inc \
34+
include/fms_string_utils_r4.fh \
35+
include/fms_string_utils_r8.fh \
3336
fms_string_utils_binding.c
3437

3538
MODFILES = \

‎string_utils/fms_string_utils.F90

+69-29
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@
2828
!> @{
2929
module fms_string_utils_mod
3030
use, intrinsic :: iso_c_binding
31+
use platform_mod, only: r4_kind, r8_kind, i4_kind, i8_kind
3132
use mpp_mod
3233

3334
implicit none
@@ -43,6 +44,7 @@ module fms_string_utils_mod
4344
public :: fms_cstring2cpointer
4445
public :: string
4546
public :: string_copy
47+
public :: stringify
4648
!> @}
4749

4850
interface
@@ -112,11 +114,12 @@ subroutine c_free(ptr) bind(c,name="free")
112114
module procedure cpointer_fortran_conversion
113115
end interface
114116

115-
!> Converts a number to a string
117+
!> Converts an array of real numbers to a string
116118
!> @ingroup fms_mod
117-
interface string
118-
module procedure string_from_integer
119-
module procedure string_from_real
119+
interface 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
120123
end interface
121124

122125
!> @addtogroup fms_string_utils_mod
@@ -237,31 +240,65 @@ subroutine fms_f2c_string (dest, str_in)
237240
enddo
238241
end subroutine fms_f2c_string
239242

240-
241-
!> @brief Converts an integer to a string
242-
!> @return The integer as a string
243-
function string_from_integer(i) result (res)
244-
integer, intent(in) :: i !< Integer to be converted to a string
245-
character(:),allocatable :: res !< String converted frominteger
246-
character(range(i)+2) :: tmp !< Temp string that is set to correct size
247-
write(tmp,'(i0)') i
248-
res = trim(tmp)
249-
return
250-
251-
end function string_from_integer
252-
253-
!#######################################################################
254-
!> @brief Converts a real to a string
255-
!> @return The real number as a string
256-
function string_from_real(r)
257-
real, intent(in) :: r !< Real number to be converted to a string
258-
character(len=32) :: string_from_real
259-
260-
write(string_from_real,*) r
261-
262-
return
263-
264-
end function string_from_real
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
265302

266303
!> @brief Safely copy a string from one buffer to another.
267304
subroutine string_copy(dest, source, check_for_null)
@@ -290,6 +327,9 @@ subroutine string_copy(dest, source, check_for_null)
290327
dest = adjustl(trim(source(1:i)))
291328
end subroutine string_copy
292329

330+
#include "fms_string_utils_r4.fh"
331+
#include "fms_string_utils_r8.fh"
332+
293333
end module fms_string_utils_mod
294334
!> @}
295335
! close documentation grouping

‎string_utils/include/fms_string_utils.inc

+87
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,87 @@
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+
!> @brief Converts a 1D array of real numbers to a string
21+
!> @return The 1D array as a string
22+
function STRINGIFY_1D_(arr, fmt)
23+
real(STRING_UTILS_KIND_), dimension(:), intent(in) :: arr !< Real array to be converted to a string
24+
character(*), intent(in), optional :: fmt !< Optional format string for the real array entries
25+
character(:), allocatable :: STRINGIFY_1D_
26+
integer :: i, n
27+
28+
n = size(arr)
29+
30+
if (n .gt. 0) then
31+
STRINGIFY_1D_ = "[" // string(arr(1), fmt)
32+
else
33+
STRINGIFY_1D_ = "["
34+
endif
35+
36+
do i = 2,n
37+
STRINGIFY_1D_ = STRINGIFY_1D_ // ", " // string(arr(i), fmt)
38+
enddo
39+
40+
STRINGIFY_1D_ = STRINGIFY_1D_ // "]"
41+
end function
42+
43+
!> @brief Converts a 2D array of real numbers to a string
44+
!> @return The 2D array as a string
45+
function STRINGIFY_2D_(arr, fmt)
46+
real(STRING_UTILS_KIND_), dimension(:,:), intent(in) :: arr !< Real array to be converted to a string
47+
character(*), intent(in), optional :: fmt !< Optional format string for the real array entries
48+
character(:), allocatable :: STRINGIFY_2D_
49+
integer :: i, n
50+
51+
n = size(arr, 2)
52+
53+
if (n .gt. 0) then
54+
STRINGIFY_2D_ = "[" // STRINGIFY_1D_(arr(:,1), fmt)
55+
else
56+
STRINGIFY_2D_ = "["
57+
endif
58+
59+
do i = 2,n
60+
STRINGIFY_2D_ = STRINGIFY_2D_ // ", " // STRINGIFY_1D_(arr(:,i), fmt)
61+
enddo
62+
63+
STRINGIFY_2D_ = STRINGIFY_2D_ // "]"
64+
end function
65+
66+
!> @brief Converts a 3D array of real numbers to a string
67+
!> @return The 3D array as a string
68+
function STRINGIFY_3D_(arr, fmt)
69+
real(STRING_UTILS_KIND_), dimension(:,:,:), intent(in) :: arr !< Real array to be converted to a string
70+
character(*), intent(in), optional :: fmt !< Optional format string for the real array entries
71+
character(:), allocatable :: STRINGIFY_3D_
72+
integer :: i, n
73+
74+
n = size(arr, 3)
75+
76+
if (n .gt. 0) then
77+
STRINGIFY_3D_ = "[" // STRINGIFY_2D_(arr(:,:,1), fmt)
78+
else
79+
STRINGIFY_3D_ = "["
80+
endif
81+
82+
do i = 2,n
83+
STRINGIFY_3D_ = STRINGIFY_3D_ // ", " // STRINGIFY_2D_(arr(:,:,i), fmt)
84+
enddo
85+
86+
STRINGIFY_3D_ = STRINGIFY_3D_ // "]"
87+
end function

‎string_utils/include/fms_string_utils_r4.fh

+30
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
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+
#define STRING_UTILS_KIND_ r4_kind
21+
#define STRINGIFY_1D_ stringify_1d_r4
22+
#define STRINGIFY_2D_ stringify_2d_r4
23+
#define STRINGIFY_3D_ stringify_3d_r4
24+
25+
#include "fms_string_utils.inc"
26+
27+
#undef STRING_UTILS_KIND_
28+
#undef STRINGIFY_1D_
29+
#undef STRINGIFY_2D_
30+
#undef STRINGIFY_3D_

‎string_utils/include/fms_string_utils_r8.fh

+30
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
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+
#define STRING_UTILS_KIND_ r8_kind
21+
#define STRINGIFY_1D_ stringify_1d_r8
22+
#define STRINGIFY_2D_ stringify_2d_r8
23+
#define STRINGIFY_3D_ stringify_3d_r8
24+
25+
#include "fms_string_utils.inc"
26+
27+
#undef STRING_UTILS_KIND_
28+
#undef STRINGIFY_1D_
29+
#undef STRINGIFY_2D_
30+
#undef STRINGIFY_3D_

0 commit comments

Comments
 (0)