From 0f9143aa49a03f4b2330704a63198b93e5f2e902 Mon Sep 17 00:00:00 2001
From: Andrey Debolskiy <and.debol@gmail.com>
Date: Fri, 28 Feb 2025 12:18:04 +0300
Subject: [PATCH] introduce lake model api (needed since it uses double
precision)
---
CMakeLists.txt | 1 +
srcF/sfx_api_lake.f90 | 77 +++++++++++++++++++++++++++++++++++++++++++
srcF/sfx_surface.f90 | 2 ++
3 files changed, 80 insertions(+)
create mode 100644 srcF/sfx_api_lake.f90
diff --git a/CMakeLists.txt b/CMakeLists.txt
index 98b57e9..33c6743 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -100,6 +100,7 @@ set(SOURCES_F
srcF/sfx_fc_wrapper.F90
srcF/sfx_api_inmcm.f90
srcF/sfx_api_term.f90
+ srcF/sfx_api_lake.f90
)
set(DIAG
diff --git a/srcF/sfx_api_lake.f90 b/srcF/sfx_api_lake.f90
new file mode 100644
index 0000000..3279bf8
--- /dev/null
+++ b/srcF/sfx_api_lake.f90
@@ -0,0 +1,77 @@
+!> @brief sfx-inmcm coupling API
+module sfx_api_lake
+
+ ! modules used
+ ! --------------------------------------------------------------------------------
+ use sfx_data
+ ! --------------------------------------------------------------------------------
+
+ ! directives list
+ ! --------------------------------------------------------------------------------
+ implicit none
+ private
+ ! --------------------------------------------------------------------------------
+
+ ! public interface
+ ! --------------------------------------------------------------------------------
+ public :: lake_to_sfx_in_cell, sfx_to_lake_out_cell
+ ! --------------------------------------------------------------------------------
+
+contains
+
+ ! --------------------------------------------------------------------------------
+ subroutine lake_to_sfx_in_cell(meteo, arg, IVEG_sfx, depth_inm, lai_inm)
+ !> @brief converts legacy arg [AR1 INMCM format but double pres] array to sfx meteo input
+ ! ----------------------------------------------------------------------------
+ use, intrinsic :: iso_c_binding, only: real_d => c_double, & ! 8-byte real
+ real_f => c_float ! 4-byte real
+ implicit none
+ type (meteoDataType), intent(inout) :: meteo
+ real(kind=real_d), dimension(6), intent(in) :: arg
+ integer,intent(in) :: IVEG_sfx
+ real(kind=real_d),intent(in) :: depth_inm
+ real(kind=real_d),intent(in) :: lai_inm
+
+ ! ----------------------------------------------------------------------------
+
+
+ meteo%U = real(arg(1),real_f)
+ meteo%dT = real(arg(2),real_f)
+ meteo%Tsemi = real(arg(3),real_f)
+ meteo%dQ = real(arg(4),real_f)
+ meteo%h = real(arg(5),real_f)
+ meteo%z0_m = real(arg(6),real_f)
+ meteo%depth = real(depth_inm,real_f)
+ meteo%lai = real(lai_inm,real_f)
+ meteo%surface_type = IVEG_sfx
+ !write(*,*) 'surface_type, IVEG_sfx', meteo%surface_type, IVEG_sfx
+ end subroutine lake_to_sfx_in_cell
+ ! --------------------------------------------------------------------------------
+
+ ! --------------------------------------------------------------------------------
+ subroutine sfx_to_lake_out_cell(arg, sfx)
+ !> @brief converts sfx cell output to legacy arg [AR2 INMCM format] array
+ ! ----------------------------------------------------------------------------
+ use, intrinsic :: iso_c_binding, only: real_d => c_double ! 8-byte real
+ implicit none
+ type(sfxDataType), intent(in) :: sfx
+ real(kind=real_d), dimension(11), intent(inout) :: arg
+ ! ----------------------------------------------------------------------------
+
+
+ arg(1) = dble(sfx%zeta)
+ arg(2) = dble(sfx%Rib)
+ arg(3) = dble(sfx%Re)
+ arg(4) = dble(sfx%B)
+ arg(5) = dble(sfx%z0_m)
+ arg(6) = dble(sfx%z0_t)
+ !arg(7) = 0.0 ! arg(7) is never used in legacy code
+ arg(8) = dble(sfx%Cm)
+ arg(9) = dble(sfx%Ct)
+ arg(10) = dble(sfx%Km)
+ arg(11) = dble(sfx%Pr_t_inv)
+
+ end subroutine sfx_to_lake_out_cell
+ ! --------------------------------------------------------------------------------
+
+end module sfx_api_lake
diff --git a/srcF/sfx_surface.f90 b/srcF/sfx_surface.f90
index 70b10b2..3b23599 100644
--- a/srcF/sfx_surface.f90
+++ b/srcF/sfx_surface.f90
@@ -322,6 +322,8 @@ contains
#if defined(INCLUDE_CXX)
subroutine set_c_struct_sfx_surface_param_values(surface_param)
use sfx_data
+ use sfx_z0m_all_surface
+ use sfx_z0t_all_surface
implicit none
type (sfx_surface_param), intent(inout) :: surface_param
surface_param%surface_ocean = surface_ocean
--
GitLab