feat: extend string interface in fms_string_utils_mod (#1142)

CMakeLists.txt

@@ -296,6 +296,7 @@ foreach(kind ${kinds})
   target_include_directories(${libTgt}_f PRIVATE include
                                                  fms
                                                  fms2_io/include
+                                                 string_utils/include
                                                  mpp/include
                                                  diag_manager/include
                                                  constants4
@@ -334,6 +335,7 @@ foreach(kind ${kinds})
     $<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/include>
     $<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/fms>
     $<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/fms2_io/include>
+    $<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/string_utils/include>
     $<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/mpp/include>
     $<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/diag_manager/include>)
 

string_utils/Makefile.am

@@ -21,7 +21,7 @@
 # package.
 
 # Include .h and .mod files.
-AM_CPPFLAGS = -I$(top_srcdir)/include
+AM_CPPFLAGS = -I$(top_srcdir)/include -I$(top_srcdir)/string_utils/include
 AM_FCFLAGS = $(FC_MODINC). $(FC_MODOUT)$(MODDIR)
 
 # Build this uninstalled convenience library.
@@ -30,6 +30,9 @@ noinst_LTLIBRARIES = libstring_utils.la
 # The convenience library depends on its source.
 libstring_utils_la_SOURCES = \
   fms_string_utils.F90 \
+  include/fms_string_utils.inc \
+  include/fms_string_utils_r4.fh \
+  include/fms_string_utils_r8.fh \
   fms_string_utils_binding.c
 
 MODFILES = \

string_utils/fms_string_utils.F90

@@ -28,6 +28,7 @@
 !> @{
 module fms_string_utils_mod
   use, intrinsic :: iso_c_binding
+  use platform_mod, only: r4_kind, r8_kind, i4_kind, i8_kind
   use mpp_mod
 
   implicit none
@@ -43,6 +44,7 @@ module fms_string_utils_mod
   public :: fms_cstring2cpointer
   public :: string
   public :: string_copy
+  public :: stringify
 !> @}
 
   interface
@@ -112,11 +114,12 @@ subroutine c_free(ptr) bind(c,name="free")
   module procedure cpointer_fortran_conversion
 end interface
 
-!> Converts a number to a string
+!> Converts an array of real numbers to a string
 !> @ingroup fms_mod
-interface string
-   module procedure string_from_integer
-   module procedure string_from_real
+interface stringify
+  module procedure stringify_1d_r4, stringify_1d_r8
+  module procedure stringify_2d_r4, stringify_2d_r8
+  module procedure stringify_3d_r4, stringify_3d_r8
 end interface
 
 !> @addtogroup fms_string_utils_mod
@@ -237,31 +240,65 @@ subroutine fms_f2c_string (dest, str_in)
     enddo
 end subroutine fms_f2c_string
 
-
-  !> @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 Converts a number or a Boolean value to a string
+  !> @return The argument as a string
+  function string(v, fmt)
+    class(*), intent(in) :: v !< Value to be converted to a string
+    character(*), intent(in), optional :: fmt !< Optional format string for a real or integral argument
+    character(:), allocatable :: string
+
+    select type(v)
+      type is (logical)
+        if (present(fmt)) then
+          call mpp_error(WARNING, "string(): Ignoring `fmt` argument for type `logical`")
+        endif
+        if (v) then
+          string = "True"
+        else
+          string = "False"
+        endif
+
+      type is (integer(i4_kind))
+        allocate(character(32) :: string)
+        if (present(fmt)) then
+          write(string, "(" // fmt // ")") v
+        else
+          write(string, '(i0)') v
+        endif
+        string = trim(adjustl(string))
+
+      type is (integer(i8_kind))
+        allocate(character(32) :: string)
+        if (present(fmt)) then
+          write(string, "(" // fmt // ")") v
+        else
+          write(string, '(i0)') v
+        endif
+        string = trim(adjustl(string))
+
+      type is (real(r4_kind))
+        allocate(character(32) :: string)
+        if (present(fmt)) then
+          write(string, "(" // fmt // ")") v
+        else
+          write(string, *) v
+        endif
+        string = trim(adjustl(string))
+
+      type is (real(r8_kind))
+        allocate(character(32) :: string)
+        if (present(fmt)) then
+          write(string, "(" // fmt // ")") v
+        else
+          write(string, *) v
+        endif
+        string = trim(adjustl(string))
+
+      class default
+        call mpp_error(FATAL, "string(): Called with incompatible argument type. Possible types &
+                              &include integer(4), integer(8), real(4), real(8), or logical.")
+    end select
+  end function string
 
   !> @brief Safely copy a string from one buffer to another.
   subroutine string_copy(dest, source, check_for_null)
@@ -290,6 +327,9 @@ subroutine string_copy(dest, source, check_for_null)
     dest = adjustl(trim(source(1:i)))
   end subroutine string_copy
 
+#include "fms_string_utils_r4.fh"
+#include "fms_string_utils_r8.fh"
+
 end module fms_string_utils_mod
 !> @}
 ! close documentation grouping

string_utils/include/fms_string_utils.inc

@@ -0,0 +1,87 @@
+!***********************************************************************
+!*                   GNU Lesser General Public License
+!*
+!* This file is part of the GFDL Flexible Modeling System (FMS).
+!*
+!* FMS is free software: you can redistribute it and/or modify it under
+!* the terms of the GNU Lesser General Public License as published by
+!* the Free Software Foundation, either version 3 of the License, or (at
+!* your option) any later version.
+!*
+!* FMS is distributed in the hope that it will be useful, but WITHOUT
+!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+!* FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+!* for more details.
+!*
+!* You should have received a copy of the GNU Lesser General Public
+!* License along with FMS.  If not, see <http://www.gnu.org/licenses/>.
+!***********************************************************************
+
+!> @brief Converts a 1D array of real numbers to a string
+!> @return The 1D array as a string
+function STRINGIFY_1D_(arr, fmt)
+  real(STRING_UTILS_KIND_), dimension(:), intent(in) :: arr !< Real array to be converted to a string
+  character(*), intent(in), optional :: fmt !< Optional format string for the real array entries
+  character(:), allocatable :: STRINGIFY_1D_
+  integer :: i, n
+
+  n = size(arr)
+
+  if (n .gt. 0) then
+    STRINGIFY_1D_ = "[" // string(arr(1), fmt)
+  else
+    STRINGIFY_1D_ = "["
+  endif
+
+  do i = 2,n
+    STRINGIFY_1D_ = STRINGIFY_1D_ // ", " // string(arr(i), fmt)
+  enddo
+
+  STRINGIFY_1D_ = STRINGIFY_1D_ // "]"
+end function
+
+!> @brief Converts a 2D array of real numbers to a string
+!> @return The 2D array as a string
+function STRINGIFY_2D_(arr, fmt)
+  real(STRING_UTILS_KIND_), dimension(:,:), intent(in) :: arr !< Real array to be converted to a string
+  character(*), intent(in), optional :: fmt !< Optional format string for the real array entries
+  character(:), allocatable :: STRINGIFY_2D_
+  integer :: i, n
+
+  n = size(arr, 2)
+
+  if (n .gt. 0) then
+    STRINGIFY_2D_ = "[" // STRINGIFY_1D_(arr(:,1), fmt)
+  else
+    STRINGIFY_2D_ = "["
+  endif
+
+  do i = 2,n
+    STRINGIFY_2D_ = STRINGIFY_2D_ // ", " // STRINGIFY_1D_(arr(:,i), fmt)
+  enddo
+
+  STRINGIFY_2D_ = STRINGIFY_2D_ // "]"
+end function
+
+!> @brief Converts a 3D array of real numbers to a string
+!> @return The 3D array as a string
+function STRINGIFY_3D_(arr, fmt)
+  real(STRING_UTILS_KIND_), dimension(:,:,:), intent(in) :: arr !< Real array to be converted to a string
+  character(*), intent(in), optional :: fmt !< Optional format string for the real array entries
+  character(:), allocatable :: STRINGIFY_3D_
+  integer :: i, n
+
+  n = size(arr, 3)
+
+  if (n .gt. 0) then
+    STRINGIFY_3D_ = "[" // STRINGIFY_2D_(arr(:,:,1), fmt)
+  else
+    STRINGIFY_3D_ = "["
+  endif
+
+  do i = 2,n
+    STRINGIFY_3D_ = STRINGIFY_3D_ // ", " // STRINGIFY_2D_(arr(:,:,i), fmt)
+  enddo
+
+  STRINGIFY_3D_ = STRINGIFY_3D_ // "]"
+end function

string_utils/include/fms_string_utils_r4.fh

@@ -0,0 +1,30 @@
+!***********************************************************************
+!*                   GNU Lesser General Public License
+!*
+!* This file is part of the GFDL Flexible Modeling System (FMS).
+!*
+!* FMS is free software: you can redistribute it and/or modify it under
+!* the terms of the GNU Lesser General Public License as published by
+!* the Free Software Foundation, either version 3 of the License, or (at
+!* your option) any later version.
+!*
+!* FMS is distributed in the hope that it will be useful, but WITHOUT
+!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+!* FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+!* for more details.
+!*
+!* You should have received a copy of the GNU Lesser General Public
+!* License along with FMS.  If not, see <http://www.gnu.org/licenses/>.
+!***********************************************************************
+
+#define STRING_UTILS_KIND_ r4_kind
+#define STRINGIFY_1D_ stringify_1d_r4
+#define STRINGIFY_2D_ stringify_2d_r4
+#define STRINGIFY_3D_ stringify_3d_r4
+
+#include "fms_string_utils.inc"
+
+#undef STRING_UTILS_KIND_
+#undef STRINGIFY_1D_
+#undef STRINGIFY_2D_
+#undef STRINGIFY_3D_

string_utils/include/fms_string_utils_r8.fh

@@ -0,0 +1,30 @@
+!***********************************************************************
+!*                   GNU Lesser General Public License
+!*
+!* This file is part of the GFDL Flexible Modeling System (FMS).
+!*
+!* FMS is free software: you can redistribute it and/or modify it under
+!* the terms of the GNU Lesser General Public License as published by
+!* the Free Software Foundation, either version 3 of the License, or (at
+!* your option) any later version.
+!*
+!* FMS is distributed in the hope that it will be useful, but WITHOUT
+!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+!* FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+!* for more details.
+!*
+!* You should have received a copy of the GNU Lesser General Public
+!* License along with FMS.  If not, see <http://www.gnu.org/licenses/>.
+!***********************************************************************
+
+#define STRING_UTILS_KIND_ r8_kind
+#define STRINGIFY_1D_ stringify_1d_r8
+#define STRINGIFY_2D_ stringify_2d_r8
+#define STRINGIFY_3D_ stringify_3d_r8
+
+#include "fms_string_utils.inc"
+
+#undef STRING_UTILS_KIND_
+#undef STRINGIFY_1D_
+#undef STRINGIFY_2D_
+#undef STRINGIFY_3D_