#include "obl_def.fi"
!> @brief ocean boundary layer model config subroutines
module obl_config
! modules used
! --------------------------------------------------------------------------------
#ifdef USE_CONFIG_PARSER
use iso_c_binding, only: C_NULL_CHAR
use config_parser
#endif
! --------------------------------------------------------------------------------
! directives list
! --------------------------------------------------------------------------------
implicit none
! --------------------------------------------------------------------------------
public
!> @brief config enum def.
integer, parameter :: obl_config_kato = 0 !< Kato-Phillips setup
integer, parameter :: obl_config_papa_fluxes = 1 !< Papa-station (fluxes) setup
integer, parameter :: obl_config_papa_meteo = 2 !< Papa-station (meteo) setup
integer, parameter :: obl_config_cbl = 3 !< CBL setup
integer, parameter :: obl_config_cyclone = 4 !< cyclone setup
integer, parameter :: obl_config_papa_long_fluxes = 5 !< Papa-station (fluxes) setup
integer, parameter :: obl_config_papa_long_meteo = 6 !< Papa-station (fluxes) setup
character(len = 16), parameter :: obl_config_kato_tag = 'kato'
character(len = 16), parameter :: obl_config_papa_fluxes_tag = 'papa-fluxes'
character(len = 16), parameter :: obl_config_papa_meteo_tag = 'papa-meteo'
character(len = 16), parameter :: obl_config_cbl_tag = 'cbl'
character(len = 16), parameter :: obl_config_cyclone_tag = 'cyclone'
character(len = 16), parameter :: obl_config_papa_long_fluxes_tag = 'papa-long-fluxes'
character(len = 16), parameter :: obl_config_papa_long_meteo_tag = 'papa-long-meteo'
!> @brief model enum def.
integer, parameter :: obl_model_pph = 0 !< pacanowski-philander
integer, parameter :: obl_model_pph_dyn = 1 !< pacanowski-philander (dynamic)
integer, parameter :: obl_model_k_epsilon = 2 !< k-epsilon
integer, parameter :: obl_model_most = 3 !< most scheme
character(len = 16), parameter :: obl_model_pph_tag = 'pph'
character(len = 16), parameter :: obl_model_pph_dyn_tag = 'pph-dyn'
character(len = 16), parameter :: obl_model_k_epsilon_tag = 'k-epsilon'
character(len = 16), parameter :: obl_model_most_tag = 'most'
contains
! --------------------------------------------------------------------------------
function get_obl_config_id(tag) result(id)
implicit none
character(len=*), intent(in) :: tag
integer :: id
id = - 1
if (trim(tag) == trim(obl_config_kato_tag)) then
id = obl_config_kato
else if (trim(tag) == trim(obl_config_papa_fluxes_tag)) then
id = obl_config_papa_fluxes
else if (trim(tag) == trim(obl_config_papa_meteo_tag)) then
id = obl_config_papa_meteo
else if (trim(tag) == trim(obl_config_cbl_tag)) then
id = obl_config_cbl
else if (trim(tag) == trim(obl_config_cyclone_tag)) then
id = obl_config_cyclone
else if (trim(tag) == trim(obl_config_papa_long_fluxes_tag)) then
id = obl_config_papa_long_fluxes
else if (trim(tag) == trim(obl_config_papa_long_meteo_tag)) then
id = obl_config_papa_long_meteo
end if
end function
function get_obl_config_tag(id) result(tag)
implicit none
integer :: id
character(len=:), allocatable :: tag
tag = 'undefined'
if (id == obl_config_kato) then
tag = obl_config_kato_tag
else if (id == obl_config_papa_fluxes) then
tag = obl_config_papa_fluxes_tag
else if (id == obl_config_papa_meteo) then
tag = obl_config_papa_meteo_tag
else if (id == obl_config_cbl) then
tag = obl_config_cbl_tag
else if (id == obl_config_cyclone) then
tag = obl_config_cyclone_tag
else if (id == obl_config_papa_long_fluxes) then
tag = obl_config_papa_long_fluxes_tag
else if (id == obl_config_papa_long_meteo) then
tag = obl_config_papa_long_meteo_tag
end if
end function
! --------------------------------------------------------------------------------
function get_obl_model_id(tag) result(id)
implicit none
character(len=*), intent(in) :: tag
integer :: id
id = - 1
if (trim(tag) == trim(obl_model_pph_tag)) then
id = obl_model_pph
else if (trim(tag) == trim(obl_model_pph_dyn_tag)) then
id = obl_model_pph_dyn
else if (trim(tag) == trim(obl_model_k_epsilon_tag)) then
id = obl_model_k_epsilon
else if (trim(tag) == trim(obl_model_most_tag)) then
id = obl_model_most
end if
end function
function get_obl_model_tag(id) result(tag)
implicit none
integer :: id
character(len=:), allocatable :: tag
tag = 'undefined'
if (id == obl_model_pph) then
tag = obl_model_pph_tag
else if (id == obl_model_pph_dyn) then
tag = obl_model_pph_dyn_tag
else if (id == obl_model_k_epsilon) then
tag = obl_model_k_epsilon_tag
else if (id == obl_model_most) then
tag = obl_model_most_tag
end if
end function
! --------------------------------------------------------------------------------
subroutine set_grid(grid, config_id, ierr)
!> @brief grid parameters setup
! ----------------------------------------------------------------------------
use obl_grid
use obl_run_kato, only : set_grid_kato => set_grid
use obl_run_papa_fluxes, only : set_grid_papa_fluxes => set_grid
use obl_run_papa_meteo, only : set_grid_papa_meteo => set_grid
use obl_run_cbl, only : set_grid_cbl => set_grid
use obl_run_cyclone, only : set_grid_cyclone => set_grid
use obl_run_papa_long_fluxes, only : set_grid_papa_long_fluxes => set_grid
use obl_run_papa_long_meteo, only : set_grid_papa_long_meteo => set_grid
type (gridDataType), intent(inout) :: grid
integer, intent(in) :: config_id
integer, intent(out) :: ierr
! ----------------------------------------------------------------------------
ierr = 0 ! = OK
!< bultin modes
if (config_id == obl_config_kato) then
call set_grid_kato(grid)
return
endif
if (config_id == obl_config_papa_fluxes) then
call set_grid_papa_fluxes(grid)
return
endif
if (config_id == obl_config_papa_meteo) then
call set_grid_papa_meteo(grid)
return
endif
if (config_id == obl_config_cbl) then
call set_grid_cbl(grid)
return
endif
if (config_id == obl_config_cyclone) then
call set_grid_cyclone(grid)
return
endif
if (config_id == obl_config_papa_long_fluxes) then
call set_grid_papa_long_fluxes(grid)
return
endif
if (config_id == obl_config_papa_long_meteo) then
call set_grid_papa_long_meteo(grid)
return
endif
#ifdef USE_CONFIG_PARSER
block
real :: depth
integer :: cz
integer :: status
call c_config_get_float("domain.depth"//C_NULL_CHAR, depth, status)
if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
call c_config_get_int("grid.cz"//C_NULL_CHAR, cz, status)
if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
call set_uniform_grid(grid, -depth, depth, cz)
end block
#else
!> unable to define without configuration file
ierr = 1
#endif
end subroutine set_grid
! --------------------------------------------------------------------------------
subroutine set_time(time_begin, time_end, dt, config_id, ierr)
!> @brief time parameters setup
! ----------------------------------------------------------------------------
use obl_run_kato, only : set_time_kato => set_time
use obl_run_papa_fluxes, only : set_time_papa_fluxes => set_time
use obl_run_papa_meteo, only : set_time_papa_meteo => set_time
use obl_run_cbl, only : set_time_cbl => set_time
use obl_run_cyclone, only : set_time_cyclone => set_time
use obl_run_papa_long_fluxes, only : set_time_papa_long_fluxes => set_time
use obl_run_papa_long_meteo, only : set_time_papa_long_meteo => set_time
real, intent(out) :: time_begin, time_end, dt
integer, intent(in) :: config_id
integer, intent(out) :: ierr
! ----------------------------------------------------------------------------
ierr = 0 ! = OK
!< bultin modes
if (config_id == obl_config_kato) then
call set_time_kato(time_begin, time_end, dt)
return
endif
if (config_id == obl_config_papa_fluxes) then
call set_time_papa_fluxes(time_begin, time_end, dt)
return
endif
if (config_id == obl_config_papa_meteo) then
call set_time_papa_meteo(time_begin, time_end, dt)
return
endif
if (config_id == obl_config_cbl) then
call set_time_cbl(time_begin, time_end, dt)
return
endif
if (config_id == obl_config_cyclone) then
call set_time_cyclone(time_begin, time_end, dt)
return
endif
if (config_id == obl_config_papa_long_fluxes) then
call set_time_papa_long_fluxes(time_begin, time_end, dt)
return
endif
if (config_id == obl_config_papa_long_meteo) then
call set_time_papa_long_meteo(time_begin, time_end, dt)
return
endif
#ifdef USE_CONFIG_PARSER
block
integer :: status
call c_config_get_float("time.begin"//C_NULL_CHAR, time_begin, status)
if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
call c_config_get_float("time.end"//C_NULL_CHAR, time_end, status)
if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
call c_config_get_float("time.dt"//C_NULL_CHAR, dt, status)
if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
end block
#else
!> unable to define without configuration file
ierr = 1
#endif
end subroutine set_time
! --------------------------------------------------------------------------------
subroutine set_phys(config_id, ierr)
!> @brief phys parameters setup
! ----------------------------------------------------------------------------
use obl_scm
use obl_run_kato, only : set_phys_kato => set_phys
use obl_run_papa_fluxes, only : set_phys_papa_fluxes => set_phys
use obl_run_papa_meteo, only : set_phys_papa_meteo => set_phys
use obl_run_cbl, only : set_phys_cbl => set_phys
use obl_run_cyclone, only : set_phys_cyclone => set_phys
use obl_run_papa_long_fluxes, only : set_phys_papa_long_fluxes => set_phys
use obl_run_papa_long_meteo, only : set_phys_papa_long_meteo => set_phys
integer, intent(in) :: config_id
integer, intent(out) :: ierr
! ----------------------------------------------------------------------------
ierr = 0 ! = OK
if (config_id == obl_config_kato) then
call set_phys_kato
return
endif
if (config_id == obl_config_papa_fluxes) then
call set_phys_papa_fluxes
return
endif
if (config_id == obl_config_papa_meteo) then
call set_phys_papa_meteo
return
endif
if (config_id == obl_config_cbl) then
call set_phys_cbl
return
endif
if (config_id == obl_config_cyclone) then
call set_phys_cyclone
return
endif
if (config_id == obl_config_papa_long_fluxes) then
call set_phys_papa_long_fluxes
return
endif
if (config_id == obl_config_papa_long_meteo) then
call set_phys_papa_long_meteo
return
endif
#ifdef USE_CONFIG_PARSER
block
integer :: status
call c_config_get_float("phys.f"//C_NULL_CHAR, f, status)
if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
call c_config_get_float("phys.a_band_ratio"//C_NULL_CHAR, a_band_ratio, status)
if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
call c_config_get_float("phys.a_extinction_coeff"//C_NULL_CHAR, a_extinction_coeff, status)
if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
call c_config_get_float("phys.b_extinction_coeff"//C_NULL_CHAR, b_extinction_coeff, status)
if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
call c_config_get_float("phys.sw_albedo"//C_NULL_CHAR, sw_albedo, status)
if (status == 0) then
ierr = 1 ! signal ERROR
return
end if
end block
#else
!> unable to define without configuration file
ierr = 1
#endif
end subroutine set_phys
! --------------------------------------------------------------------------------
subroutine set_forcing(config_id, ierr)
!> @brief phys parameters setup
! ----------------------------------------------------------------------------
use obl_fluxes
use obl_tforcing
use obl_run_kato, only : set_forcing_kato => set_forcing
use obl_run_papa_fluxes, only : set_forcing_papa_fluxes => set_forcing
use obl_run_papa_meteo, only : set_forcing_papa_meteo => set_forcing
use obl_run_cbl, only : set_forcing_cbl => set_forcing
use obl_run_cyclone, only : set_forcing_cyclone => set_forcing
use obl_run_papa_long_fluxes, only : set_forcing_papa_long_fluxes => set_forcing
use obl_run_papa_long_meteo, only : set_forcing_papa_long_meteo => set_forcing
integer, intent(in) :: config_id
integer, intent(out) :: ierr
! ----------------------------------------------------------------------------
ierr = 0 ! = OK
if (config_id == obl_config_kato) then
call set_forcing_kato
return
endif
if (config_id == obl_config_papa_fluxes) then
call set_forcing_papa_fluxes
return
endif
if (config_id == obl_config_papa_meteo) then
call set_forcing_papa_meteo
return
endif
if (config_id == obl_config_cbl) then
call set_forcing_cbl
return
endif
if (config_id == obl_config_cyclone) then
call set_forcing_cyclone
return
endif
if (config_id == obl_config_papa_long_fluxes) then
call set_forcing_papa_long_fluxes
return
endif
if (config_id == obl_config_papa_long_meteo) then
call set_forcing_papa_long_meteo
return
endif
!< assuming that forcing def. is optional
block
call set_config_tforcing(tau_x_surf, "atm.tau_x", ierr)
if (ierr /= 0) return
call set_config_tforcing(tau_y_surf, "atm.tau_y", ierr)
if (ierr /= 0) return
call set_config_tforcing(sensible_hflux_surf, "atm.sensible_hflux", ierr)
if (ierr /= 0) return
call set_config_tforcing(latent_hflux_surf, "atm.latent_hflux", ierr)
if (ierr /= 0) return
call set_config_tforcing(salin_flux_surf, "atm.salin_flux", ierr)
if (ierr /= 0) return
call set_config_tforcing(Ua, "atm.Ua", ierr)
if (ierr /= 0) return
call set_config_tforcing(Va, "atm.Va", ierr)
if (ierr /= 0) return
call set_config_tforcing(Ta, "atm.Ta", ierr)
if (ierr /= 0) return
call set_config_tforcing(Pa, "atm.Pa", ierr)
if (ierr /= 0) return
call set_config_tforcing(Qa, "atm.Qa", ierr)
if (ierr /= 0) return
call set_config_tforcing(RHa, "atm.RHa", ierr)
if (ierr /= 0) return
call set_config_tforcing(sw_flux_surf, "atm.sw_in", ierr)
if (ierr /= 0) return
call set_config_tforcing(lw_net_surf, "atm.lw_net", ierr)
if (ierr /= 0) return
call set_config_tforcing(lw_in_surf, "atm.lw_in", ierr)
if (ierr /= 0) return
!< default: using 'flux' mode
is_meteo_setup = 0
if ((Ua%num > 0).OR.(Va%num > 0).OR.(Ta%num > 0).OR.&
(Pa%num > 0).OR.(Qa%num > 0).OR.(RHa%num > 0)) then
is_meteo_setup = 1
endif
! ----------------------------------------------------------------------------
!< setting bottom forcing
! ----------------------------------------------------------------------------
call set_const_tforcing(hflux_bot, 0.0)
call set_const_tforcing(salin_flux_bot, 0.0)
call set_const_tforcing(tau_x_bot, 0.0)
call set_const_tforcing(tau_y_bot, 0.0)
! ----------------------------------------------------------------------------
!< check consistency
! *: not implemented
! ----------------------------------------------------------------------------
end block
!> assuming that surface fluxes could be not set
!> *: this will use LW[in] and calculate LW[out]
!> *: probably to better set = 0 in all explicitly
end subroutine set_forcing
! --------------------------------------------------------------------------------
subroutine set_initial_conditions(grid, config_id, ierr)
!> @brief initial conditions setup
! ----------------------------------------------------------------------------
use obl_state
use obl_init
use obl_grid
use obl_run_kato, only : set_initial_conditions_kato => set_initial_conditions
use obl_run_papa_fluxes, only : set_initial_conditions_papa_fluxes => set_initial_conditions
use obl_run_papa_meteo, only : set_initial_conditions_papa_meteo => set_initial_conditions
use obl_run_cbl, only : set_initial_conditions_cbl => set_initial_conditions
use obl_run_cyclone, only : set_initial_conditions_cyclone => set_initial_conditions
use obl_run_papa_long_fluxes, only : set_initial_conditions_papa_long_fluxes => set_initial_conditions
use obl_run_papa_long_meteo, only : set_initial_conditions_papa_long_meteo => set_initial_conditions
type (gridDataType), intent(in) :: grid
integer, intent(in) :: config_id
integer, intent(out) :: ierr
! ----------------------------------------------------------------------------
ierr = 0 ! = OK
if (config_id == obl_config_kato) then
call set_initial_conditions_kato(grid)
return
endif
if (config_id == obl_config_papa_fluxes) then
call set_initial_conditions_papa_fluxes(grid)
return
endif
if (config_id == obl_config_papa_meteo) then
call set_initial_conditions_papa_meteo(grid)
return
endif
if (config_id == obl_config_cbl) then
call set_initial_conditions_cbl(grid)
return
endif
if (config_id == obl_config_cyclone) then
call set_initial_conditions_cyclone(grid)
return
endif
if (config_id == obl_config_papa_long_fluxes) then
call set_initial_conditions_papa_long_fluxes(grid)
return
endif
if (config_id == obl_config_papa_long_meteo) then
call set_initial_conditions_papa_long_meteo(grid)
return
endif
block
!< *: will fail without configuration file
call set_config_profile(Theta, "initial_conditions.Theta", grid, ierr)
if (ierr /= 0) then
return
endif
call set_config_profile(Salin, "initial_conditions.Salin", grid, ierr)
if (ierr /= 0) then
return
endif
call set_config_profile(U, "initial_conditions.U", grid, ierr)
if (ierr /= 0) then
return
endif
call set_config_profile(V, "initial_conditions.V", grid, ierr)
if (ierr /= 0) then
return
endif
end block
end subroutine set_initial_conditions
end module obl_config