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

версия после сириуса

parent c72c2dca
No related branches found
No related tags found
No related merge requests found
Expand all Show whitespace changes
Inline Side-by-side
Showing
with 910 additions and 72703 deletions
build.sh
+ 10
− 12
View file @ f0cca80a
...@@ -51,19 +51,17 @@ gfortran $keys_compile -c source/environment/environment_data_generator.f90 -o b ...@@ -51,19 +51,17 @@ gfortran $keys_compile -c source/environment/environment_data_generator.f90 -o b
gfortran $keys_compile -c source/environment/environment_data_lsm_offline.f90 -o bin/environment_data_lsm_offline.o -Jbin gfortran $keys_compile -c source/environment/environment_data_lsm_offline.f90 -o bin/environment_data_lsm_offline.o -Jbin
gfortran $keys_compile -c source/environment/environment_model_INMCM.f90 -o bin/environment_model_INMCM.o -Jbin gfortran $keys_compile -c source/environment/environment_model_INMCM.f90 -o bin/environment_model_INMCM.o -Jbin
gfortran $keys_compile -c source/environment/environment.f90 -o bin/environment.o -Jbin gfortran $keys_compile -c source/environment/environment.f90 -o bin/environment.o -Jbin
gfortran $keys_compile -c source/carbon/carbon_grid.f90 -o bin/carbon_grid.o -Jbin
gfortran $keys_compile -c source/carbon/carbon_mult_arg_kit.f90 -o bin/carbon_mult_arg_kit.o -Jbin
gfortran $keys_compile -c source/carbon/carbon_mult_par_kit.f90 -o bin/carbon_mult_par_kit.o -Jbin
gfortran $keys_compile -c source/carbon/carbon_mult_fun_kit.f90 -o bin/carbon_mult_fun_kit.o -Jbin
gfortran $keys_compile -c source/carbon/carbon_mult.f90 -o bin/carbon_mult.o -Jbin
gfortran $keys_compile -c source/carbon/carbon_core.f90 -o bin/carbon_core.o -Jbin gfortran $keys_compile -c source/carbon/carbon_core.f90 -o bin/carbon_core.o -Jbin
gfortran $keys_compile -c source/carbon/carbon_model2core_interface.f90 -o bin/carbon_model2core_interface.o -Jbin gfortran $keys_compile -c source/carbon/carbon_model_to_core_arg_kit.f90 -o bin/carbon_model_to_core_arg_kit.o -Jbin
gfortran $keys_compile -c ui3_carbon_model_aux.f90 -o bin/carbon_model_template_aux.o -Jbin gfortran $keys_compile -c source/carbon/carbon_model_to_core_par_kit.f90 -o bin/carbon_model_to_core_par_kit.o -Jbin
gfortran $keys_compile -c ui2_carbon_model.f90 -o bin/carbon_model_template.o -Jbin gfortran $keys_compile -c source/carbon/carbon_model_to_core_fun_kit.f90 -o bin/carbon_model_to_core_fun_kit.o -Jbin
gfortran $keys_compile -c source/carbon/carbon_model_INMCM_aux.f90 -o bin/carbon_model_INMCM_aux.o -Jbin gfortran $keys_compile -c source/carbon/carbon_model_to_core.f90 -o bin/carbon_model_to_core.o -Jbin
gfortran $keys_compile -c source/carbon/carbon_model_INMCM.f90 -o bin/carbon_model_INMCM.o -Jbin gfortran $keys_compile -c ui3_carbon_model_aux.f90 -o bin/carbon_model_user_aux.o -Jbin
gfortran $keys_compile -c source/carbon/carbon_model_SOCS_aux.f90 -o bin/carbon_model_SOCS_aux.o -Jbin gfortran $keys_compile -c ui2_carbon_model.f90 -o bin/carbon_model_user.o -Jbin
gfortran $keys_compile -c source/carbon/carbon_model_SOCS.f90 -o bin/carbon_model_SOCS.o -Jbin gfortran $keys_compile -c source/carbon/carbon_models/carbon_model_INMCM_aux.f90 -o bin/carbon_model_INMCM_aux.o -Jbin
gfortran $keys_compile -c source/carbon/carbon_models/carbon_model_INMCM.f90 -o bin/carbon_model_INMCM.o -Jbin
gfortran $keys_compile -c source/carbon/carbon_models/carbon_model_SOCS_aux.f90 -o bin/carbon_model_SOCS_aux.o -Jbin
gfortran $keys_compile -c source/carbon/carbon_models/carbon_model_SOCS.f90 -o bin/carbon_model_SOCS.o -Jbin
gfortran $keys_compile -c source/carbon/carbon_solver.f90 -o bin/carbon_solver.o -Jbin gfortran $keys_compile -c source/carbon/carbon_solver.f90 -o bin/carbon_solver.o -Jbin
gfortran $keys_compile -c source/carbon/carbon_postprocessing.f90 -o bin/carbon_postprocessing.o -Jbin gfortran $keys_compile -c source/carbon/carbon_postprocessing.f90 -o bin/carbon_postprocessing.o -Jbin
gfortran $keys_compile -c source/carbon/carbon.f90 -o bin/carbon.o -Jbin gfortran $keys_compile -c source/carbon/carbon.f90 -o bin/carbon.o -Jbin
......
data/inmcm_05x05/OLIJAN deleted 100755 → 0
+ 0
− 3259
View file @ c72c2dca
This diff is collapsed.
data/inmcm_05x05/SOILCOL deleted 100755 → 0
+ 0
− 24093
View file @ c72c2dca
This diff is collapsed.
data/inmcm_05x05/VEG_BART deleted 100644 → 0
+ 0
− 34801
View file @ c72c2dca
This diff is collapsed.
data/logs/error_test_log_inmcm.bin 0 → 100644
+ 0
− 0
View file @ f0cca80a
File added
data/logs/error_test_log_inmcm.txt deleted 100644 → 0
+ 0
− 10000
View file @ c72c2dca
This diff is collapsed.
data/logs/error_test_log_other.txt deleted 100644 → 0
+ 0
− 0
View file @ c72c2dca
data/logs/error_test_log_socs.txt deleted 100644 → 0
+ 0
− 100
View file @ c72c2dca
1 2.40255758E-05
2 4.77690919E-05
3 7.17946605E-05
4 9.66666339E-05
5 1.22946920E-04
6 1.51182874E-04
7 1.81880430E-04
8 -5.00867318E-04
9 -1.18968007E-03
10 -1.86517264E-03
11 -2.50583305E-03
12 -3.09756468E-03
13 -3.64667317E-03
14 -4.18461300E-03
15 -4.75229416E-03
16 -5.37442416E-03
17 -6.04887167E-03
18 -6.75577018E-03
19 -6.71903742E-03
20 -6.68545533E-03
21 -6.65475382E-03
22 -6.62651472E-03
23 -6.60023186E-03
24 -6.57535717E-03
25 -6.55132858E-03
26 -6.52758218E-03
27 -6.50355360E-03
28 -6.47867890E-03
29 -6.45239605E-03
30 -6.42415695E-03
31 -6.39345543E-03
32 -7.07619917E-03
33 -7.76500814E-03
34 -8.44049733E-03
35 -9.08115320E-03
36 -9.67288204E-03
37 -1.02219870E-02
38 -1.07599217E-02
39 -1.13275973E-02
40 -1.19497217E-02
41 -1.26241641E-02
42 -1.33310575E-02
43 -1.32943206E-02
44 -1.32607343E-02
45 -1.32300295E-02
46 -1.32017871E-02
47 -1.31755015E-02
48 -1.31506240E-02
49 -1.31265931E-02
50 -1.31028444E-02
51 -1.30788134E-02
52 -1.30539360E-02
53 -1.30276503E-02
54 -1.29994079E-02
55 -1.29687032E-02
56 -1.36514418E-02
57 -1.43402470E-02
58 -1.50157316E-02
59 -1.56563837E-02
60 -1.62481070E-02
61 -1.67972054E-02
62 -1.73351392E-02
63 -1.79028101E-02
64 -1.85249280E-02
65 -1.91993639E-02
66 -1.99062526E-02
67 -1.98695119E-02
68 -1.98359247E-02
69 -1.98052172E-02
70 -1.97769739E-02
71 -1.97506864E-02
72 -1.97258070E-02
73 -1.97017733E-02
74 -1.96780227E-02
75 -1.96539890E-02
76 -1.96291097E-02
77 -1.96028221E-02
78 -1.95745789E-02
79 -1.95438713E-02
80 -2.02266071E-02
81 -2.09154096E-02
82 -2.15908904E-02
83 -2.22315360E-02
84 -2.28232518E-02
85 -2.33723428E-02
86 -2.39102710E-02
87 -2.44779363E-02
88 -2.51000486E-02
89 -2.57744789E-02
90 -2.64813602E-02
91 -2.64446158E-02
92 -2.64110230E-02
93 -2.63803098E-02
94 -2.63520610E-02
95 -2.63257697E-02
96 -2.63008866E-02
97 -2.62768492E-02
98 -2.62530949E-02
99 -2.62290575E-02
100 -2.62041744E-02
readme.md
+ 16
− 10
View file @ f0cca80a
Конструктор поддерживает возможность реализации разных моделей углеродного цикла #### Начало работы:
Вы можете использовать готовую конфигурацию или создать свою
Готовые конфигурации можно найти в папке `models/`
Для создания своей конфигурации начните редактировать файл `my_carbon_model.f90`
#### Быстрый старт: 1) Настройте конструктор
1) Отредактируйте файл `settings.f90` для задания настроек расчета Настройки доступны из следующих файлов:
2) Соберите модель желаемой конфигурации, выполнив команду: ```plaintext
ui1_config.nml - основные настройки
ui2_carbon_model.а90 - настройка модели углеродного цикла
ui3_carbon_model_aux.f90 - пользовательские расчеты
```
2) Соберите программу
```plaintext ```plaintext
./build.sh <название_файла_конфигурации> ./build.sh [--debug] [-pg]
Опции:
--debug : собрать в отладочном режиме
-pg : использовать профилировку gprof
``` ```
Если не указать файл конфигурации, по умолчанию будет использована конфигурация модели inmcm (файл `models/inmcm_carbon_model.f90`)
3) Для запуска модели выполните: 3) Запустите программу
```plaintext ```plaintext
./run.exe ./run.exe
......
source/carbon/carbon.f90
+ 84
− 82
View file @ f0cca80a
module carbon module carbon
!< @brief углеродный конструктор !< @brief модуль углерода
!< @details главный модуль, маршрутизация вызовов подпрограмм !< @details главный модуль, маршрутизация вызовов подпрограмм
use config, only : carbon_model_type, & use config, only : carbon_model_type, &
& if_carbon_core_print, & & if_standard_print, &
& if_carbon_core_error_testing_write_log & if_standard_output, &
use carbon_solver, only : carbon_core_calc_fluxes, & & testing_log_mode
& carbon_core_solver use carbon_solver, only : carbon_solver_fluxes, &
use carbon_postprocessing, only : carbon_core_print, & & carbon_solver_pools
& carbon_core_output, & use carbon_postprocessing, only : carbon_standard_print, &
& carbon_core_error_testing_write_log, & & carbon_standard_output, &
& carbon_core_error_testing_read_log & carbon_testing_write_log, &
& carbon_testing_read_log
use carbon_model_inmcm, only : carbon_model_assembly_inmcm => carbon_model_assembly use carbon_model_inmcm, only : carbon_model_assembly_inmcm => carbon_model_assembly
use carbon_model_inmcm_aux, only : carbon_model_init_inmcm => carbon_model_init, & use carbon_model_inmcm_aux, only : carbon_model_init_inmcm => carbon_model_init, &
& carbon_model_calc_at_timestep_inmcm => carbon_model_calc_at_timestep, & & carbon_model_calc_at_timestep_inmcm => carbon_model_calc_at_timestep, &
...@@ -97,7 +98,7 @@ module carbon ...@@ -97,7 +98,7 @@ module carbon
call carbon_model_assembly() call carbon_model_assembly()
call carbon_core_output() if (if_standard_output) call carbon_standard_output()
end subroutine end subroutine
...@@ -124,29 +125,30 @@ module carbon ...@@ -124,29 +125,30 @@ module carbon
call carbon_model_calc_at_tile(ii,jj,nn) call carbon_model_calc_at_tile(ii,jj,nn)
call carbon_core_calc_fluxes(ii,jj,nn) call carbon_solver_fluxes(ii,jj,nn)
call carbon_core_solver(ii,jj,nn) call carbon_solver_pools(ii,jj,nn)
end subroutine end subroutine
subroutine carbon_postprocessing() subroutine carbon_postprocessing()
if (if_carbon_core_error_testing_write_log) then select case(testing_log_mode)
call carbon_core_error_testing_write_log() case('write')
else call carbon_testing_write_log()
call carbon_core_error_testing_read_log() case('read')
endif call carbon_testing_read_log()
case('none')
end select
if (if_carbon_core_print) call carbon_core_print() if (if_standard_print) call carbon_standard_print()
call carbon_core_output() if (if_standard_output) call carbon_standard_output()
call carbon_model_postprocessing() call carbon_model_postprocessing()
end subroutine end subroutine
end module end module
source/carbon/carbon_core.f90
+ 47
− 9
View file @ f0cca80a
...@@ -6,7 +6,7 @@ module carbon_core ...@@ -6,7 +6,7 @@ module carbon_core
! интерфейс ! интерфейс
! --------------------------------------------------------------------------------- ! ---------------------------------------------------------------------------------
use carbon_core_multiplier_kit, only : multiplier_kit_type use const, only : len_default
implicit none implicit none
...@@ -17,12 +17,50 @@ module carbon_core ...@@ -17,12 +17,50 @@ module carbon_core
integer, parameter :: npool_default = 10 !< макс число пулов integer, parameter :: npool_default = 10 !< макс число пулов
integer, parameter :: nflux_default = 20 !< макс число потоков integer, parameter :: nflux_default = 20 !< макс число потоков
integer, parameter :: nmult_default = 10 !< макс число множителей в функции перехода integer, parameter :: nmult_default = 10 !< макс число множителей в выражении для потока
integer, parameter :: len_default = 100 integer, parameter :: narg_default = 1 !< макс число аргументов функций в множителях
integer, parameter :: npar_default = 5 !< макс число параметров функций в множителях
! производные типы данных ! производные типы данных
! --------------------------------------------------------------------------------- ! ---------------------------------------------------------------------------------
abstract interface
function fun_interface(args, pars) result(y)
import :: narg_default, npar_default
implicit none
real, intent(in) :: args(narg_default)
real, intent(in) :: pars(npar_default)
real :: y
end function
end interface
type fun_kit_type
procedure(fun_interface), pointer, nopass :: fun
end type
type arg_kit_type
real, pointer :: arg1
real, pointer :: arg2(:)
real, pointer :: arg3(:,:)
real, pointer :: arg4(:,:,:)
real, pointer :: arg5(:,:,:,:)
real, pointer :: arg6(:)
integer :: num
end type
type par_kit_type
real :: par1
real, allocatable :: par2(:)
real, allocatable :: par3(:,:)
integer :: num
end type
type mult_kit_type
type(arg_kit_type) :: arg_kit(narg_default)
type(par_kit_type) :: par_kit(npar_default)
type(fun_kit_type) :: fun_kit
end type
type pool_type type pool_type
character(len_default) :: name character(len_default) :: name
real, allocatable :: val(:,:,:) real, allocatable :: val(:,:,:)
...@@ -34,7 +72,7 @@ module carbon_core ...@@ -34,7 +72,7 @@ module carbon_core
integer :: pid_out integer :: pid_out
integer :: pid_in integer :: pid_in
integer :: nmult integer :: nmult
type(multiplier_kit_type) :: multiplier_kit(nmult_default) type(mult_kit_type) :: mult_kit(nmult_default)
end type end type
! переменные ! переменные
...@@ -45,8 +83,8 @@ module carbon_core ...@@ -45,8 +83,8 @@ module carbon_core
type(pool_type), target :: pool(npool_default) type(pool_type), target :: pool(npool_default)
type(flux_type), target :: flux(nflux_default) type(flux_type), target :: flux(nflux_default)
integer :: ntile = 1
real, allocatable :: tile_weight(:,:,:)
end module end module
source/carbon/carbon_grid.f90 deleted 100644 → 0
+ 0
− 11
View file @ c72c2dca
module carbon_grid
implicit none
public
integer :: ntiles
real, allocatable :: tileFrac(:,:,:)
end module
source/carbon/carbon_model2core_interface.f90 deleted 100644 → 0
+ 0
− 147
View file @ c72c2dca
module carbon_model_to_core_interface
use carbon_grid
use carbon_core
use carbon_core_multiplier_kit, only : set_multiplier
implicit none
public :: carbon_tiles_init
public :: carbon_core_assembly_pool_init
public :: carbon_core_assembly_flux_init
public :: carbon_core_assembly_mult_init
contains
! сборка конструктора
! ---------------------------------------------------------------------------------
subroutine carbon_tiles_init(my_ntiles, my_tileFrac)
use grid, only : i0, i1, j0, j1
integer, intent(in) :: my_ntiles
real, intent(in), optional :: my_tileFrac(:,:,:)
ntiles = my_ntiles
allocate(tileFrac(i0:i1,j0:j1,ntiles))
if (present(my_tileFrac)) then
tileFrac = my_tileFrac
else
tileFrac = 100.
endif
end subroutine
subroutine carbon_core_assembly_pool_init(pid, initial_value, name, alias)
!< @brief процедура для добавления пула в модель
use grid, only : i0, i1, j0, j1
use carbon_grid, only : ntiles
integer, intent(out) :: pid
real, intent(in), optional :: initial_value
character(*), intent(in), optional :: name
real, intent(inout), pointer, optional :: alias(:,:,:)
npool = npool + 1
pid = npool
allocate(pool(pid)%val(i0:i1,j0:j1,ntiles))
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 already associated"
alias(i0:i1,j0:j1,1:ntiles) => pool(pid)%val(:,:,:)
endif
end subroutine
subroutine carbon_core_assembly_flux_init(fid, pid_out, pid_in, name, alias)
!< @brief процедура для добавления потока в модель
use grid, only : i0, i1, j0, j1
use carbon_grid, only : ntiles
integer, intent(out) :: fid
integer, intent(in) :: pid_out, pid_in
character(*), intent(in), optional :: name
real, intent(inout), pointer, optional :: 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,ntiles))
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 already associated"
alias(i0:i1,j0:j1,1:ntiles) => flux(fid)%val(:,:,:)
endif
end subroutine
subroutine carbon_core_assembly_mult_init(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)
integer, intent(in) :: fid
character(*), intent(in) :: funtype
! possible arguments list:
real, intent(in), optional :: x, x_n(:), x_ij(:,:), x_ijn(:,:,:), x_ijn_month(:,:,:,:), x_year(:)
! possible parameters list
real, intent(in), optional :: c, c_n(:), c_ij(:,:)
real, intent(in), optional :: y0, y0_n(:), y0_ij(:,:)
real, intent(in), optional :: x0, x0_n(:), x0_ij(:,:)
real, intent(in), optional :: k, k_n(:), k_ij(:,:)
real, intent(in), optional :: a, a_n(:), a_ij(:,:)
real, intent(in), optional :: amp, amp_n(:), amp_ij(:,:)
integer :: m
flux(fid)%nmult = flux(fid)%nmult + 1
m = flux(fid)%nmult
call set_multiplier( flux(fid)%multiplier_kit(m), &
& 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)
end subroutine
end module
source/carbon/carbon_model_INMCM.f90 deleted 100644 → 0
+ 0
− 125
View file @ c72c2dca
module carbon_model_inmcm
!< @brief модель углеродного цикла inmcm
! интерфейс
! ----------------------------------------------------------------------------------------------------------------------
use carbon_model_to_core_interface, only : tiles_init => carbon_tiles_init, &
& pool_init => carbon_core_assembly_pool_init, &
& flux_init => carbon_core_assembly_flux_init, &
& mult_init => carbon_core_assembly_mult_init
implicit none
private
public :: carbon_model_assembly
! программа
! ----------------------------------------------------------------------------------------------------------------------
contains
subroutine carbon_model_assembly()
use const, only : yrs, umol2kg, Kelvin0
use grid, only : ms, dt, area
use environment_core, only : Temp, Tsoil
use environment_model_inmcm, only : nv2, vegg_nv2
use environment_model_inmcm, only : weight, tlai, elai, fsun, fsha
use carbon_model_inmcm_aux, only : psnsun, laisun, amndf, psnsha, laisha, rmf25, arm, t_ref, tmin, btran, foln, folnmx, vegStemFrac, rms25, vegRootFrac, rmr25, amrp, tmin_soil, rsw, cv81b, al5, dfr_weight, ers_weight, landuseDfrA, landuseDfrB, landuseErs, landuseCutFrac
use carbon_model_inmcm_aux, only : Cveg, Csoil, Csoilb, Fpsn_sun, Fpsn_sha, Frg_sun, Frg_sha, Frmf, Frms, Frmr, Fmicr, Fmicrb, Flit, FdfrA, FdfrB, Fers
integer :: n_Catm, n_Cveg, n_Csoil, n_Csoilb !< id пулов
integer :: n_F !< id потока
call tiles_init(nv2, vegg_nv2)
call pool_init(pid = n_Catm, name = 'catm')
call pool_init(pid = n_Cveg, name = 'cveg', alias = Cveg)
call pool_init(pid = n_Csoil, name = 'csoil', alias = Csoil)
call pool_init(pid = n_Csoilb, name = 'csoilb', alias = Csoilb)
call flux_init(fid = n_F, pid_out = n_Catm, pid_in = n_Cveg, name = 'fpsn_sun', alias = Fpsn_sun)
call mult_init(n_F, 'lin', x_n = psnsun, k = umol2kg)
call mult_init(n_F, 'lin', x_n = laisun)
call mult_init(n_F, 'lin', x_n = weight)
call mult_init(n_F, 'lin', x_n = amndf)
call flux_init(fid = n_F, pid_out = n_Catm, pid_in = n_Cveg, name = 'fpsn_sha', alias = Fpsn_sha)
call mult_init(n_F, 'lin', x_n = psnsha, k = umol2kg)
call mult_init(n_F, 'lin', x_n = laisha)
call mult_init(n_F, 'lin', x_n = weight)
call mult_init(n_F, 'lin', x_n = amndf)
call flux_init(fid = n_F, pid_out = n_Cveg, pid_in = n_Catm, name = 'frg_sun', alias = Frg_sun)
call mult_init(n_F, 'lin', x_ijn = Fpsn_sun, k = 0.25)
call flux_init(fid = n_F, pid_out = n_Cveg, pid_in = n_Catm, name = 'frg_sha', alias = Frg_sha)
call mult_init(n_F, 'lin', x_ijn = Fpsn_sha, k = 0.25)
call flux_init(fid = n_F, pid_out = n_Cveg, pid_in = n_Catm, name = 'frmf', alias = Frmf)
call mult_init(n_F, 'lin', x_n = tlai)
call mult_init(n_F, 'lin', x_n = weight)
call mult_init(n_F, 'const', c_n = rmf25(:) * umol2kg)
call mult_init(n_F, 'exp', x_ij = Temp, a_n = arm(:), k = 0.1, x0 = t_ref)
call mult_init(n_F, 'step', x_ij = Temp, x0_n = tmin(:), k = 0.5, y0 = 0.5)
call mult_init(n_F, 'lin', x_n = btran)
call mult_init(n_F, 'const', c_n = min(1.,foln(:)/folnmx(:)))
call mult_init(n_F, 'lin', x_n = amndf)
call flux_init(fid = n_F, pid_out = n_Cveg, pid_in = n_Catm, name = 'frms', alias = Frms)
call mult_init(n_F, 'lin', x_ijn = Cveg, k_n = vegStemFrac(:))
call mult_init(n_F, 'const', c_n = rms25(:) * umol2kg)
call mult_init(n_F, 'exp', x_ij = Temp, a_n = arm(:), k = 0.1, x0 = t_ref)
call mult_init(n_F, 'step', x_ij = Temp, x0_n = tmin(:), k = 0.5, y0 = 0.5)
call mult_init(n_F, 'const', c = 0.35)
call mult_init(n_F, 'lin', x_n = amndf)
call flux_init(fid = n_F, pid_out = n_Cveg, pid_in = n_Catm, name = 'frmr', alias = Frmr)
call mult_init(n_F, 'lin', x_ijn = Cveg, k_n = vegRootFrac(:))
call mult_init(n_F, 'const', c_n = rmr25(:) * umol2kg)
call mult_init(n_F, 'exp', x_ij = Temp, a_n = arm(:), k = 0.1, x0 = t_ref)
call mult_init(n_F, 'step', x_ij = Temp, x0_n = tmin(:), k = 0.5, y0 = 0.5)
call mult_init(n_F, 'const', c = 0.35)
call mult_init(n_F, 'lin', x_n = amndf)
call flux_init(fid = n_F, pid_out = n_Csoil, pid_in = n_Catm, name = 'fmicr', alias = Fmicr)
call mult_init(n_F, 'lin', x_ijn = Csoil)
call mult_init(n_F, 'const', c_n = amrp(:) * umol2kg)
call mult_init(n_F, 'exp', x_ij = Tsoil(:,:,ms+1), a = 2., k = 0.1, x0 = t_ref)
call mult_init(n_F, 'step', x_ij = Tsoil(:,:,ms+1), x0 = tmin_soil, k = 0.5, y0 = 0.5)
call mult_init(n_F, 'mm', x_n = rsw, k = 1., x0 = -0.20)
call mult_init(n_F, 'hyp', x_n = rsw, k = 0.23, x0 = -0.23)
call mult_init(n_F, 'const', c = 1.5)
call flux_init(fid = n_F, pid_out = n_Csoilb, pid_in = n_Catm, name = 'fmicrb', alias = Fmicrb)
call mult_init(n_F, 'lin', x_ijn = Csoilb)
call mult_init(n_F, 'const', c_n = amrp(:) * umol2kg)
call mult_init(n_F, 'exp', x_ij = Tsoil(:,:,ms+1), a = 2., k = 0.1, x0 = t_ref)
call mult_init(n_F, 'step', x_ij = Tsoil(:,:,ms+1), x0 = tmin_soil, k = 0.5, y0 = 0.5)
call mult_init(n_F, 'mm', x_n = rsw, k = 1., x0 = -0.20)
call mult_init(n_F, 'hyp', x_n = rsw, k = 0.23, x0 = -0.23)
call mult_init(n_F, 'const', c = 1.5)
call mult_init(n_F, 'const', c = cv81b)
call flux_init(fid = n_F, pid_out = n_Cveg, pid_in = n_Csoil, name = 'dv68', alias = Flit)
call mult_init(n_F, 'lin', x_ijn = Cveg, k_n = 1./(al5(:)*yrs))
! call flux_init(fid = n_F, pid_out = n_Cveg, pid_in = n_Csoilb, name = 'ddc6a', alias = FdfrA)
! call mult_init(n_F, 'lin', x_ijn = Cveg, k_ij = landuseCutFrac(:,:)/yrs)
call flux_init(fid = n_F, pid_out = n_Cveg, pid_in = n_Csoilb, name = 'ddc6a', alias = FdfrA)
call mult_init(n_F, 'lin', x_ijn = dfr_weight, k = landuseDfrA)
call flux_init(fid = n_F, pid_out = n_Cveg, pid_in = n_Csoilb, name = 'ddc6b', alias = FdfrB)
call mult_init(n_F, 'lin', x_ijn = dfr_weight, k = landuseDfrB)
call flux_init(fid = n_F, pid_out = n_Csoil, pid_in = n_Csoilb, name = 'ddc8', alias = Fers)
call mult_init(n_F, 'lin', x_ijn = ers_weight, k = landuseErs)
end subroutine carbon_model_assembly
end module
source/carbon/carbon_model_SOCS.f90 deleted 100644 → 0
+ 0
− 54
View file @ c72c2dca
module carbon_model_socs
!< @brief модель углеродного цикла SOCS (модель почвоведов)
! интерфейс
! ----------------------------------------------------------------------
use carbon_model_to_core_interface, only : tiles_init => carbon_tiles_init, &
& pool_init => carbon_core_assembly_pool_init, &
& flux_init => carbon_core_assembly_flux_init, &
& mult_init => carbon_core_assembly_mult_init
implicit none
private
public :: carbon_model_assembly
contains
subroutine carbon_model_assembly()
use carbon_model_socs_aux, only : C1, C2, Irk, kd, rare, kirk, Cm, ntiles
integer :: n_Catm, n_Cveg, n_Csoil1, n_Csoil2 !< id пулов
integer :: n_F !< id потока
call tiles_init(ntiles)
call pool_init(pid = n_Catm, name = 'catm')
call pool_init(pid = n_Cveg, name = 'cveg')
call pool_init(pid = n_Csoil1, name = 'csoil1', alias = C1)
call pool_init(pid = n_Csoil2, name = 'csoil2', alias = C2)
call flux_init(fid = n_F, pid_out = n_Cveg, pid_in = n_Csoil1, name = 'litterfall')
call mult_init(n_F, 'const', c_n = Irk)
call flux_init(fid = n_F, pid_out = n_Csoil2, pid_in = n_Csoil1, name = 'destabilization')
call mult_init(n_F, 'lin', x_ijn = C2, k_n = kd)
call flux_init(fid = n_F, pid_out = n_Csoil1, pid_in = n_Csoil2, name = 'mineralization')
call mult_init(n_F, 'lin', x_ijn = C2, k = -1./Cm, y0 = 1.)
call mult_init(n_F, 'const', c = rare)
call mult_init(n_F, 'const', c_n = kirk)
call mult_init(n_F, 'lin', x_ijn = C1)
call flux_init(fid = n_F, pid_out = n_Csoil1, pid_in = n_Catm, name = 'microbal_respiration')
call mult_init(n_F, 'lin', x_ijn = C1, k = (1.-rare))
call mult_init(n_F, 'const', c_n = kirk)
end subroutine carbon_model_assembly
end module
source/carbon/carbon_model_to_core.f90 0 → 100644
+ 199
− 0
View file @ f0cca80a
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)
! ---------------------------------------
!< @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(:,:)
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)
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
source/carbon/carbon_model_to_core_arg_kit.f90 0 → 100644
+ 126
− 0
View file @ f0cca80a
module carbon_model_to_core_arg_kit
!< @brief обработка аргументов мультипликативных функций
! интерфейс
! ---------------------------------------------------------------------------------
use carbon_core, only : arg_kit_type, narg_default
implicit none
private
public :: set_args
public :: get_args
! параметры
! ---------------------------------------------------------------------------------
integer, parameter :: nmonth = 12
integer, parameter :: year_min = 1 !< предусмотренный диапазон лет
integer, parameter :: year_max = 3000 !<
contains
! внешние процедуры
! ---------------------------------------------------------------------------------
subroutine set_args(arg_kit, &
& x, x_n, x_ij, x_ijn, x_ijn_month, x_year)
! ---------------------------------------
!< @brief установка аргументов
use const, only : miss_v
use grid, only : i0, i1, j0, j1
use carbon_core, only : ntile
type(arg_kit_type), intent(inout) :: arg_kit(narg_default)
!> перечень возможных аргументов:
real, optional, intent(in), target :: x
real, optional, intent(in), target :: x_n(ntile)
real, optional, intent(in), target :: x_ij(i0:i1,j0:j1)
real, optional, intent(in), target :: x_ijn(i0:i1,j0:j1,ntile)
real, optional, intent(in), target :: x_ijn_month(i0:i1,j0:j1,ntile,nmonth)
real, optional, intent(in), target :: x_year(year_min:year_max)
integer :: n
do n = 1, narg_default
allocate(arg_kit(n)%arg1)
allocate(arg_kit(n)%arg2(ntile))
allocate(arg_kit(n)%arg3(i0:i1,j0:j1))
allocate(arg_kit(n)%arg4(i0:i1,j0:j1,ntile))
allocate(arg_kit(n)%arg5(i0:i1,j0:j1,ntile,nmonth))
allocate(arg_kit(n)%arg6(year_min:year_max))
arg_kit(n)%arg1 = miss_v
arg_kit(n)%arg2 = miss_v
arg_kit(n)%arg3 = miss_v
arg_kit(n)%arg4 = miss_v
arg_kit(n)%arg5 = miss_v
arg_kit(n)%arg6 = miss_v
enddo
! arg_kit(1) - x
if (present(x)) then
arg_kit(1)%arg1 => x
arg_kit(1)%num = 1
elseif (present(x_n)) then
arg_kit(1)%arg2 => x_n
arg_kit(1)%num = 2
elseif (present(x_ij)) then
arg_kit(1)%arg3 => x_ij
arg_kit(1)%num = 3
elseif (present(x_ijn)) then
arg_kit(1)%arg4 => x_ijn
arg_kit(1)%num = 4
elseif (present(x_ijn_month)) then
arg_kit(1)%arg5 => x_ijn_month
arg_kit(1)%num = 5
elseif (present(x_year)) then
arg_kit(1)%arg6 => x_year
arg_kit(1)%num = 6
else
arg_kit(1)%arg1 = miss_v
arg_kit(1)%num = 1 ! для const
end if
end subroutine
function get_args(arg_kit, ii, jj, nn, month, year) result (args)
! ---------------------------------------
type(arg_kit_type), intent(in) :: arg_kit(narg_default)
integer, intent(in) :: ii
integer, intent(in) :: jj
integer, intent(in) :: nn
integer, intent(in) :: month
integer, intent(in) :: year
real :: args(narg_default)
integer :: n
do n = 1, narg_default
select case(arg_kit(n)%num)
case(1)
args(n) = arg_kit(n)%arg1
case(2)
args(n) = arg_kit(n)%arg2(nn)
case(3)
args(n) = arg_kit(n)%arg3(ii,jj)
case(4)
args(n) = arg_kit(n)%arg4(ii,jj,nn)
case(5)
args(n) = arg_kit(n)%arg5(ii,jj,nn,month)
case(6)
args(n) = arg_kit(n)%arg6(year)
end select
enddo
end function
end module
source/carbon/carbon_model_to_core_fun_kit.f90 0 → 100644
+ 127
− 0
View file @ f0cca80a
module carbon_model_to_core_fun_kit
!< @brief библиотека мультипликативных функций
! интерфейс
! ---------------------------------------------------------------------------------
use carbon_core, only : fun_kit_type, narg_default, npar_default
implicit none
private
public :: set_fun
public :: get_fun_result
contains
! внешние процедуры
! ---------------------------------------------------------------------------------
subroutine set_fun(fun_kit, funtype)
! ---------------------------------------
!< @brief установка вида функций и их параметров
type(fun_kit_type), intent(inout) :: fun_kit
character(*), intent(in) :: funtype
select case (funtype)
case('const')
fun_kit%fun => fun_const
case('lin')
fun_kit%fun => fun_lin
case('exp')
fun_kit%fun => fun_exp
case('hyp')
fun_kit%fun => fun_hyp
case('mm')
fun_kit%fun => fun_mm
case('step')
fun_kit%fun => fun_step
case default
stop "check failed : unknown funtype at set_fun"
end select
end subroutine
function get_fun_result(fun_kit, args, pars) result (mult)
! ---------------------------------------
type(fun_kit_type), intent(in) :: fun_kit
real, intent(in) :: args(narg_default), pars(npar_default)
real :: mult
mult = fun_kit%fun(args, pars)
end function
! внутренние процедуры
! ---------------------------------------------------------------------------------
! args(1) - x
! pars(1) - y0 или c
! pars(2) - x0
! pars(3) - k
! pars(4) - a
! pars(5) - amp
!> Constant function: y = c
function fun_const(args, pars) result(y)
implicit none
real, intent(in) :: args(narg_default)
real, intent(in) :: pars(npar_default)
real :: y
y = pars(1)
end function fun_const
!> Linear function: y = k*(x-x0) + y0
function fun_lin(args, pars) result(y)
implicit none
real, intent(in) :: args(narg_default)
real, intent(in) :: pars(npar_default)
real :: y
y = args(1) * pars(3) + pars(1)
end function fun_lin
!> Hyperbolic function: y = k/(x-x0) + y0
function fun_hyp(args, pars) result(y)
implicit none
real, intent(in) :: args(narg_default)
real, intent(in) :: pars(npar_default)
real :: y
y = pars(3) / (args(1) - pars(2))
end function fun_hyp
!> Michaelis-Menthen function: y = k*x/(x-x0) + y0
function fun_mm(args, pars) result(y)
implicit none
real, intent(in) :: args(narg_default)
real, intent(in) :: pars(npar_default)
real :: y
y = pars(3) * args(1) / (args(1) - pars(2))
end function fun_mm
!> Step function: y = k*θ(x-x0) + y0
function fun_step(args, pars) result(y)
implicit none
real, intent(in) :: args(narg_default)
real, intent(in) :: pars(npar_default)
real :: y, theta
theta = 0.5*(1.+sign(1.,args(1) - pars(2)))
y = pars(1) + pars(3) * theta
end function fun_step
!> Exponent function: y = amp*a**[k*(x-x0)] + y0
function fun_exp(args, pars) result(y)
implicit none
real, intent(in) :: args(narg_default)
real, intent(in) :: pars(npar_default)
real :: y
y = pars(5) * pars(4)**( pars(3) * (args(1) - pars(2)) ) + pars(1)
end function fun_exp
end module
source/carbon/carbon_model_to_core_par_kit.f90 0 → 100644
+ 180
− 0
View file @ f0cca80a
module carbon_model_to_core_par_kit
!< @brief обработка параметров мультипликативных функций
! интерфейс
! ---------------------------------------------------------------------------------
use carbon_core, only : par_kit_type, npar_default
implicit none
private
public :: set_pars
public :: get_pars
! параметры
! ---------------------------------------------------------------------------------
real, parameter :: y0_default = 0.
real, parameter :: x0_default = 0.
real, parameter :: k_default = 1.
real, parameter :: a_default = exp(1.)
real, parameter :: amp_default = 1.
contains
! внешние процедуры
! ---------------------------------------------------------------------------------
subroutine set_pars(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)
! ---------------------------------------
!< @brief установка вида функций и их параметров
use const, only : miss_v
use grid, only : i0, i1, j0, j1
use carbon_core, only : ntile
type(par_kit_type), intent(inout) :: par_kit(npar_default)
!> перечень возможных параметров:
real, optional, intent(in) :: c, c_n(ntile), c_ij(i0:i1,j0:j1)
real, optional, intent(in) :: y0, y0_n(ntile), y0_ij(i0:i1,j0:j1)
real, optional, intent(in) :: x0, x0_n(ntile), x0_ij(i0:i1,j0:j1)
real, optional, intent(in) :: k, k_n(ntile), k_ij(i0:i1,j0:j1)
real, optional, intent(in) :: a, a_n(ntile), a_ij(i0:i1,j0:j1)
real, optional, intent(in) :: amp, amp_n(ntile), amp_ij(i0:i1,j0:j1)
integer :: n
do n = 1, npar_default
allocate(par_kit(n)%par2(ntile))
allocate(par_kit(n)%par3(i0:i1,j0:j1))
par_kit(n)%par1 = miss_v
par_kit(n)%par2 = miss_v
par_kit(n)%par3 = miss_v
enddo
! par_kit(1) - y0 или c
! par_kit(2) - x0
! par_kit(3) - k
! par_kit(4) - a
! par_kit(5) - amp
if (present(y0)) then
par_kit(1)%par1 = y0
par_kit(1)%num = 1
elseif (present(y0_n)) then
par_kit(1)%par2 = y0_n
par_kit(1)%num = 2
elseif (present(y0_ij)) then
par_kit(1)%par3 = y0_ij
par_kit(1)%num = 3
elseif (present(c)) then
par_kit(1)%par1 = c
par_kit(1)%num = 1
elseif (present(c_n)) then
par_kit(1)%par2 = c_n
par_kit(1)%num = 2
elseif (present(c_ij)) then
par_kit(1)%par3 = c_ij
par_kit(1)%num = 3
else
par_kit(1)%par1 = y0_default
par_kit(1)%num = 1
endif
if (present(x0)) then
par_kit(2)%par1 = x0
par_kit(2)%num = 1
elseif (present(x0_n)) then
par_kit(2)%par2 = x0_n
par_kit(2)%num = 2
elseif (present(x0_ij)) then
par_kit(2)%par3 = x0_ij
par_kit(2)%num = 3
else
par_kit(2)%par1 = x0_default
par_kit(2)%num = 1
endif
if (present(k)) then
par_kit(3)%par1 = k
par_kit(3)%num = 1
elseif (present(k_n)) then
par_kit(3)%par2 = k_n
par_kit(3)%num = 2
elseif (present(k_ij)) then
par_kit(3)%par3 = k_ij
par_kit(3)%num = 3
else
par_kit(3)%par1 = k_default
par_kit(3)%num = 1
endif
if (present(a)) then
par_kit(4)%par1 = a
par_kit(4)%num = 1
elseif (present(a_n)) then
par_kit(4)%par2 = a_n
par_kit(4)%num = 2
elseif (present(a_ij)) then
par_kit(4)%par3 = a_ij
par_kit(4)%num = 3
else
par_kit(4)%par1 = a_default
par_kit(4)%num = 1
endif
if (present(amp)) then
par_kit(5)%par1 = amp
par_kit(5)%num = 1
elseif (present(amp_n)) then
par_kit(5)%par2 = amp_n
par_kit(5)%num = 2
elseif (present(amp_ij)) then
par_kit(5)%par3 = amp_ij
par_kit(5)%num = 3
else
par_kit(5)%par1 = amp_default
par_kit(5)%num = 1
endif
end subroutine
function get_pars(par_kit, ii, jj, nn, month, year) result (pars)
! ---------------------------------------
type(par_kit_type), intent(in) :: par_kit(npar_default)
integer, intent(in) :: ii
integer, intent(in) :: jj
integer, intent(in) :: nn
integer, intent(in) :: month
integer, intent(in) :: year
real :: pars(npar_default)
integer :: n
do n = 1, npar_default
select case(par_kit(n)%num)
case(1)
pars(n) = par_kit(n)%par1
case(2)
pars(n) = par_kit(n)%par2(nn)
case(3)
pars(n) = par_kit(n)%par3(ii,jj)
end select
enddo
end function
end module
source/carbon/carbon_models/carbon_model_INMCM.f90 0 → 100644
+ 121
− 0
View file @ f0cca80a
module carbon_model_inmcm
!< @brief модель углеродного цикла inmcm
! интерфейс
! ---------------------------------------------------------------------------------
use carbon_model_to_core, only : set_tiles, set_pool, set_flux, set_mult
use carbon_model_inmcm_aux
implicit none
private
public :: carbon_model_assembly
contains
! внешние процедуры
! ---------------------------------------------------------------------------------
subroutine carbon_model_assembly()
use const, only : yrs, umol2kg, Kelvin0
use grid, only : ms, dt, area
use environment_core, only : Temp, Tsoil
use environment_model_inmcm, only : nv2, vegg_nv2, weight, tlai, elai, fsun, fsha
integer :: n_Catm, n_Cveg, n_Csoil, n_Csoilb !< id пулов
integer :: n_F !< id потока
call set_tiles(nv2, vegg_nv2)
call set_pool(pid = n_Catm, name = 'catm')
call set_pool(pid = n_Cveg, name = 'cveg', alias = Cveg)
call set_pool(pid = n_Csoil, name = 'csoil', alias = Csoil)
call set_pool(pid = n_Csoilb, name = 'csoilb', alias = Csoilb)
call set_flux(fid = n_F, pid_out = n_Catm, pid_in = n_Cveg, name = 'fpsn_sun', alias = Fpsn_sun)
call set_mult(n_F, 'lin', x_n = psnsun, k = umol2kg)
call set_mult(n_F, 'lin', x_n = laisun)
call set_mult(n_F, 'lin', x_n = weight)
call set_mult(n_F, 'lin', x_n = amndf)
call set_flux(fid = n_F, pid_out = n_Catm, pid_in = n_Cveg, name = 'fpsn_sha', alias = Fpsn_sha)
call set_mult(n_F, 'lin', x_n = psnsha, k = umol2kg)
call set_mult(n_F, 'lin', x_n = laisha)
call set_mult(n_F, 'lin', x_n = weight)
call set_mult(n_F, 'lin', x_n = amndf)
call set_flux(fid = n_F, pid_out = n_Cveg, pid_in = n_Catm, name = 'frg_sun', alias = Frg_sun)
call set_mult(n_F, 'lin', x_ijn = Fpsn_sun, k = 0.25)
call set_flux(fid = n_F, pid_out = n_Cveg, pid_in = n_Catm, name = 'frg_sha', alias = Frg_sha)
call set_mult(n_F, 'lin', x_ijn = Fpsn_sha, k = 0.25)
call set_flux(fid = n_F, pid_out = n_Cveg, pid_in = n_Catm, name = 'frmf', alias = Frmf)
call set_mult(n_F, 'lin', x_n = tlai)
call set_mult(n_F, 'lin', x_n = weight)
call set_mult(n_F, 'const', c_n = rmf25(:) * umol2kg)
call set_mult(n_F, 'exp', x_ij = Temp, a_n = arm(:), k = 0.1, x0 = t_ref)
call set_mult(n_F, 'step', x_ij = Temp, x0_n = tmin(:), k = 0.5, y0 = 0.5)
call set_mult(n_F, 'lin', x_n = btran)
call set_mult(n_F, 'const', c_n = min(1.,foln(:)/folnmx(:)))
call set_mult(n_F, 'lin', x_n = amndf)
call set_flux(fid = n_F, pid_out = n_Cveg, pid_in = n_Catm, name = 'frms', alias = Frms)
call set_mult(n_F, 'lin', x_ijn = Cveg, k_n = vegStemFrac(:))
call set_mult(n_F, 'const', c_n = rms25(:) * umol2kg)
call set_mult(n_F, 'exp', x_ij = Temp, a_n = arm(:), k = 0.1, x0 = t_ref)
call set_mult(n_F, 'step', x_ij = Temp, x0_n = tmin(:), k = 0.5, y0 = 0.5)
call set_mult(n_F, 'const', c = 0.35)
call set_mult(n_F, 'lin', x_n = amndf)
call set_flux(fid = n_F, pid_out = n_Cveg, pid_in = n_Catm, name = 'frmr', alias = Frmr)
call set_mult(n_F, 'lin', x_ijn = Cveg, k_n = vegRootFrac(:))
call set_mult(n_F, 'const', c_n = rmr25(:) * umol2kg)
call set_mult(n_F, 'exp', x_ij = Temp, a_n = arm(:), k = 0.1, x0 = t_ref)
call set_mult(n_F, 'step', x_ij = Temp, x0_n = tmin(:), k = 0.5, y0 = 0.5)
call set_mult(n_F, 'const', c = 0.35)
call set_mult(n_F, 'lin', x_n = amndf)
call set_flux(fid = n_F, pid_out = n_Csoil, pid_in = n_Catm, name = 'fmicr', alias = Fmicr)
call set_mult(n_F, 'lin', x_ijn = Csoil)
call set_mult(n_F, 'const', c_n = amrp(:) * umol2kg)
call set_mult(n_F, 'exp', x_ij = Tsoil(:,:,ms+1), a = 2., k = 0.1, x0 = t_ref)
call set_mult(n_F, 'step', x_ij = Tsoil(:,:,ms+1), x0 = tmin_soil, k = 0.5, y0 = 0.5)
call set_mult(n_F, 'mm', x_n = rsw, k = 1., x0 = -0.20)
call set_mult(n_F, 'hyp', x_n = rsw, k = 0.23, x0 = -0.23)
call set_mult(n_F, 'const', c = 1.5)
call set_flux(fid = n_F, pid_out = n_Csoilb, pid_in = n_Catm, name = 'fmicrb', alias = Fmicrb)
call set_mult(n_F, 'lin', x_ijn = Csoilb)
call set_mult(n_F, 'const', c_n = amrp(:) * umol2kg)
call set_mult(n_F, 'exp', x_ij = Tsoil(:,:,ms+1), a = 2., k = 0.1, x0 = t_ref)
call set_mult(n_F, 'step', x_ij = Tsoil(:,:,ms+1), x0 = tmin_soil, k = 0.5, y0 = 0.5)
call set_mult(n_F, 'mm', x_n = rsw, k = 1., x0 = -0.20)
call set_mult(n_F, 'hyp', x_n = rsw, k = 0.23, x0 = -0.23)
call set_mult(n_F, 'const', c = 1.5)
call set_mult(n_F, 'const', c = cv81b)
call set_flux(fid = n_F, pid_out = n_Cveg, pid_in = n_Csoil, name = 'dv68', alias = Flit)
call set_mult(n_F, 'lin', x_ijn = Cveg, k_n = 1./(al5(:)*yrs))
! call set_flux(fid = n_F, pid_out = n_Cveg, pid_in = n_Csoilb, name = 'ddc6a', alias = FdfrA)
! call set_mult(n_F, 'lin', x_ijn = Cveg, k_ij = landuseCutFrac(:,:)/yrs)
call set_flux(fid = n_F, pid_out = n_Cveg, pid_in = n_Csoilb, name = 'ddc6a', alias = FdfrA)
call set_mult(n_F, 'lin', x_ijn = dfr_weight, k = landuseDfrA)
call set_flux(fid = n_F, pid_out = n_Cveg, pid_in = n_Csoilb, name = 'ddc6b', alias = FdfrB)
call set_mult(n_F, 'lin', x_ijn = dfr_weight, k = landuseDfrB)
call set_flux(fid = n_F, pid_out = n_Csoil, pid_in = n_Csoilb, name = 'ddc8', alias = Fers)
call set_mult(n_F, 'lin', x_ijn = ers_weight, k = landuseErs)
end subroutine carbon_model_assembly
end module
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment