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

Clieaning the INMCM_aux.f90

parent 8917e209
No related branches found
No related tags found
No related merge requests found
......@@ -35,10 +35,10 @@ obs_data_path = 'data/obs_data_Rostov.csv'
#'results/common.txt'
#]
#if carbon_model_type = INMCM
pools = {'Csoil' : 'Почва',
'Csoilb': 'Почва типа b',}
'Csoilb': 'Почва типа b'
}
#elif carbon_model_type = ROTHC
#pools = {'CDPM': 'Разлагаемый растительный материал',
# 'CRPM': 'Устойчивый растительный материал',
......
......@@ -59,9 +59,6 @@ contains
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 = lambd)
!call set_mult(n_F, 'lin', x_ijn = Cveg, k_n = 1./(al5(:)*yrs))
!call set_mult(n_F, 'const', c = 0.212/yrs)
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)
......
......@@ -3,7 +3,7 @@ module carbon_model_inmcm_aux
! интерфейс
! -------------------------------------------------------------------------------------------------------------------
use const, only : pi, r_earth, yrs
use const, only : pi, yrs
use environment_model_inmcm, only : nv2
use environment_core, only : Tsoil, Temp, Wsoil, Isoil
use carbon_model_to_core_arg_kit, only : year_min, year_max, nmonth
......@@ -15,8 +15,8 @@ module carbon_model_inmcm_aux
! Интерфейс
! -------------------------------------------------------------------------------------------------------------------
! ------- Station of observation ------
character(len=10) :: station = 'Rostov' !< Станция наблюдения за климатом ! Нужно указать название
character(len=2) :: opt = '3' !< Имя варианта подачи удобрения ! Нужно указать номер
character(len=10) :: station = 'Rostov' !< Станция наблюдения за климатом !!! Нужно указать название !!!
character(len=2) :: opt = '1' !< Имя варианта подачи удобрения !!! Нужно указать номер !!!
! ------- Serve value -------
integer, parameter :: mnc = (year_max - year_min + 1)*nmonth !Как часть параметров для задания климатических данных
......@@ -25,7 +25,6 @@ module carbon_model_inmcm_aux
! -------------------------------------------------------------------------------------------------------------------
! Main part of INMCM
! ---- Pools ----
real, dimension(:,:,:), pointer :: Catm !< атмосфера
real, dimension(:,:,:), pointer :: Cveg !< растительность
......@@ -35,50 +34,29 @@ module carbon_model_inmcm_aux
real, dimension(:,:,:), pointer :: Fmicr !< микробное дыхание
real, dimension(:,:,:), pointer :: Fmicrb !< микробное дыхание b
real, dimension(:,:,:), pointer :: Flit !< отмирание растений
!real, dimension(:,:,:), pointer :: FdfrA !< обезлесивание тип A
!real, dimension(:,:,:), pointer :: FdfrB !< обезлесивание тип B
real, dimension(:,:,:), pointer :: Fers !< почвенная эрозия
! ---- Constant from main program INMCM ----
!real, parameter :: rmf25(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(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(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(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(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 :: tmin(nv2) = (/ 5., 0., -2.5, -5., -5., 5., 0., -5., 0., 0., 0., 0., 0. /) ! minimum temperature for photosynthesis, [C]
real, parameter :: tmin_soil = 0. ! эквивалент label='fst'
real, parameter :: t_ref = 25. ! референсная температура для величин типа rmf25, kc25 и тд [C]
real, parameter :: t_ref_soil = 10.! референсная температура для величин типа Ts [C]
!real, parameter :: al5(nv2) = (/8.,30.,30.,30.,30.,20.,1.,30.,30.,30.,1.,30.,1./)
!real, parameter :: foln(nv2) = 2. !< foliage nitrogen concentration, [%]
!real, parameter :: folnmx(nv2) = 1.5 !< foliage nitrogen concentration when f(n)=1, [%]
!real, parameter :: arm(nv2) = 2. !< q10 for maintenance respiration
!real, parameter :: stemb(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(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 :: vegStemFrac(nv2) = (/0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.0, 0.0, 0.0, 0.2, 0.2, 0.0, 0.0/)
!real, parameter :: vegRootFrac(nv2) = (/0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.0, 0.0, 0.0, 0.8, 0.8, 0.0, 0.0/)
real, parameter :: tmin_soil = 0. !< эквивалент label='fst'
real, parameter :: t_ref = 25. !< референсная температура для величин типа rmf25, kc25 и тд [C]
real, parameter :: t_ref_soil = 10. !< референсная температура для величин типа Ts [C]
real, parameter :: hint = 100. !< Depth above which the total (rswa) and average (rsw) soil moisture is calculated,! в модели изначально 200.
real, parameter :: cv81b = 50. !< Decomposition time, [year]
!real, parameter :: mpe = 0.000001 !< Prevents division by zero errors, [dimensionless]
! ---- Landuse ----
real, parameter :: gt2year_to_kg2m2s = 1.e+12 / (4.*pi*r_earth**2 * yrs)
real, parameter :: defor0 = 1. * gt2year_to_kg2m2s
!real, parameter :: defor1861 = 0.54 * gt2year_to_kg2m2s
real, parameter :: gt2year_to_kg2s = 1.e+12 / yrs
real, parameter :: defor0 = 1. * gt2year_to_kg2s
real, parameter :: adefr = 0.6 !< deforest/(deforest+soil erosion)
!real, parameter :: defr(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(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(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 :: landuseTot, landuseDfrA, landuseDfrB, landuseErs !< замена переменных для defor
real, allocatable, target :: dfr_weight(:,:,:), ers_weight(:,:,:) !< пространственные веса
real :: conversion_defor_global_to_regional
! ---- Динамические переменные (from inmcm) ----
real, target :: rsw(nv2), btran(nv2)
!real, target :: amndf(nv2) = 1.25
!integer, parameter :: nadm = 99
!real, allocatable :: admAreaFrac(:,:,:)
!real, allocatable :: landuseCutArea(:,:)
!real, allocatable :: admForestArea(:)
!real, allocatable :: landuseCutFrac(:,:)
! ------ Climate variables --------
real :: in_temp(0:mnc) !< Поступление извне данных cредней температуры почвы в месяц, [Celsius]
......@@ -91,17 +69,18 @@ contains
subroutine carbon_model_init()
! ---- Part of INMCM carbon_model_init() ----
use grid, only : i0, i1, j0, j1, mask, area, date_c
!use environment_model_inmcm, only : vegg_nv2
!use netcdf
!use netcdf_kit, only : nc_errhand
!use paths, only : path_inmcm_data
use grid, only : i0, i1, j0, j1, mask, area, date_c, dlon, dlat, nlon, nlat, ich
use netcdf
use netcdf_kit, only : nc_errhand
use paths, only : path_inmcm_data
integer :: i, j, n, na !< count
!integer :: ncid, varid
!real :: fill_v
integer :: ncid, varid
real, allocatable, dimension(:,:,:) :: cveg_global, csoil_global
real :: sc6_global, sc6_regional
real :: sc8_global, sc8_regional
!allocate(dfr_weight(i0:i1,j0:j1,nv2))
allocate(ers_weight(i0:i1,j0:j1,nv2))
! ---- Part of enviromental carbon_model_init() ----
......@@ -132,59 +111,59 @@ contains
! ---- Part of inmcm carbon_model_init() ----
! ---- Variables from INMCM ----
!landuseTot = landuseDfrA + landuseDfrB + landuseErs:
!landuseTot = defor0
!landuseDfrA = adefr * min(defor0,defor1861)
!landuseDfrB = adefr * (defor0 - min(defor0,defor1861))
landuseErs = (1. - adefr) * defor0
!allocate(admAreaFrac(720,360,nadm))
!call nc_errhand( nf90_open(path_inmcm_data//'admAreaFrac_NED_grid05x05.nc', nf90_nowrite, ncid) )
!call nc_errhand( nf90_inq_varid(ncid, 'admAreaFrac', varid) )
!call nc_errhand( nf90_get_att(ncid, varid, '_FillValue', fill_v) )
!call nc_errhand( nf90_get_var(ncid, varid, admAreaFrac(:,:,:), (/1,1,1/), (/720,360,nadm/)) )
!call nc_errhand( nf90_close(ncid) )
!where (admAreaFrac == fill_v) admAreaFrac = 0.
!allocate(landuseCutArea(9,nadm))
!call nc_errhand( nf90_open(path_inmcm_data//'landuseCutArea_Rosleshoz_adminlist.nc', nf90_nowrite, ncid) )
!call nc_errhand( nf90_inq_varid(ncid, 'landuseCutArea', varid) )
!call nc_errhand( nf90_get_att(ncid, varid, '_FillValue', fill_v) )
!call nc_errhand( nf90_get_var(ncid, varid, landuseCutArea(:,:), (/1,1/), (/9,nadm/)) )
!call nc_errhand( nf90_close(ncid) )
!where (landuseCutArea == fill_v) landuseCutArea = 0.
!allocate(admForestArea(nadm))
!admForestArea(:) = 0.
!do i = i0, i1
! do j = j0, j1
! if (mask(i,j) == 1) then
! do na = 1, nadm
! if (admAreaFrac(i-1,j-1,na) > 0.) then
! do n = 1, 5
! if (vegg_nv2(i,j,n) > 0.) then
! admForestArea(na) = admForestArea(na) + area(i,j) * vegg_nv2(i,j,n)/100. * admAreaFrac(i-1,j-1,na)/100.
! endif
! enddo
! endif
! enddo
! endif
! enddo
!enddo
!allocate(landuseCutFrac(i0:i1,j0:j1))
!landuseCutFrac(:,:) = 0.
!do j = j0, j1
! do i = i0, i1
! if (mask(i,j) == 1) then
! do na = 1, nadm
! if (admAreaFrac(i-1,j-1,na) > 0. .and. admForestArea(na) > 0.) then
! landuseCutFrac(i,j) = landuseCutFrac(i,j) + sum(landuseCutArea(:,na))/9. / admForestArea(na) * admAreaFrac(i-1,j-1,na)/100.
! endif
! enddo
! endif
! enddo
!enddo
if (dlon == 0.5 .and. dlat == 0.5) then
allocate(cveg_global(nlon,nlat,nv2))
allocate(csoil_global(nlon,nlat,nv2))
call nc_errhand( nf90_open(path_inmcm_data//'control_point_for_carbon_pools.nc', nf90_nowrite, ncid) )
call nc_errhand( nf90_inq_varid(ncid, 'cveg', varid) )
call nc_errhand( nf90_get_var(ncid, varid, cveg_global(:,:,:), (/1,1,1/), (/nlon,nlat,nv2/)) )
call nc_errhand( nf90_inq_varid(ncid, 'csoil', varid) )
call nc_errhand( nf90_get_var(ncid, varid, csoil_global(:,:,:), (/1,1,1/), (/nlon,nlat,nv2/)) )
call nc_errhand( nf90_close(ncid) )
sc6_global = 0.
sc8_global = 0.
do j = 1, nlat ! sum for the whole globe
do i = 1, nlon
if (ich(i,j) /= 0) then
do n = 1, nv2
sc6_global = sc6_global + cveg_global(i,j,n)*defr(n)*area(i,j)
sc8_global = sc8_global + csoil_global(i,j,n)*soer(n)*area(i,j)
enddo
endif
enddo
enddo
if (sc6_global > 0. .and. sc8_global > 0.) then
sc6_regional = 0.
sc8_regional = 0.
do j = j0, j1 ! sum for the regional simulation domain
do i = i0, i1
if (ich(i,j) /= 0) then
do n = 1, nv2
sc6_regional = sc6_regional + cveg_global(i,j,n)*defr(n)*area(i,j)
sc8_regional = sc8_regional + csoil_global(i,j,n)*soer(n)*area(i,j)
enddo
endif
enddo
enddo
conversion_defor_global_to_regional = adefr * sc6_regional/sc6_global + &
& (1.-adefr) * sc8_regional/sc8_global
else
conversion_defor_global_to_regional = 1.
endif
deallocate(cveg_global)
deallocate(csoil_global)
else
conversion_defor_global_to_regional = 1.
endif
landuseErs = (1. - adefr) * defor0 * conversion_defor_global_to_regional
end subroutine
......@@ -195,18 +174,27 @@ contains
use grid, only : i0, i1, j0, j1, area
integer :: ii, jj, n
real :: sc8
sc8 = 0.
do ii = i0, i1
do jj = j0, j1
do n = 1, nv2
!dfr_weight(ii,jj,n) = Cveg(ii,jj,n) * defr(n) * area(ii,jj)
ers_weight(ii,jj,n) = Csoil(ii,jj,n) * soer(n) * area(ii,jj)
sc8 = sc8 + Csoil(ii,jj,n) * soer(n) * area(ii,jj)
end do
end do
end do
!if (sum(dfr_weight) /= 0.) dfr_weight(:,:,:) = dfr_weight(:,:,:) / sum(dfr_weight)
if (sum(ers_weight) /= 0.) ers_weight(:,:,:) = ers_weight(:,:,:) / sum(ers_weight)
ers_weight(:,:,:) = 0.
if (sc8 > 0) then
do ii = i0, i1
do jj = j0, j1
do n = 1, nv2
ers_weight(ii,jj,n) = Csoil(ii,jj,n) * soer(n) / sc8
end do
end do
end do
end if
end subroutine
......
......@@ -13,8 +13,6 @@ implicit none
character(len=2) :: opt = '2' !< Имя варианта подачи удобрения ! Нужно указать номер
! ------- Serve value -------
! integer :: year_min = date_fst%y
! integer :: year_max = date_lst%y
integer, parameter :: mnc = (year_max - year_min + 1)*nmonth !Как часть параметров для задания климатических данных
!< Колличество месяцев в расчете
integer :: k !< Номер месяца с начала работы программы !Как часть параметров для шага по времени
......@@ -199,9 +197,9 @@ contains
Rs = RDPM + RRPM + RBIO + RHUM
print*, 'date_fst, ', date_fst%y
print*, 'date_lst, ', date_lst%y
!print*, 'important thing 3, ', j
!print*, 'date_fst, ', date_fst%y
!print*, 'date_lst, ', date_lst%y
!print*, 'timestamp_fst, ', timestamp_fst
!print*, 'important thing 4, ', Temp(k)
end subroutine
......
......@@ -321,19 +321,19 @@ contains
j1 = j1_nc
end select
allocate(lon(i0:i1))
do i = i0, i1
allocate(lon(nlon))
do i = 1, nlon
lon(i) = lon_ref + (i-1)*dlon
enddo
allocate(lat(j0:j1))
do j = j0, j1
allocate(lat(nlat))
do j = 1, nlat
lat(j) = lat_ref + (j-1)*dlat
enddo
allocate(area(i0:i1,j0:j1))
do j = j0, j1
do i = i0, i1
allocate(area(nlon,nlat))
do j = 1, nlat
do i = 1, nlon
area(i,j) = r_earth*abs(dlat)*deg2rad * r_earth*cos(lat(j)*deg2rad)*abs(dlon)*deg2rad
enddo
enddo
......
......@@ -63,7 +63,9 @@
! 'ich' - ячейка по индексу OLIM
ich = 46967 ! Федоровское, 05x05
! 'point' - ячейка по координатам [lon, lat]
point(:) = 32.75, 56.25 ! Федоровское
! point(:) = 32.75, 56.25 ! Федоровское
point(:) = 39.888735, 47.364103 ! ФАНЦ (Ростов)
! point(:) = 37.535197, 55.942416 ! ДАОС (Долгопрудный)
! 'polygon' - область по координатам [lon_west, lon_east, lat_south, lat_north]
polygon(:) = 26.25, 69.75, 50.75, 69.75 ! лесная зона ЕТР
! (для lsm_offline) 'all' - вся область nectdf-файла
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment