Dm p rupdate

CMakeLists.txt

@@ -165,6 +165,7 @@ list(APPEND fms_fortran_src_files
   random_numbers/random_numbers.F90
   sat_vapor_pres/sat_vapor_pres_k.F90
   sat_vapor_pres/sat_vapor_pres.F90
+  string_utils/fms_string_utils.F90
   time_interp/time_interp_external.F90
   time_interp/time_interp_external2.F90
   time_interp/time_interp.F90
@@ -188,6 +189,7 @@ list(APPEND fms_c_src_files
   mosaic/read_mosaic.c
   mpp/mpp_memuse.c
   parser/yaml_parser_binding.c
+  string_utils/fms_string_utils_binding.c
 )
 
 # Collect FMS header files

Makefile.am

@@ -43,6 +43,7 @@ SUBDIRS = \
   mosaic2 \
   fms \
   parser \
+  string_utils \
   affinity \
   mosaic \
   time_manager \

configure.ac

@@ -357,6 +357,7 @@ AC_CONFIG_FILES([
   libFMS/Makefile
   docs/Makefile
   parser/Makefile
+  string_utils/Makefile
   test_fms/test_common.sh
   test_fms/Makefile
   test_fms/diag_manager/Makefile
@@ -378,6 +379,7 @@ AC_CONFIG_FILES([
   test_fms/affinity/Makefile
   test_fms/coupler/Makefile
   test_fms/parser/Makefile
+  test_fms/string_utils/Makefile
   FMS.pc
   ])
 

docs/grouping.h

@@ -130,6 +130,10 @@
  *
  */
 
+/** @defgroup string_utils String Utils
+ *
+ */
+
 /** @defgroup time_interp Time Interpolator
  *
  */

libFMS/Makefile.am

@@ -63,6 +63,7 @@ libFMS_la_LIBADD += $(top_builddir)/random_numbers/librandom_numbers.la
 libFMS_la_LIBADD += $(top_builddir)/diag_integral/libdiag_integral.la
 libFMS_la_LIBADD += $(top_builddir)/sat_vapor_pres/libsat_vapor_pres.la
 libFMS_la_LIBADD += $(top_builddir)/parser/libparser.la
+libFMS_la_LIBADD += $(top_builddir)/string_utils/libstring_utils.la
 libFMS_la_LIBADD += $(top_builddir)/libFMS_mod.la
 
 # At least one source file must be included to please Automake.

parser/yaml_parser.F90

@@ -283,6 +283,14 @@ subroutine get_value_from_key_0d(file_id, block_id, key_name, key_value, is_opti
           if (err_unit .ne. 0) call mpp_error(FATAL, "Key:"//trim(key_name)//" Error converting '"//trim(buffer)//"' to r8")
        type is (character(len=*))
           call string_copy(key_value, buffer)
+       type is (logical)
+          if (lowercase(trim(buffer)) == "false") then
+            key_value = .false.
+          elseif (lowercase(trim(buffer)) == "true") then
+            key_value = .true.
+          else
+            call mpp_error(FATAL, "Key:"//trim(key_name)//" Error converting '"//trim(buffer)//"' to logical")
+          endif
      class default
        call mpp_error(FATAL, "The type of your buffer in your get_value_from_key call for key "//trim(key_name)//&
                             &" is not supported. Only i4, i8, r4, r8 and strings are supported.")

string_utils/Makefile.am

@@ -0,0 +1,40 @@
+#***********************************************************************
+#*                   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/>.
+#***********************************************************************
+
+# This is an automake file for the constants directory of the FMS
+# package.
+
+# Include .h and .mod files.
+AM_CPPFLAGS = -I$(top_srcdir)/include
+AM_FCFLAGS = $(FC_MODINC). $(FC_MODOUT)$(MODDIR)
+
+# Build this uninstalled convenience library.
+noinst_LTLIBRARIES = libstring_utils.la
+
+# The convenience library depends on its source.
+libstring_utils_la_SOURCES = \
+  fms_string_utils.F90 \
+  fms_string_utils_binding.c
+
+MODFILES = \
+  fms_string_utils_mod.$(FC_MODEXT)
+BUILT_SOURCES = $(MODFILES)
+nodist_include_HEADERS = $(MODFILES)
+
+include $(top_srcdir)/mkmods.mk

string_utils/fms_string_utils.F90

@@ -0,0 +1,148 @@
+!***********************************************************************
+!*                   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/>.
+!***********************************************************************
+
+!> @defgroup fms_string_utils_mod fms_string_utils_mod
+!> @ingroup string_utils
+!> @brief Routines to use for string manipulation
+
+!> @file
+!> @brief File for @ref fms_string_utils_mod
+
+!> @addtogroup fms_string_utils_mod
+!> @{
+module fms_string_utils_mod
+  use, intrinsic :: iso_c_binding
+  use fms_mod, only: fms_c2f_string
+  use mpp_mod
+
+  implicit none
+  private
+
+  public :: fms_array_to_pointer
+  public :: fms_pointer_to_array
+  public :: fms_sort_this
+  public :: fms_find_my_string
+!> @}
+
+  interface
+  !> @brief Sorts an array of pointers (my pointer) of size (p_size) in
+  !! alphabetical order.
+  subroutine fms_sort_this(my_pointer, p_size, indices) bind(c)
+    use iso_c_binding
+
+    type(c_ptr),         intent(inout) :: my_pointer(*) !< IN:  Array of c pointers to sort
+                                                        !! OUT: Sorted array of c pointers
+    integer(kind=c_int), intent(in)    :: p_size        !< Size of the array
+    integer(kind=c_int), intent(inout) :: indices(*)    !< IN:  Array of the indices of my_pointer
+                                                        !! OUT: Sorted array of indices
+  end subroutine fms_sort_this
+
+  !> @brief Private c function that finds a string in a SORTED array of c pointers
+  !! @return Indices of my_pointer where the string was found as a string!!!
+  function fms_find_my_string_binding(my_pointer, p_size, string_to_find, nfound) bind(c) &
+  result(indices)
+    use iso_c_binding
+
+    type(c_ptr),            intent(in) :: my_pointer(*)     !< Array of sorted c pointer
+    integer(kind=c_int),    intent(in) :: p_size            !< Size of the array
+    character(kind=c_char), intent(in) :: string_to_find(*) !< String to find
+    integer(kind=c_int), intent(inout) :: nfound            !< Number of times the array was found
+
+    type(c_ptr) :: indices
+  end function fms_find_my_string_binding
+
+  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
+  function fms_array_to_pointer(my_array) &
+  result(my_pointer)
+    character(len=*), target :: my_array(:) !!< Array of strings to convert
+    type(c_ptr), allocatable :: my_pointer(:)
+
+    integer :: i !< For do loops
+
+    if (allocated(my_pointer)) call mpp_error(FATAL, "The c pointer array is &
+      already allocated. Deallocated before calling fms_array_to_pointer")
+    allocate(my_pointer(size(my_array)))
+
+    do i = 1, size(my_array)
+      my_pointer(i) = c_loc(my_array(i))
+    enddo
+  end function fms_array_to_pointer
+
+  !> @brief Convert an array of c pointers back to a character array
+  !! @return A character array
+  function fms_pointer_to_array(my_pointer, narray) &
+  result(my_array)
+    type(c_ptr), intent(in)       :: my_pointer(*) !< Array of c pointer
+    integer,     intent(in)       :: narray        !< Length of the array
+    character(len=:), allocatable :: my_array(:)
+
+    character(len=:), allocatable :: buffer !< Buffer to store a string
+    integer                       :: i      !< For do loops
+
+    allocate(character(len=255) :: my_array(narray))
+    do i = 1, narray
+      buffer = fms_c2f_string(my_pointer(i))
+      my_array(i) = buffer
+      deallocate(buffer)
+    enddo
+  end function fms_pointer_to_array
+
+  !> @brief Searches through a SORTED array of pointers for a string
+  !! @return the indices where the array was found
+  !! If the string was not found, indices will be indices(1) = -999
+  !> <br>Example usage:
+  !!     my_pointer = fms_array_to_pointer(my_array)
+  !!     call fms_sort_this(my_pointer, n_array, indices)
+  !!     ifind = fms_find_my_string(my_pointer, n_array, string_to_find)
+  function fms_find_my_string(my_pointer, narray, string_to_find) &
+  result(ifind)
+    type(c_ptr),      intent(in)    :: my_pointer(*)  !< Array of c pointer
+    integer,          intent(in)    :: narray         !< Length of the array
+    character(len=*), intent(in)    :: string_to_find !< string to find
+    integer, allocatable            :: ifind(:)
+
+    integer                       :: nfind  !< number of times the string was found
+    character(len=:), allocatable :: buffer !< buffer to read the indices into
+
+    buffer = fms_c2f_string(&
+      fms_find_my_string_binding(my_pointer, narray, trim(string_to_find)//c_null_char, nfind))
+
+    if (allocated(ifind)) call mpp_error(FATAL, "The indices array is already allocated. &
+    Deallocate it before calling fms_find_my_string")
+
+    if (nfind .gt. 0) then
+      allocate(ifind(nfind))
+      read(buffer,*) ifind
+    else
+      allocate(ifind(1))
+      ifind = -999
+    endif
+
+  end function fms_find_my_string
+
+end module fms_string_utils_mod
+!> @}
+! close documentation grouping