Skip to content
Snippets Groups Projects
Commit 8debcc67 authored by Georgiy Faikin's avatar Georgiy Faikin
Browse files

First step of ROMUL integration. Doesnt finish, doesnt work

parent af3fe662
No related branches found
No related tags found
No related merge requests found
module carbon_model_Romul_aux
! интерфейс
! ----------------------------------------------- Use pack ------------------------------------------------------------
!use environment_core, only: Tsoil, Wsoil, lambd
use config, only: station_name, station_opt, carbon_model_type
use const, only: yrs
use grid, only: date_c, i0, i1, j0, j1, ml
! ---------------------------------------------- Variables ------------------------------------------------------------
implicit none
! ------- Pools -------
real, dimension(:,:,:), pointer :: Catm !< атмосфера с углеродом
real, dimension(:,:,:), pointer :: Cveg1 !< растительность c поверхности почвы, ОРВП
real, dimension(:,:,:), pointer :: Cveg2 !< растительность под поверхностью почвы, ОРВП
real, dimension(:,:,:), pointer :: Natm !< атмосфера с озотом
real, dimension(:,:,:), pointer :: Nveg1 !< растительность c поверхности почвы, озот
real, dimension(:,:,:), pointer :: Nveg2 !< растительность под поверхностью почвы, озот
!real, dimension(:,:,:), pointer :: N_bacter !< пул органических бактерий, поедающих около 20% азота
real, dimension(:,:,:), pointer :: CL !< Слаборазложившаяся когорта напочвенного опада, подстилка
real, dimension(:,:,:), pointer :: CF !< Среднеразложившаяся когорта напочвенного опада, подстилка
real, dimension(:,:,:), pointer :: CLs !< Слаборазложившаяся когорта внутрипочвенного опада
real, dimension(:,:,:), pointer :: CFs !< Среднеразложившаяся когорта внутрипочвенного опада
real, dimension(:,:,:), pointer :: CHs !< Гумуфицированный материал, стабильный гумус
real, dimension(:,:,:), pointer :: NL !< Значение азота неразложившейся части напочвенной когорты опада
real, dimension(:,:,:), pointer :: NF !< Значение азота напочвенной когорты опада
real, dimension(:,:,:), pointer :: NLs !< Значение азота неразложившейся части внутрипочвенной когорты опада
real, dimension(:,:,:), pointer :: NFs !< Значение азота внутрипочвенной когорты опада
real, dimension(:,:,:), pointer :: NHs !< Значение азота в стабильном гумусе
! ------- Flows -------
!real, dimension(:,:,:), pointer ::
!real, dimension(:,:,:), pointer ::
!real, dimension(:,:,:), pointer ::
!real, dimension(:,:,:), pointer ::
! ------- Serve value -------
integer, parameter :: ntiles = 10 !< В данном случае, количество пулов
! ------- Кинетические параметры ----------------------
! С учётом поправочного коэффициента на температуру и влажность ------------
real :: k1l !< Из L в Catm, [1/день]
real :: k2l !< Из F в Catm, [1/день]
real :: k3l !< Из L в F, [1/день]
real :: k4l !< Из F в Hs, [1/день]
real :: k1s !< Из Ls в Catm, [1/день]
real :: k2s !< Из Fs в Catm, [1/день]
real :: k3s !< Из Ls в Fs, [1/день]
real :: k4s !< Из Fs в Hs, [1/день]
real :: k5s !< Из Fs в Hs, и из F в Hs, [1/день]
real :: k6 !< Из Hs в Catm, [1/день]
! ------- Coefficients ------------
real :: kh !< Обобщённый коэффициент гумификации КГВ
real :: km !< Обобщённый коэффициент минерализации лабильного гумуса
real :: CNF !< Концентрация азота в КГВ
real :: gamma !< отношение расхода азота на формирования гумуса и биомассу разлогателей
real :: bacter!< отношение расхода азота на формирования гумуса и биомассу разлогателей
real :: lumb !< отношение расхода азота на формирования гумуса и биомассу разлогателей
real :: Ml !< поправочный коэффициент на минерализацию азота в когорте L и Ls
real :: Mf !< поправочный коэффициент на минерализацию азота в когорте F
real :: Mfs !< поправочный коэффициент на минерализацию азота в когорте Fs
real :: MH !< поправочный коэффициент на минерализацию азота в когорте Hs
! ------ Climate variables --------
real :: Temp !< температура воздуха
real :: Tsurf !< температура подстилки
real :: Tsoil !< температура почвы
real :: Wsoil !< влажность почвы
real :: Wsurf !< влажность подстилки
contains
subroutine carbon_model_init()
integer :: i !< count
end subroutine
subroutine carbon_model_calc_at_timestep()
end subroutine
subroutine carbon_model_calc_at_cell(ii,jj)
integer, intent(in) :: ii, jj
end subroutine
subroutine carbon_model_calc_at_tile(ii,jj,nn)
integer, intent(in) :: ii, jj, nn
if (Wsurf(ii,jj,1) < 7.) then
Fwl = 0.
elseif ( 7. <= Wsurf(ii,jj,1) < 125.) then
Fwl = 0.00000453*Wsurf(ii,jj,1)**2.5492
elseif ( 125. <= Wsurf(ii,jj,1) < 400.) then
Fwl = 1.
else !if ( 400. <= Wsurf(ii,jj,1)) then
Fwl = 1.0027*0.99157**(Wsurf(ii,jj,1) - 400.)
end if
if (Wsoil(ii,jj,1) < 7.) then
Fws = 0.
elseif ( 7. <= Wsoil(ii,jj,1) < 125.) then
Fws = 0.00000453*Wsoil(ii,jj,1)**2.5492
elseif ( 125. <= Wsoil(ii,jj,1) < 400.) then
Fws = 1.
else !if ( 400. <= Wsoil(ii,jj,1)) then
Fws = 1.0027*0.99157**(Wsoil(ii,jj,1) - 400.)
end if
if (Tsoil(ii,jj,1) <= -5.) then
Ftl1 = 0.
elseif (-5. < Tsoil(ii,jj,1) <= 1.) then
Ftl1 = 0.1595 + 0.0319*Tsoil(ii,jj,1)
elseif (1. < Tsoil(ii,jj,1) <= 35.) then
Ftl1 = 0.1754*exp(0.0871*Tsoil(ii,jj,1))
elseif (35. < Tsoil(ii,jj,1) <= 60.) then
Ftl1 = 8.791 - 0.1465*Tsoil(ii,jj,1)
else !if (Tsoil(ii,jj,1) > 60.) then
Ftl1 = 0.
end if
if (Tsoil(ii,jj,1) <= -5.) then
Ftl2 = 0.
elseif (-5. < Tsoil(ii,jj,1) <= 1.) then
Ftl2 = 0.1595 + 0.0319*Tsoil(ii,jj,1)
elseif (1. < Tsoil(ii,jj,1) <= 25.) then
Ftl2 = 0.1754*exp(0.0871*Tsoil(ii,jj,1))
elseif (25. < Tsoil(ii,jj,1) <= 35.) then
Ftl2 = 1.534
elseif (35. < Tsoil(ii,jj,1) <= 60.) then
Ftl2 = 3.690 - 0.0615*Tsoil(ii,jj,1)
else !if (Tsoil(ii,jj,1) > 60.) then
Ftl2 = 0.
end if
if (Tsoil(ii,jj,1) <= -5.) then
Ftl4 = 0.
elseif (-5. < Tsoil(ii,jj,1) <= 1.) then
Ftl4 = 0.1595 + 0.0319*Tsoil(ii,jj,1)
elseif (1. < Tsoil(ii,jj,1) <= 25.) then
Ftl4 = 0.1754*exp(0.0871*Tsoil(ii,jj,1))
elseif (25. < Tsoil(ii,jj,1) <= 35.) then
Ftl4 = 1.0
elseif (35. < Tsoil(ii,jj,1) <= 80.) then
Ftl4 = 2.0 - 0.025*Tsoil(ii,jj,1)
else !if (Tsoil(ii,jj,1) > 80.) then
Ftl4 = 0.
end if
if (Tsoil(ii,jj,1) <= -3.) then
Ftl3 = 0.
elseif (-3. < Tsoil(ii,jj,1) <= 7.) then
Ftl3 = 1.3
elseif (7. < Tsoil(ii,jj,1) <= 60.) then
Ftl3 = 1.4717 - 0.0245*Tsoil(ii,jj,1)
else !if (Tsoil(ii,jj,1) > 60.) then
Ftl3 = 0.
end if
if (Tsoil(ii,jj,1) <= -5.) then
Ft6 = 0.
elseif (-5. < Tsoil(ii,jj,1) <= 1.) then
Ft6 = 0.1595 + 0.0319*Tsoil(ii,jj,1)
elseif (1. < Tsoil(ii,jj,1) <= 27.5) then
Ft6 = 0.1754*exp(0.0871*Tsoil(ii,jj,1))
elseif (27.5 < Tsoil(ii,jj,1) <= 35.) then
Ft6 = 1.95
elseif (35. < Tsoil(ii,jj,1) <= 60.) then
Ft6 = 4.68 - 0.078*Tsoil(ii,jj,1)
else !if (Tsoil(ii,jj,1) > 80.) then
Ft6 = 0.
end if
if (Tsoil(ii,jj,1) <= -5.) then
Ft5 = 0.
elseif (-5. < Tsoil(ii,jj,1) <= 1.) then
Ft5 = 0.078 + 0.0156*Tsoil(ii,jj,1)
elseif (1. < Tsoil(ii,jj,1) <= 13.) then
Ft5 = 0.675*exp(0.2088*Tsoil(ii,jj,1))
elseif (13. < Tsoil(ii,jj,1) <= 25.) then
Ft5 = 1.0
elseif (25. < Tsoil(ii,jj,1) <= 50.) then
Ft5 = 2.0 - 0.04*Tsoil(ii,jj,1)
else !if (Tsoil(ii,jj,1) > 80.) then
Ft5 = 0.
end if
k1l = Ftl1*Fwl
k2l = Ftl2*Fwl
k3l = Ftl3*Fwl
k4l = Ftl4*Fwl
k1s = Fts1*Fws !@todo расписать расчёт Fts, лучше всего через сторонюю функцию, куда закидываются T, вместо дубля kl
k2s = Fts2*Fws
k3s = Fts3*Fws
k4s = Fts4*Fws
k5 = Ft5*Fws
k6 = Ft6*Fws
km = k2l + (1. - bacter*CNF)*k4l + (1. - lumb*CNF)*k5
kh = bacter*CNF*k4l + lumb*CNF*k5
CNF = NF/F !@todo откуда F и Nf, написать их выведение из соседнего файла
end subroutine
subroutine carbon_model_postprocessing()
use grid, only : date_c
open(unit=500, file='results/'//trim(carbon_model_type)//'/'//trim(station_name)//'_'//trim(station_opt)//'.txt', status='unknown')
write(500,*) date_c%timestamp,';',C1(:,:,1),';',C2(:,:,1)
end subroutine
end module
\ No newline at end of file
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment