From 083f3a52f206fd0de581bb88c45bce4b8e97bd5e Mon Sep 17 00:00:00 2001
From: Evgeny Mortikov <evgeny.mortikov@gmail.com>
Date: Wed, 18 Dec 2024 12:26:16 +0300
Subject: [PATCH] adding common module

---
 CMakeLists.txt   |  1 +
 obl_common.f90   | 52 ++++++++++++++++++++++++++++++++++++++++++++++++
 obl_math.f90     | 48 +++++++++++++++++++-------------------------
 obl_tforcing.f90 |  2 +-
 4 files changed, 75 insertions(+), 28 deletions(-)
 create mode 100644 obl_common.f90

diff --git a/CMakeLists.txt b/CMakeLists.txt
index e3aaa9e..29eef62 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -31,6 +31,7 @@ endif(BUILD_DOC)
 set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/modules/)
 
 set(SOURCES
+    obl_common.f90
     obl_grid.f90
     obl_tslice.f90
     obl_tseries.f90
diff --git a/obl_common.f90 b/obl_common.f90
new file mode 100644
index 0000000..9764db8
--- /dev/null
+++ b/obl_common.f90
@@ -0,0 +1,52 @@
+!> @brief ocean boundary layer model common subroutines
+module obl_common
+    public
+
+contains
+
+    !> @brief string to int conversion
+    elemental subroutine str2int(int, str, stat)
+        ! ----------------------------------------------------------------------------
+        implicit none
+        integer, intent(out) :: int
+        integer, intent(out) :: stat                !> output status, /= 0 signals ERROR
+
+        character(len = *), intent(in) :: str
+        ! ----------------------------------------------------------------------------
+
+        read(str, * , iostat = stat) int
+    end subroutine str2int
+    ! ----------------------------------------------------------------------------
+
+    !> @brief string to real conversion
+    elemental subroutine str2real(x, str, stat)
+        ! ----------------------------------------------------------------------------
+        implicit none
+        real, intent(out) :: x
+        integer, intent(out) :: stat                !> output status, /= 0 signals ERROR
+
+        character(len = *), intent(in) :: str
+        ! ----------------------------------------------------------------------------
+
+        read(str, * , iostat = stat) x
+    end subroutine str2real
+    ! ----------------------------------------------------------------------------
+
+    !> @brief character array to string conversion
+    function char_array2str(char_array) result(str)
+        ! ----------------------------------------------------------------------------
+        implicit none
+        character, intent(in) :: char_array(:)
+        character(len=:), allocatable :: str
+        integer :: i
+        ! ----------------------------------------------------------------------------
+
+        str = ""
+        do i = 1, size(char_array)
+            str = str(:) // char_array(i)
+        end do
+
+    end function
+    ! ----------------------------------------------------------------------------
+
+end module obl_common
diff --git a/obl_math.f90 b/obl_math.f90
index ef15709..afc28be 100644
--- a/obl_math.f90
+++ b/obl_math.f90
@@ -18,8 +18,7 @@ module obl_math
     public :: c_interp_linear
     public :: limit_min_array, limit_max_array
     public :: tma
-    public :: is_finite
-    public :: char_array2str
+    public :: is_finite, is_finite_array
     ! --------------------------------------------------------------------------------
 
 
@@ -125,14 +124,27 @@ module obl_math
         end do
 
     end subroutine tma
-    
+
     ! --------------------------------------------------------------------------------
-    function is_finite(F, n)
-        !> @brief check if any value in array is finite
+    elemental function is_finite(value)
+        !> @brief check if value is finite
         ! ----------------------------------------------------------------------------
         use ieee_arithmetic
         implicit none
         logical :: is_finite
+
+        real, intent(in) :: value
+        ! ----------------------------------------------------------------------------
+
+        is_finite = ieee_is_finite(value)
+    end function is_finite
+    
+    function is_finite_array(F, n)
+        !> @brief check if any value in array is finite
+        ! ----------------------------------------------------------------------------
+        use ieee_arithmetic
+        implicit none
+        logical :: is_finite_array
         
         integer, intent(in) :: n
         real, intent(in), dimension(n) :: F
@@ -140,29 +152,11 @@ module obl_math
         integer :: k
         ! ----------------------------------------------------------------------------
 
-        is_finite = .true.
+        is_finite_array = .true.
         do k=1, n
-            is_finite = ieee_is_finite(F(k))
-            if (is_finite.eqv..false.) exit
+            is_finite_array = ieee_is_finite(F(k))
+            if (.not.is_finite_array) exit
         enddo
-    end function is_finite
-
-    !> @brief character array to string conversion
-    function char_array2str(char_array) result(str)
-        ! ----------------------------------------------------------------------------
-        implicit none
-        character, intent(in) :: char_array(:)
-        character(len=:), allocatable :: str
-        integer :: i
-        ! ----------------------------------------------------------------------------
-
-        str = ""
-        do i = 1, size(char_array)
-            str = str(:) // char_array(i)
-        end do
-
-    end function
-    ! ----------------------------------------------------------------------------
-
+    end function is_finite_array
 
 end module
diff --git a/obl_tforcing.f90 b/obl_tforcing.f90
index 37b7936..6eacfda 100644
--- a/obl_tforcing.f90
+++ b/obl_tforcing.f90
@@ -136,7 +136,7 @@ module obl_tforcing
     subroutine set_config_tforcing(tforcing, tag, ierr)
         !> @brief generic forcing setup
         ! ----------------------------------------------------------------------------
-        use obl_math, only : char_array2str
+        use obl_common, only : char_array2str
 
         type (timeForcingDataType), intent(inout) :: tforcing
         integer, intent(out) :: ierr
-- 
GitLab