Newer
Older
!> @brief sfx-inmcm coupling API
module sfx_api_inmcm
! modules used
! --------------------------------------------------------------------------------
use sfx_data
! --------------------------------------------------------------------------------
! directives list
! --------------------------------------------------------------------------------
implicit none
private
! --------------------------------------------------------------------------------
! public interface
! --------------------------------------------------------------------------------
public :: inmcm_to_sfx_in_cell, sfx_to_inmcm_out_cell
! --------------------------------------------------------------------------------
contains
! --------------------------------------------------------------------------------
subroutine inmcm_to_sfx_in_cell(meteo, arg, VEGG, depth_inm, lai_inm)
!> @brief converts legacy arg [AR1 INMCM format] array to sfx meteo input
! ----------------------------------------------------------------------------
implicit none
type (meteoDataType), intent(inout) :: meteo
real, dimension(6), intent(in) :: arg
real,intent(in) :: depth_inm
real,intent(in) :: lai_inm
! ----------------------------------------------------------------------------
meteo%U = arg(1)
meteo%dT = arg(2)
meteo%Tsemi = arg(3)
meteo%dQ = arg(4)
meteo%h = arg(5)
meteo%z0_m = arg(6)
meteo%depth = depth_inm
meteo%lai = lai_inm
end subroutine inmcm_to_sfx_in_cell
! --------------------------------------------------------------------------------
! --------------------------------------------------------------------------------
subroutine sfx_to_inmcm_out_cell(arg, sfx)
!> @brief converts sfx cell output to legacy arg [AR2 INMCM format] array
! ----------------------------------------------------------------------------
implicit none
type(sfxDataType), intent(in) :: sfx
real, dimension(11), intent(inout) :: arg
! ----------------------------------------------------------------------------
arg(1) = sfx%zeta
arg(2) = sfx%Rib
arg(3) = sfx%Re
arg(4) = sfx%B
arg(5) = sfx%z0_m
arg(6) = sfx%z0_t
!arg(7) = 0.0 ! arg(7) is never used in legacy code
arg(8) = sfx%Cm
arg(9) = sfx%Ct
arg(10) = sfx%Km
arg(11) = sfx%Pr_t_inv
end subroutine sfx_to_inmcm_out_cell
! --------------------------------------------------------------------------------
end module sfx_api_inmcm