module carbon_model_to_core
!< @brief процедуры взаимодействия между ядром и моделью углерода
! интерфейс
! ---------------------------------------------------------------------------------
implicit none
private
public :: set_tiles
public :: set_pool
public :: set_flux
public :: set_mult
public :: get_mult
contains
! внешние процедуры
! ---------------------------------------------------------------------------------
subroutine set_tiles(ntile, tile_weight)
! ---------------------------------------
!< @brief установить число тайлов (типов растительности)
use carbon_core, only : ntile_core => ntile, &
& tile_weight_core => tile_weight
use grid, only : i0, i1, j0, j1
integer, intent(in) :: ntile !< число тайлов (по умолчанию 1)
real, optional, intent(in) :: tile_weight(:,:,:) !< веса тайлов (по умолчанию 1)
ntile_core = ntile
allocate(tile_weight_core(i0:i1,j0:j1,ntile))
if (present(tile_weight)) then
tile_weight_core = tile_weight
else
tile_weight_core = 1.
endif
end subroutine
subroutine set_pool(pid, initial_value, name, alias)
! ---------------------------------------
!< @brief создать пул
use carbon_core, only : pool, npool, ntile
use grid, only : i0, i1, j0, j1
integer, intent(out) :: pid !< ID пула
real, optional, intent(in) :: initial_value !< начальное значение пула (по умолчанию 0)
character(*), optional, intent(in) :: name !< название
real, pointer, optional, intent(inout) :: alias(:,:,:) !< псевдоним
npool = npool + 1
pid = npool
allocate(pool(pid)%val(i0:i1,j0:j1,ntile))
if (present(initial_value)) then
pool(pid)%val(:,:,:) = initial_value
else
pool(pid)%val(:,:,:) = 0.
endif
if (present(name)) then
pool(pid)%name = name
else
write(pool(pid)%name,'(a4,i2.2)') 'pool', pid
endif
if (present(alias)) then
if (associated(alias)) stop "check failed : pool alias already associated"
alias(i0:i1,j0:j1,1:ntile) => pool(pid)%val(:,:,:)
endif
end subroutine
subroutine set_flux(fid, pid_out, pid_in, name, alias)
! ---------------------------------------
!< @brief создать поток между парой пулов
use carbon_core, only : flux, nflux, ntile
use grid, only : i0, i1, j0, j1
integer, intent(out) :: fid !< ID потока
integer, intent(in) :: pid_out !< ID пула откуда идет поток
integer, intent(in) :: pid_in !< ID пула куда идет поток
character(*), optional, intent(in) :: name !< название
real, pointer, optional, intent(inout) :: alias(:,:,:) !< псевдоним
nflux = nflux + 1
fid = nflux
flux(fid)%pid_out = pid_out
flux(fid)%pid_in = pid_in
flux(fid)%nmult = 0
allocate(flux(fid)%val(i0:i1,j0:j1,ntile))
flux(fid)%val(:,:,:) = 0.
if (present(name)) then
flux(fid)%name = name
else
write(flux(fid)%name,'(a4,i2.2)') 'flux', fid
endif
if (present(alias)) then
if (associated(alias)) stop "check failed : flux alias already associated"
alias(i0:i1,j0:j1,1:ntile) => flux(fid)%val(:,:,:)
endif
end subroutine
subroutine set_mult(fid, &
& funtype, &
& x, x_n, x_ij, x_ijn, x_ijn_month, x_year, &
& c, c_n, c_ij, &
& y0, y0_n, y0_ij, &
& x0, x0_n, x0_ij, &
& k, k_n, k_ij, &
& a, a_n, a_ij, &
& amp, amp_n, amp_ij, &
& c01, c01_n, c01_ij, &
& c02, c02_n, c02_ij)
! ---------------------------------------
!< @brief добавить множитель в выражение для потока
use carbon_core, only : flux
use carbon_model_to_core_arg_kit, only : set_args
use carbon_model_to_core_par_kit, only : set_pars
use carbon_model_to_core_fun_kit, only : set_fun
integer, intent(in) :: fid !< ID потока
character(*), intent(in) :: funtype !< тип функциональной зависимости
!> перечень возможных аргументов:
real, optional, intent(in) :: x, x_n(:), x_ij(:,:), x_ijn(:,:,:), x_ijn_month(:,:,:,:), x_year(:)
!> перечень возможных параметров:
real, optional, intent(in) :: c, c_n(:), c_ij(:,:)
real, optional, intent(in) :: y0, y0_n(:), y0_ij(:,:)
real, optional, intent(in) :: x0, x0_n(:), x0_ij(:,:)
real, optional, intent(in) :: k, k_n(:), k_ij(:,:)
real, optional, intent(in) :: a, a_n(:), a_ij(:,:)
real, optional, intent(in) :: amp, amp_n(:), amp_ij(:,:)
real, optional, intent(in) :: c01, c01_n(:), c01_ij(:,:)
real, optional, intent(in) :: c02, c02_n(:), c02_ij(:,:)
integer :: m
flux(fid)%nmult = flux(fid)%nmult + 1
m = flux(fid)%nmult
call set_args(flux(fid)%mult_kit(m)%arg_kit, &
& x, x_n, x_ij, x_ijn, x_ijn_month, x_year)
call set_pars(flux(fid)%mult_kit(m)%par_kit, &
& c, c_n, c_ij, &
& y0, y0_n, y0_ij, &
& x0, x0_n, x0_ij, &
& k, k_n, k_ij, &
& a, a_n, a_ij, &
& amp, amp_n, amp_ij, &
& c01, c01_n, c01_ij, &
& c02, c02_n, c02_ij)
call set_fun(flux(fid)%mult_kit(m)%fun_kit, &
& funtype)
end subroutine
function get_mult(mult_kit) result (mult)
! ---------------------------------------
!< @brief рассчитать множитель в выражении для потока
use carbon_core, only : mult_kit_type, narg_default, npar_default
use carbon_model_to_core_arg_kit, only : get_args
use carbon_model_to_core_par_kit, only : get_pars
use carbon_model_to_core_fun_kit, only : get_fun_result
use grid, only : ii, jj, nn, date_c
type(mult_kit_type), intent(in) :: mult_kit
real :: args(narg_default), pars(npar_default)
real :: mult
args(:) = get_args( mult_kit%arg_kit, ii, jj, nn, date_c%m, date_c%y )
pars(:) = get_pars( mult_kit%par_kit, ii, jj, nn, date_c%m, date_c%y )
mult = get_fun_result( mult_kit%fun_kit, args, pars )
end function
end module