Skip to content
Snippets Groups Projects
Commit 4d089096 authored by a_medvedev's avatar a_medvedev
Browse files

стилевые правки

parent 50e621dd
No related branches found
No related tags found
No related merge requests found
bin/*.o bin/*.o
bin/*.mod bin/*.mod
run.exe run.exe
*Zone.Identifier
module carbon_model module carbon_model
!> модель углеродного цикла inmcm !> Модель углеродного цикла inmcm
! ----------------------------------------------- Use pack ------------------------------------------------------------
use const, only : nv2, ms, ml, kl use const, only : nv2, ms, ml, kl
use settings, only : i0m, i1m, j0m, j1m use settings, only : i0m, i1m, j0m, j1m
! ------------------------------------ Model structure options --------------------------------------------------------
implicit none implicit none
! ------------------------------------ Model structure options ----------------------------------------
! >>> укажите число пулов: ! >>> укажите число пулов:
integer, parameter :: npool = 4 integer, parameter :: npool = 4
! >>> назначьте номера пулам: ! >>> назначьте номера пулам:
...@@ -34,65 +31,56 @@ real, dimension(:,:), pointer :: Flit !< отмирание растени ...@@ -34,65 +31,56 @@ real, dimension(:,:), pointer :: Flit !< отмирание растени
real, dimension(:,:), pointer :: FdfrA !< обезлесивание тип A real, dimension(:,:), pointer :: FdfrA !< обезлесивание тип A
real, dimension(:,:), pointer :: FdfrB !< обезлесивание тип B real, dimension(:,:), pointer :: FdfrB !< обезлесивание тип B
real, dimension(:,:), pointer :: Fers !< почвенная эрозия real, dimension(:,:), pointer :: Fers !< почвенная эрозия
! ---------------------------- Any additional variables need at model -------------------------------------------------
! ---------------------------- Any additional variables need at model -----------------------------------
! >>> если требуются дополнительные переменные, укажите их здесь ! >>> если требуются дополнительные переменные, укажите их здесь
!> константы (из inmcm) !> константы (из inmcm)
real, parameter :: rmf25(1:nv2) = (/0.75,0.50,0.50,0.50,0.50,0.75,0.50,0.26,0.26,0.50,0.50,0.75,0.75/) ! foliage maintenance respiration rate at 25c (umol co2 /m**2 /s) real, parameter :: rmf25(1:nv2) = (/0.75,0.50,0.50,0.50,0.50,0.75,0.50,0.26,0.26,0.50,0.50,0.75,0.75/) ! foliage maintenance respiration rate at 25c, [umol co2/m**2/s]
real, parameter :: rms25(1:nv2) = (/0.1622,0.0198,0.0781,0.9396,0.1364,0.0227,0.0000,0.0000,0.0000,1.0230,1.0230,0.0000,0.0000/) ! stem maintenance respiration at 25c (umol co2/kg biomass/s) real, parameter :: rms25(1:nv2) = (/0.1622,0.0198,0.0781,0.9396,0.1364,0.0227,0.0000,0.0000,0.0000,1.0230,1.0230,0.0000,0.0000/) ! stem maintenance respiration at 25c, [umol co2/kg biomass/s]
real, parameter :: rmr25(1:nv2) = (/0.0455,0.0088,0.0309,0.3637,0.0530,0.2091,0.5911,0.0000,0.0000,2.1142,2.1142,0.0000,0.0000/) ! root maintenance respiration at 25c (umol co2/kg biomass/s) real, parameter :: rmr25(1:nv2) = (/0.0455,0.0088,0.0309,0.3637,0.0530,0.2091,0.5911,0.0000,0.0000,2.1142,2.1142,0.0000,0.0000/) ! root maintenance respiration at 25c, [umol co2/kg biomass/s]
real, parameter :: amrp(1:nv2) = (/0.5, 0.4000, 0.3864, 0.25, 0.25, 0.1250, 0.1700, 0.1909, 0.1909, 0.05, 0.05, 0.2273, 0.2273/) ! microbial respiration parameter (umol co2 /kg c /s) real, parameter :: amrp(1:nv2) = (/0.5, 0.4000, 0.3864, 0.25, 0.25, 0.1250, 0.1700, 0.1909, 0.1909, 0.05, 0.05, 0.2273, 0.2273/) ! microbial respiration parameter, [umol co2/kg c/s]
real, parameter :: tmin(1:nv2) = (/278.16,273.16,270.66,268.16,268.16,278.16,273.16,268.16,273.16,273.16,273.16,273.16,273.16/) ! minimum temperature for photosynthesis (kelvin) real, parameter :: tmin(1:nv2) = (/278.16,273.16,270.66,268.16,268.16,278.16,273.16,268.16,273.16,273.16,273.16,273.16,273.16/) ! minimum temperature for photosynthesis, [k]
real, parameter :: al5(1:nv2) = (/8.,30.,30.,30.,30.,20.,1.,30.,30.,30.,1.,30.,1./) real, parameter :: al5(1:nv2) = (/8.,30.,30.,30.,30.,20.,1.,30.,30.,30.,1.,30.,1./)
real, parameter :: defr(1:nv2) = (/1.,0.2,0.2,0.05,0.05,0.2,0.2,0.2,0.02,0.02,0.2,0.5,0.5/) real, parameter :: defr(1:nv2) = (/1.,0.2,0.2,0.05,0.05,0.2,0.2,0.2,0.02,0.02,0.2,0.5,0.5/)
real, parameter :: soer(1:nv2) = (/1.,0.2,0.2,0.05,0.05,0.2,0.2,0.2,0.02,0.02,0.2,0.5,0.5/) real, parameter :: soer(1:nv2) = (/1.,0.2,0.2,0.05,0.05,0.2,0.2,0.2,0.02,0.02,0.2,0.5,0.5/)
real, parameter :: foln(1:nv2) = 2. !< foliage nitrogen concentration (%) real, parameter :: foln(1:nv2) = 2. !< foliage nitrogen concentration, [%]
real, parameter :: folnmx(1:nv2) = 1.5 !< foliage nitrogen concentration when f(n)=1 (%) real, parameter :: folnmx(1:nv2) = 1.5 !< foliage nitrogen concentration when f(n)=1, [%]
real, parameter :: arm(1:nv2) = 2. !< q10 for maintenance respiration real, parameter :: arm(1:nv2) = 2. !< q10 for maintenance respiration
real, parameter :: cv81b = 50. !< Decomposition time (year) real, parameter :: cv81b = 50. !< Decomposition time, [year]
real, parameter :: adefr = 0.6 !< deforest/(deforest+soil erosion) real, parameter :: adefr = 0.6 !< deforest/(deforest+soil erosion)
real :: gai(1:nv2,1:12) !< monthly leaf area index, one-sided real :: gai(1:nv2,1:12) !< monthly leaf area index, one-sided
real, parameter :: stemb(1:nv2) = (/ 9.0, 6.2, 4.9, 3.6, 3.6, 4.5, 0.0, 0.0, 0.0, 0.1, 0.1, 0.0, 0.0/) ! stem biomass (kg /m**2) real, parameter :: stemb(1:nv2) = (/ 9.0, 6.2, 4.9, 3.6, 3.6, 4.5, 0.0, 0.0, 0.0, 0.1, 0.1, 0.0, 0.0/) ! stem biomass, [kg/m**2]
real, parameter :: rootb(1:nv2) = (/18.0,12.4, 9.8, 7.2, 7.2, 9.0, 0.3, 0.0, 0.0, 0.4, 0.4, 0.0, 0.0/) ! root biomass (kg /m**2) real, parameter :: rootb(1:nv2) = (/18.0,12.4, 9.8, 7.2, 7.2, 9.0, 0.3, 0.0, 0.0, 0.4, 0.4, 0.0, 0.0/) ! root biomass, [kg/m**2]
real, parameter :: PSI1(1:nv2) = (/-10000.,-19000.,-20000.,-20000.,-20000.,-19000.,-12000.,& real, parameter :: psi1(1:nv2) = (/-10000.,-19000.,-20000.,-20000.,-20000.,-19000.,-12000.,&
& -20000.,-20000.,-20000.,-30.,-19000.,-10000./) & -20000.,-20000.,-20000.,-30.,-19000.,-10000./)
real, parameter :: PSI2(1:nv2) = (/-50000.,-25000.,-25000.,-25000.,-25000.,-25000.,-23000.,& real, parameter :: psi2(1:nv2) = (/-50000.,-25000.,-25000.,-25000.,-25000.,-25000.,-23000.,&
& -40000.,-40000.,-40000.,-15000.,-25000.,-20000./) & -40000.,-40000.,-40000.,-15000.,-25000.,-20000./)
real, parameter :: ROOTSM(1:nv2) = (/100.,100.,100.,100.,50.,100.,50.,50.,50.,50.,50.,50.,50./) !< MAX. ROOTS LENGTH, CM real, parameter :: rootsm(1:nv2) = (/100.,100.,100.,100.,50.,100.,50.,50.,50.,50.,50.,50.,50./) !< MAX. roots LENGTH, [CM]
real :: wssg(ml,nv2) !< водный потенциал начала завядания real :: wssg(ml,nv2) !< водный потенциал начала завядания
real :: wssl(ml,nv2) !< водный потенциал полного завядания real :: wssl(ml,nv2) !< водный потенциал полного завядания
real :: roots(ml,nv2) !< профиль плотности корневой системы real :: roots(ml,nv2) !< профиль плотности корневой системы
!> динамические переменные (из inmcm) !> динамические переменные (из inmcm)
real, target :: amndf(1:nv2) = 1. real, target :: amndf(1:nv2) = 1.
real, target :: rsw(1:nv2), btran(1:nv2), igs(1:nv2) real, target :: rsw(1:nv2), btran(1:nv2), igs(1:nv2)
real, target :: tlai(nv2), elai(nv2) real, target :: tlai(nv2), elai(nv2)
real, parameter :: defor0 = 1. real, parameter :: defor0 = 1.
! --- ! --- Осатльное
real :: landuseTot, landuseDfrA, landuseDfrB, landuseErs !< замена переменных для defor real :: landuseTot, landuseDfrA, landuseDfrB, landuseErs !< замена переменных для defor
real, dimension(i0m:i1m,j0m:j1m), target :: dfr_weight, ers_weight !< веса для defor real, dimension(i0m:i1m,j0m:j1m), target :: dfr_weight, ers_weight !< веса для defor
common /photo_common/ igs, btran, elai, amndf !> временный интерфейс для подачи аргументов в фотоситнез
! <<< ! <<<
common /photo_common/ igs, btran, elai, amndf !> временный интерфейс для подачи аргументов в фотоситнез
! ----------------------------------------------- Subroutines ---------------------------------------------------------
contains contains
! >>> процедура model_assembly ! >>> процедура model_assembly
! задайте матрицу переходов между пулами, разместите указатели ! задайте матрицу переходов между пулами, разместите указатели
subroutine model_assembly() subroutine model_assembly()
! ----------------------------------------------- Use pack ------------------------------------------------------------
use const, only : umol2kg, Kelvin0, yrs use const, only : umol2kg, Kelvin0, yrs
use core, only : pool, flux, nflux, nmult, set_fun, route, my_label use core, only : pool, flux, nflux, nmult, set_fun, route, my_label
use env, only : Temp, Tsoil, veget_ich, amsq, sq use env, only : Temp, Tsoil, veget_ich, amsq, sq
use settings, only : i0, i1, j0, j1, nv use settings, only : i0, i1, j0, j1, nv
! ----------------------------------------------- Local variables -----------------------------------------------------
integer :: n, m, f integer :: n, m, f
! ----------------------------------------------- Main program --------------------------------------------------------
Catm(i0:i1,j0:j1) => pool(:,:,n_Catm) Catm(i0:i1,j0:j1) => pool(:,:,n_Catm)
Cveg(i0:i1,j0:j1) => pool(:,:,n_Cveg) Cveg(i0:i1,j0:j1) => pool(:,:,n_Cveg)
Csoil(i0:i1,j0:j1) => pool(:,:,n_Csoil) Csoil(i0:i1,j0:j1) => pool(:,:,n_Csoil)
...@@ -101,7 +89,7 @@ contains ...@@ -101,7 +89,7 @@ contains
n = n_Cveg n = n_Cveg
m = n_Csoil m = n_Csoil
nflux(n,m) = 1 nflux(n,m) = 1
! отмирание растений ! ----------------------------------------------- Отмирание растений --------------------------------------------------
! dv68(i) = dc6(i) / (al5(i) * yrs) ! dv68(i) = dc6(i) / (al5(i) * yrs)
f = 1 f = 1
nmult(n,m,f) = 1 nmult(n,m,f) = 1
...@@ -112,13 +100,13 @@ contains ...@@ -112,13 +100,13 @@ contains
n = n_Cveg n = n_Cveg
m = n_Catm m = n_Catm
nflux(n,m) = 5 nflux(n,m) = 5
! фотосинтез ! ----------------------------------------------- Фотосинтез ----------------------------------------------------------
f = 1 f = 1
nmult(n,m,f) = 1 nmult(n,m,f) = 1
call set_fun(n, m, f, 1, 'special_photo') call set_fun(n, m, f, 1, 'special_photo')
route(n,m,f) = -1 route(n,m,f) = -1
Fpsn(i0:i1,j0:j1) => flux(:,:,m,n,f) Fpsn(i0:i1,j0:j1) => flux(:,:,m,n,f)
! дыхание растений ! ----------------------------------------------- Дыхание растений ----------------------------------------------------
! frg(i) = 0.25 * fpsn(i) ! frg(i) = 0.25 * fpsn(i)
! frmf(i) = 1.00 * amndf(i) * rmf25(i) * tlai(i) * fnf * tf * rf * btran(i) ! frmf(i) = 1.00 * amndf(i) * rmf25(i) * tlai(i) * fnf * tf * rf * btran(i)
! frms(i) = 0.35 * amndf(i) * rms25(i) * dc6(i) * amns * tf * rf ! frms(i) = 0.35 * amndf(i) * rms25(i) * dc6(i) * amns * tf * rf
...@@ -128,6 +116,7 @@ contains ...@@ -128,6 +116,7 @@ contains
call set_fun(n, m, f, 1, 'lin', x_i_j = fpsn, k = 0.25) call set_fun(n, m, f, 1, 'lin', x_i_j = fpsn, k = 0.25)
route(n,m,f) = +1 route(n,m,f) = +1
Frg(i0:i1,j0:j1) => flux(:,:,n,m,f) Frg(i0:i1,j0:j1) => flux(:,:,n,m,f)
f = 3 f = 3
nmult(n,m,f) = 9 nmult(n,m,f) = 9
call set_fun(n, m, f, 1, 'const', c = 1.) call set_fun(n, m, f, 1, 'const', c = 1.)
...@@ -141,6 +130,7 @@ contains ...@@ -141,6 +130,7 @@ contains
call set_fun(n, m, f, 9, 'const', c = umol2kg * veget_ich(nv)*amsq*(1.0-sq(4))) call set_fun(n, m, f, 9, 'const', c = umol2kg * veget_ich(nv)*amsq*(1.0-sq(4)))
route(n,m,f) = +1 route(n,m,f) = +1
Frmf(i0:i1,j0:j1) => flux(:,:,n,m,f) Frmf(i0:i1,j0:j1) => flux(:,:,n,m,f)
f = 4 f = 4
nmult(n,m,f) = 7 nmult(n,m,f) = 7
call set_fun(n, m, f, 1, 'const', c = 0.35) call set_fun(n, m, f, 1, 'const', c = 0.35)
...@@ -152,6 +142,7 @@ contains ...@@ -152,6 +142,7 @@ contains
call set_fun(n, m, f, 7, 'const', c = umol2kg) call set_fun(n, m, f, 7, 'const', c = umol2kg)
route(n,m,f) = +1 route(n,m,f) = +1
Frms(i0:i1,j0:j1) => flux(:,:,n,m,f) Frms(i0:i1,j0:j1) => flux(:,:,n,m,f)
f = 5 f = 5
nmult(n,m,f) = 7 nmult(n,m,f) = 7
call set_fun(n, m, f, 1, 'const', c = 0.35) call set_fun(n, m, f, 1, 'const', c = 0.35)
...@@ -167,7 +158,7 @@ contains ...@@ -167,7 +158,7 @@ contains
n = n_Csoil n = n_Csoil
m = n_Catm m = n_Catm
nflux(n,m) = 1 nflux(n,m) = 1
! микробное дыхание ! ----------------------------------------------- Микробное дыхание ---------------------------------------------------
! fmicr(i) = 1.5 * fsw * fst * amrp(i) * dc8(i) ! fmicr(i) = 1.5 * fsw * fst * amrp(i) * dc8(i)
f = 1 f = 1
nmult(n,m,f) = 7 nmult(n,m,f) = 7
...@@ -185,7 +176,7 @@ contains ...@@ -185,7 +176,7 @@ contains
n = n_Csoilb n = n_Csoilb
m = n_Catm m = n_Catm
nflux(n,m) = 1 nflux(n,m) = 1
! микробное дыхание ! ----------------------------------------------- Микробное дыхание ---------------------------------------------------
! fmicrb(i) = 1.5 * fsw * fst * amrp(i) * dc8b(i) * cv81b ! fmicrb(i) = 1.5 * fsw * fst * amrp(i) * dc8b(i) * cv81b
f = 1 f = 1
nmult(n,m,f) = 8 nmult(n,m,f) = 8
...@@ -204,7 +195,7 @@ contains ...@@ -204,7 +195,7 @@ contains
n = n_Cveg n = n_Cveg
m = n_Csoilb m = n_Csoilb
nflux(n,m) = 2 nflux(n,m) = 2
! обезлесивание ! ----------------------------------------------- Обезлесивание -------------------------------------------------------
! ddc6a(i) = dc6(i) * defr(i) * defor0a * adefr * dt / yrs / sc6 ! ddc6a(i) = dc6(i) * defr(i) * defor0a * adefr * dt / yrs / sc6
! ddc6b(i) = dc6(i) * defr(i) * defor0b * adefr * dt / yrs / sc6 ! ddc6b(i) = dc6(i) * defr(i) * defor0b * adefr * dt / yrs / sc6
f = 1 f = 1
...@@ -212,6 +203,7 @@ contains ...@@ -212,6 +203,7 @@ contains
call set_fun(n, m, f, 1, 'lin', x_i_j = dfr_weight, k = landuseDfrA, b = 0.) call set_fun(n, m, f, 1, 'lin', x_i_j = dfr_weight, k = landuseDfrA, b = 0.)
route(n,m,f) = +1 route(n,m,f) = +1
FdfrA(i0:i1,j0:j1) => flux(:,:,n,m,f) FdfrA(i0:i1,j0:j1) => flux(:,:,n,m,f)
f = 2 f = 2
nmult(n,m,f) = 1 nmult(n,m,f) = 1
call set_fun(n, m, f, 1, 'lin', x_i_j = dfr_weight, k = landuseDfrB, b = 0.) call set_fun(n, m, f, 1, 'lin', x_i_j = dfr_weight, k = landuseDfrB, b = 0.)
...@@ -221,7 +213,7 @@ contains ...@@ -221,7 +213,7 @@ contains
n = n_Csoil n = n_Csoil
m = n_Csoilb m = n_Csoilb
nflux(n,m) = 1 nflux(n,m) = 1
! эрозия почвы ! ----------------------------------------------- Эрозия почвы --------------------------------------------------------
! ddc8(i) = dc8(i) * soer(i) * defor0 * (1.0 - adefr) * dt / yrs / sc8 ! ddc8(i) = dc8(i) * soer(i) * defor0 * (1.0 - adefr) * dt / yrs / sc8
f = 1 f = 1
nmult(n,m,f) = 1 nmult(n,m,f) = 1
...@@ -235,22 +227,24 @@ contains ...@@ -235,22 +227,24 @@ contains
! >>> процедура calc_init вызывается до начала интегрирования модели ! >>> процедура calc_init вызывается до начала интегрирования модели
! разместите здесь расчеты, необходимые для инициализации переменных ! разместите здесь расчеты, необходимые для инициализации переменных
subroutine calc_init() subroutine calc_init()
! ----------------------------------------------- Use pack ------------------------------------------------------------
use const, only : pi, r_earth, yrs use const, only : pi, r_earth, yrs
use env, only : por, psimax, bh, rhodry, z use env, only : por, psimax, bh, rhodry, z
integer :: in, k ! ----------------------------------------------- Array/loop index ----------------------------------------------------
integer :: i, k
WSSG = 0. ! ----------------------------------------------- Program -------------------------------------------------------------
WSSL = 0. wssg = 0.
ROOTS = 0. wssl = 0.
DO IN = 1, NV2 roots = 0.
DO K = MS+1, ML-1
WSSG(K,IN)=POR(K)*(PSI1(IN)/PSIMAX(K))**(-1.0E0/BH(K))/RHOdry(K) do i = 1, nv2
WSSL(K,IN)=POR(K)*(PSI2(IN)/PSIMAX(K))**(-1.0E0/BH(K))/RHOdry(K) do k = ms+1, ml-1
IF(Z(K).LT.ROOTSM(IN)) ROOTS(K,IN)=1.0E0 wssg(k,i)=por(k)*(psi1(i)/psimax(k))**(-1.0/bh(k))/rhodry(k)
IF(Z(K).LT.10.) ROOTS(K,IN)=5.0E0 wssl(k,i)=por(k)*(psi2(i)/psimax(k))**(-1.0/bh(k))/rhodry(k)
END DO if (Z(k) < rootsm(i)) roots(k,i) = 1.0
END DO if (Z(k) < 10.) roots(k,i) = 5.0
end do
end do
gai(1, 1:12) = (/4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5/) gai(1, 1:12) = (/4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5,4.5/)
gai(2, 1:12) = (/0.0,0.0,0.3,1.2,3.0,4.7,4.5,3.4,1.2,0.3,0.0,0.0/) gai(2, 1:12) = (/0.0,0.0,0.3,1.2,3.0,4.7,4.5,3.4,1.2,0.3,0.0,0.0/)
...@@ -268,8 +262,7 @@ contains ...@@ -268,8 +262,7 @@ contains
tlai(:) = gai(:,7) tlai(:) = gai(:,7)
tlai(:) = max(tlai(:), 0.1) tlai(:) = max(tlai(:), 0.1)
elai(:) = tlai(:) elai(:) = tlai(:)
! ----------------------------------------------- Замена переменных для defor -----------------------------------------
! замена переменных для defor:
landuseTot = defor0 landuseTot = defor0
! 1) landuseTot = landuseDfrA + landuseDfrB + landuseErs: ! 1) landuseTot = landuseDfrA + landuseDfrB + landuseErs:
landuseDfrA = adefr * min(defor0,0.54) landuseDfrA = adefr * min(defor0,0.54)
...@@ -283,16 +276,14 @@ contains ...@@ -283,16 +276,14 @@ contains
end subroutine end subroutine
! >>> разместите здесь расчеты, необходимые на каждом шаге по времени перед началом интегрирования модели ! >>> разместите здесь расчеты, необходимые на каждом шаге по времени перед началом интегрирования модели
! процедура calc_preliminary_global вызывается перед началом цикла по пространству ! процедура calc_preliminary_global вызывается перед началом цикла по пространству
! процедура calc_preliminary_local вызывается внутри цикла по пространству ! процедура calc_preliminary_local вызывается внутри цикла по пространству
subroutine calc_preliminary_global() subroutine calc_preliminary_global()
use core, only : pool, area use core, only : pool, area
use settings, only : nv, i0, i1, j0, j1 use settings, only : nv, i0, i1, j0, j1
integer :: ii, jj integer :: ii, jj
do ii = i0, i1 do ii = i0, i1
...@@ -301,6 +292,7 @@ contains ...@@ -301,6 +292,7 @@ contains
ers_weight(ii,jj) = pool(ii,jj,n_Csoil) * soer(nv) * area ers_weight(ii,jj) = pool(ii,jj,n_Csoil) * soer(nv) * area
end do end do
end do end do
if (sum(dfr_weight) /= 0.) dfr_weight(:,:) = dfr_weight(:,:) / sum(dfr_weight) if (sum(dfr_weight) /= 0.) dfr_weight(:,:) = dfr_weight(:,:) / sum(dfr_weight)
if (sum(ers_weight) /= 0.) ers_weight(:,:) = ers_weight(:,:) / sum(ers_weight) if (sum(ers_weight) /= 0.) ers_weight(:,:) = ers_weight(:,:) / sum(ers_weight)
...@@ -311,12 +303,12 @@ contains ...@@ -311,12 +303,12 @@ contains
use const, only : Tz, Kelvin0 use const, only : Tz, Kelvin0
use env, only : Tsoil, Wsoil, Isoil, Temp, z, rhodry, row, hint use env, only : Tsoil, Wsoil, Isoil, Temp, z, rhodry, row, hint
integer, intent(in) :: ii, jj integer, intent(in) :: ii, jj
integer :: k, n, nval integer :: k, n, nval
real :: work, val real :: work, val
do n = 1, nv2 do n = 1, nv2
work = 0. work = 0.
do k = ms+1, ml-1 do k = ms+1, ml-1
if (z(k) <= hint) then if (z(k) <= hint) then
...@@ -324,7 +316,6 @@ contains ...@@ -324,7 +316,6 @@ contains
end if end if
end do end do
rsw(n) = work / hint rsw(n) = work / hint
work = 0. work = 0.
nval = 0 nval = 0
do k = ms+1, ml-1 do k = ms+1, ml-1
......
module carbon_model module carbon_model
!> моя модель углеродного цикла !> моя модель углеродного цикла
! ----------------------------------------------- Use pack ------------------------------------------------------------
use const, only : nv2, ms, ml, kl use const, only : nv2, ms, ml, kl
use settings, only : i0m, i1m, j0m, j1m use settings, only : i0m, i1m, j0m, j1m
implicit none
! ------------------------------------ Model structure options ---------------------------------------- ! ------------------------------------ Model structure options ----------------------------------------
implicit none
! >>> укажите число пулов: ! >>> укажите число пулов:
integer, parameter :: npool = 4 integer, parameter :: npool = 4
! >>> назначьте номера пулам: ! >>> назначьте номера пулам:
...@@ -25,21 +22,16 @@ real, dimension(:,:), pointer :: Csoilb ...@@ -25,21 +22,16 @@ real, dimension(:,:), pointer :: Csoilb
! потоки: ! потоки:
real, dimension(:,:), pointer :: FmicrBC !< микробное дыхание типа BC real, dimension(:,:), pointer :: FmicrBC !< микробное дыхание типа BC
real, dimension(:,:), pointer :: FmicrAD !< микробное дыхание типа AD real, dimension(:,:), pointer :: FmicrAD !< микробное дыхание типа AD
! ---------------------------- Any additional variables need at model ----------------------------------- ! ---------------------------- Any additional variables need at model -----------------------------------
! >>> если требуются дополнительные переменные, укажите их здесь ! >>> если требуются дополнительные переменные, укажите их здесь
real :: A = 15. ! пример: инициализируется здесь real :: A = 15. ! пример: инициализируется здесь
real :: B ! пример: инициализируется в calc_init real :: B ! пример: инициализируется в calc_init
real :: C(i0m:i1m,j0m:j1m) ! пример: инициализируется в calc_preliminary_global real :: C(i0m:i1m,j0m:j1m) ! пример: инициализируется в calc_preliminary_global
real :: D(i0m:i1m,j0m:j1m) ! пример: инициализируется в calc_preliminary_local real :: D(i0m:i1m,j0m:j1m) ! пример: инициализируется в calc_preliminary_local
! <<< ! <<<
contains contains
! >>> процедура model_assembly ! >>> процедура model_assembly
! задайте матрицу переходов между пулами, разместите указатели ! задайте матрицу переходов между пулами, разместите указатели
subroutine model_assembly() subroutine model_assembly()
...@@ -48,6 +40,7 @@ contains ...@@ -48,6 +40,7 @@ contains
use core, only : pool, flux, nflux, nmult, set_fun, route, my_label use core, only : pool, flux, nflux, nmult, set_fun, route, my_label
use env, only : Temp use env, only : Temp
use settings, only : i0, i1, j0, j1 use settings, only : i0, i1, j0, j1
integer :: n, m, f integer :: n, m, f
! >>> ассоциируйте указатели с массивом pool по аналогии с данным примером: ! >>> ассоциируйте указатели с массивом pool по аналогии с данным примером:
...@@ -94,9 +87,11 @@ contains ...@@ -94,9 +87,11 @@ contains
use const, only : pi use const, only : pi
use env, only : Wsoil, por use env, only : Wsoil, por
use settings, only : i0, j0 use settings, only : i0, j0
integer :: k integer :: k
B = 0. B = 0.
do k = ms, ml do k = ms, ml
B = B + Wsoil(i0,j0,k)/por(k) B = B + Wsoil(i0,j0,k)/por(k)
end do end do
...@@ -113,6 +108,7 @@ contains ...@@ -113,6 +108,7 @@ contains
use const, only : Kelvin0 use const, only : Kelvin0
use env, only : Rswd use env, only : Rswd
use settings, only : i0, i1, j0, j1 use settings, only : i0, i1, j0, j1
integer :: ii, jj integer :: ii, jj
do ii = i0, i1 do ii = i0, i1
...@@ -128,6 +124,7 @@ contains ...@@ -128,6 +124,7 @@ contains
use const, only : Kelvin0 use const, only : Kelvin0
use env, only : Rswd use env, only : Rswd
integer, intent(in) :: ii, jj integer, intent(in) :: ii, jj
D(ii,jj) = log(Rswd(ii,jj)**2 + Kelvin0) D(ii,jj) = log(Rswd(ii,jj)**2 + Kelvin0)
......
...@@ -5,13 +5,23 @@ ...@@ -5,13 +5,23 @@
#### Быстрый старт: #### Быстрый старт:
1. отредактируйте файл settings.f90 для задания настроек расчета 1) Отредактируйте файл settings.f90 для задания настроек расчета
2. соберите модель желаемой конфигурации, выполнив команду: 2) Соберите модель желаемой конфигурации, выполнив команду:
./build.sh <название\_файла\_конфигурации> По умолчанию - модель inmcm:
Если не указать файл конфигурации, по умолчанию будет использована конфигурация модели inmcm ./build.sh models/inmcm_carbon_model.f90
Если нужно запустить свою модель - my_carbon_model:
./build.sh my_carbon_model.f90
Или аналогичную ей
*В случае неудачи запуска использовать команду:
sudo chmod +x build.sh
3. Для запуска модели выполните: 3. Для запуска модели выполните:
......
...@@ -20,8 +20,8 @@ integer, parameter :: j0 = j0m !< Latitude min ...@@ -20,8 +20,8 @@ integer, parameter :: j0 = j0m !< Latitude min
integer, parameter :: j1 = j1m !< Latitude max integer, parameter :: j1 = j1m !< Latitude max
! сетка по времени: ! сетка по времени:
integer, parameter :: ntime = 100 !< Number of timesteps integer, parameter :: ntime = 109500 !< Number of timesteps
integer, parameter :: dt = 3600 !< Timestep, sec integer, parameter :: dt = 3600*24 !< Timestep, sec
! начальная дата: ! начальная дата:
integer, parameter :: year0 = 1 !< year integer, parameter :: year0 = 1 !< year
......
...@@ -13,7 +13,7 @@ real, parameter :: pi = 4.*atan(1.) !< pi ...@@ -13,7 +13,7 @@ real, parameter :: pi = 4.*atan(1.) !< pi
real, parameter :: hPa2Pa = 100. !< гектопаскали в паскали real, parameter :: hPa2Pa = 100. !< гектопаскали в паскали
real, parameter :: umol2kg = 12.e-9 !< микромоли в килограммы углерода real, parameter :: umol2kg = 12.e-9 !< микромоли в килограммы углерода
real, parameter :: Tz = 0. !< точка замерзания воды, С real, parameter :: Tz = 0. !< точка замерзания воды, С
real, parameter :: Kelvin0 = 273.15 !< real, parameter :: Kelvin0 = 273.15 !< Температура замерзания воды, [K]
real, parameter :: ppm2frac = 1.e-6 !< real, parameter :: ppm2frac = 1.e-6 !<
real, parameter :: r_earth = 6371000. !< радиус Земли, м real, parameter :: r_earth = 6371000. !< радиус Земли, м
......
module core MODULE core
!> вся техническая начинка !> вся техническая начинка
! ----------------------------------------------- Use pack ------------------------------------------------------------
use const, only : miss_v, nshapes, npar_default use const, only : miss_v, nshapes, npar_default
use fun_library, only : fun_interface use fun_library, only : fun_interface
! ----------------------------------------- Spatial and temporal grid -------------------------------------------------
implicit none implicit none
real :: area = 1. !< площадь ячейки, здесь заменяет произведение SC1*SC(J)
! ----------------------------------------- Spatial and temporal grid ------------------------------------------
real :: area = 1. ! площадь ячейки, здесь заменяет произведение SC1*SC(J)
integer time, second, minute, day, hour, month, year integer time, second, minute, day, hour, month, year
integer :: hour_mem = miss_v integer :: hour_mem = miss_v
! ---------------------------------------------- Main variables -------------------------------------------------------
! ---------------------------------------------- Main variables ------------------------------------------------
! пулы и потоки: ! пулы и потоки:
real, allocatable, dimension(:,:,:), target :: pool, pool_test !< new pools: core real, allocatable, dimension(:,:,:), target :: pool, pool_test !< new pools: core
real, allocatable, dimension(:,:,:,:,:), target :: flux, flux_test !< new fluxes: core real, allocatable, dimension(:,:,:,:,:), target :: flux, flux_test !< new fluxes: core
! переходы между пулами: ! переходы между пулами:
type transition_type type transition_type
procedure(fun_interface), pointer, nopass :: fun !< указатели на функции (линейная, эксп. и т.д.) procedure(fun_interface), pointer, nopass :: fun !< указатели на функции (линейная, эксп. и т.д.)
real, pointer :: arg1 => null() !< указатели на аргументы для каждой функции real, pointer :: arg1 => null() !< указатели на аргументы для каждой функции
...@@ -32,11 +26,13 @@ type transition_type ...@@ -32,11 +26,13 @@ type transition_type
logical :: arg_mask(nshapes) = .false. logical :: arg_mask(nshapes) = .false.
real, dimension(npar_default) :: par = miss_v !< значения параметров для каждой функции real, dimension(npar_default) :: par = miss_v !< значения параметров для каждой функции
end type end type
type(transition_type), allocatable, dimension(:,:,:,:) :: trans !< стурктура данных, хранящая информацию о каждом множителе функций переходов
character(10), allocatable, dimension(:,:,:,:):: my_label !< пользовательские метки ко множителям функций переходов (если нужно рассчитать их каким-то особым способом)
integer, allocatable, dimension(:,:) :: nflux !< число переходов между пулами integer, allocatable, dimension(:,:) :: nflux !< число переходов между пулами
integer, allocatable, dimension(:,:,:) :: nmult !< число множителей в функциях переходов между пулами integer, allocatable, dimension(:,:,:) :: nmult !< число множителей в функциях переходов между пулами
integer, allocatable, dimension(:,:,:) :: route !< направление перехода. если N это 1-й индекс массива, M это 2-й, то +1 означает поток от пула N к пулу M, -1 - наоборот integer, allocatable, dimension(:,:,:) :: route !< направление перехода. если N это 1-й индекс массива, M это 2-й, то +1 означает поток от пула N к пулу M, -1 - наоборот
type(transition_type), allocatable, dimension(:,:,:,:) :: trans !< стурктура данных, хранящая информацию о каждом множителе функций переходов
character(10), allocatable, dimension(:,:,:,:):: my_label !< пользовательские метки ко множителям функций переходов (если нужно рассчитать их каким-то особым способом)
real, target :: dum1 !< пустышки для указателей: real, target :: dum1 !< пустышки для указателей:
real, allocatable, target :: dum2(:,:) real, allocatable, target :: dum2(:,:)
real, allocatable, target :: dum3(:,:,:) real, allocatable, target :: dum3(:,:,:)
...@@ -44,15 +40,16 @@ real, allocatable, target :: dum4(:,:,:,:) ...@@ -44,15 +40,16 @@ real, allocatable, target :: dum4(:,:,:,:)
real, allocatable, target :: dum5(:) real, allocatable, target :: dum5(:)
real, allocatable, target :: dum6(:) real, allocatable, target :: dum6(:)
real, allocatable, target :: dum_special(:,:) real, allocatable, target :: dum_special(:,:)
! ---------------------------------------------- Program --------------------------------------------------------------
contains contains
subroutine core_init(npool) SUBROUTINE core_init(npool)
! ----------------------------------------------- Use pack ------------------------------------------------------------
use const, only : nv2, nflux_default, nmult_default, year_min, year_max use const, only : nv2, nflux_default, nmult_default, year_min, year_max
use settings, only : i0m, i1m, j0m, j1m use settings, only : i0m, i1m, j0m, j1m
! ----------------------------------------------- Input variables -----------------------------------------------------
integer, intent(in) :: npool integer, intent(in) :: npool
! ----------------------------------------------- Program -------------------------------------------------------------
allocate(pool(i0m:i1m, j0m:j1m, npool)) allocate(pool(i0m:i1m, j0m:j1m, npool))
allocate(flux(i0m:i1m, j0m:j1m, npool, npool, nflux_default)) allocate(flux(i0m:i1m, j0m:j1m, npool, npool, nflux_default))
...@@ -72,17 +69,17 @@ contains ...@@ -72,17 +69,17 @@ contains
allocate(dum6(nv2)) allocate(dum6(nv2))
allocate(dum_special(i0m:i1m, j0m:j1m)) allocate(dum_special(i0m:i1m, j0m:j1m))
end subroutine end SUBROUTINE
subroutine set_fun(n, m, f, i, funtype, x, x_i_j, x_i_j_nv, x_i_j_nv_month, x_year, x_nv, k, b, a, c, x0, y0, y1)
SUBROUTINE set_fun(n, m, f, i, funtype, x, x_i_j, x_i_j_nv, x_i_j_nv_month, x_year, x_nv, k, b, a, c, x0, y0, y1)
! ----------------------------------------------- Use pack ------------------------------------------------------------
use const, only : nv2, year_min, year_max use const, only : nv2, year_min, year_max
use fun_library, only : fun_const, fun_lin, fun_exp, fun_hyp, fun_mm, fun_step, fun_special_photo use fun_library, only : fun_const, fun_lin, fun_exp, fun_hyp, fun_mm, fun_step, fun_special_photo
use settings, only : i0m, i1m, j0m, j1m use settings, only : i0m, i1m, j0m, j1m
! ----------------------------------------------- Input variables -----------------------------------------------------
integer, intent(in) :: n, m, f, i implicit none
character(*), intent(in) :: funtype character(*), intent(in) :: funtype
integer, intent(in) :: n, m, f, i
real, intent(in), optional, target :: x real, intent(in), optional, target :: x
real, intent(in), optional, target :: x_i_j(i0m:i1m,j0m:j1m) real, intent(in), optional, target :: x_i_j(i0m:i1m,j0m:j1m)
real, intent(in), optional, target :: x_i_j_nv(i0m:i1m,j0m:j1m,nv2) real, intent(in), optional, target :: x_i_j_nv(i0m:i1m,j0m:j1m,nv2)
...@@ -90,17 +87,16 @@ contains ...@@ -90,17 +87,16 @@ contains
real, intent(in), optional, target :: x_year(year_min:year_max) real, intent(in), optional, target :: x_year(year_min:year_max)
real, intent(in), optional, target :: x_nv(nv2) real, intent(in), optional, target :: x_nv(nv2)
real, intent(in), optional :: k, b, a, c, x0, y0, y1 real, intent(in), optional :: k, b, a, c, x0, y0, y1
! ----------------------------------------------- Local variables -----------------------------------------------------
integer :: ierr integer :: ierr
! ----------------------------------------------- Установка аргументов ------------------------------------------------
! --- установка аргументов ---
ierr = count((/ associated(trans(n,m,f,i)%arg1), & ierr = count((/ associated(trans(n,m,f,i)%arg1), &
& associated(trans(n,m,f,i)%arg2), & & associated(trans(n,m,f,i)%arg2), &
& associated(trans(n,m,f,i)%arg3), & & associated(trans(n,m,f,i)%arg3), &
& associated(trans(n,m,f,i)%arg4), & & associated(trans(n,m,f,i)%arg4), &
& associated(trans(n,m,f,i)%arg5), & & associated(trans(n,m,f,i)%arg5), &
& associated(trans(n,m,f,i)%arg6) /)) & associated(trans(n,m,f,i)%arg6) /))
if (ierr /= 0) call crash('check failed: try to remake function', ierr) if (ierr /= 0) call crash('check failed: try to remake FUNCTION', ierr)
trans(n,m,f,i)%arg1 => dum1 trans(n,m,f,i)%arg1 => dum1
trans(n,m,f,i)%arg2 => dum2 trans(n,m,f,i)%arg2 => dum2
...@@ -143,11 +139,10 @@ contains ...@@ -143,11 +139,10 @@ contains
& .not.associated(trans(n,m,f,i)%arg4,dum4), & & .not.associated(trans(n,m,f,i)%arg4,dum4), &
& .not.associated(trans(n,m,f,i)%arg5,dum5), & & .not.associated(trans(n,m,f,i)%arg5,dum5), &
& .not.associated(trans(n,m,f,i)%arg6,dum6) /)) & .not.associated(trans(n,m,f,i)%arg6,dum6) /))
if (ierr /= 1) call crash('check failed: not one argument at function', ierr) if (ierr /= 1) call crash('check failed: not one argument at FUNCTION', ierr)
! ----------------------------------------------- Установка вида функций и их параметров ------------------------------
! --- установка вида функций и их параметров ---
select case (funtype) select case (funtype)
case('const') case('const')
trans(n,m,f,i)%fun => fun_const trans(n,m,f,i)%fun => fun_const
if (present(c)) then if (present(c)) then
...@@ -155,6 +150,7 @@ contains ...@@ -155,6 +150,7 @@ contains
else else
trans(n,m,f,i)%par(1) = 1. trans(n,m,f,i)%par(1) = 1.
end if end if
case('lin') case('lin')
trans(n,m,f,i)%fun => fun_lin trans(n,m,f,i)%fun => fun_lin
if (present(b)) then if (present(b)) then
...@@ -167,6 +163,7 @@ contains ...@@ -167,6 +163,7 @@ contains
else else
trans(n,m,f,i)%par(2) = 1. trans(n,m,f,i)%par(2) = 1.
end if end if
case('exp') case('exp')
trans(n,m,f,i)%fun => fun_exp trans(n,m,f,i)%fun => fun_exp
if (present(b)) then if (present(b)) then
...@@ -184,6 +181,7 @@ contains ...@@ -184,6 +181,7 @@ contains
else else
trans(n,m,f,i)%par(3) = 1. trans(n,m,f,i)%par(3) = 1.
end if end if
case('hyp') case('hyp')
trans(n,m,f,i)%fun => fun_hyp trans(n,m,f,i)%fun => fun_hyp
if (present(b)) then if (present(b)) then
...@@ -196,6 +194,7 @@ contains ...@@ -196,6 +194,7 @@ contains
else else
trans(n,m,f,i)%par(2) = 1. trans(n,m,f,i)%par(2) = 1.
end if end if
case('mm') case('mm')
trans(n,m,f,i)%fun => fun_mm trans(n,m,f,i)%fun => fun_mm
if (present(b)) then if (present(b)) then
...@@ -208,6 +207,7 @@ contains ...@@ -208,6 +207,7 @@ contains
else else
trans(n,m,f,i)%par(2) = 1. trans(n,m,f,i)%par(2) = 1.
end if end if
case('step') case('step')
trans(n,m,f,i)%fun => fun_step trans(n,m,f,i)%fun => fun_step
if (present(x0)) then if (present(x0)) then
...@@ -225,24 +225,28 @@ contains ...@@ -225,24 +225,28 @@ contains
else else
trans(n,m,f,i)%par(3) = 1. trans(n,m,f,i)%par(3) = 1.
end if end if
case('special_photo') case('special_photo')
trans(n,m,f,i)%fun => fun_special_photo trans(n,m,f,i)%fun => fun_special_photo
case default case default
stop "unknown funtype at set_fun" stop "unknown funtype at set_fun"
end select end select
end subroutine end SUBROUTINE
subroutine date_shift(dt)
!< SUBROUTINE date_shift(dt) takes into account date changes
SUBROUTINE date_shift(dt)
! ----------------------------------------------- Input variables -----------------------------------------------------
implicit none
integer, intent(in) :: dt ! в секундах, больше нуля integer, intent(in) :: dt ! в секундах, больше нуля
! ----------------------------------------------- Local variables -----------------------------------------------------
integer :: days(12) integer :: days(12)
! ----------------------------------------------- Program -------------------------------------------------------------
days = days_in_year(year) days = days_in_year(year)
time = time + dt time = time + dt
second = second + dt second = second + dt
if (second >= 60) then if (second >= 60) then
minute = minute + second/60 minute = minute + second/60
second = mod(second,60) second = mod(second,60)
...@@ -265,17 +269,19 @@ contains ...@@ -265,17 +269,19 @@ contains
end if end if
end if end if
end subroutine date_shift end SUBROUTINE date_shift
function days_in_year(y)
!< FUNCTION days_in_year(y) counts leap years and days in a month
FUNCTION days_in_year(y)
! ----------------------------------------------- Input variables -----------------------------------------------------
implicit none
integer, intent(in) :: y
! ----------------------------------------------- Local variables -----------------------------------------------------
logical :: is_leap
integer, parameter :: days_norm(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/) integer, parameter :: days_norm(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/)
integer, parameter :: days_leap(12) = (/31,29,31,30,31,30,31,31,30,31,30,31/) integer, parameter :: days_leap(12) = (/31,29,31,30,31,30,31,31,30,31,30,31/)
integer :: days_in_year(12) integer :: days_in_year(12)
integer, intent(in) :: y ! ----------------------------------------------- Program -------------------------------------------------------------
logical :: is_leap
is_leap = (mod(y,4) == 0. .and. (mod(y,100) /= 0 .or. mod(y,400) == 0)) is_leap = (mod(y,4) == 0. .and. (mod(y,100) /= 0 .or. mod(y,400) == 0))
if (is_leap) then if (is_leap) then
days_in_year = days_leap days_in_year = days_leap
...@@ -283,17 +289,21 @@ contains ...@@ -283,17 +289,21 @@ contains
days_in_year = days_norm days_in_year = days_norm
end if end if
end function days_in_year end FUNCTION days_in_year
!< SUBROUTINE crash(message, ierr) print error text
subroutine crash(message, ierr) SUBROUTINE crash(message, ierr)
! ----------------------------------------------- Local variables -----------------------------------------------------
implicit none
character(*), optional :: message character(*), optional :: message
integer, optional :: ierr integer, optional :: ierr
integer :: a = 1 integer :: a = 1
! ----------------------------------------------- Program -------------------------------------------------------------
print*, '--- error ---' print*, '--- error ---'
if (present(message)) print*, message if (present(message)) print*, message
if (present(ierr)) print*, 'ierr = ', ierr if (present(ierr)) print*, 'ierr = ', ierr
print*, a/(a-a) print*, a/(a-a)
end subroutine
end module end SUBROUTINE
end MODULE
...@@ -2,30 +2,27 @@ module env ...@@ -2,30 +2,27 @@ module env
!> прототип будущего блока деятельного слоя !> прототип будущего блока деятельного слоя
! ----------------------------------------------- Use pack ------------------------------------------------------------
use const, only : nv2, kl, ml use const, only : nv2, kl, ml
! ---------------------------------------------- Environmental factors ------------------------------------------------
implicit none implicit none
! ---------------------------------------------- Environmental factors --------------------------------------
!Level 1(necessary) !Level 1(necessary)
real, allocatable, dimension(:,:), target :: Temp !< Temperature of air, С real, allocatable, dimension(:,:), target :: Temp !< Temperature of air, [Celsius]
real, allocatable, dimension(:,:), target :: e !< Humidity function, hPa real, allocatable, dimension(:,:), target :: e !< Humidity function, [hPa]
real, allocatable, dimension(:,:), target :: Rlwd !< Radiation long wave flux (downstream), W/m2 real, allocatable, dimension(:,:), target :: Rlwd !< Radiation long wave flux (downstream), [W/m2]
real, allocatable, dimension(:,:), target :: Rswd !< Radiation short wave flux (downstream), W/m2 real, allocatable, dimension(:,:), target :: Rswd !< Radiation short wave flux (downstream), [W/m2]
real, allocatable, dimension(:,:), target :: p !< Pressure, hPa real, allocatable, dimension(:,:), target :: p !< Pressure, [hPa]
real, allocatable, dimension(:,:), target :: pr !< Precipitation, mm/s real, allocatable, dimension(:,:), target :: pr !< Precipitation, [mm/s]
real, allocatable, dimension(:,:), target :: Wind !< Wind speed, m/s real, allocatable, dimension(:,:), target :: Wind !< Wind speed, [m/s]
real, allocatable, dimension(:,:), target :: ra !< Turbulent aerodynamical resistance in atmosphere surface layer, c/m real, allocatable, dimension(:,:), target :: ra !< Turbulent aerodynamical resistance in atmosphere surface layer, [c/m]
real, allocatable, dimension(:,:), target :: Tsrf !< Temperature of surface, С real, allocatable, dimension(:,:), target :: Tsrf !< Temperature of surface, [Celsius]
real, allocatable, dimension(:,:,:), target :: Tsoil !< Temerature at soil on depth levels, C real, allocatable, dimension(:,:,:), target :: Tsoil !< Temerature at soil on depth levels, [Celsius]
real, allocatable, dimension(:,:,:), target :: Wsoil !< Mass water content at soil on depth levels, g/g real, allocatable, dimension(:,:,:), target :: Wsoil !< Mass water content at soil on depth levels, [g/g]
real, allocatable, dimension(:,:,:), target :: Isoil !< Mass ice content at soil on depth levels, g/g real, allocatable, dimension(:,:,:), target :: Isoil !< Mass ice content at soil on depth levels, [g/g]
!Level 2(minor) !Level 2(minor)
!Concentration of mineral substances: !Concentration of mineral substances:
!Carbon(С), Sodium(N), Calcium(Ca), Potassium(K), Phosphorus(P), Silicon(Si), Iron(Fe),... !Carbon(С), Sodium(N), Calcium(Ca), Potassium(K), Phosphorus(P), Silicon(Si), Iron(Fe),...
! ---------------------------------------------- Variables from inmcm -------------------------------------------------
! переменные из inmcm
real, parameter :: co2c = 284.2104 ! концентрация CO2 в атмосфере - из модуля AR4 real, parameter :: co2c = 284.2104 ! концентрация CO2 в атмосфере - из модуля AR4
real, parameter :: z(1:ml) = (/-1.,-2./3.,-1./3.,0.,1.,2.,4.,8.,15.,25.,35.,45.,55.,65., & real, parameter :: z(1:ml) = (/-1.,-2./3.,-1./3.,0.,1.,2.,4.,8.,15.,25.,35.,45.,55.,65., &
& 75.,85.,95.,105.,115.,125.,135.,145.,155.,200.,300.,500.,1000./) & 75.,85.,95.,105.,115.,125.,135.,145.,155.,200.,300.,500.,1000./)
...@@ -38,17 +35,15 @@ real, parameter :: hint = 200. !< Depth above which the total (rswa) an ...@@ -38,17 +35,15 @@ real, parameter :: hint = 200. !< Depth above which the total (rswa) an
real veget_ich(nv2) !< Fractions covered by different vegetation types (+ bare soil + water) real veget_ich(nv2) !< Fractions covered by different vegetation types (+ bare soil + water)
real :: sq(4) = (/1., 0., 0., 0./) !< Fractions covered by different land surface types real :: sq(4) = (/1., 0., 0., 0./) !< Fractions covered by different land surface types
real :: amsq = 0.01 !< Vegetation part from percent to fraction real :: amsq = 0.01 !< Vegetation part from percent to fraction
real :: tpbl(kl), pgr, ea, ei, co2, apar(nv2), rb(nv2) ! доп. метеофорсинг (временно нужен для фотоситнеза) real :: tpbl(kl), pgr, ea, ei, co2, apar(nv2), rb(nv2) ! доп. метеофорсинг (временно нужен для фотоситнеза)
! ----------------------------------------------- Program -------------------------------------------------------------
contains contains
SUBROUTINE env_init()
subroutine env_init() ! ----------------------------------------------- Use pack ------------------------------------------------------------
use const, only : ml use const, only : ml
use settings, only : i0m, i1m, j0m, j1m, nv use settings, only : i0m, i1m, j0m, j1m, nv
! ----------------------------------------------- Program -------------------------------------------------------------
allocate(Temp(i0m:i1m, j0m:j1m)) allocate(Temp(i0m:i1m, j0m:j1m))
allocate(e(i0m:i1m, j0m:j1m)) allocate(e(i0m:i1m, j0m:j1m))
allocate(Rlwd(i0m:i1m, j0m:j1m)) allocate(Rlwd(i0m:i1m, j0m:j1m))
...@@ -65,24 +60,25 @@ contains ...@@ -65,24 +60,25 @@ contains
veget_ich(:) = 0. veget_ich(:) = 0.
veget_ich(nv) = 100. ! для отладки только один тип растительности veget_ich(nv) = 100. ! для отладки только один тип растительности
end subroutine end SUBROUTINE
subroutine environment_gen(time)
SUBROUTINE environment_gen(time)
! ----------------------------------------------- Use pack ------------------------------------------------------------
use const, only : ms, ml, pi, Kelvin0, hPa2Pa, ppm2frac, ti, miss_v use const, only : ms, ml, pi, Kelvin0, hPa2Pa, ppm2frac, ti, miss_v
use settings, only : n0, i0, i1, j0, j1 use settings, only : n0, i0, i1, j0, j1
integer, intent(in) :: time integer, intent(in) :: time
real, parameter :: alb = 0.2 !< альбедо real, parameter :: alb = 0.2 !< альбедо
real, parameter :: w = 2.*pi/24. !< угловая частота суточных колебаний, рад/ч real, parameter :: w = 2.*pi/24. !< угловая частота суточных колебаний, рад/ч
real :: h !< час, может быть дробным real :: h !< час, может быть дробным
real :: x real :: x
integer :: i, j, k integer :: i, j, k
real :: amndf(nv2), btran(nv2), igs(nv2), elai(nv2) real :: amndf(nv2), btran(nv2), igs(nv2), elai(nv2)
common /photo_common/ igs, btran, elai, amndf ! временный блок для деления на elai common /photo_common/ igs, btran, elai, amndf ! временный блок для деления на elai
real :: mpe =0.00001 !< Prevents overflow for division by zero
! ----------------------------------------------- Program -------------------------------------------------------------
h = mod(time,ti)/(60.*60.) h = mod(time,ti)/(60.*60.)
select case (n0) select case (n0)
...@@ -139,10 +135,10 @@ contains ...@@ -139,10 +135,10 @@ contains
ea = e(i,j) * hPa2Pa ! давление водяного пара в воздухе, Па ea = e(i,j) * hPa2Pa ! давление водяного пара в воздухе, Па
ei = 6.107 * 10**(7.6326*Tsrf(i,j)/(Tsrf(i,j) + 241.9)) * hPa2Pa ! давление водяного пара на поверхности, Па ei = 6.107 * 10**(7.6326*Tsrf(i,j)/(Tsrf(i,j) + 241.9)) * hPa2Pa ! давление водяного пара на поверхности, Па
co2 = co2c*ppm2frac * pgr * 44./29. ! давление CO2 в воздухе, Па co2 = co2c*ppm2frac * pgr * 44./29. ! давление CO2 в воздухе, Па
apar(:) = Rswd(i,j)*(1.-alb) / max(0.00001,elai(:)) ! поглощенная кв радиация на единицу листовой поверхности apar(:) = Rswd(i,j)*(1.-alb) / max(mpe,elai(:)) ! поглощенная кв радиация на единицу листовой поверхности
rb(:) = ra(i,j) ! аэродинамическое сопротивление, с/м rb(:) = ra(i,j) ! аэродинамическое сопротивление, с/м
end subroutine end SUBROUTINE
end module env end module env
module fun_library module fun_library
!> библиотека мультипликативных функций !> библиотека мультипликативных функций
! ----------------------------------------------- Use pack ------------------------------------------------------------
use const, only : npar_default use const, only : npar_default
! ------------------------------------- Общий интерфейс для всех мультипликативных функций ----------------------------
implicit none implicit none
! общий интерфейс для всех мультипликативных функций:
abstract interface abstract interface
function fun_interface(args, pars) result (f) function fun_interface(args, pars) result (f)
import :: npar_default import :: npar_default
implicit none implicit none
...@@ -15,11 +15,13 @@ abstract interface ...@@ -15,11 +15,13 @@ abstract interface
real, intent(in) :: pars(npar_default) ! function parameters real, intent(in) :: pars(npar_default) ! function parameters
real :: f real :: f
end function fun_interface end function fun_interface
end interface end interface
! ----------------------------------------------- Main program --------------------------------------------------------
contains contains
!< constant function !< Constant function
function fun_const(args,pars) result(f) function fun_const(args,pars) result(f)
implicit none implicit none
real, intent(in) :: args(1) real, intent(in) :: args(1)
...@@ -27,9 +29,9 @@ contains ...@@ -27,9 +29,9 @@ contains
real :: f, x real :: f, x
x = args(1) x = args(1)
f = pars(1) f = pars(1)
end function end function fun_const
!< linear function !< Linear function
function fun_lin(args,pars) result(f) function fun_lin(args,pars) result(f)
implicit none implicit none
real, intent(in) :: args(1) real, intent(in) :: args(1)
...@@ -37,9 +39,9 @@ contains ...@@ -37,9 +39,9 @@ contains
real :: f, x real :: f, x
x = args(1) x = args(1)
f = x * pars(2) + pars(1) f = x * pars(2) + pars(1)
end function end function fun_lin
!< exponent function !< Exponent function
function fun_exp(args,pars) result(f) function fun_exp(args,pars) result(f)
implicit none implicit none
real, intent(in) :: args(1) real, intent(in) :: args(1)
...@@ -47,9 +49,9 @@ contains ...@@ -47,9 +49,9 @@ contains
real :: f, x real :: f, x
x = args(1) x = args(1)
f = pars(3)*exp( pars(2) * (x + pars(1)) ) f = pars(3)*exp( pars(2) * (x + pars(1)) )
end function end function fun_exp
!< hyperbolic function !< Hyperbolic function
function fun_hyp(args,pars) result(f) function fun_hyp(args,pars) result(f)
implicit none implicit none
real, intent(in) :: args(1) real, intent(in) :: args(1)
...@@ -57,7 +59,7 @@ contains ...@@ -57,7 +59,7 @@ contains
real :: f, x real :: f, x
x = args(1) x = args(1)
f = pars(2)/(x+pars(1)) f = pars(2)/(x+pars(1))
end function end function fun_hyp
!< Michaelis-Menthen function !< Michaelis-Menthen function
function fun_mm(args,pars) result(f) function fun_mm(args,pars) result(f)
...@@ -67,9 +69,9 @@ contains ...@@ -67,9 +69,9 @@ contains
real :: f, x real :: f, x
x = args(1) x = args(1)
f = pars(2)*x/(x+pars(1)) f = pars(2)*x/(x+pars(1))
end function end function fun_mm
!< step function !< Step function
function fun_step(args,pars) result(f) function fun_step(args,pars) result(f)
implicit none implicit none
real, intent(in) :: args(1) real, intent(in) :: args(1)
...@@ -77,9 +79,9 @@ contains ...@@ -77,9 +79,9 @@ contains
real :: f, x real :: f, x
x = args(1) x = args(1)
f = pars(2) + (pars(3) - pars(2)) * 0.5*(1.+sign(1.,x + pars(1))) f = pars(2) + (pars(3) - pars(2)) * 0.5*(1.+sign(1.,x + pars(1)))
end function end function fun_step
!< special functions: photosyntesis !< Special functions: photosyntesis
function fun_special_photo(dummy_args,dummy_pars) result(f) function fun_special_photo(dummy_args,dummy_pars) result(f)
use const, only : nv2, kl, Kelvin0, umol2kg use const, only : nv2, kl, Kelvin0, umol2kg
...@@ -98,51 +100,51 @@ contains ...@@ -98,51 +100,51 @@ contains
! переменные из inmcm ! переменные из inmcm
real cf(nv2) !< S m**2/umol -> s/m real cf(nv2) !< S m**2/umol -> s/m
real tv(nv2) !< Vegetation temperature (kelvin) real tv(nv2) !< Vegetation temperature, [K]
real :: bp(1:nv2) = 2.E+3 !< minimum leaf conductance (umol/m**2/s) real :: bp(1:nv2) = 2.E+3 !< minimum leaf conductance, [umol/m**2/s]
real rs(nv2) !< Leaf stomatal resistance, s/m real rs(nv2) !< Leaf stomatal resistance, [s/m]
real :: foln(1:nv2) = 2. !< foliage nitrogen concentration (%) real :: foln(1:nv2) = 2. !< foliage nitrogen concentration, [%]
real :: folnmx(1:nv2) = 1.5 !< foliage nitrogen concentration when f(n)=1 (%) real :: folnmx(1:nv2) = 1.5 !< foliage nitrogen concentration when f(n)=1, [%]
real :: mpe = 0.000001 !< Prevents division by zero errors real :: mpe = 0.000001 !< Prevents division by zero errors, [dimensionless]
real fnf !< Foliage nitrogen adjustemt to respiration factor (0 to 1) real fnf !< Foliage nitrogen adjustemt to respiration factor (0 to 1)
real, parameter :: tfrz = Kelvin0 !< Freezing point (kelvin) real, parameter :: tfrz = Kelvin0 !< Freezing point, [K]
real tc !< Foliage temperature (degree celsius) real tc !< Foliage temperature, [Celsius]
real ppf !< Absorb photosynthetic photon flux (umol photons/m**2/s) real ppf !< Absorb photosynthetic photon flux, [umol photons/m**2/s]
real :: qe25(1:nv2) = 0.06 !< quantum efficiency at 25c (umol co2 / umol photon) real :: qe25(1:nv2) = 0.06 !< quantum efficiency at 25c, [umol co2/umol photon]
real ej(nv2) !< Electron transport (umol co2/m**2/s) real ej(nv2) !< Electron transport, [umol co2/m**2/s]
real :: akc(1:nv2) = 2.1 !< q10 for kc25 real :: akc(1:nv2) = 2.1 !< q10 for kc25
real :: kc25(1:nv2) = 30. !< co2 michaelis-menten constant at 25c (pa) real :: kc25(1:nv2) = 30. !< co2 michaelis-menten constant at 25c, [Pa]
real kc !< Co2 michaelis-menten constant (pa) real kc !< Co2 michaelis-menten constant, [Pa]
real :: ako(1:nv2) = 1.2 !< q10 for ko25 real :: ako(1:nv2) = 1.2 !< q10 for ko25
real :: ko25(1:nv2) = 3.E+4 !< o2 michaelis-menten constant at 25c (pa) real :: ko25(1:nv2) = 3.E+4 !< o2 michaelis-menten constant at 25c, [Pa]
real ko !< O2 michaelis-menten constant (pa) real ko !< O2 michaelis-menten constant, [Pa]
real :: o2 = 28000. !< Atmospheric o2 concentration, Pa real :: o2 = 28000. !< Atmospheric o2 concentration, [Pa]
real awc(nv2) !< Intermediate calcuation for wc real awc(nv2) !< Intermediate calcuation for wc
real cp(nv2) !< Co2 compensation point (pa) real cp(nv2) !< Co2 compensation point, [Pa]
real :: avcmx(1:nv2) = 2.4 !< q10 for vcmx25 real :: avcmx(1:nv2) = 2.4 !< q10 for vcmx25
real :: vcmx25(1:nv2) = (/50.,33.,41.,33.,33.,50.,33.,17.,17.,33.,33.,50.,50./) !< maximum rate of carboxylation at 25c (umol co2/m**2/s) real :: vcmx25(1:nv2) = (/50.,33.,41.,33.,33.,50.,33.,17.,17.,33.,33.,50.,50./) !< maximum rate of carboxylation at 25c, [umol co2/m**2/s]
real vcmx(nv2) !< Amax1imum rate of carboxylation (umol co2/m**2/s) real vcmx(nv2) !< Amax1imum rate of carboxylation, [umol co2/m**2/s]
real :: c3psn(1:nv2) = 1. !< photosynthetic pathway: c3 = 1, c4 = 0 real :: c3psn(1:nv2) = 1. !< photosynthetic pathway: c3 = 1, c4 = 0
real ci(nv2) !< Internal co2 (pa) real ci(nv2) !< Internal co2, [Pa]
real cea(nv2) !< Constrain ea or else model blows up real cea(nv2) !< Constrain ea or else model blows up
integer :: niter = 3 !< Number of iterations integer :: niter = 3 !< Number of iterations
real wj !< Light limited photosynthesis (umol co2/m**2/s) real wj !< Light limited photosynthesis, [umol co2/m**2/s]
real wc !< Rubisco limited photosynthesis (umol co2/m**2/s) real wc !< Rubisco limited photosynthesis, [umol co2/m**2/s]
real we !< Export limited photosynthesis (umol co2/m**2/s) real we !< Export limited photosynthesis, [umol co2/m**2/s]
real psn(nv2) !< Foliage photosynthesis, umol co2 /m**2/ s [always +] real psn(nv2) !< Foliage photosynthesis, [umol co2/m**2/s] [always +]
real cs !< Co2 concentration at leaf surface (pa) real cs !< Co2 concentration at leaf surface, [Pa]
real :: mp(1:nv2) = (/9.,9.,8.,6.,6.,9.,9.,9.,9.,9.,9.,9.,9./) !< slope for conductance-to-photosynthesis relationship real :: mp(1:nv2) = (/9.,9.,8.,6.,6.,9.,9.,9.,9.,9.,9.,9.,9./) !< slope for conductance-to-photosynthesis relationship
real a,b,c,q !< Intermediate calculations for rs real a,b,c,q !< Intermediate calculations for rs
real r1,r2 !< Roots for rs real r1,r2 !< Roots for rs
real psnsha(nv2) !< Shaded leaf photosynthesis (umol co2 /m**2/ s) real psnsha(nv2) !< Shaded leaf photosynthesis, [umol co2/m**2/s]
real psnsun(nv2) !< Sunlit leaf photosynthesis (umol co2 /m**2/ s) real psnsun(nv2) !< Sunlit leaf photosynthesis, [umol co2/m**2/s]
real :: fsun(nv2) = 0.5 real :: fsun(nv2) = 0.5
real fsha(nv2) !< Shaded fraction of canopy real fsha(nv2) !< Shaded fraction of canopy
real laisun(nv2) !< Sunlit leaf area real laisun(nv2) !< Sunlit leaf area
real laisha(nv2) !< Shaded leaf area real laisha(nv2) !< Shaded leaf area
real fpsn(nv2) !< Photosynthesis umol co2 /m**2 /s real fpsn(nv2) !< Photosynthesis, [umol co2/m**2/s]
k = 3 k = 3
...@@ -183,6 +185,7 @@ contains ...@@ -183,6 +185,7 @@ contains
rs(k) = amax1(r1,r2) rs(k) = amax1(r1,r2)
ci(k) = amax1(cs - psn(k) * pgr * 1.65 * rs(k), 0.) ci(k) = amax1(cs - psn(k) * pgr * 1.65 * rs(k), 0.)
end do end do
rs(k) = rs(k) * cf(k) rs(k) = rs(k) * cf(k)
rb(k) = rb(k) * cf(k) rb(k) = rb(k) * cf(k)
...@@ -214,7 +217,7 @@ contains ...@@ -214,7 +217,7 @@ contains
return return
end function f2 end function f2
end function end function fun_special_photo
end module end module
program main program main
!> главная программа !> главная программа
! ----------------------------------------------- Use pack ------------------------------------------------------------
use core use core
use carbon_model use carbon_model
use env, only : env_init, environment_gen use env, only : env_init, environment_gen
use settings use settings
! ----------------------------------------------- Local variables -----------------------------------------------------
implicit none implicit none
integer i, j, ii, jj, k, t, n, m, f !< Array/loop index
real arg(1), par(npar_default), mult, prod !< Service variables
logical :: firstcall = .true. logical :: firstcall = .true.
integer :: ios integer :: ios
! ----------------------------------------------- Service variables ---------------------------------------------------
! ---------------------------------------------------- Initialization ------------------------------------------------ real arg(1), par(npar_default), mult, prod !< Service variables
! ----------------------------------------------- Array/loop index ----------------------------------------------------
! инициализация переменных: integer i, j, ii, jj, k, t, n, m, f !< Array/loop index
! ----------------------------------------------- Инициализация переменных --------------------------------------------
call core_init(npool) call core_init(npool)
call env_init() call env_init()
call calc_init() call calc_init()
! ----------------------------------------------- Сборка модели по заданной пользователем структуре -------------------
! сборка модели по заданной пользователем структуре:
nflux(:,:) = 0 nflux(:,:) = 0
nmult(:,:,:) = 0 nmult(:,:,:) = 0
route(:,:,:) = 0 route(:,:,:) = 0
my_label(:,:,:,:) = '' my_label(:,:,:,:) = ''
call model_assembly() call model_assembly()
! matrices flip ! ----------------------------------------------- Matrices flip -------------------------------------------------------
do n = 1, npool do n = 1, npool
do m = 1, npool do m = 1, npool
if (nflux(n,m) /= 0) then if (nflux(n,m) /= 0) then
...@@ -39,11 +36,9 @@ do n = 1, npool ...@@ -39,11 +36,9 @@ do n = 1, npool
endif endif
enddo enddo
enddo enddo
! ----------------------------------------------- Установка начальных значений ----------------------------------------
! установка начальных значений:
pool(:,:,:) = pool_iv pool(:,:,:) = pool_iv
flux(:,:,:,:,:) = 0. flux(:,:,:,:,:) = 0.
time = 0 time = 0
year = year0 year = year0
month = month0 month = month0
...@@ -51,21 +46,15 @@ hour = hour0 ...@@ -51,21 +46,15 @@ hour = hour0
day = day0 day = day0
minute = minute0 minute = minute0
second = second0 second = second0
! ----------------------------------------------- Main cycle ----------------------------------------------------------
! ------------------------------------------------------- Main cycle -------------------------------------------------
do t = 1, ntime do t = 1, ntime
! ----------------------------------------------- Генерация состояния окружающей среды --------------------------------
! генерация состояния окружающей среды:
call environment_gen(time) call environment_gen(time)
call calc_preliminary_global() call calc_preliminary_global()
do ii = i0, i1 do ii = i0, i1
do jj = j0, j1 do jj = j0, j1
call calc_preliminary_local(ii,jj) call calc_preliminary_local(ii,jj)
! ----------------------------------------------- Расчет потоков ------------------------------------------------------
! расчет потоков:
do n = 1, npool do n = 1, npool
do m = 1, n - 1 do m = 1, n - 1
if (nflux(n,m) > 0) then if (nflux(n,m) > 0) then
...@@ -83,12 +72,12 @@ do t = 1, ntime ...@@ -83,12 +72,12 @@ do t = 1, ntime
& trans(n,m,f,i)%arg_mask(:) ) & trans(n,m,f,i)%arg_mask(:) )
par = trans(n,m,f,i)%par(:) par = trans(n,m,f,i)%par(:)
mult = trans(n,m,f,i)%fun(arg, par) mult = trans(n,m,f,i)%fun(arg, par)
! --- здесь можно указать дополнительные опции --- ! ----------------------------------------------- Здесь можно указать дополнительные опции ----------------------------
select case (my_label(n,m,f,i)) select case (my_label(n,m,f,i))
case('fst') case('fst')
if (mult < 0.5) mult = mult * 0.5 if (mult < 0.5) mult = mult * 0.5
end select end select
! --- ! ---------------------------------------------------------------------------------------------------------------------
prod = prod * mult prod = prod * mult
end do end do
prod = prod * route(n,m,f) prod = prod * route(n,m,f)
...@@ -98,8 +87,7 @@ do t = 1, ntime ...@@ -98,8 +87,7 @@ do t = 1, ntime
end if end if
end do end do
end do end do
! ----------------------------------------------- Расчет пулов --------------------------------------------------------
! расчет пулов:
do n = 1, npool do n = 1, npool
do m = 1, n - 1 do m = 1, n - 1
if (nflux(n,m) > 0.) then if (nflux(n,m) > 0.) then
...@@ -110,15 +98,12 @@ do t = 1, ntime ...@@ -110,15 +98,12 @@ do t = 1, ntime
end if end if
end do end do
end do end do
end do end do
end do end do
! ----------------------------------------------- Сдвиг даты и времени ------------------------------------------------
! сдвиг даты и времени:
call date_shift(dt) call date_shift(dt)
! ----------------------------------------------- Вывод данных --------------------------------------------------------
! вывод данных: !if (hour /= hour_mem) then
if (hour /= hour_mem) then
print'(" ",i4.4,"-",i2.2,"-",i2.2," ",i2.2,":",i2.2,":",i2.2)', year, month, day, hour, minute, second print'(" ",i4.4,"-",i2.2,"-",i2.2," ",i2.2,":",i2.2,":",i2.2)', year, month, day, hour, minute, second
! print*, Cveg(i0,j0), Csoil(i0,j0), Csoilb(i0,j0), Catm(i0,j0) ! print*, Cveg(i0,j0), Csoil(i0,j0), Csoilb(i0,j0), Catm(i0,j0)
! print*, '---' ! print*, '---'
...@@ -135,13 +120,18 @@ do t = 1, ntime ...@@ -135,13 +120,18 @@ do t = 1, ntime
! print*, 'ddc8', ddc8_new(i0,j0)/umol2kg ! print*, 'ddc8', ddc8_new(i0,j0)/umol2kg
do n = 1, npool do n = 1, npool
print*, 'pool', n, pool(i0,j0,n) print*, 'pool', n, pool(i0,j0,n)
write(10+n,*) pool(i0,j0,n)
write(7,*) 'pool', n, pool(i0,j0,n)
end do end do
print*, 'F_litterfall', F_litterfall(i0,j0)
print*, 'F_microbal_respiration', F_microbal_respiration(i0,j0)
print*, 'F_mineralization', F_mineralization(i0,j0)
print*, 'F_destabilization', F_destabilization(i0,j0)
print* print*
hour_mem = hour hour_mem = hour
endif !write(7,*) 'pool', 4, pool(i0,j0,4)
!end if
! отслеживание технических ошибок: ! ----------------------------------------------- Отслеживание технических ошибок--------------------------------------
!запись в лог-файл: !запись в лог-файл:
!if (firstcall) then !if (firstcall) then
! open(2, file='log/error_test_log.txt', status='replace') ! open(2, file='log/error_test_log.txt', status='replace')
...@@ -160,9 +150,6 @@ do t = 1, ntime ...@@ -160,9 +150,6 @@ do t = 1, ntime
else else
print*, 'test eps = end of file' print*, 'test eps = end of file'
end if end if
end do end do
end program main end program main
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment