Skip to content
Snippets Groups Projects

Compare revisions

Changes are shown as if the source revision was being merged into the target revision. Learn more about comparing revisions.

Source

Select target project
No results found

Target

Select target project
  • foresee/4C
  • gutsch/4C
2 results
Show changes
Hide whitespace changes
Inline Side-by-side
Showing
with 5484 additions and 0 deletions
source_code/version_2.3_windows/amod_clim.f 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* 4C (FORESEE) Simulation Model *!
!* *!
!* climate data modules *!
!* *!
!* containes: *!
!* DATA_CLIMATE *!
!* DATA_EVAPO *!
!* DATA_INTER *!
!* DATA_DEPO *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
module data_climate
! flag defines structure of climate data file
integer :: flag_climtyp = 0
integer :: i_exit ! day number of first missing data record
integer,allocatable,save,dimension(:) :: recs,yy
integer,allocatable,save,dimension(:,:) :: dd,mm
real,allocatable,save,dimension(:,:) :: tp,hm,prc,prs,rd,wd, tx, tn,vp, sdu,bw, sde
real,allocatable,save,dimension(:) :: tpmean
real :: airtemp = -99., & ! air temperature (°C)
airtemp_1 = -99., & ! air temperature of previous day (°C)
airtemp_2 = -99., & ! air temperature of two days before (°C)
airtemp_max = -99., & ! maximum air temperature (°C)
airtemp_min = -99., & ! minimum air temperature (°C)
hum = -99., & ! humidity (%)
prec = -99., & ! precipitation (mm)
press = -99., & ! pressure (hPa)
rad = -99., & ! solar radiation(J/cm2)
rad_max = -99., & ! maximal solar radiation(J/cm2)
wind = -99., & ! wind velocity (m/s)
rnet_tot = -99., & ! total net radiation(J/cm2)
avg_incl , & ! average sun inclination [degrees]
beta , & ! average sun inclination [radians]
dlength = -99., & ! day length == Photoperiode (h)
dptemp = -99., & ! dew point temperature
co2 = -99. ! atmospheric CO2 content (mol/mol)
integer :: flag_vegper = 0 ! indicates vegetation period described by temeprature > 10°C
integer :: flag_tveg = 0
integer :: iday_vegper = 0
! cumulative and mean values per year
real :: med_air ! yearly mean air temperature
real :: med_air_ms ! average temperature May - September
real :: med_air_mj ! avarage temperature May - July
real :: sum_prec ! yearly precipitation sum
real :: sum_prec_ms ! precipitation sum May - September
real :: sum_prec_mj ! precipitation sum may - July
real :: med_air_wm ! average temperature of the warmest month
real :: med_air_cm ! average temperature of the coldest month
real :: med_rad
real :: med_rad1 ! annual mean of daily solar radiation of the first year of simulation
real :: med_wind
real :: gdday ! annual growing degree day
! values per month
real, dimension(12) :: temp_mon ! mean monthly average air temperature (°C)
real, dimension(12) :: prec_mon ! mean monthly precipitation sum (mm)
real, dimension(12) :: rad_mon ! mean monthly average of daily radiation (J/cm2)
real, dimension(12) :: hum_mon ! mean monthly average daily relative humidity (%)
real :: aet_dec ! sum of AET of last december (mm)
real :: temp_dec ! mean average air temperature of last december (°C)
real :: prec_dec ! precipitation sum of last december (mm)
real :: rad_dec ! mean average of daily radiation of last december (J/cm2)
real :: hum_dec ! mean average of daily relative humidity of last december (%)
! values per week
real, dimension(53) :: temp_week ! mean monthly average air temperature (°C)
real, dimension(53) :: prec_week ! mean monthly precipitation sum (mm)
! for calculation of long-term monthly means
real, dimension(12) :: tempmean_mo ! long-term monthly means
real, dimension(12) :: tempmean_mo_a ! annual monthly means
integer :: days_summer = -99, & ! number of summer days (Tmax > 25°C)
days_hot = -99, & ! number of hot days (Tmax > 30°C)
days_ice = -99, & ! number of ice days (Tmax < 0°C)
days_dry = -99, & ! number of days without precipitation
days_hrain = -99, & ! number of days with heavy rain (> 10mm)
days_snow = -99, & ! number of days with snow (4C simulation)
days_rain = -99, & ! number of days with rain > 0.1 mm
days_rain_mj = -99, & ! number of days with rain > 0.1 mm May - July
days_wof = -99 ! number of days without frost Tmin > 0°C
! total mean values
real :: med_air_all ! overall yearly mean air temperature
real :: sum_prec_all ! overall mean yearly precipitation sum
real :: med_rad_all ! overall mean annual radiation
real :: gdday_all ! overlall mean annual growing degree day
! monthly climate indices
real :: ind_cout_mo ! monthly index Coutange
real :: ind_wiss_mo ! monthly index v. Wissmann
real :: ind_arid_mo ! monthly Index UNEP
real :: cwb_mo ! monthly climate water balance
! annual climate indices
real :: ind_arid_an ! annual aridity index UNEP
real :: cwb_an ! annual climate water balance
real :: ind_lang_an ! annual climate index acc. Linsser/Lang
real :: ind_cout_an ! annual index Coutange
real :: ind_wiss_an ! annual index v. Wissmann
real :: ind_mart_an ! annual index Martonne
real :: ind_mart_vp ! annual index martonne vegetation period (May- Sept.)
real :: ind_emb ! annual index Emberger
real :: ind_weck ! annual index Weck
real :: ind_reich ! annual index Reichel
real :: con_gor ! annual continentality index Gorczynski
real :: con_cur ! annual continentality index Currey
real :: con_con ! annual continentality index Conrad
real :: ind_bud ! annual dryness index Budyko
real :: ind_shc ! annual index Seljaninov
real :: cwb_an_m ! mean annual climate water balance of simulation period
! mean annual climate inidces of the simulation period
real :: ind_arid_an_m ! annual aridity index UNEP
real :: ind_lang_an_m ! annual climate index acc. Linsser/Lang
real :: ind_cout_an_m ! annual index Coutange
real :: ind_wiss_an_m ! annual index v. Wissmann
real :: ind_mart_an_m ! annual index Martonne
real :: ind_mart_vp_m ! annual index martonne vegetation perio (May- Sept.)
real :: ind_emb_m ! annual index Emberger
real :: ind_weck_m ! annual index Weck
real :: ind_reich_m ! annual index Reichel
real :: con_gor_m ! annual continentality index Gorczynski
real :: con_cur_m ! annual continentality index Currey
real :: con_con_m ! annual continentality index Conrad
real :: ind_bud_m ! annual dryness index Budyko
real :: ind_shc_m ! annual index Seljaninov
! values for evaluation of npp module
real,allocatable,save,dimension(:) :: tempfield
real,allocatable,save,dimension(:) :: globfield
real,allocatable,save,dimension(:) :: dayfield
real, dimension(5) :: clim_waterb = 0. ! climatic water balance (fire_risk)
! Mauna Loa CO2 time series, annual means
REAL :: year_CO2 = 2016
REAL :: Mauna_Loa_CO2(1959:2016) ! time series of annual mean CO2 measured at Mauna Loa, Hawaii
Real :: RCP_2p6(1765:2300)
Real :: RCP_6p0(1765:2150)
DATA Mauna_Loa_CO2 /0.00031598, 0.00031691, 0.00031765, 0.00031845, 0.00031899, &
0.00031952, 0.00032003, 0.00032137, 0.00032218, 0.00032305, &
0.00032462, 0.00032568, 0.00032632, 0.00032746, 0.00032968, &
0.00033025, 0.00033115, 0.00033215, 0.0003339, 0.0003355, &
0.00033685, 0.00033869, 0.00033993, 0.00034113, 0.00034278, &
0.00034442, 0.0003459, 0.00034715, 0.00034893, 0.00035148, &
0.00035291, 0.00035419, 0.00035559, 0.00035637, 0.00035704, &
0.00035888, 0.00036088, 0.00036264, 0.00036376, 0.00036663, &
0.00036831, 0.00036948, 0.00037102, 0.0003731, 0.00037564, &
0.00037738, 0.00037975, 0.00038185, 0.00038372, 0.00038557, &
0.00038738, 0.00038985, 0.00039163, 0.00039382, 0.00039648, &
0.00039861, 0.00040083, 0.00040421/
DATA RCP_2p6/278.05,278.11,278.22,278.34,278.47,278.60,278.73,278.87,279.01,279.15,279.30,279.46,279.62,279.78,279.94,280.10,280.24,280.38,280.52,280.66,&
280.80,280.96,281.12,281.28,281.44,281.60,281.75,281.89,282.03,282.17,282.30,282.43,282.55,282.67,282.79,282.90,283.01,283.11,283.21,283.31,283.40,283.49,&
283.58,283.66,283.74,283.80,283.85,283.89,283.93,283.96,284.00,284.04,284.09,284.13,284.17,284.20,284.22,284.24,284.26,284.28,284.30,284.32,284.34,284.36,&
284.38,284.40,284.39,284.28,284.13,283.98,283.83,283.68,283.53,283.43,283.40,283.40,283.43,283.50,283.60,283.73,283.90,284.08,284.23,284.40,284.58,284.73,&
284.88,285.00,285.13,285.28,285.43,285.58,285.73,285.90,286.08,286.23,286.38,286.50,286.63,286.78,286.90,287.00,287.10,287.23,287.38,287.53,287.70,287.90,&
288.13,288.40,288.70,289.03,289.40,289.80,290.23,290.70,291.20,291.68,292.13,292.58,292.98,293.30,293.58,293.80,294.00,294.18,294.33,294.48,294.60,294.70,&
294.80,294.90,295.03,295.23,295.50,295.80,296.13,296.48,296.83,297.20,297.63,298.08,298.50,298.90,299.30,299.70,300.08,300.43,300.78,301.10,301.40,301.73,&
302.08,302.40,302.70,303.03,303.40,303.78,304.13,304.53,304.98,305.40,305.83,306.30,306.78,307.23,307.70,308.18,308.60,309.00,309.40,309.75,310.00,310.18,&
310.30,310.38,310.38,310.30,310.20,310.13,310.10,310.13,310.20,310.33,310.50,310.75,311.10,311.50,311.93,312.43,313.00,313.60,314.23,314.85,315.50,316.27,&
317.08,317.80,318.40,318.93,319.65,320.65,321.61,322.64,323.90,324.99,325.86,327.14,328.68,329.74,330.59,331.75,333.27,334.85,336.53,338.36,339.73,340.79,&
342.20,343.78,345.28,346.80,348.65,350.74,352.49,353.86,355.02,355.89,356.78,358.13,359.84,361.46,363.16,365.32,367.35,368.87,370.47,372.52,374.76,376.81,&
378.81,380.83,382.78,384.80,387.00,389.29,391.56,393.84,396.12,398.40,400.68,402.97,405.25,407.53,409.80,412.07,414.33,416.52,418.60,420.60,422.52,424.35,&
426.10,427.75,429.31,430.78,432.16,433.44,434.59,435.65,436.63,437.52,438.33,439.06,439.69,440.22,440.66,441.02,441.35,441.62,441.86,442.08,442.28,442.46,&
442.60,442.70,442.75,442.76,442.73,442.66,442.55,442.41,442.25,442.08,441.89,441.67,441.42,441.13,440.80,440.43,440.01,439.54,439.05,438.54,438.02,437.48,&
436.92,436.34,435.76,435.18,434.60,434.00,433.38,432.78,432.19,431.62,431.06,430.51,429.96,429.41,428.86,428.30,427.73,427.14,426.57,426.00,425.46,424.94,&
424.43,423.93,423.43,422.93,422.43,421.92,421.40,420.90,420.41,419.95,419.50,419.06,418.62,418.17,417.71,417.25,416.77,416.28,415.80,415.32,414.87,414.42,&
413.99,413.55,413.10,412.64,412.17,411.69,411.19,410.70,410.22,409.76,409.31,408.86,408.42,407.97,407.52,407.07,406.61,406.15,405.69,405.26,404.84,404.45,&
404.07,403.68,403.29,402.90,402.51,402.10,401.69,401.28,400.89,400.53,400.17,399.83,399.49,399.14,398.79,398.43,398.06,397.68,397.31,396.96,396.62,396.30,&
395.99,395.68,395.36,395.03,394.70,394.36,394.00,393.66,393.33,393.02,392.72,392.44,392.14,391.85,391.54,391.23,390.91,390.58,390.26,389.95,389.65,389.38,&
389.11,388.83,388.55,388.27,387.97,387.67,387.35,387.05,386.75,386.48,386.21,385.96,385.70,385.44,385.16,384.88,384.59,384.29,384.00,383.72,383.45,383.20,&
382.96,382.72,382.46,382.20,381.93,381.66,381.37,381.08,380.81,380.56,380.32,380.09,379.86,379.61,379.36,379.11,378.84,378.56,378.29,378.03,377.78,377.56, &
377.33,377.11,376.87,376.63,376.38,376.12,375.85,375.59,375.34,375.11,374.89,374.67,374.45,374.23,373.99,373.75,373.50,373.24,372.98,372.74,372.52,372.30,&
372.10,371.89,371.67,371.44,371.21,370.96,370.71,370.46,370.23,370.01,369.80,369.60,369.40,369.19,368.97,368.74,368.50,368.26,368.02,367.79,367.58,367.38,&
367.18,366.98,366.78,366.57,366.35,366.11,365.87,365.64,365.42,365.21,365.02,364.83,364.64,364.44,364.23,364.02,363.79,363.55,363.32,363.11,362.91,362.72,&
362.54,362.35,362.16,361.95,361.75,361.52,361.29,361.07,360.86,360.67/
DATA RCP_6p0/ 278.05,278.11,278.22,278.34,278.47,278.60,278.73,278.87,279.01,279.15,279.30,279.46,279.62,279.78,279.94,280.10,280.24,280.38,280.52,280.66,&
280.80,280.96,281.12,281.28,281.44,281.60,281.75,281.89,282.03,282.17,282.30,282.43,282.55,282.67,282.79,282.90,283.01,283.11,283.21,283.31,283.40,283.49,&
283.58,283.66,283.74,283.80,283.85,283.89,283.93,283.96,284.00,284.04,284.09,284.13,284.17,284.20,284.22,284.24,284.26,284.28,284.30,284.32,284.34,284.36,&
284.38,284.40,284.39,284.28,284.13,283.98,283.83,283.68,283.53,283.43,283.40,283.40,283.43,283.50,283.60,283.73,283.90,284.08,284.23,284.40,284.58,284.73,&
284.88,285.00,285.13,285.28,285.43,285.58,285.73,285.90,286.08,286.23,286.38,286.50,286.63,286.78,286.90,287.00,287.10,287.23,287.38,287.53,287.70,287.90,&
288.13,288.40,288.70,289.03,289.40,289.80,290.23,290.70,291.20,291.68,292.13,292.58,292.98,293.30,293.58,293.80,294.00,294.18,294.33,294.48,294.60,294.70,&
294.80,294.90,295.03,295.23,295.50,295.80,296.13,296.48,296.83,297.20,297.63,298.08,298.50,298.90,299.30,299.70,300.08,300.43,300.78,301.10,301.40,301.73,&
302.08,302.40,302.70,303.03,303.40,303.78,304.13,304.53,304.98,305.40,305.83,306.30,306.78,307.23,307.70,308.18,308.60,309.00,309.40,309.75,310.00,310.18,&
310.30,310.38,310.38,310.30,310.20,310.13,310.10,310.13,310.20,310.33,310.50,310.75,311.10,311.50,311.93,312.43,313.00,313.60,314.23,314.85,315.50,316.27,&
317.08,317.80,318.40,318.93,319.65,320.65,321.61,322.64,323.90,324.99,325.86,327.14,328.68,329.74,330.59,331.75,333.27,334.85,336.53,338.36,339.73,340.79,&
342.20,343.78,345.28,346.80,348.65,350.74,352.49,353.86,355.02,355.89,356.78,358.13,359.84,361.46,363.16,365.32,367.35,368.87,370.47,372.52,374.76,376.81,&
378.81,380.83,382.78,384.80,386.93,389.07,391.17,393.24,395.30,397.35,399.39,401.42,403.43,405.43,407.40,409.36,411.30,413.22,415.14,417.08,419.04,421.00,&
422.98,424.95,426.92,428.88,430.83,432.81,434.83,436.92,439.07,441.29,443.57,445.90,448.28,450.70,453.15,455.65,458.18,460.76,463.41,466.12,468.91,471.77,&
474.69,477.67,480.70,483.78,486.92,490.10,493.34,496.64,500.02,503.48,507.02,510.63,514.31,518.03,521.80,525.62,529.49,533.40,537.38,541.44,545.59,549.82,&
554.13,558.49,562.87,567.27,571.70,576.15,580.61,585.10,589.65,594.26,598.92,603.54,608.02,612.36,616.57,620.65,624.58,628.38,632.06,635.65,639.14,642.60,&
646.06,649.52,652.95,656.36,659.75,663.11,666.42,669.72,673.02,676.29,679.50,682.65,685.71,688.69,691.59,694.40,697.11,699.73,702.28,704.76,707.20,709.60,&
711.93,714.21,716.40,718.52,720.56,722.51,724.37,726.16,727.90,729.59,731.24,732.85,734.39,735.86,737.26,738.59,739.83,740.99,742.08,743.12,744.13,745.10,&
746.02,746.88,747.68,748.40,749.05,749.62,750.09,750.51,750.87,751.20,751.49,751.74,751.92,752.00 /
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!^
end module data_climate
module data_evapo
! evapotranspiration data
real :: aet = 0. ! daily total actual evapotranspiration / mm
real :: aet_cum = 0. ! yearly total actual evapotranspiration / mm
real :: aet_m = 0. ! mean yearly total actual evapotranspiration / mm
real :: pet = 0. ! daily total potential evapotranspiration / mm
real :: pet_cum = 0. ! yearly total potential evapotranspiration / mm
real :: pet_m = 0. ! mean yearly total potential evapotranspiration / mm
real :: pev_s = 0. ! potential evaporation of soil / mm
real :: pev_sn = 0. ! potential evaporation of snow / mm
real :: dew_rime = 0. ! dew or rime resp. / mm
real :: dew_cum = 0. ! yearly total dew or rime resp. / mm
real :: dew_m = 0. ! mean yearly total dew or rime resp. / mm
real :: trans_dem = 0. ! potential transpiration / mm
real :: trans_tree= 0. ! actual transpiration of trees / mm
real :: trans_sveg= 0. ! actual transpiration of ground vegetation / mm
real :: tra_tr_cum= 0. ! yearly transpiration of trees / mm
real :: tra_sv_cum= 0. ! yearly transpiration of ground vegetation / mm
real :: aev_s = 0. ! actual evaporation of soil / mm
real :: aev_i = 0. ! actual evaporation of intercepted water / mm
real :: demand_mistletoe_cohort = 0. ! helping variable: transfer of mistletoe demand from evapo.f to soil.f
REAL, dimension(12) :: aet_mon ! monthly actual evapotranspiration sum / mm
REAL, dimension(53) :: aet_week ! weekly actual evapotranspiration sum / mm
REAL, dimension(12) :: pet_mon ! monthly potential evapotranspiration sum / mm
REAL, dimension(53) :: pet_week ! weekly potential evapotranspiration sum / mm
real :: Rnet_cum = 0. ! net radiation J/cm²
integer:: unit_eva
end module data_evapo
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
module data_inter
! interception data
real :: interc_can = 0. ! total daily canopy interception / mm
real :: int_st_can = 0. ! canopy interception storage / mm
real :: int_cum_can = 0. ! cumulative canopy interception / mm
real :: interc_m_can = 0. ! mean yearly canopy interception / mm
real :: prec_stand = 0. ! stand precipitation / mm
real :: prec_stand_red= 0. ! reduction of stand precipitation by percentage (drought experiments) / %
real :: interc_sveg = 0. ! total daily interception of ground vegetation / mm
real :: int_st_sveg = 0. ! interception storage of ground vegetation / mm
real :: int_cum_sveg = 0. ! cumulative interception of ground vegetation / mm
real :: interc_m_sveg= 0. ! mean yearly interception of ground vegetation / mm
real :: stem_flow = 0. ! stem flow / mm
logical:: lint_snow = .false. ! interception of snow = .true.
end module data_inter
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
module data_depo
! deposition data
real,allocatable,save,dimension(:,:) :: NHd, NOd ! input fields / mg N/m2
real :: NH_dep = 0. ! deposition of NHx-N / g N/m2
real :: NO_dep = 0. ! deposition of NOx-N / g N/m2
real :: Ndep_cum = 0. ! yearly cumulative deposition / g N/m2
real :: Ndep_cum_all = 0. ! overall mean yearly deposition / g N/m2
end module data_depo
source_code/version_2.3_windows/amod_effect.f 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* 4C (FORESEE) Simulation Model *!
!* *!
!* environmental variables and indices *!
!* *!
!* containes: *!
!* DATA_BIODIV *!
!* DATA_FROST *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
module data_biodiv
! indices of fire and biodiversity
! sum of hot days (Tmax>=25°C) and precipitation sum in the potential fire period
integer :: Ndayshot
real :: Psum_FP
integer :: prec_flag1 = 0 ! flag is equal 1 if first time precipitation of 5 mm occurs after bud burst of birch
integer :: prec_flag2 = 0
real :: ntindex ! temperature index
! fire risk
integer :: fire_indw = -99 ! fire index west
integer :: fd_fire_indw(1:5) = 0 ! frequency distribution of fore index west values
integer :: fire_inde = -99 ! fire index east
integer :: fire_indi_day = 0 ! days with forest fire indicator greater then a threshold (east)
real :: fire_indi = 0.0 ! forest fire indicator (east)
real :: fire_indi_max = 0.0 ! maximum forest fire indicator (east)
real :: fire_indb = -99 ! fire index Bruschek
real :: fire_indb_m = -99 ! mean yearly fire index Bruschek of simulation period
real :: tsumrob ! temperature sum 'Robinie'
real :: day_bb_rob = 0 ! day of budburst 'Robinie'
real :: tsumbi ! temperature sum birch
real :: day_bb_bi = 0 ! day of budburst birch
integer :: day_nest = 0 ! days since the last prec. greater then 3 mm (Nesterov)
real :: p_nest = 0.0 ! ignition index of Nesterov
type fire_risk
integer :: index ! daily fire risk level
integer, dimension (5):: frequ ! frequency of of fire risk levels (5 classes) of a year
real :: mean ! mean fire risk level of a year
real :: mean_m ! mean yearly fire risk level of simulation period
end type fire_risk
type (fire_risk),dimension(3) :: fire ! 1 - fire index west
! 2 - fire index east (M68 international)
! 3 - fire index Nesterov
! upper limit of climatic water balance for fire risk class (west)
real, dimension(4,7) :: risk_class
DATA risk_class &
/ 5., -3., -9., -15., & ! march
3., -8., -16., -27., & ! april
-3., -16., -25., -35., & ! may
-12., -24., -32., -41., & ! june
-12., -24., -31., -40., & ! july
-8., -20., -28., -37., & ! august
-6., -18., -26., -35./ ! september
integer, dimension(38) :: daybb_rob
integer, dimension(38) :: daybb_bi
DATA daybb_bi/100,114,115,113,120,115,111,109,123,124,113,110,119,99,117,117,118,117,120,124,101,117,113,117,112,119,116,112, &
102,92,106,109,109,110,111,112,112,101/
DATA daybb_rob/152,165,156,151,166,148,153,153,160,163,151,161,160,163,159,161,162,158,153,163,153,153,154,159,151,152,166,154, &
147,143,168,145,135,148,151,155,155,138/
end module data_biodiv
module data_frost
integer, allocatable, save, dimension(:) :: dnlf ! number of days with late frost during vegetation period
real, allocatable, save, dimension (:) :: tminmay_ann ! minimum temperature in may
integer, allocatable, save, dimension(:) :: date_lf ! date of last frost after start of vegetation period per year
integer, allocatable, save, dimension(:) :: date_lftot ! annual date of last frost event
integer, allocatable, save, dimension(:) :: anzdlf ! number of days with frost from April until June
integer, allocatable, save, dimension(:) :: sumtlf ! sum of temperature of days with frost from April until June
integer :: dlfabs ! number of day of the last frost for the whole simulation period
real :: tminmay ! minimum temperature of may of the whole simulation period
integer, allocatable, save, dimension(:) :: dnlf_sp ! number of day with late frost during vegetation period
integer :: dlfabs_sp ! number of day of the last frost for the whole simulation period
real :: tminmay_sp ! minimum temperature of may of the whole simulation period
real :: temp_frost = 0. ! temperature threshold of frost
integer :: lfind ! last frost index
real :: mlfind ! mean lfind
integer :: maxlfind ! maximum value of 5 part inidces
integer :: lfind_sp ! last frost index birch
integer :: maxlfind_sp ! last frost index beech
real :: mlfind_sp ! mean lfind
integer :: taxnum
end module data_frost
source_code/version_2.3_windows/amod_help.f 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* 4C (FORESEE) Simulation Model *!
!* *!
!* *!
!* data module *!
!* data_help *!
!* data_help_dbh *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
Module data_help
integer :: hnspec=0 ! species number
real :: mschelp ! weight of seed class
real ::heihelp ! height of plant class
REAL :: x_sap,x_hrt,x_fol,x_frt,x_Ahb !inital values for cohorts
integer :: fail
end module data_help
module data_help_dbh
! for function in calc_dbh
real :: fAhb = 0., & ! cross sectional area heartwood at tree base
fB = 0., & ! bole height,
fH = 0., & ! heartwood
fHt = 0., & ! total tree height
fsprhos
end module data_help_dbh
source_code/version_2.3_windows/amod_init.f 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* 4C (FORESEE) Simulation Model *!
!* *!
!* *!
!* module data_init *!
!* declaration of variables for additional information *!
!* used during initialisation *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
MODULE data_init
IMPLICIT NONE
INTEGER :: spec_nrDSW(120) ! species ordinal number in DSW according to BRA
INTEGER :: spec_nrBAY(120) ! species ordinal number in Bavaria
INTEGER :: spec_4C(120) ! species code number of 4C assigned to DSW species
CHARACTER (3) :: spec_code(120) ! specifies three letter code in DSW according to BRA
CHARACTER (50) :: GER_name(120) ! german name
CHARACTER (50) :: LAT_name(120) ! scientific, latin name
CHARACTER (50) :: ENG_name(120) ! english name
INTEGER :: spnum_for_DSW(800) ! species ordinal number (1..120) for DSW in element of vector
! which corresponds to species number according to BRA
! variables for treatment of DSW initialisation data
TYPE group_vec
INTEGER :: locid ! ID for stand
INTEGER :: taxid ! 4C species number
INTEGER :: BRAid ! DSW species code
INTEGER :: alter
INTEGER :: baumzahl
INTEGER :: schicht ! 10 = upper storey trees/Oberstand, 20 = retention trees/berhlter, 40 = understorey 50 = selction/plenter forest/ plenterartig
REAL :: dm
REAL :: mhoe
REAL :: gf
REAL :: patchsize
REAL :: standsize
REAL :: volume
END TYPE group_vec
TYPE(group_vec), DIMENSION(:), ALLOCATABLE :: ngroups
! variables for plenterwald initialisation
INTEGER, DIMENSION(4) :: low_age, high_age
! Parameter for volume functions provided by Eberswalde
REAL, DIMENSION (10,3) :: parEBW
! Parameter Pine (Kiefer) EBERSWALDE
DATA parEBW(10,1:3)/-9.780614,1.96047,0.89443/
! Parameter Ponderosa pine taken equal to Pine (Kiefer) EBERSWALDE
DATA parEBW(10,1:3)/-9.780614,1.96047,0.89443/
! Parameter for volume function adapted from SILVA
REAL, dimension (11,9) :: par_S
! Paramter Fichte/spruce SILVA
DATA par_S(2,1:9)/-3.59624,1.80213,-0.288243, 1.06247, -0.128993, 0.0353434, 0.142264, -0.058259, 0.00459854/
! Parameter Buche/beech SILVA
DATA par_S(1,1:9)/-2.7284,0.837563,-0.105843,1.62283,-0.214812,0.0289272,-0.0879719,0.0325667,-0.00446295/
! Parameter Eiche/oak SILVA
DATA par_S(4,1:9)/-3.06118,1.45506,-0.19992,1.93898,-0.689727,0.112653,-0.165102,0.120127,-0.0202543/
! Parameter Kiefer/ pine SILVA
DATA par_S(3,1:9)/-5.80915,3.387,-0.494392,3.67116,-1.83211,0.273999,-0.459282,0.29989,-0.0444931/
! Parameter Birke/birch SILVA = Weichlaub
DATA par_S(5,1:9)/-5.98031,2.65905,-0.3374,3.78395,-1.47318,0.188661,-0.540955,0.296957,-0.0385165/
! Parameter Pinus contorta (von Kiefer)
DATA par_S(6,1:9)/ -5.80915,3.387,-0.494392,3.67116,-1.83211,0.273999,-0.459282,0.29989,-0.0444931/
! Parameter Pinus ponderosa (von Kiefer)
DATA par_S(7,1:9)/ -5.80915,3.387,-0.494392,3.67116,-1.83211,0.273999,-0.459282,0.29989,-0.0444931/
! parameter Populus tremula
DATA par_S(8,1:9)/ -5.98031,2.65905,-0.3374,3.78395,-1.47318,0.188661,-0.54095500,0.296957,-0.03851650/
! parameter Robinie( black locust)
DATA par_S(11,1:9)/-2.7284,0.837563,-0.105843,1.62283,-0.214812,0.0289272,-0.0879719,0.0325667,-0.00446295/
END ! module data_init
source_code/version_2.3_windows/amod_manag.f 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* 4C (FORESEE) Simulation Model *!
!* *!
!* *!
!* data module management SR *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
module data_manag
real :: basarea_tot ! total basal area
real :: tardiam_dstem=15. ! diameter target for dead stems to C_opm_stems
integer :: thin_type ! type of management scenario
integer :: thin_nr ! Number of thinnings (years with management actions)
integer :: act_thin_year ! year field index of thinning
integer :: target_type ! type of thinning in case of target thinning
integer,allocatable,save,dimension(:) :: thin_year ! Field of management years
integer,allocatable,save,dimension(:) :: thin_age ! stand age of target thinning
integer,allocatable,save,dimension(:) :: thin_tree ! number of remaining stems after thinning
integer,allocatable,save,dimension(:) :: thin_spec ! species number for thinning (target)
integer,allocatable,save,dimension(:) :: thin_tysp ! type of thinning (for target thinning)
real, allocatable,save,dimension(:) :: target_mass ! target value of stem mass
integer,allocatable,save,dimension(:) :: thinyear ! year of last thinning
integer, allocatable, save, dimension(:) :: thin_stor ! information of storey which hase to manage
real,allocatable,save,dimension(:) :: np_mod ! multiplier for 'Nutzungsprozent'
integer :: thin_dead = 0 ! 0 dead stembiomass is accumulated in litter pools
! 1 dead stem biomass is removed as harvested
integer :: domspec ! dominant species of initialised stnad for management
integer :: domspec_reg ! dominant species of regenerated/planted stand after clear cut/shelterwood
real :: stump_sum= 0
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! thinning types
! 1 - Niederdurchforstung (mäßig) low thinning ( moderate)
! 2 - Niederdurchforstung (stark) low thinning (heavy)
! 3 - Hochdurchforstung crown thinning
! 4 - Auslesedurchforstung selective thinning
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
real :: ho1=0. ! dominant height first thinning
real :: ho2=0. ! dominant height second thinning
real :: ho3=0. ! dominant height third thinning
real :: ho4=0. ! dominant height fourth thinning
integer :: thr1=0 ! thinning regime for ho2
integer :: thr2=0 ! thinning regime for ho3
integer :: thr3=0 ! thinning regime for ho4
integer :: thr4=0 ! thinning regime for ho>ho4
integer :: thr5=0 ! 'Rückegassen'
real :: thr6=0. ! if thr5=1 this flag control time of realization =ho1,ho2,ho3 or ho4
integer :: thr7=0 ! management regime for rotation year
integer :: mgreg=0 ! regeneration, natural/artificial
integer :: thin_ob ! control of optimal basal area thinning, =1 yes, =0 no
real :: optb= 1. ! optimal 'Bestockungsgrad'
integer :: thinonce =0 ! special case of managemnet for only one single management activity; default=0
integer, allocatable,save,dimension(:) :: thin_flag1 ! aux. varaibles for adaptive management
integer, allocatable,save,dimension(:) :: thin_flag2
integer, allocatable,save,dimension(:) :: thin_flag3
integer, allocatable,save,dimension(:) :: thin_flag4
real, allocatable, save, dimension(:) :: zbnr ! number of 'Zielbäume'/target trees
real, allocatable, save, dimension(:) :: tend ! percentage of young tree tending/'tending of plantations'
integer, allocatable,save,dimension(:) :: rot ! rotation
integer, allocatable, save, dimension(:) :: regage ! age of natural/planted regeneration
integer :: flag_direct=0 !
integer :: thinstep=0 ! number of years between thinning if ho>ho4
integer :: flag_brush=1 ! defaul, if 1 then all harvested stems remain in the litter and are not removed from the stand
integer :: cutyear =0 ! year of cutting
real :: direcfel=0. ! percentage display of 'Rückegassen' creation 'directional felling'
real :: limit=0. ! limit für hight query (+- range)
integer :: shelteryear=0 ! year of last shelterwood mang.
integer :: stand_age =0 ! age of stand
integer :: flag_manreal=0 ! management no/yes
integer :: flag_shelter = 0! shelterwood management started
integer :: flag_sh_first=0 ! aux variable for the case age(1) > regage and age(1)> rotage-20
integer :: flag_plant_shw = 0 ! flag for planting in specieal case trhat initial age is > rot-20
character(30) :: maninf ! description of measure
integer :: meas ! flag of measure
! parameter for thinning depending on age ang stand density : percent of using
real, dimension(20,20) :: usp
! multi-species management
integer,allocatable,save,dimension(:) :: specnr, age_spec,anz_tree_spec
! Austrian management
integer,dimension(10) :: num_rel_cl ! number of relative diameter classes
integer :: num_man ! total numbe rof management treatments
integer, allocatable, save, dimension(:) :: yman ! years of management for each species
integer, allocatable, save, dimension(:) :: dbh_clm ! number of relative dbh class wihich is used for thinning
integer, allocatable, save, dimension(:) :: spec_man ! number of species for treatment
real, allocatable, save, dimension(:) :: rem_clm ! removal of biomass
integer, allocatable, save, dimension(:) :: act ! activity flag
real, allocatable,save, dimension(:) :: rel_part ! mixture flag for planting
! disturbance management
integer, allocatable, save, dimension(:) :: dis_id ! number of standid with disturbance
integer :: dis_row_nr ! the total number of disturbance events (line number of disturbance section)
integer, dimension(1:6,1:2) :: dis_control ! array which is used to control the dirsturbance simulation (dim1=disturbance type(D,X,P,R,S), dim2=zeile man-file)
character(1), allocatable, save, dimension(:) :: dis_type ! disturbance type D - defoliator, X - xylem clogger, P - phloem feeder
! R - root pathogen or feeder, S - stem rot
integer, allocatable, save, dimension(:) :: fortype ! forest type 1 managed forest, 2 - naturla forest
integer, allocatable, save, dimension(:) :: dis_year ! date of disturbance
integer, allocatable, save, dimension(:) :: dis_spec ! disturbed tree species
integer, allocatable, save, dimension(:) :: dis_start ! start of disturbance within year
real, allocatable, save, dimension(:) :: dis_rel ! relative value of disturbed area
real, allocatable,save, dimension(:) :: sum_dis ! accumulated value of disturbed area (relative), for each standid
real, allocatable, save, dimension(:) :: dis_year_id ! year of last disturbance for each standid
integer ::dis_number
integer :: count_dis_real =0 ! counter for realised disturbances
! aspen managment
integer :: nsprout = 3 ! number of sprouts per tree
integer :: flag_sprout = 0 ! 0 - sprouting 1-if sprouts exist
! liocourt management
real :: dbh_max ! maximum diameter
real :: lic_a ! parameter a of licourt function
real :: lic_b ! parameter b of licourt function
real :: thin_proc ! volume removal percent
integer :: spec_lic ! species number für li management
integer :: thin_int ! thinning interval
integer, dimension(22,11) :: ntree_lic ! filed for calculation of licourt function for species i and diamter class j
end module data_manag
source_code/version_2.3_windows/amod_mess.f 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* 4C (FORESEE) Simulation Model *!
!* *!
!* *!
!* data module for statistics with observed and simulated values *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
module data_mess
character(150):: dirmess = 'mess/' ! directory of files with measurements
integer:: anz_mesf = 1 ! amount of measurement files
character(150),allocatable,dimension(:) :: mesfile ! name of files with measurements
logical:: flag_mess ! TRUE: measurements within the simulation period / FALSE: no measurements
integer:: unit_cons ! console unit
integer:: unit_stat ! output unit for statistical analysis
integer:: unit_mess = -99 ! unit of file with measurements
integer:: unit_mout = -99 ! output unit of file with measurements and residuals
integer unitday, unitsum, unitlit, unittemp, unitwater, unitsoil, unitsoilini, unitcbal, &
unitveg, unitveg_pi, unitveg_sp, unitveg_bi
integer,allocatable,save,dimension(:) :: unit_mon ! array of output unit numbers for monthly values
integer,allocatable,save,dimension(:) :: unit_mon_stat ! array of output unit numbers for statistics of monthly values
integer imkind, & ! amount of read maesurement value typs
tkind, & ! chronological resolution of measurement values( 1 - Tage
! 2 - Jahre)
imess, & ! amount of read measuerment values
anz_val, & ! amount of filled in measurement values
imk_nme, & ! amount of measurment numbers for mean value calculation NME
imk_nmae, & ! amount of measure numbers for mean value calculation NMAE
imk_nrmse, & ! amount of measure numbers for mean value calculation NRMSE
imk_rsq ! amount of measure numbers for mean value calculations RSQ
real,allocatable,dimension(:,:):: mess1, mess2, sim1, help2
integer,allocatable,dimension(:,:):: mtz ! arry for dates of measurements: day of the year, year
integer,allocatable,dimension(:,:):: help1, stz
integer,allocatable,dimension(:):: app
real:: &
nme_av, & ! Average normalised mean error
nmae_av, & ! Average normalised mean absolut error
nrmse_av, & ! Average normalised root mean square error
pme_av, & ! Average mean precental error
prmse_av, & ! Average mean squared percental error
tic_av, & ! Average Theil's inequality coefficient
meff_av, & ! Average modell efficiency
rsq_av ! Average coefficient of determination
type res_struct
character(15) :: mkind ! measurement value type
integer :: imes ! amount of measurement value
integer :: tkind ! chronological resolution of measurement values
integer,pointer,dimension(:):: day, year
real,pointer,dimension(:) :: resid
real,pointer,dimension(:) :: sim
real,pointer,dimension(:) :: mess
end type res_struct
type (res_struct),allocatable,dimension(:),target :: val
integer:: ikind = 50 ! amount of allowed measurement value types
integer:: fkind = 0 ! amount of not defined measurement value types
character(10), dimension(50):: sim_kind
integer, dimension(80):: mpos1, mpos2 ! position of measurement value in input file
integer, dimension(80):: spos1, spos2 ! position of variables in simulations output
integer, dimension(80):: opos1, opos2 ! position of variables in simulation output file
end module data_mess
!**************************************************************
source_code/version_2.3_windows/amod_out.f 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* 4C (FORESEE) Simulation Model *!
!* *!
!* *!
!* data module for various output files (Header ,...) *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
module data_out
! definition of output form each output type (kind_name) with 4 DATA statements
! character strings with more than 1 row must be separated only by &
! Attention! Blanks are normally significant, but problematic:
! at the beginning of the row only one blank is significant
!
! Recipe for new output files:
! add 1 to the dimension field "(type (out_struct),dimension(x+1),target :: out??)"
! a n d to the number of files "out??_n"+1
! add the specifier of output file to DATA kind_name
! add the comments on first and second line to the respective DATA statements
! add the column header to DATA header (pay attention to the above remarks regarding blanks!)
! add the write statements to the case construct with the kind_name (in output.f)
! depending on the output structure special open statements might have to be added
! in OLD_OUT in output.f
! data structure of skalar and field output
type out_struct
character (10) :: kind_name ! specifies the kind and the name of the output file
integer :: unit_nr ! output unit, set in output.f
integer :: out_flag ! output flag
character (200) :: f_line ! first comment line
character (500) :: s_line ! second comment line
character (900) :: header ! header of output columns
end type out_struct
! daily output of scalars and fields
type (out_struct),dimension(24),target :: outd ! daily output files
integer :: outd_n = 24 ! number of all declared daily output files
DATA outd%kind_name /'Cday','Chumd','Copmd','Copmfractd','Cbcd', 'day', 'day_short','NH4','NH4c','NO3','NO3c','Nhumd','Nopmd', &
'NOPMfract', 'Nuptd', 'Nmind', 'perc', 'specd', 'temp', 'wat_potent', 'wat_res', 'water', 'watvol', 'wupt'/
DATA outd%f_line /'# Daily C balance', & ! Cday
'# C content of humus (hum) per layer', & ! Chumd
'# C content of organic primary matter (OPM) per layer', & ! Copmd
'# C content of organic primary matter (OPM) fractions', & ! Copmfractd
'# C content of biochar per layer', & ! Cbcd
'# Daily output', & ! day
'# Short daily output', & ! day_short
'# NH4 content per layer', & ! NH4
'# NH4 concentration per layer', & ! NH4c
'# NO3 content per layer', & ! NO3
'# NO3 concentration per layer', & ! NO3c
'# N content of humus (hum) per layer', & ! Nhumd
'# N content of organic primary matter (OPM) per layer', & ! Nopmd
'# N content of organic primary matter (OPM) fractions', & ! NOPMfract
'# Daily nitrogen uptake by roots per layer Nupt', & ! Nuptd
'# Daily nitrogen mineralisation per layer Nmin', & ! Nmind
'# Daily percolation of water per layer perc', & ! perc
'# Daily species variables svar', & ! specd
'# Daily soil temperature per layer temps', & ! temp
'# Daily soil water potential per layer wat_potential',& ! wat_potent
'# Daily water uptake resistance per layer wat_res', & ! wat_res
'# Daily soil water content per layer wats', & ! water
'# Daily soil water content per layer watvol', & ! watvol
'# Daily water uptake by roots per layer wupt_r'/ ! wupt
DATA outd%s_line / &
'# gC/m2 gC/m2 gC/m2 gC/m2 gC/m2 gC/m2 gC/m2 gC/m2 gC/m2 gC/m2&
& gC/m2 gC/m2 gC/m2 %' , & ! Cday
'# gC_m2', & ! Chumd
'# gC_m2', & ! Copmd
'# gC/m2',& ! Copmfractd
'# gC_m2', & ! Cbcd
'# Grad C J/cm2 mm mm mm mm mm mm mm mm&
& mol/m2 gC/m2 gN/m2 gN/m2 gN/m2 gN/m2 mgN/m2 &
& mm mm C&
J/cm2 J/cm2', & ! day
'# - mm', & ! day_short
'# gN/m2', & ! NH4
'# mgN/l', & ! NH4c
'# gN/m2', & ! NO3
'# mgN/l', & ! NO3c
'# gN/m2', & ! Nhumd
'# gN/m2', & ! Nopmd
'# gN/m2 |------------- Fagus sylvatica ----------------|--------------- Picea abies -----------------|&
&------------ Pinus sylvestris ----------------|--------------- Quercus robur ----------------|&
&------------- Betula pendula -----------------|-------------- Pinus contorta ---------------|&
&------------- Pinus ponderosa -----------------|-------------- Populus tremula ---------------|&
&------------- Bodenvegetation ----------------|', & ! NOPMfract
'# gN/m2', & ! Nuptd
'# gN/m2', & ! Nmind
'# mm/day', & ! perc
'# ', & ! specd
'# C', & ! temp
'# hPa', & ! wat_potent
'# ', & ! wat_res
'# mm', & ! water
'# vol%', & ! watvol
'# mm/day'/ ! wupt
DATA outd%header / &
'# Day Year gross_Phot gross_Ass net_Ass pot_NPP NPP NPP_day GPP_day NEE &
& TER_day autresp Resp_aut Resp_het Resp_fol FaPar',& ! Cday
'# Day Year Chum_1 Chum_2 Chum_3 Chum_4 Chum_5 Chum_6 ....',& ! Chumd
'# Day Year Copm_1 Copm_2 Copm_3 Copm_4 Copm_5 Copm_6 ....',& ! Copmd
'# Day Year species C_opm_fol C_opm_tb C_opm_frt C_opm_crt C_opm_stm species C_opm_fol C_opm_tb C_opm_frt C_opm_crt C_opm_stm &
& ....',& ! Copmfractd
'# Day Year Cbc_1 Cbc_2 Cbc_3 Cbc_4 Cbc_5 Cbc_6 ....',& ! Cbcd
'# Day Year Temp Rad Prec Intercep Snow PET AET Transdem Transtree Transsveg&
& GP_can Resp_het Nleach_d Nupt_d Nmin_d_c N_antot N_Depo Cover&
& LAI s_Light toFPARcan fire_indi fire_e fire_w fire_n snowday drIndd&
& buckroot buck100 cl_WatBal dewp.temp dew/rime Rnet_tot Rad_max',& ! day
'# Date fire_e cl_WatBal',& ! day_short
'# Day Year NH4_1 NH4_2 NH4_3 NH4_4 NH4_5 NH4_6 ....',& ! NH4
'# Day Year NH4_1 NH4_2 NH4_3 NH4_4 NH4_5 NH4_6 ....',& ! NH4c
'# Day Year NO3_1 NO3_2 NO3_3 NO3_4 NO3_5 NO3_6 ....',& ! NO3
'# Day Year NO3_1 NO3_2 NO3_3 NO3_4 NO3_5 NO3_6 ....',& ! NO3c
'# Day Year Nhum_1 Nhum_2 Nhum_3 Nhum_4 Nhum_5 Nhum_6 ....',& ! Nhumd
'# Day Year Nopm_1 Nopm_2 Nopm_3 Nopm_4 Nopm_5 Nopm_6 ....',& ! Nopmd
'# Day Year N_opm_fol N_opm_tb N_opm_frt N_opm_crt N_opm_stm N_opm_fol N_opm_tb N_opm_frt N_opm_crt N_opm_stm &
& N_opm_fol N_opm_tb N_opm_frt N_opm_crt N_opm_stm N_opm_fol N_opm_tb N_opm_frt N_opm_crt N_opm_stm &
& N_opm_fol N_opm_tb N_opm_frt N_opm_crt N_opm_stm N_opm_fol N_opm_tb N_opm_frt N_opm_crt N_opm_stm &
& N_opm_fol N_opm_tb N_opm_frt N_opm_crt N_opm_stm ',& ! NOPMfract
'# Day Year Nupt_1 Nupt_2 Nupt_3 Nupt_4 Nupt_5 Nupt_6 ....',& ! Nuptd
'# Day Year Nmin_1 Nmin_2 Nmin_3 Nmin_4 Nmin_5 Nmin_6 ....',& ! Nmind
'# Day Year Percol_1 Percol_2 Percol_3 Percol_4 Percol_5 Percol_6 ....',& ! perc
'# Day Year species_name number Ndem Nupt Ndemp Nuptp RedN ',& ! specd
'# Day Year Temp_surf Temps_1 Temps_2 Temps_3 Temps_4 Temps_5 Temps_6 ....',& ! temp
'# Day Year Pot_1 Pot_2 Pot_3 Pot_4 Pot_5 Pot_6 ....',& ! wat_potent
'# Day Year Wat_res_1 Wat_res_2 Wat_res_3 Wat_res_4 Wat_res_5 Wat_res_6 ....',& ! wat_res
'# Day Year Wats_1 Wats_2 Wats_3 Wats_4 Wats_5 Wats_6 ....',& ! water
'# Day Year Wats_1 Wats_2 Wats_3 Wats_4 Wats_5 Wats_6 ....',& ! watvol
'# Day Year Wupt_r_1 Wupt_r_2 Wupt_r_3 Wupt_r_4 Wupt_r_5 Wupt_r_6 ....'/ ! wupt
! ----------------------------------------------------- !
! yearly output of scalars and fields
type (out_struct),dimension(58),target :: outy ! yearly output files
integer :: outy_n = 58 ! number of all declared yearly output files
DATA outy%kind_name /'AET_mon','c_bal','Cbc','Chum','Copm','Copmfract','classd','classage','classmvol','classd_h','classdm', 'classdm_h',&
'classh', 'classt', 'clim', 'clim_temp', 'clim_prec', 'clim_rad', 'clim_hum', &
'fcap_av','fcapv_av', 'fr_loss','GPP_mon', 'humusv', 'indi', &
'litter','Nbc','Nhum','Nopm','NEE_mon','NPP_mon','manrec', 'mansort', 'redis', 'root', 'sdrought',&
'soil', 'spec', 'standsort','TER_mon','veg', 'veg_in', 'veg_out', &
'veg_be','veg_bi','veg_pi', 'veg_pc', 'veg_pp', 'veg_pt', &
'veg_oa','veg_sp','veg_ph', 'veg_dg', 'veg_rb', 'veg_egl', 'veg_egr','veg_sveg','veg_mist'/
DATA outy%f_line /'# Monthly sum of actual evapotranspiration (AET)', & ! AET_mon
'# Yearly C-Balance, C-stocks and -fluxes; C_sumvsab is part of C_biomass', & ! c_bal
'# C content of biochar (C_bc) per layer', & ! Cbc
'# C content of humus (hum) per layer', & ! Chum
'# C content of organic primary matter (OPM) per layer', & ! Copm
'# C content of organic primary matter (OPM) fractions', & ! Copmfract
'#', & ! classd
'#', & ! classage
'#', & ! classmvol
'#', & ! classd_h
'#', & ! classdm
'#', & ! classdm_h
'#', & ! classh
'#', & ! classt
'# Climate data', & ! clim
'# Air temperature: monthly climate data', & ! clim_temp
'# Precipitation: monthly climate data', & ! clim_prec
'# Radiation: monthly climate data', & ! clim_rad
'# Relative humidity: monthly climate data', & ! clim_hum
'# Available field capacity per layer', & ! fcap_av
'# Available field capacity per layer', & ! fcapv_av
'# Percentage fine root C-loss per soil layer', & ! fr_loss
'# Monthly GPP of all cohorts and species', & ! GPP_mon
'# Content of humus per layer', & ! humusv
'# Indices of fire and biodiversity', & ! indi
'# Yearly litter fractions', & ! litter
'# N content of biochar (N_bc) per layer', & ! Nbc
'# N content of humus (hum) per layer', & ! Nhum
'# N content of organic primary matter (OPM) per layer', & ! Nopm
'# Monthly NEE of all cohorts and species', & ! NEE_mon
'# Monthly NPP of all cohorts and species', & ! NPP_mon
'# Management record', & ! manrec
'# Management sortiment',& ! mansort
'# Redistribution of root C (redis)', & ! redis
'# Root distribution (root_fr)', & ! root
'# Data from soil model', & ! sdrought
'# Data from soil model', & ! soil
'# Species number and name', & ! spec
'# sortiment of whole stand (without harvested trees)',& ! standsort
'# Monthly TER of all cohorts and species', & ! TER_mon
'# Values for the whole stand (per ha); see files veg_in, veg_out in addition', & ! veg
'# New trees (by planting or regeneration), values for the whole stand (per ha)', & ! veg_in
'# Removed trees (by mortality or management) with number of cohorts from which trees are removed (per ha)', & ! veg_out
'# Values for the whole stand (per ha) for beech', & ! veg_be
'# Values for the whole stand (per ha) for birch', & ! veg_bi
'# Values for the whole stand (per ha) for pinus sylvestris', & ! veg_pi
'# Values for the whole stand (per ha) for pinus contorta', & ! veg_pc
'# Values for the whole stand (per ha) for pinus ponderosa', & ! veg_pp
'# Values for the whole stand (per ha) for populus tremula', & ! veg_pt
'# Values for the whole stand (per ha) for oak', & ! veg_oa
'# Values for the whole stand (per ha) for spruce', & ! veg_sp
'# Values for the whole stand (per ha) for pinus halepensis', & ! veg_ph
'# Values for the whole stand (per ha) for douglas fir', & ! veg_dg
'# Values for the whole stand (per ha) for black locust', & ! veg_rb
'# Values for the whole stand (per ha) for E.globulus', & ! veg_egl
'# Values for the whole stand (per ha) for E.grandis', & ! veg_egr
'# Values for the whole stand (per ha) for ground vegetation', & ! veg_sveg
'# Values for the whole stand (per ha) for mistletoe (Visc. a.)'/! veg_mist
DATA outy%s_line / &
'# mm', & ! AET_mon
'# kg/ha kg/ha kg/ha kg/ha kg/ha kg/ha kg/ha kg/ha&
& kg/ha kg/ha t/ha t/ha t/ha t/ha t/ha t/ha t/ha t/ha t/ha&
& mol/m2 mol/m2 mol/m2 mol/m2 mol/m2 mol/m2 mol/m2 mol/m2&
& mol/m2 mol/m2 mol/m2 kg/ha', & ! c_bal
'# gC/m2', & ! Cbc
'# gC/m2', & ! Chum
'# gC/m2', & ! Copm
'# gC/m2', & ! Copmfract
'# diam_class: Number of trees (per ha) in diameter classes, step 5 cm', & ! classd
'# diam_class: Mean age of trees (per ha) in diamter classes, step 5 cm', & ! classage
'# diam_class: Mean volume (m/ha) of harvested trees in diamter classes, step 5 cm', & ! classmvol
'# diam_class: Mean height of trees in diameter classes, step 5 cm', & ! classd_h
'# diam_class: Number of harvested trees (per ha) in diameter classes, step 5 cm', & ! classdm
'# diam_class: Mean height of trees in diameter classes, step 5 cm', & ! classdm_h
'# height_class: Number of trees in height classes, bis 1,5,6,7,...,50,55,>55m', & ! classh
'# diam_class: Number of dead trees (per ha) in diameter classes, step 5 cm', & ! classt
'# C mm J/cm2 m/s ppm C', & ! clim
'# C ... ', & ! clim_temp
'# mm ... ', & ! clim_prec
'# J/cm2 ... ', & ! clim_rad
'# % ... ', & ! clim_hum
'# mm', & ! fcap_av
'# %', & ! fcapv_av
'# yearly mean fine root C-loss', & ! fr_loss
'# gC/m2', & ! GPP_mon
'# %', & ! humusv
'# fire index |------------ fire index west ------------|&
&|----------------------- fire index east -----------------------|&
&|------- fire index Nesterov -------|', & ! indi
'# |-------------------------------- Dry mass kg DW/ha_yr ---------------------------------|&
& |----------------- Carbon content kg C/ha_yr -------------------|&
& |----------------- Nitrogen content kg N/ha_yr -----------------|', & ! litter
!& % % % % ', & ! litter
'# gN/m2', & ! Nbc
'# gN/m2', & ! Nhum
'# gN/m2', & ! Nopm
'# gC/m2', & ! NEE_mon
'# gC/m2', & ! NPP_mon
' ', & ! manrec
' cm cm cm cm cm m/ha kg C/ha ', & ! mansort
'# relative share of redistributed C per layer (whole stand) ', & ! redis
'# relative share of root mass per layer (whole stand) ', & ! root
'# s_drought: Number of days with water content near wilting point (drought days) per layer', & ! sdrought
'# Grad_C mm mm mm mm mm mm mm mm mm mm mol_m2 gN_m2&
& gN_m2 gC_m2 gN_m2 gN_m2 gC_m2 gN_m2 gC_m2 gN_m2 gC_m2 gC_m2 gC_m2 gC_m2 gC_m2 gC_m2&
& gN_m2 gN_m2 gN_m2 gC_m2 mm mm cm mm J/cm2 gN_m2 gC_m2 gC_m2',& ! soil
'#', & ! spec
' cm cm cm cm cm m/ha kg C/ha ', & ! standsort
'# gC/m2', & ! TER_mon
'# /ha m2_m2 kg_DW/ha kg_DW_yr/ha cm cm&
& kg_DW/ha kg_DW/ha kg_DW/ha kg_DW/ha kg_DW/ha m3/ha kg_DW/ha kg_DW/ha m2_m2&
& gN/m2 mol/m2 mol/m2 mol/m2 cm cm m m/ha m/ha', & ! veg
2*'# /ha m2_m2 kg_DW/ha cm cm&
& kg_DW/ha kg_DW/ha kg_DW/ha kg_DW/ha kg_DW/ha m3/ha kg_DW/ha kg_DW/ha m2_m2&
& gN/m2 mol/m2 mol/m2 mol/m2', & ! veg_in, veg_out
15*'# /ha m2_m2 kg_DW/ha kg_DW_yr/ha cm &
&cm kg_DW/ha kg_DW/ha kg_DW/ha kg_DW/ha kg_DW/ha m3/ha kg_DW/ha kg_DW/ha m2_m2&
& gN/m2 gN/m2 - - cm cm m m/ha m/ha mm'/ ! veg_be, bi, pi, oa, sp, sveg
DATA outy%header / &
'# Year AET_1 AET_2 AET_3 AET_4 AET_5 AET_6 AET_7 AET_8 AET_9 AET_10&
& AET_11 AET_12 AET_Quar1 AET_Quar2 AET_Quar3 AET_Quar4 AET_DJF AET_MAM AET_JJA AET_SON', & ! AET_mon
'# Year GPP NPP NEP Aut_Resp Het_Resp Tot_Resp C_dead_st C_sumvsab C_biomass&
& C_tot_ES C_soil C_tot_1 C_hum_1 C_tot_40 C_hum_40 C_tot_80 C_hum_80 C_tot_100 C_hum_100&
& GPP NPP NEP Aut_Resp Het_Resp Tot_Resp C_dead_st&
& C_sumvsab C_biomass C_tot_ES C_soil gppsum', & ! c_bal
'# Year Cbc_1 Cbc_2 Cbc_3 Cbc_4 Cbc_5 Cbc_6 ....',& ! Cbc
'# Year Chum_1 Chum_2 Chum_3 Chum_4 Chum_5 Chum_6 ....',& ! Chum
'# Year Copm_1 Copm_2 Copm_3 Copm_4 Copm_5 Copm_6 ....',& ! Copm
'# Year species C_opm_fol C_opm_tb C_opm_frt C_opm_crt C_opm_stm species C_opm_fol C_opm_tb C_opm_frt C_opm_crt C_opm_stm &
& ....',& ! Copmfract
'# Year', & ! classd
'# Year', & ! classage
'# Year', & ! classmvol
'# Year', & ! classd_h
'# Year', & ! classdm
'# Year', & ! classdm_h
'# Year', & ! classh
'# Year', & ! classt
'# Year Temp Prec Radiation Wind CO2 GDD summerdays hotdays icedays &
& drydays hraindays snowdays Ind_arid CWB Ind_Lang Ind_Cout Ind_Wissm Ind_Mart Ind_Mart_VP &
&Ind_Emb Ind_Weck Ind_Reich Ind_Gor I_Currey I_Conrad NTIndex Ind_Budyko F_day F_day_sp l_frost l_frosttot anzfd sumtfd iday_vp Ind_SHC', & ! clim
'# Year Temp_1 Temp_2 Temp_3 Temp_4 Temp_5 Temp_6 Temp_7 Temp_8 Temp_9 Temp_10&
& Temp_11 Temp_12 T_Quart1 T_Quart2 T_Quart3 T_Quart4 T_DJF T_MAM T_JJA T_SON', & ! clim_temp
'# Year Prec_1 Prec_2 Prec_3 Prec_4 Prec_5 Prec_6 Prec_7 Prec_8 Prec_9 Prec_10&
& Prec_11 Prec_12 P_Quart1 P_Quart2 P_Quart3 P_Quart4 P_DJF P_MAM P_JJA P_SON', & ! clim_prec
'# Year Rad_1 Rad_2 Rad_3 Rad_4 Rad_5 Rad_6 Rad_7 Rad_8 Rad_9 Rad_10&
& Rad_11 Rad_12 R_Quart1 R_Quart2 R_Quart3 R_Quart4 R_DJF R_MAM R_JJA R_SON', & ! clim_rad
'# Year Hum_1 Hum_2 Hum_3 Hum_4 Hum_5 Hum_6 Hum_7 Hum_8 Hum_9 Hum_10&
& Hum_11 Hum_12 H_Quart1 H_Quart2 H_Quart3 H_Quart4 H_DJF H_MAM H_JJA H_SON', & ! clim_hum
'# Year fcap_av_1 fcap_av_2 fcap_av_3 fcap_av_4 fcap_av_5 fcap_av_6 ....',& ! fcap_av
'# Year fcapvav_1 fcapvav_2 fcapvav_3 fcapvav_4 fcapvav_5 fcapvav_6 ....',& ! fcapv_av
'# Year lay_1 lay_2 lay_3 lay_4 lay_5 lay_6 ....',& ! fr_loss
'# Year GPP_1 GPP_2 GPP_3 GPP_4 GPP_5 GPP_6 GPP_7 GPP_8 GPP_9 GPP_10&
& GPP_11 GPP_12 GPP_Quar1 GPP_Quar2 GPP_Quar3 GPP_Quar4 GPP_DJF GPP_MAM GPP_JJA GPP_SON', & ! GPP_mon
'# Year humus_1 humus_2 humus_3 humus_4 humus_5 humus_6 ....',& ! humusv
'# Bruschek Mean class1 class2 class3 class4 class5&
& Mean class1 class2 class3 class4 class5 Ind_max Ind_day Mean class1 class2 class3 class4', & ! indi
'# Year fol_litter fol_lit_tr frt_litter frt_lit_tr crt_litter tb_litter stem_litter tot_litter&
& fol_litter frt_litter crt_litter tb_litter stem_litter tot_litter&
& fol_litter frt_litter crt_litter tb_litter stem_litter tot_litter', & ! litter
!'# Year fol_litter frt_litter crt_litter tb_litter stem_litter fol_litter frt_litter&
!& crt_litter tb_litter stem_litter', & ! litter
'# Year Nbc_1 Nbc_2 Nbc_3 Nbc_4 Nbc_5 Nbc_6 ....',& ! Nbc
'# Year Nhum_1 Nhum_2 Nhum_3 Nhum_4 Nhum_5 Nhum_6 ....',& ! Nhum
'# Year Nopm_1 Nopm_2 Nopm_3 Nopm_4 Nopm_5 Nopm_6 ....',& ! Nopm
'# Year NEE_1 NEE_2 NEE_3 NEE_4 NEE_5 NEE_6 NEE_7 NEE_8 NEE_9 NEE_10&
& NEE_11 NEE_12 NEE_Quar1 NEE_Quar2 NEE_Quar3 NEE_Quar4 NEE_DJF NEE_MAM NEE_JJA NEE_SON', & ! NEE_mon
'# Year NPP_1 NPP_2 NPP_3 NPP_4 NPP_5 NPP_6 NPP_7 NPP_8 NPP_9 NPP_10&
& NPP_11 NPP_12 NPP_Quar1 NPP_Quar2 NPP_Quar3 NPP_Quar4 NPP_DJF NPP_MAM NPP_JJA NPP_SON', & ! NPP_mon
'# Year management measure ', & ! manrec
'# year count spec type len diam diam wob top_d t_d wob Volume DW number type', & ! mansort
'# Year lay_1 lay_2 lay_3 lay_4 lay_5 lay_6 ....',& ! redis
'# Year root_1 root_2 root_3 root_4 root_5 root_6 ....',& ! root
'# Year layer1 layer2 layer3 layer4 ........', & ! sdrought
'# Year Temp Prec Interc Percol Wupt Wuptroot Transtree Transsveg Wuptsoil AET Wats_tot&
& GP_can N_min N_tot C_tot N_antot N_humtot C_humtot N_hum(1) C_hum(1) N_litter&
& C_litter C_opm_fol C_opm_frt C_opm_crt C_opm_tbc C_opm_stm Nupt Nleach N_depo Soil_Resp&
& PET interc_sv thick1 dew/rime Rnet_tot N_bc_tot C_bc_tot C_bc_app', & ! soil
'# Year', & ! spec
' year count spec type len diam diam wob top_d t_d wob Volume DW number ', & ! standsort
'# Year TER_1 TER_2 TER_3 TER_4 TER_5 TER_6 TER_7 TER_8 TER_9 TER_10&
& TER_11 TER_12 TER_Quar1 TER_Quar2 TER_Quar3 TER_Quar4 TER_DJF TER_MAM TER_JJA TER_SON', & ! TER_mon
'# Year num_Spec Coh Tree LAI Biomass NPPsum Meddiam&
& Domhei Fol_Bio Sap_Bio Frt_Bio Hrt_Bio Stem_inc Stemvol rem_stems&
& dead_stems cover drIndAl Ndem gp_can_mean gp_can_min gp_can_max mean_diam mean_height basal_area dead_stems_m3 stem_inc_m3', & ! veg
2* '# Year num_Spec Coh Tree LAI Biomass Meddiam&
& mean_hei Fol_Bio Sap_Bio Frt_Bio Hrt_Bio Stem_inc Stemvol rem_stems&
& dead_stems cover drIndAl Ndem gp_can_mean gp_can_min gp_can_max', & ! veg_in, veg_out
15*'# Year Spec_id Coh Tree LAI Biomass NPPsum Meddiam&
& Domhei Fol_Bio Sap_Bio Frt_Bio Hrt_Bio Stem_inc Stemvol rem_stems&
& dead_stems cover drIndAl Ndem Nupt Red_N daybb endbb mean_diam mean_height basal_area dead_stems_m3 stem_inc_m3 YRW'/ ! veg_be, bi, pi, oa, sp,lp, sveg, mist
! ----------------------------------------------------- !
! daily output of cohorts
type (out_struct),dimension(23),target :: outcd
integer :: outcd_n = 23 ! number of all declared cohort output files
DATA outcd%kind_name /'ass', 'aevi', 'ddi', 'dem', 'dips', 'gp', 'gsdps', 'intcap', 'interc', &
'Ndemc_d', 'Nuptc_d', 'N_fol', 'N_pool', 'RedNc', 'resp', 'respaut', &
'respbr', 'respfol', 'resphet', 'respsap', 'respfrt', 'sup', 'totfpar'/
DATA outcd%s_line /23*'# Cohort output'/ ! ass, ddi, dem, gp, gsdps, res,
! resbr, ressap, resfrt, sup
DATA outcd%f_line / &
'# Optimum gross assimilation rate (kg DW/d) assi', & ! ass
'# Daily evaporation of intercepted water (mm/day) aev_i', & ! aevi
'# Daily drought index drindd', & ! ddi
'# Demand for soil water of the cohort (mm/day) demand', & ! dem
'# Drought index for Photosyntheses calculation (cum) drindps', & ! dips
'# Unstressed stomatal conductance (mol/m2*d) gp', & ! gp
'# Number of growing season days per time step of photosynthesis ndaysps', & ! gsdps
'# Interception capacity (mm) sum of intcap(layer)', & ! intcap
'# Interception storage (mm) interc_st', & ! interc
'# Daily N demand per tree (g)', & ! Ndemc_d
'# Daily N uptake per tree (g)', & ! Nuptc_d
'# Daily N content of foliage per tree (g)', & ! N_fol
'# Daily N_pool per tree (g)', & ! N_pool
'# Daily photosynthesis nitrogen reduction factor [-]', & ! RedNc
'# Leaf respiration rate (g C/d) resp', & ! resp
'# Daily autotrophic respiration rate (g C/d) respaut', & ! respaut
'# Daily respiration rate of branches (g C/d) respbr', & ! respbr
'# Daily respiration rate of leaves (g C/d) respfol', & ! respfol
'# Daily heterotrophic respiration rate (g C/d) resphet', & ! resphet
'# Daily respiration rate of sapwood (g C/d) respsap', & ! respsap
'# Daily respiration rate of frt (g C/d) respfrt', & ! respfrt
'# Supply of soil water to roots of the cohort (mm/day) supply', & ! sup
'# Total fraction of PAR absorbed per m patch area (-) totFPAR'/ ! totfpar
DATA outcd%header / &
23*'# Day Year Coh1 Coh2 Coh3 Coh4 ...'/ ! ass, ddi, dem, gp, gsdps, res,
! resbr, ressap, resfrt, sup
! ----------------------------------------------------- !
! yearly output of cohorts
type (out_struct),dimension(58),target :: outcy
integer :: outcy_n = 58 ! number of all declared cohort output files
DATA outcy%kind_name /'age', 'ahb', 'ahbasrel', 'ahc', 'ahcasrel', 'asapw', 'atr', 'bioi', 'botlayer','cpa', 'crt', 'daybb', 'dcrb', 'diac', 'diam', &
'dtr', 'dwd','fol', 'foli', 'frt', 'frti', 'frtrel', 'frtrelc', 'geff', 'gfol', 'gfrt', 'grossass', 'gsap', &
'gsd', 'hbo', 'hea', 'hei', 'hrt', 'leaf', 'maintres', 'nas', 'npp', 'rdpt', 'rld', 'sap', &
'sfol', 'sfrt', 'spn', 'ssap', 'stem', 'str', 'tdb','toplayer', 'trman', 'ttb','Ndemc_c','Nuptc_c', &
'Nfol', 'Npool', 'Nstr','rooteff', 'watleft', 'yrw'/
DATA outcy%s_line /58*'# Cohort output'/ ! age, ahb, ahc, atr, asapw, bioi, botLayer, cpa, crt, daybb, dcrb, diac, diam,
! dtr, dwd, fol, foli, frt, frti, frtrel, geff, gfol, gfrt,
! grossass, gsap, gsd, hbo, hea, hrt, hei,
! leaf, maintres, nas, npp, rdpt, rld, sap, sfol, sfrt, spn,
! ssap, stem, str, tdb, topLayer, trman,ttb, Ndemc,Nuptc, rooteff,watleft
DATA outcy%f_line / &
'# Tree age (year)', & ! age
'# Cross sectional area of heartwood at stem base [cm**2] x_Ahb', & ! ahb
'# Relation of heartwood to sapwood at stem base', & ! ahbasrel
'# Cross sectional area of heartwood at crown base [cm**2] Ahc', & ! ahc
'# Relation of heartwood to sapwood at crown base', & ! ahcasrel
'# Cross sectional area of sapwood in bole space [cm**2] Asapw', & ! asapw
'# Number of alive trees per cohort', & ! atr
'# Net biomass increment (kg DM/year)', & ! bioi
'# Number of bottom layer of crown [-]', & ! botLayer
'# Cohort crown projection area (m2)', & ! cpa
'# coarse root biomass (kg DM/tree)', & ! crt
'# Day of leaf bud burst', & ! daybb
'# Diameter of stem at crown base (cm)',& ! dcrb
'# Drought index for allocation calculation (cum)', & ! diac
'# Diameter at breast height (cm)', & ! diam
'# Number of dead trees per cohort', & ! dtr
'# Stem biomass of dead trees per cohort', & ! dwd
'# Foliage biomass (kg DM/tree)', & ! fol
'# Foliage increment (kg DM/year/tree)', & ! foli
'# Fine root biomass (kg DM/tree)', & ! frt
'# Net fine root increment (kg DM/year/tree)', & ! frti
'# Relative fine root fraction of tree per soil layer (root profile)', & ! frtrel
'# Relative fine root fraction of cohort of total layer fine root mass per soil layer', & ! frtrel
'# Growth efficiency kg/m2', & ! geff
'# Gross growth rate foliage (kg DM/year/tree)', & ! gfol
'# Gross growth rate fine root (kg DM/year/tree)', & ! gfrt
'# Gross assimilation rate (kg DM/year/tree)', & ! grossass
'# Gross growth rate sapwood (kg DM/year/tree)', & ! gsap
'# Number of growing season days per year ndaysgr',& ! gsd
'# Bole height (cm)', & ! hbo
'# Number of years without stress', & ! hea
'# Total tree height (cm)', & ! hei
'# Heartwood biomass (kg DM/tree)', & ! hrt
'# Leaf area per tree (m2)', & ! leaf
'# Maintenance respiration (kg DM/year/tree)', & ! maintres
'# Net foliage assimilation rate (kg DM/year/tree)', & ! nas
'# NPP (kg DM/year/tree)', & ! npp
'# Rooting depth calculated with TRAP model[cm]', & ! rdpt
'# estimated root length density [cm]', & ! rld
'# Sapwood biomass (kg DM)', & ! sap
'# Senescence rate foliage (kg DM/year/tree)', & ! sfol
'# Senescence rate fine roots (kg DM/year/tree)', & ! sfrt
'# Species number of the cohort', & ! spn
'# Senescence rate sapwood (kg DM/year/tree)', & ! ssap
'# Stemwood biomass increment (kg DM/year/tree)', & ! stem
'# Number of stress years', & ! str
'# Total cohort dead biomass (kg DM/year/cohort)', & ! tdb
'# Number of top layer of crown [-]', & ! topLayer
'# Number of trees harvested by managment', & ! trman
'# Total tree biomass (kg DM/tree)', & ! ttb
'# N demand per tree and year (g)', & ! Ndemc_c
'# N uptake per tree and year (g)', & ! Nuptc_c
'# N content of foliage per tree and year (g)', & ! Nfol
'# N pool per tree and year (g)', & ! Npool
'# Ratio of N uptake to demand per tree and year', & ! Nstr
'# Root uptake efficiency factor', & ! rooteff
'# Water left in next layer', & ! watleft
'# Year ring width [mm]' / ! yrw
DATA outcy%header / &
58*'# Year Coh1 Coh2 Coh3 Coh4 ...'/ !age, ahb, ahc, atr, bioi, cpa, crt, daybb, dcrb, diac, diam,
! dtr, dwd, fol, foli, frt, frti, frtrel, geff, gfol, gfrt,
! gsap, gsd, hbo, hea, hrt, hei,
! leaf, maintres, nas, npp, rdpt, rld, sap, sfol, sfrt, spn,
! stem, str, tdb,trman, ttb, Ndemc,Nuptc, rooteff,watleft, yrw
! output at simulation end
type (out_struct),dimension(6),target :: oute
integer :: oute_n = 6 ! number of all declared end output files
DATA oute%kind_name /'sea', 'sea_ms', 'sea_npv', 'sea_st','wpm', 'wpm_inter'/
DATA oute%f_line / &
'# SEA: Costs and assets of standing stock, harvested timber, silvicultural costs, fix costs, and subsidies in euro/ha', &
'# SEA: Timber grading for harvested wood, m3/ha', &
'# SEA: liquidation value, npv, npv+ in euro/ha', &
'# SEA: Timber grading for standing stock, m3/ha', &
'# Wood product model output', &
'# Wood product model intermediate steps'/ !
DATA oute%s_line / &
'# shotcuts: sum: summe, st: standing stock, ms: harvested wood, fc: fix costs, sv: silvicultural costs, co: costs, as: assets, sub: subsidies, sp: spruce, be: beech, pi: pine, oa: oak, bi: birch, ' , &
'# Timber grades 1-7: 1-fue, 2-in, 3-LAS1a, 4-LAS1b, 5-LAS2a, 6-LAS2b, 7-LAS3a, 8-L2b, 9-L3a, 10-L3b ' , &
'# a: without discounting, b-d: interest rate (see "sea_prices.wpm" file) ' , &
'# Timber grades 1-7: 1-fue, 2-in, 3-LAS1a, 4-LAS1b, 5-LAS2a, 6-LAS2b, 7-LAS3a, 8-L2b, 9-L3a, 10-L3b ' , &
'# Carbon in different products, kg C/ha ' , &
'# Carbon in different products, kg C/ha tg: timber grades, il: industrial lines, pl: product lines'/
DATA oute%header / &
'# Year sum_all sum_st sum_ms sum_sv sum_fc sum_sub be_st_co sp_st_co pi_st_co oa_st_co bi_st_co |be_st_as sp_st_as pi_st_as oa_st_as bi_st_as |be_ms_co sp_ms_co pi_ms_co oa_ms_co bi_ms_co |be_ms_as sp_ms_as pi_ms_as oa_ms_as bi_ms_as fix_costs sub_har sub_sv_co sub_fix ', &! sea
'# Year be_tg1 be_tg2 be_tg5 be_tg6 be_tg7 be_tg8 be_tg9 be_tg10 &
&sp_tg1 sp_tg2 sp_tg4 sp_tg5 sp_tg6 sp_tg7 sp_tg8 sp_tg9 sp_tg10 &
&pi_tg1 pi_tg2 pi_tg3 pi_tg4 pi_tg5 pi_tg6 pi_tg7 pi_tg8 pi_tg9 pi_tg10 &
&oa_tg1 oa_tg2 oa_tg5 oa_tg6 oa_tg7 oa_tg8 oa_tg9 oa_tg10 &
&bi_tg1 bi_tg2 bi_tg5 bi_tg6 bi_tg7 bi_tg8 bi_tg9 bi_tg10', &! sea_ms
'# Year LVa LVb LVc LVd NPVa NPVb NPVc NPVd NPV+a NPV+b NPV+c NPV+d ', &! sea_npv
'# Year be_tg1 be_tg2 be_tg5 be_tg6 be_tg7 be_tg8 be_tg9 be_tg10 &
&sp_tg1 sp_tg2 sp_tg4 sp_tg5 sp_tg6 sp_tg7 sp_tg8 sp_tg9 sp_tg10 &
&pi_tg1 pi_tg2 pi_tg3 pi_tg4 pi_tg5 pi_tg6 pi_tg7 pi_tg8 pi_tg9 pi_tg10 &
&oa_tg1 oa_tg2 oa_tg5 oa_tg6 oa_tg7 oa_tg8 oa_tg9 oa_tg10 &
&bi_tg1 bi_tg2 bi_tg5 bi_tg6 bi_tg7 bi_tg8 bi_tg9 bi_tg10', &! sea_st
'# Year sum_input u1 u2 u3 u4 u5 u6 u7 sum_u1-7 burn&
& landfill atmo atmo_cum emission sub_energ sub_mat sub_sum', & ! wpm
'# Year tg1 tg2 tg3 tg4 tg5 tg6 il1 il2 il3 il4 il5 il6 il7 pl1 pl2 pl3 pl4 pl5 pl6 pl7 u1 u2 u3 u4 u5 u6 u7 '/ ! wpm_inter
! special output forms
INTEGER :: out_flag_light ! output flag light-file
INTEGER :: unit_err ! unit for error log file
INTEGER :: unit_trace ! unit for trace log file
INTEGER :: unit_sum ! unit for summation output (fluxes) file
INTEGER :: unit_comp1, unit_comp2 ! ncompressed output
INTEGER :: unit_light, unit_wat
INTEGER :: unit_ctr, unit_prod, unit_allo, unit_soil
INTEGER :: unit_soicnd, unit_soicna, unit_soicnr
! store output variables of veg-file
type out_veg
integer,dimension(3):: help_veg1
real,dimension(11):: help_veg2
real help_veg3
real :: help_veg4
real :: help_veg5
real :: help_veg6
end type out_veg
type (out_veg),allocatable,dimension(:),target :: sout
type (out_veg) :: vout
type out_C
real, dimension(366):: NEE ! net ecosystem exchange
real, dimension(366):: Resp_aut ! autotrophic respiration
end type out_C
type (out_C) :: Cout
character(100) :: mess_info = '# ' ! output of measurements: information line
end module data_out
!**************************************************************
source_code/version_2.3_windows/amod_out.fold 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* 4C (FORESEE) Simulation Model *!
!* *!
!* *!
!* data module for various output files (Header ,...) *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
module data_out
! definition of output form each output type (kind_name) with 4 DATA statements
! character strings with more than 1 row must be separated only by &
! Attention! Blanks are normally significant, but problematic:
! at the beginning of the row only one blank is significant
!
! Recipe for new output files:
! add 1 to the dimension field "(type (out_struct),dimension(x+1),target :: out??)"
! a n d to the number of files "out??_n"+1
! add the specifier of output file to DATA kind_name
! add the comments on first and second line to the respective DATA statements
! add the column header to DATA header (pay attention to the above remarks regarding blanks!)
! add the write statements to the case construct with the kind_name (in output.f)
! depending on the output structure special open statements might have to be added
! in OLD_OUT in output.f
! data structure of skalar and field output
type out_struct
character (10) :: kind_name ! specifies the kind and the name of the output file
integer :: unit_nr ! output unit, set in output.f
integer :: out_flag ! output flag
character (200) :: f_line ! first comment line
character (500) :: s_line ! second comment line
character (900) :: header ! header of output columns
end type out_struct
! daily output of scalars and fields
type (out_struct),dimension(24),target :: outd ! daily output files
integer :: outd_n = 24 ! number of all declared daily output files
DATA outd%kind_name /'Cday','Chumd','Copmd','COPMfract','Cbcd', 'day', 'day_short','NH4','NH4c','NO3','NO3c','Nhumd','Nopmd', &
'NOPMfract', 'Nuptd', 'Nmind', 'perc', 'specd', 'temp', 'wat_potent', 'wat_res', 'water', 'watvol', 'wupt'/
DATA outd%f_line /'# Daily C balance', & ! Cday
'# C content of humus (hum) per layer', & ! Chumd
'# C content of organic primary matter (OPM) per layer', & ! Copmd
'# C content of organic primary matter (OPM) fractions', & ! COPMfract
'# C content of biochar per layer', & ! Cbcd
'# Daily output', & ! day
'# Short daily output', & ! day_short
'# NH4 content per layer', & ! NH4
'# NH4 concentration per layer', & ! NH4c
'# NO3 content per layer', & ! NO3
'# NO3 concentration per layer', & ! NO3c
'# N content of humus (hum) per layer', & ! Nhumd
'# N content of organic primary matter (OPM) per layer', & ! Nopmd
'# N content of organic primary matter (OPM) fractions', & ! NOPMfract
'# Daily nitrogen uptake by roots per layer Nupt', & ! Nuptd
'# Daily nitrogen mineralisation per layer Nmin', & ! Nmind
'# Daily percolation of water per layer perc', & ! perc
'# Daily species variables svar', & ! specd
'# Daily soil temperature per layer temps', & ! temp
'# Daily soil water potential per layer wat_potential',& ! wat_potent
'# Daily water uptake resistance per layer wat_res', & ! wat_res
'# Daily soil water content per layer wats', & ! water
'# Daily soil water content per layer watvol', & ! watvol
'# Daily water uptake by roots per layer wupt_r'/ ! wupt
DATA outd%s_line / &
'# gC/m2 gC/m2 gC/m2 gC/m2 gC/m2 gC/m2 gC/m2 gC/m2 gC/m2 gC/m2&
& gC/m2 gC/m2 gC/m2 %' , & ! Cday
'# gC_m2', & ! Chumd
'# gC_m2', & ! Copmd
'# gC/m2 |------------- Fagus sylvatica ----------------|--------------- Picea abies -----------------|&
&------------ Pinus sylvestris ----------------|--------------- Quercus robur ----------------|&
&------------- Betula pendula -----------------|-------------- Pinus contorta ---------------|&
&------------- Bodenvegetation ----------------|', & ! COPMfract
'# gC_m2', & ! Cbcd
'# Grad C J/cm2 mm mm mm mm mm mm mm mm&
& mol/m2 gC/m2 gN/m2 gN/m2 gN/m2 gN/m2 mgN/m2 &
& mm mm C&
J/cm2 J/cm2', & ! day
'# - mm', & ! day_short
'# gN/m2', & ! NH4
'# mgN/l', & ! NH4c
'# gN/m2', & ! NO3
'# mgN/l', & ! NO3c
'# gN/m2', & ! Nhumd
'# gN/m2', & ! Nopmd
'# gN/m2 |------------- Fagus sylvatica ----------------|--------------- Picea abies -----------------|&
&------------ Pinus sylvestris ----------------|--------------- Quercus robur ----------------|&
&------------- Betula pendula -----------------|-------------- Pinus contorta ---------------|&
&------------- Pinus ponderosa -----------------|-------------- Populus tremula ---------------|&
&------------- Bodenvegetation ----------------|', & ! NOPMfract
'# gN/m2', & ! Nuptd
'# gN/m2', & ! Nmind
'# mm/day', & ! perc
'# ', & ! specd
'# C', & ! temp
'# hPa', & ! wat_potent
'# ', & ! wat_res
'# mm', & ! water
'# vol%', & ! watvol
'# mm/day'/ ! wupt
DATA outd%header / &
'# Day Year gross_Phot gross_Ass net_Ass pot_NPP NPP NPP_day GPP_day NEE &
& TER_day autresp Resp_aut Resp_het Resp_fol FaPar',& ! Cday
'# Day Year Chum_1 Chum_2 Chum_3 Chum_4 Chum_5 Chum_6 ....',& ! Chumd
'# Day Year Copm_1 Copm_2 Copm_3 Copm_4 Copm_5 Copm_6 ....',& ! Copmd
'# Day Year C_opm_fol C_opm_tb C_opm_frt C_opm_crt C_opm_stm C_opm_fol C_opm_tb C_opm_frt C_opm_crt C_opm_stm &
& C_opm_fol C_opm_tb C_opm_frt C_opm_crt C_opm_stm C_opm_fol C_opm_tb C_opm_frt C_opm_crt C_opm_stm &
& C_opm_fol C_opm_tb C_opm_frt C_opm_crt C_opm_stm C_opm_fol C_opm_tb C_opm_frt C_opm_crt C_opm_stm &
& C_opm_fol C_opm_tb C_opm_frt C_opm_crt C_opm_stm ',& ! COPMfract
'# Day Year Cbc_1 Cbc_2 Cbc_3 Cbc_4 Cbc_5 Cbc_6 ....',& ! Cbcd
'# Day Year Temp Rad Prec Intercep Snow PET AET Transdem Transtree Transsveg&
& GP_can Resp_het Nleach_d Nupt_d Nmin_d_c N_antot N_Depo Cover&
& LAI s_Light toFPARcan fire_indi fire_e fire_w fire_n snowday drIndd&
& buckroot buck100 cl_WatBal dewp.temp dew/rime Rnet_tot Rad_max',& ! day
'# Date fire_e cl_WatBal',& ! day_short
'# Day Year NH4_1 NH4_2 NH4_3 NH4_4 NH4_5 NH4_6 ....',& ! NH4
'# Day Year NH4_1 NH4_2 NH4_3 NH4_4 NH4_5 NH4_6 ....',& ! NH4c
'# Day Year NO3_1 NO3_2 NO3_3 NO3_4 NO3_5 NO3_6 ....',& ! NO3
'# Day Year NO3_1 NO3_2 NO3_3 NO3_4 NO3_5 NO3_6 ....',& ! NO3c
'# Day Year Nhum_1 Nhum_2 Nhum_3 Nhum_4 Nhum_5 Nhum_6 ....',& ! Nhumd
'# Day Year Nopm_1 Nopm_2 Nopm_3 Nopm_4 Nopm_5 Nopm_6 ....',& ! Nopmd
'# Day Year N_opm_fol N_opm_tb N_opm_frt N_opm_crt N_opm_stm N_opm_fol N_opm_tb N_opm_frt N_opm_crt N_opm_stm &
& N_opm_fol N_opm_tb N_opm_frt N_opm_crt N_opm_stm N_opm_fol N_opm_tb N_opm_frt N_opm_crt N_opm_stm &
& N_opm_fol N_opm_tb N_opm_frt N_opm_crt N_opm_stm N_opm_fol N_opm_tb N_opm_frt N_opm_crt N_opm_stm &
& N_opm_fol N_opm_tb N_opm_frt N_opm_crt N_opm_stm ',& ! NOPMfract
'# Day Year Nupt_1 Nupt_2 Nupt_3 Nupt_4 Nupt_5 Nupt_6 ....',& ! Nuptd
'# Day Year Nmin_1 Nmin_2 Nmin_3 Nmin_4 Nmin_5 Nmin_6 ....',& ! Nmind
'# Day Year Percol_1 Percol_2 Percol_3 Percol_4 Percol_5 Percol_6 ....',& ! perc
'# Day Year species_name number Ndem Nupt Ndemp Nuptp RedN ',& ! specd
'# Day Year Temp_surf Temps_1 Temps_2 Temps_3 Temps_4 Temps_5 Temps_6 ....',& ! temp
'# Day Year Pot_1 Pot_2 Pot_3 Pot_4 Pot_5 Pot_6 ....',& ! wat_potent
'# Day Year Wat_res_1 Wat_res_2 Wat_res_3 Wat_res_4 Wat_res_5 Wat_res_6 ....',& ! wat_res
'# Day Year Wats_1 Wats_2 Wats_3 Wats_4 Wats_5 Wats_6 ....',& ! water
'# Day Year Wats_1 Wats_2 Wats_3 Wats_4 Wats_5 Wats_6 ....',& ! watvol
'# Day Year Wupt_r_1 Wupt_r_2 Wupt_r_3 Wupt_r_4 Wupt_r_5 Wupt_r_6 ....'/ ! wupt
! ----------------------------------------------------- !
! yearly output of scalars and fields
type (out_struct),dimension(57),target :: outy ! yearly output files
integer :: outy_n = 57 ! number of all declared yearly output files
DATA outy%kind_name /'AET_mon','c_bal','Cbc','Chum','Copm','classd','classage','classmvol','classd_h','classdm', 'classdm_h',&
'classh', 'classt', 'clim', 'clim_temp', 'clim_prec', 'clim_rad', 'clim_hum', &
'fcap_av','fcapv_av', 'fr_loss','GPP_mon', 'humusv', 'indi', &
'litter','Nbc','Nhum','Nopm','NEE_mon','NPP_mon','manrec', 'mansort', 'redis', 'root', 'sdrought',&
'soil', 'spec', 'standsort','TER_mon','veg', 'veg_in', 'veg_out', &
'veg_be','veg_bi','veg_pi', 'veg_pc', 'veg_pp', 'veg_pt', &
'veg_oa','veg_sp','veg_ph', 'veg_dg', 'veg_rb', 'veg_egl', 'veg_egr','veg_sveg','veg_mist'/
DATA outy%f_line /'# Monthly sum of actual evapotranspiration (AET)', & ! AET_mon
'# Yearly C-Balance, C-stocks and -fluxes; C_sumvsab is part of C_biomass', & ! c_bal
'# C content of biochar (C_bc) per layer', & ! Cbc
'# C content of humus (hum) per layer', & ! Chum
'# C content of organic primary matter (OPM) per layer', & ! Copm
'#', & ! classd
'#', & ! classage
'#', & ! classmvol
'#', & ! classd_h
'#', & ! classdm
'#', & ! classdm_h
'#', & ! classh
'#', & ! classt
'# Climate data', & ! clim
'# Air temperature: monthly climate data', & ! clim_temp
'# Precipitation: monthly climate data', & ! clim_prec
'# Radiation: monthly climate data', & ! clim_rad
'# Relative humidity: monthly climate data', & ! clim_hum
'# Available field capacity per layer', & ! fcap_av
'# Available field capacity per layer', & ! fcapv_av
'# Percentage fine root C-loss per soil layer', & ! fr_loss
'# Monthly GPP of all cohorts and species', & ! GPP_mon
'# Content of humus per layer', & ! humusv
'# Indices of fire and biodiversity', & ! indi
'# Yearly litter fractions', & ! litter
'# N content of biochar (N_bc) per layer', & ! Nbc
'# N content of humus (hum) per layer', & ! Nhum
'# N content of organic primary matter (OPM) per layer', & ! Nopm
'# Monthly NEE of all cohorts and species', & ! NEE_mon
'# Monthly NPP of all cohorts and species', & ! NPP_mon
'# Management record', & ! manrec
'# Management sortiment',& ! mansort
'# Redistribution of root C (redis)', & ! redis
'# Root distribution (root_fr)', & ! root
'# Data from soil model', & ! sdrought
'# Data from soil model', & ! soil
'# Species number and name', & ! spec
'# sortiment of whole stand (without harvested trees)',& ! standsort
'# Monthly TER of all cohorts and species', & ! TER_mon
'# Values for the whole stand (per ha); see files veg_in, veg_out in addition', & ! veg
'# New trees (by planting or regeneration), values for the whole stand (per ha)', & ! veg_in
'# Removed trees (by mortality or management) with number of cohorts from which trees are removed (per ha)', & ! veg_out
'# Values for the whole stand (per ha) for beech', & ! veg_be
'# Values for the whole stand (per ha) for birch', & ! veg_bi
'# Values for the whole stand (per ha) for pinus sylvestris', & ! veg_pi
'# Values for the whole stand (per ha) for pinus contorta', & ! veg_pc
'# Values for the whole stand (per ha) for pinus ponderosa', & ! veg_pp
'# Values for the whole stand (per ha) for populus tremula', & ! veg_pt
'# Values for the whole stand (per ha) for oak', & ! veg_oa
'# Values for the whole stand (per ha) for spruce', & ! veg_sp
'# Values for the whole stand (per ha) for pinus halepensis', & ! veg_ph
'# Values for the whole stand (per ha) for douglas fir', & ! veg_dg
'# Values for the whole stand (per ha) for black locust', & ! veg_rb
'# Values for the whole stand (per ha) for E.globulus', & ! veg_egl
'# Values for the whole stand (per ha) for E.grandis', & ! veg_egr
'# Values for the whole stand (per ha) for ground vegetation', & ! veg_sveg
'# Values for the whole stand (per ha) for mistletoe (Visc. a.)'/! veg_mist
DATA outy%s_line / &
'# mm', & ! AET_mon
'# kg/ha kg/ha kg/ha kg/ha kg/ha kg/ha kg/ha kg/ha&
& kg/ha kg/ha t/ha t/ha t/ha t/ha t/ha t/ha t/ha t/ha t/ha&
& mol/m2 mol/m2 mol/m2 mol/m2 mol/m2 mol/m2 mol/m2 mol/m2&
& mol/m2 mol/m2 mol/m2 kg/ha', & ! c_bal
'# gC/m2', & ! Cbc
'# gC/m2', & ! Chum
'# gC/m2', & ! Copm
'# diam_class: Number of trees (per ha) in diameter classes, step 5 cm', & ! classd
'# diam_class: Mean age of trees (per ha) in diamter classes, step 5 cm', & ! classage
'# diam_class: Mean volume (m/ha) of harvested trees in diamter classes, step 5 cm', & ! classmvol
'# diam_class: Mean height of trees in diameter classes, step 5 cm', & ! classd_h
'# diam_class: Number of harvested trees (per ha) in diameter classes, step 5 cm', & ! classdm
'# diam_class: Mean height of trees in diameter classes, step 5 cm', & ! classdm_h
'# height_class: Number of trees in height classes, bis 1,5,6,7,...,50,55,>55m', & ! classh
'# diam_class: Number of dead trees (per ha) in diameter classes, step 5 cm', & ! classt
'# C mm J/cm2 m/s ppm C', & ! clim
'# C ... ', & ! clim_temp
'# mm ... ', & ! clim_prec
'# J/cm2 ... ', & ! clim_rad
'# % ... ', & ! clim_hum
'# mm', & ! fcap_av
'# %', & ! fcapv_av
'# yearly mean fine root C-loss', & ! fr_loss
'# gC/m2', & ! GPP_mon
'# %', & ! humusv
'# fire index |------------ fire index west ------------|&
&|----------------------- fire index east -----------------------|&
&|------- fire index Nesterov -------|', & ! indi
'# |-------------------------------- Dry mass kg DW/ha_yr ---------------------------------|&
& |----------------- Carbon content kg C/ha_yr -------------------|&
& |----------------- Nitrogen content kg N/ha_yr -----------------|', & ! litter
!& % % % % ', & ! litter
'# gN/m2', & ! Nbc
'# gN/m2', & ! Nhum
'# gN/m2', & ! Nopm
'# gC/m2', & ! NEE_mon
'# gC/m2', & ! NPP_mon
' ', & ! manrec
' cm cm cm cm cm m/ha kg C/ha ', & ! mansort
'# relative share of redistributed C per layer (whole stand) ', & ! redis
'# relative share of root mass per layer (whole stand) ', & ! root
'# s_drought: Number of days with water content near wilting point (drought days) per layer', & ! sdrought
'# Grad_C mm mm mm mm mm mm mm mm mm mm mol_m2 gN_m2&
& gN_m2 gC_m2 gN_m2 gN_m2 gC_m2 gN_m2 gC_m2 gN_m2 gC_m2 gC_m2 gC_m2 gC_m2 gC_m2 gC_m2&
& gN_m2 gN_m2 gN_m2 gC_m2 mm mm cm mm J/cm2 gN_m2 gC_m2 gC_m2',& ! soil
'#', & ! spec
' cm cm cm cm cm m/ha kg C/ha ', & ! standsort
'# gC/m2', & ! TER_mon
'# /ha m2_m2 kg_DW/ha kg_DW_yr/ha cm cm&
& kg_DW/ha kg_DW/ha kg_DW/ha kg_DW/ha kg_DW/ha m3/ha kg_DW/ha kg_DW/ha m2_m2&
& gN/m2 mol/m2 mol/m2 mol/m2 cm cm m m/ha m/ha', & ! veg
2*'# /ha m2_m2 kg_DW/ha cm cm&
& kg_DW/ha kg_DW/ha kg_DW/ha kg_DW/ha kg_DW/ha m3/ha kg_DW/ha kg_DW/ha m2_m2&
& gN/m2 mol/m2 mol/m2 mol/m2', & ! veg_in, veg_out
15*'# /ha m2_m2 kg_DW/ha kg_DW_yr/ha cm &
&cm kg_DW/ha kg_DW/ha kg_DW/ha kg_DW/ha kg_DW/ha m3/ha kg_DW/ha kg_DW/ha m2_m2&
& gN/m2 gN/m2 - - cm cm m m/ha m/ha mm'/ ! veg_be, bi, pi, oa, sp, sveg
DATA outy%header / &
'# Year AET_1 AET_2 AET_3 AET_4 AET_5 AET_6 AET_7 AET_8 AET_9 AET_10&
& AET_11 AET_12 AET_Quar1 AET_Quar2 AET_Quar3 AET_Quar4 AET_DJF AET_MAM AET_JJA AET_SON', & ! AET_mon
'# Year GPP NPP NEP Aut_Resp Het_Resp Tot_Resp C_dead_st C_sumvsab C_biomass&
& C_tot_ES C_soil C_tot_1 C_hum_1 C_tot_40 C_hum_40 C_tot_80 C_hum_80 C_tot_100 C_hum_100&
& GPP NPP NEP Aut_Resp Het_Resp Tot_Resp C_dead_st&
& C_sumvsab C_biomass C_tot_ES C_soil gppsum', & ! c_bal
'# Year Cbc_1 Cbc_2 Cbc_3 Cbc_4 Cbc_5 Cbc_6 ....',& ! Cbc
'# Year Chum_1 Chum_2 Chum_3 Chum_4 Chum_5 Chum_6 ....',& ! Chum
'# Year Copm_1 Copm_2 Copm_3 Copm_4 Copm_5 Copm_6 ....',& ! Copm
'# Year', & ! classd
'# Year', & ! classage
'# Year', & ! classmvol
'# Year', & ! classd_h
'# Year', & ! classdm
'# Year', & ! classdm_h
'# Year', & ! classh
'# Year', & ! classt
'# Year Temp Prec Radiation Wind CO2 GDD summerdays hotdays icedays &
& drydays hraindays snowdays Ind_arid CWB Ind_Lang Ind_Cout Ind_Wissm Ind_Mart Ind_Mart_VP &
&Ind_Emb Ind_Weck Ind_Reich Ind_Gor I_Currey I_Conrad NTIndex Ind_Budyko F_day F_day_sp l_frost l_frosttot anzfd sumtfd iday_vp Ind_SHC', & ! clim
'# Year Temp_1 Temp_2 Temp_3 Temp_4 Temp_5 Temp_6 Temp_7 Temp_8 Temp_9 Temp_10&
& Temp_11 Temp_12 T_Quart1 T_Quart2 T_Quart3 T_Quart4 T_DJF T_MAM T_JJA T_SON', & ! clim_temp
'# Year Prec_1 Prec_2 Prec_3 Prec_4 Prec_5 Prec_6 Prec_7 Prec_8 Prec_9 Prec_10&
& Prec_11 Prec_12 P_Quart1 P_Quart2 P_Quart3 P_Quart4 P_DJF P_MAM P_JJA P_SON', & ! clim_prec
'# Year Rad_1 Rad_2 Rad_3 Rad_4 Rad_5 Rad_6 Rad_7 Rad_8 Rad_9 Rad_10&
& Rad_11 Rad_12 R_Quart1 R_Quart2 R_Quart3 R_Quart4 R_DJF R_MAM R_JJA R_SON', & ! clim_rad
'# Year Hum_1 Hum_2 Hum_3 Hum_4 Hum_5 Hum_6 Hum_7 Hum_8 Hum_9 Hum_10&
& Hum_11 Hum_12 H_Quart1 H_Quart2 H_Quart3 H_Quart4 H_DJF H_MAM H_JJA H_SON', & ! clim_hum
'# Year fcap_av_1 fcap_av_2 fcap_av_3 fcap_av_4 fcap_av_5 fcap_av_6 ....',& ! fcap_av
'# Year fcapvav_1 fcapvav_2 fcapvav_3 fcapvav_4 fcapvav_5 fcapvav_6 ....',& ! fcapv_av
'# Year lay_1 lay_2 lay_3 lay_4 lay_5 lay_6 ....',& ! fr_loss
'# Year GPP_1 GPP_2 GPP_3 GPP_4 GPP_5 GPP_6 GPP_7 GPP_8 GPP_9 GPP_10&
& GPP_11 GPP_12 GPP_Quar1 GPP_Quar2 GPP_Quar3 GPP_Quar4 GPP_DJF GPP_MAM GPP_JJA GPP_SON', & ! GPP_mon
'# Year humus_1 humus_2 humus_3 humus_4 humus_5 humus_6 ....',& ! humusv
'# Bruschek Mean class1 class2 class3 class4 class5&
& Mean class1 class2 class3 class4 class5 Ind_max Ind_day Mean class1 class2 class3 class4', & ! indi
'# Year fol_litter fol_lit_tr frt_litter frt_lit_tr crt_litter tb_litter stem_litter tot_litter&
& fol_litter frt_litter crt_litter tb_litter stem_litter tot_litter&
& fol_litter frt_litter crt_litter tb_litter stem_litter tot_litter', & ! litter
!'# Year fol_litter frt_litter crt_litter tb_litter stem_litter fol_litter frt_litter&
!& crt_litter tb_litter stem_litter', & ! litter
'# Year Nbc_1 Nbc_2 Nbc_3 Nbc_4 Nbc_5 Nbc_6 ....',& ! Nbc
'# Year Nhum_1 Nhum_2 Nhum_3 Nhum_4 Nhum_5 Nhum_6 ....',& ! Nhum
'# Year Nopm_1 Nopm_2 Nopm_3 Nopm_4 Nopm_5 Nopm_6 ....',& ! Nopm
'# Year NEE_1 NEE_2 NEE_3 NEE_4 NEE_5 NEE_6 NEE_7 NEE_8 NEE_9 NEE_10&
& NEE_11 NEE_12 NEE_Quar1 NEE_Quar2 NEE_Quar3 NEE_Quar4 NEE_DJF NEE_MAM NEE_JJA NEE_SON', & ! NEE_mon
'# Year NPP_1 NPP_2 NPP_3 NPP_4 NPP_5 NPP_6 NPP_7 NPP_8 NPP_9 NPP_10&
& NPP_11 NPP_12 NPP_Quar1 NPP_Quar2 NPP_Quar3 NPP_Quar4 NPP_DJF NPP_MAM NPP_JJA NPP_SON', & ! NPP_mon
'# Year management measure ', & ! manrec
'# year count spec type len diam diam wob top_d t_d wob Volume DW number type', & ! mansort
'# Year lay_1 lay_2 lay_3 lay_4 lay_5 lay_6 ....',& ! redis
'# Year root_1 root_2 root_3 root_4 root_5 root_6 ....',& ! root
'# Year layer1 layer2 layer3 layer4 ........', & ! sdrought
'# Year Temp Prec Interc Percol Wupt Wuptroot Transtree Transsveg Wuptsoil AET Wats_tot&
& GP_can N_min N_tot C_tot N_antot N_humtot C_humtot N_hum(1) C_hum(1) N_litter&
& C_litter C_opm_fol C_opm_frt C_opm_crt C_opm_tbc C_opm_stm Nupt Nleach N_depo Soil_Resp&
& PET interc_sv thick1 dew/rime Rnet_tot N_bc_tot C_bc_tot C_bc_app', & ! soil
'# Year', & ! spec
' year count spec type len diam diam wob top_d t_d wob Volume DW number ', & ! standsort
'# Year TER_1 TER_2 TER_3 TER_4 TER_5 TER_6 TER_7 TER_8 TER_9 TER_10&
& TER_11 TER_12 TER_Quar1 TER_Quar2 TER_Quar3 TER_Quar4 TER_DJF TER_MAM TER_JJA TER_SON', & ! TER_mon
'# Year num_Spec Coh Tree LAI Biomass NPPsum Meddiam&
& Domhei Fol_Bio Sap_Bio Frt_Bio Hrt_Bio Stem_inc Stemvol rem_stems&
& dead_stems cover drIndAl Ndem gp_can_mean gp_can_min gp_can_max mean_diam mean_height basal_area dead_stems_m3 stem_inc_m3', & ! veg
2* '# Year num_Spec Coh Tree LAI Biomass Meddiam&
& mean_hei Fol_Bio Sap_Bio Frt_Bio Hrt_Bio Stem_inc Stemvol rem_stems&
& dead_stems cover drIndAl Ndem gp_can_mean gp_can_min gp_can_max', & ! veg_in, veg_out
15*'# Year Spec_id Coh Tree LAI Biomass NPPsum Meddiam&
& Domhei Fol_Bio Sap_Bio Frt_Bio Hrt_Bio Stem_inc Stemvol rem_stems&
& dead_stems cover drIndAl Ndem Nupt Red_N daybb endbb mean_diam mean_height basal_area dead_stems_m3 stem_inc_m3 YRW'/ ! veg_be, bi, pi, oa, sp,lp, sveg, mist
! ----------------------------------------------------- !
! daily output of cohorts
type (out_struct),dimension(23),target :: outcd
integer :: outcd_n = 23 ! number of all declared cohort output files
DATA outcd%kind_name /'ass', 'aevi', 'ddi', 'dem', 'dips', 'gp', 'gsdps', 'intcap', 'interc', &
'Ndemc_d', 'Nuptc_d', 'N_fol', 'N_pool', 'RedNc', 'resp', 'respaut', &
'respbr', 'respfol', 'resphet', 'respsap', 'respfrt', 'sup', 'totfpar'/
DATA outcd%s_line /23*'# Cohort output'/ ! ass, ddi, dem, gp, gsdps, res,
! resbr, ressap, resfrt, sup
DATA outcd%f_line / &
'# Optimum gross assimilation rate (kg DW/d) assi', & ! ass
'# Daily evaporation of intercepted water (mm/day) aev_i', & ! aevi
'# Daily drought index drindd', & ! ddi
'# Demand for soil water of the cohort (mm/day) demand', & ! dem
'# Drought index for Photosyntheses calculation (cum) drindps', & ! dips
'# Unstressed stomatal conductance (mol/m2*d) gp', & ! gp
'# Number of growing season days per time step of photosynthesis ndaysps', & ! gsdps
'# Interception capacity (mm) sum of intcap(layer)', & ! intcap
'# Interception storage (mm) interc_st', & ! interc
'# Daily N demand per tree (g)', & ! Ndemc_d
'# Daily N uptake per tree (g)', & ! Nuptc_d
'# Daily N content of foliage per tree (g)', & ! N_fol
'# Daily N_pool per tree (g)', & ! N_pool
'# Daily photosynthesis nitrogen reduction factor [-]', & ! RedNc
'# Leaf respiration rate (g C/d) resp', & ! resp
'# Daily autotrophic respiration rate (g C/d) respaut', & ! respaut
'# Daily respiration rate of branches (g C/d) respbr', & ! respbr
'# Daily respiration rate of leaves (g C/d) respfol', & ! respfol
'# Daily heterotrophic respiration rate (g C/d) resphet', & ! resphet
'# Daily respiration rate of sapwood (g C/d) respsap', & ! respsap
'# Daily respiration rate of frt (g C/d) respfrt', & ! respfrt
'# Supply of soil water to roots of the cohort (mm/day) supply', & ! sup
'# Total fraction of PAR absorbed per m patch area (-) totFPAR'/ ! totfpar
DATA outcd%header / &
23*'# Day Year Coh1 Coh2 Coh3 Coh4 ...'/ ! ass, ddi, dem, gp, gsdps, res,
! resbr, ressap, resfrt, sup
! ----------------------------------------------------- !
! yearly output of cohorts
type (out_struct),dimension(58),target :: outcy
integer :: outcy_n = 58 ! number of all declared cohort output files
DATA outcy%kind_name /'age', 'ahb', 'ahbasrel', 'ahc', 'ahcasrel', 'asapw', 'atr', 'bioi', 'botlayer','cpa', 'crt', 'daybb', 'dcrb', 'diac', 'diam', &
'dtr', 'dwd','fol', 'foli', 'frt', 'frti', 'frtrel', 'frtrelc', 'geff', 'gfol', 'gfrt', 'grossass', 'gsap', &
'gsd', 'hbo', 'hea', 'hei', 'hrt', 'leaf', 'maintres', 'nas', 'npp', 'rdpt', 'rld', 'sap', &
'sfol', 'sfrt', 'spn', 'ssap', 'stem', 'str', 'tdb','toplayer', 'trman', 'ttb','Ndemc_c','Nuptc_c', &
'Nfol', 'Npool', 'Nstr','rooteff', 'watleft', 'yrw'/
DATA outcy%s_line /58*'# Cohort output'/ ! age, ahb, ahc, atr, asapw, bioi, botLayer, cpa, crt, daybb, dcrb, diac, diam,
! dtr, dwd, fol, foli, frt, frti, frtrel, geff, gfol, gfrt,
! grossass, gsap, gsd, hbo, hea, hrt, hei,
! leaf, maintres, nas, npp, rdpt, rld, sap, sfol, sfrt, spn,
! ssap, stem, str, tdb, topLayer, trman,ttb, Ndemc,Nuptc, rooteff,watleft
DATA outcy%f_line / &
'# Tree age (year)', & ! age
'# Cross sectional area of heartwood at stem base [cm**2] x_Ahb', & ! ahb
'# Relation of heartwood to sapwood at stem base', & ! ahbasrel
'# Cross sectional area of heartwood at crown base [cm**2] Ahc', & ! ahc
'# Relation of heartwood to sapwood at crown base', & ! ahcasrel
'# Cross sectional area of sapwood in bole space [cm**2] Asapw', & ! asapw
'# Number of alive trees per cohort', & ! atr
'# Net biomass increment (kg DM/year)', & ! bioi
'# Number of bottom layer of crown [-]', & ! botLayer
'# Cohort crown projection area (m2)', & ! cpa
'# coarse root biomass (kg DM/tree)', & ! crt
'# Day of leaf bud burst', & ! daybb
'# Diameter of stem at crown base (cm)',& ! dcrb
'# Drought index for allocation calculation (cum)', & ! diac
'# Diameter at breast height (cm)', & ! diam
'# Number of dead trees per cohort', & ! dtr
'# Stem biomass of dead trees per cohort', & ! dwd
'# Foliage biomass (kg DM/tree)', & ! fol
'# Foliage increment (kg DM/year/tree)', & ! foli
'# Fine root biomass (kg DM/tree)', & ! frt
'# Net fine root increment (kg DM/year/tree)', & ! frti
'# Relative fine root fraction of tree per soil layer (root profile)', & ! frtrel
'# Relative fine root fraction of cohort of total layer fine root mass per soil layer', & ! frtrel
'# Growth efficiency kg/m2', & ! geff
'# Gross growth rate foliage (kg DM/year/tree)', & ! gfol
'# Gross growth rate fine root (kg DM/year/tree)', & ! gfrt
'# Gross assimilation rate (kg DM/year/tree)', & ! grossass
'# Gross growth rate sapwood (kg DM/year/tree)', & ! gsap
'# Number of growing season days per year ndaysgr',& ! gsd
'# Bole height (cm)', & ! hbo
'# Number of years without stress', & ! hea
'# Total tree height (cm)', & ! hei
'# Heartwood biomass (kg DM/tree)', & ! hrt
'# Leaf area per tree (m2)', & ! leaf
'# Maintenance respiration (kg DM/year/tree)', & ! maintres
'# Net foliage assimilation rate (kg DM/year/tree)', & ! nas
'# NPP (kg DM/year/tree)', & ! npp
'# Rooting depth calculated with TRAP model[cm]', & ! rdpt
'# estimated root length density [cm]', & ! rld
'# Sapwood biomass (kg DM)', & ! sap
'# Senescence rate foliage (kg DM/year/tree)', & ! sfol
'# Senescence rate fine roots (kg DM/year/tree)', & ! sfrt
'# Species number of the cohort', & ! spn
'# Senescence rate sapwood (kg DM/year/tree)', & ! ssap
'# Stemwood biomass increment (kg DM/year/tree)', & ! stem
'# Number of stress years', & ! str
'# Total cohort dead biomass (kg DM/year/cohort)', & ! tdb
'# Number of top layer of crown [-]', & ! topLayer
'# Number of trees harvested by managment', & ! trman
'# Total tree biomass (kg DM/tree)', & ! ttb
'# N demand per tree and year (g)', & ! Ndemc_c
'# N uptake per tree and year (g)', & ! Nuptc_c
'# N content of foliage per tree and year (g)', & ! Nfol
'# N pool per tree and year (g)', & ! Npool
'# Ratio of N uptake to demand per tree and year', & ! Nstr
'# Root uptake efficiency factor', & ! rooteff
'# Water left in next layer', & ! watleft
'# Year ring width [mm]' / ! yrw
DATA outcy%header / &
58*'# Year Coh1 Coh2 Coh3 Coh4 ...'/ !age, ahb, ahc, atr, bioi, cpa, crt, daybb, dcrb, diac, diam,
! dtr, dwd, fol, foli, frt, frti, frtrel, geff, gfol, gfrt,
! gsap, gsd, hbo, hea, hrt, hei,
! leaf, maintres, nas, npp, rdpt, rld, sap, sfol, sfrt, spn,
! stem, str, tdb,trman, ttb, Ndemc,Nuptc, rooteff,watleft, yrw
! output at simulation end
type (out_struct),dimension(6),target :: oute
integer :: oute_n = 6 ! number of all declared end output files
DATA oute%kind_name /'sea', 'sea_ms', 'sea_npv', 'sea_st','wpm', 'wpm_inter'/
DATA oute%f_line / &
'# SEA: Costs and assets of standing stock, harvested timber, silvicultural costs, fix costs, and subsidies in euro/ha', &
'# SEA: Timber grading for harvested wood, m3/ha', &
'# SEA: liquidation value, npv, npv+ in euro/ha', &
'# SEA: Timber grading for standing stock, m3/ha', &
'# Wood product model output', &
'# Wood product model intermediate steps'/ !
DATA oute%s_line / &
'# shotcuts: sum: summe, st: standing stock, ms: harvested wood, fc: fix costs, sv: silvicultural costs, co: costs, as: assets, sub: subsidies, sp: spruce, be: beech, pi: pine, oa: oak, bi: birch, ' , &
'# Timber grades 1-7: 1-fue, 2-in, 3-LAS1a, 4-LAS1b, 5-LAS2a, 6-LAS2b, 7-LAS3a, 8-L2b, 9-L3a, 10-L3b ' , &
'# a: without discounting, b-d: interest rate (see "sea_prices.wpm" file) ' , &
'# Timber grades 1-7: 1-fue, 2-in, 3-LAS1a, 4-LAS1b, 5-LAS2a, 6-LAS2b, 7-LAS3a, 8-L2b, 9-L3a, 10-L3b ' , &
'# Carbon in different products, kg C/ha ' , &
'# Carbon in different products, kg C/ha tg: timber grades, il: industrial lines, pl: product lines'/
DATA oute%header / &
'# Year sum_all sum_st sum_ms sum_sv sum_fc sum_sub be_st_co sp_st_co pi_st_co oa_st_co bi_st_co |be_st_as sp_st_as pi_st_as oa_st_as bi_st_as |be_ms_co sp_ms_co pi_ms_co oa_ms_co bi_ms_co |be_ms_as sp_ms_as pi_ms_as oa_ms_as bi_ms_as fix_costs sub_har sub_sv_co sub_fix ', &! sea
'# Year be_tg1 be_tg2 be_tg5 be_tg6 be_tg7 be_tg8 be_tg9 be_tg10 &
&sp_tg1 sp_tg2 sp_tg4 sp_tg5 sp_tg6 sp_tg7 sp_tg8 sp_tg9 sp_tg10 &
&pi_tg1 pi_tg2 pi_tg3 pi_tg4 pi_tg5 pi_tg6 pi_tg7 pi_tg8 pi_tg9 pi_tg10 &
&oa_tg1 oa_tg2 oa_tg5 oa_tg6 oa_tg7 oa_tg8 oa_tg9 oa_tg10 &
&bi_tg1 bi_tg2 bi_tg5 bi_tg6 bi_tg7 bi_tg8 bi_tg9 bi_tg10', &! sea_ms
'# Year LVa LVb LVc LVd NPVa NPVb NPVc NPVd NPV+a NPV+b NPV+c NPV+d ', &! sea_npv
'# Year be_tg1 be_tg2 be_tg5 be_tg6 be_tg7 be_tg8 be_tg9 be_tg10 &
&sp_tg1 sp_tg2 sp_tg4 sp_tg5 sp_tg6 sp_tg7 sp_tg8 sp_tg9 sp_tg10 &
&pi_tg1 pi_tg2 pi_tg3 pi_tg4 pi_tg5 pi_tg6 pi_tg7 pi_tg8 pi_tg9 pi_tg10 &
&oa_tg1 oa_tg2 oa_tg5 oa_tg6 oa_tg7 oa_tg8 oa_tg9 oa_tg10 &
&bi_tg1 bi_tg2 bi_tg5 bi_tg6 bi_tg7 bi_tg8 bi_tg9 bi_tg10', &! sea_st
'# Year sum_input u1 u2 u3 u4 u5 u6 u7 sum_u1-7 burn&
& landfill atmo atmo_cum emission sub_energ sub_mat sub_sum', & ! wpm
'# Year tg1 tg2 tg3 tg4 tg5 tg6 il1 il2 il3 il4 il5 il6 il7 pl1 pl2 pl3 pl4 pl5 pl6 pl7 u1 u2 u3 u4 u5 u6 u7 '/ ! wpm_inter
! special output forms
INTEGER :: out_flag_light ! output flag light-file
INTEGER :: unit_err ! unit for error log file
INTEGER :: unit_trace ! unit for trace log file
INTEGER :: unit_sum ! unit for summation output (fluxes) file
INTEGER :: unit_comp1, unit_comp2 ! ncompressed output
INTEGER :: unit_light, unit_wat
INTEGER :: unit_ctr, unit_prod, unit_allo, unit_soil
INTEGER :: unit_soicnd, unit_soicna, unit_soicnr
! store output variables of veg-file
type out_veg
integer,dimension(3):: help_veg1
real,dimension(11):: help_veg2
real help_veg3
real :: help_veg4
real :: help_veg5
real :: help_veg6
end type out_veg
type (out_veg),allocatable,dimension(:),target :: sout
type (out_veg) :: vout
type out_C
real, dimension(366):: NEE ! net ecosystem exchange
real, dimension(366):: Resp_aut ! autotrophic respiration
end type out_C
type (out_C) :: Cout
character(100) :: mess_info = '# ' ! output of measurements: information line
end module data_out
!**************************************************************
source_code/version_2.3_windows/amod_par.f 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* 4C (FORESEE) Simulation Model *!
!* *!
!* *!
!*data module for a variety of parameters (non-species dependent)*!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
module data_par
! from npp.f:
real :: pi = 3.1415926536 ! PI
real :: zero = 1.E-6 ! numerical zero
REAL :: lambda = 0.7 , & ! optimum ratio of ci to ca [-]
Cmass = 12.0 , & ! molar mass of carbon [g/mol]
gmin = 0.0 , & ! minimum conductance [mol/(m2*d)]
ps = 0.7 , & ! shape of PS response curve
pn = 0.025 , & ! slope of N function (eqn 27) at 20 �C [g(N) (mymol s-1)-1]
nc0 = 0.00715 , & ! minimum N content [g/g] (eqn 27)
qco2 = 0.08 , & ! C3 quantum efficiency (eqn 16)
qco2a = 1.0 , & ! scaling parameter (eqn A7)
o2 = 20.9 , & ! partial pressure of oxygen (kPa)
co2_st= 0.00035, & ! atmospheric CO2 content (mol/mol)
pfref = 0.2 , & ! albedo of the canopy
cpart = 0.5 , & ! part of C in biomass [-]
rmolw = 0.622 , & ! ratio of molecular weights of water and air
R_gas = 8.314 , & ! universal gas constant [J/mol/K] = [Pa/m3/K]
c_karman = 0.41 , & ! von Karman's constant [-]
c_air = 1.005 , & ! specific heat of air at const. pressure [J/g/K]
psycro =0.000662 , & ! psychrometer constant [hPa/K]
h_breast =137 , & ! breast height for inventory measurements [cm]
h_sapini = 200 , & ! height below which tree is initialised with sapling allometry
h_bo_br_diff = 50, & ! minimal difference between height of crown base and breast height
Q10_T = 2. ! used for calculation of dayfract from air temperature
DOUBLE PRECISION :: p0_co2 , & ! parameter variable for calculation of CO2 scenarios
p1_co2 , & ! parameter variable for calculation of CO2 scenarios
p2_co2 , & ! parameter variable for calculation of CO2 scenarios
p3_co2 , & ! parameter variable for calculation of CO2 scenarios
p4_co2 , & ! parameter variable for calculation of CO2 scenarios
p1_co2h , & ! parameter variable for calculation of historical CO2 scenarios
p2_co2h , & ! parameter variable for calculation of historical CO2 scenarios
p3_co2h , & ! parameter variable for calculation of historical CO2 scenarios
p4_co2h , & ! parameter variable for calculation of historical CO2 scenarios
p5_co2 ! parameter variable for calculation of CO2 scenarios
! Transformation coefficients
REAL :: gm2_in_kgha = 10. ! transf. coeff. from g/m2 in kg/ha
REAL :: kgha_in_gm2 = 0.1 ! transf. coeff. from kg/ha in g/m2
REAL :: gm2_in_tha = 0.01 ! transf. coeff. from g/m2 in t/ha
REAL :: tha_in_gm2 = 100. ! transf. coeff. from t/ha in g/m2
REAL :: kg_in_g = 1000. ! transf. coeff. from kg in g
REAL :: GR_in_PAR = 0.5*4.6/100. ! from global rad. in J/cm2 to PAR in mol/m2
! explanation of conversion factor:
! 0.5: PAR is 50% of incident radiation
! 4.6: 1 J = 4.6e-6 mol (Larcher 1995);
! 100: conversion J/cm2 -> MJ/m2
! soil parameter
real :: dens_om = 1.4 ! specific density of organic matter g/cm3
! parameter for snow
real :: temp_snow = 0.2 ! threshold of air temperature for snow accumulation
! parameter for calculation of potential evapotranspiration rate
real :: alpha_PT = 1.26 ! Priestley-Taylor coefficient
! parameter for calculation of transpiration demand
real :: alfm = 1.4
real :: gpmax = 14000. ! mol/(m2*d)
! parameter for growing degree day calculation
real :: thr_gdd = 5.
! van Genuchten parameter for flag_wred=9
real :: l_gnu = 0.5
! fol biomass per mistletoe [kg DW/tree], 1 Viscum (10years) see Pfiz 2010
real :: mistletoe_x_fol = 0.0158
! parameter for allocation to NSC-Pool
real :: decid_sap_allo = 0.042 !fraction of sapwood DW allocated to NSC-Pool for decidous tree species
real :: decid_tb_allo = 0.125 !fraction of twigs and branch DW allocated to NSC-Pool for decidous tree species
real :: decid_crt_allo = 0.125 !fraction of coarse root DW allocated to NSC-Pool for decidous tree species
real :: conif_sap_allo = 0.018 !fraction of sapwood allocated to NSC-Pool for coniferous tree species
real :: conif_tb_allo = 0.065 !fraction of twigs and branch allocated to NSC-Pool for coniferous tree species
real :: conif_crt_allo = 0.065 !fraction of coarse root DW allocated to NSC-Pool for coniferous tree species
! set of characters
character(len=*), parameter :: charset = &
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789.-_"
! test
real, allocatable, dimension(:,:) ::lambda_ts
end module data_par
source_code/version_2.3_windows/amod_plant.f 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* 4C (FORESEE) Simulation Model *!
!* *!
!* *!
!* data module for planting of seedlings/saplings *!
!* ! arrays have to be adapted to the species number ! *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
module data_plant
integer :: quspec= 2 ! number of planted species
integer, dimension(13) :: infspec=(/1,0,1,0,0,0,0,0,0,0,0,0,0/) ! sign of planted species = 0/1
integer, dimension(13) :: npl_mix =(/3000,0,6000,4500,0,0,0,0,0,0, 0, 0, 0/) ! number of plants in mixed stands
integer, dimension(13) :: numplant=(/178,6000,8000,9000,10000,0,8000,1666, 1140, 2000, 5000, 0, 0/) ! number of plants per ha
integer, dimension(13) :: specpl=(/1,2,3,4,5,6,7,8, 9, 10, 11, 12, 13/) ! number of species
real, dimension(13) :: plant_height=(/130.,37.5,17.5,40.,8.7,0.,17.5,40.,17.5, 30.0, 30.0, 0., 0./) ! mean height of plants
real, dimension(13) :: plant_hmin=(/70.,25.,10.,30.,3.,0.,10.,30., 10., 20., 10., 0.,0./) ! minimum height of plants
real, dimension(13) :: hsdev=(/3.33,4.1,7.5,3.33,5.9,0.0,7.5,3.33, 7.5,4.1, 7.5, 0.,0. /) ! standard deviation od height
real, dimension(13) :: pl_age=(/10.,4.,2.,2.,1.,0.,2.,1.,2.,2., 2., 0.,0./) ! age of plants
real :: kappa = 1.2 !1.2
real :: ksi = 2.99 !1.5
integer, dimension(11,10) :: m_numplant
integer, dimension(11,10) :: m_specpl
real, dimension(11,10) :: m_plant_height
real, dimension(11,10) :: m_plant_hmin
real, dimension(11,10) :: m_pl_age
real, dimension(11,10) :: m_hsdev
integer :: m_numclass
end module data_plant
source_code/version_2.3_windows/amod_simul.f 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* 4C (FORESEE) Simulation Model *!
!* *!
!* *!
!* module data_simul *!
!* *!
!* contains follow global subroutines: *!
!* GETUNIT() function for unit number handling *!
!* TESTFILE(infile,ex) subroutine for testing, if a file exists *!
!* ERRORFILE(infile,ios,unitnum) subroutine for messages *!
!* during file reading *!
!* *!
!* FUNCTION GETUNIT *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
module data_simul
integer :: anz_sim = 0 ! actual number of simulations
character(4) :: anh ! output file extension
integer :: time_b = 1951 ! start simulation year
integer :: time_cur ! current simulation year
integer :: clim_dt = 1 ! kind of climate resolution (daily/monthly) for weathergen.
integer :: repeat_number = 1 ! max. number of repeats
integer :: site_nr = 1 ! number of sites
integer :: year = 40 ! number of simulation years
integer :: ns_pro = 7 ! time step (days) for production module
integer :: ns_day ! loop variable for time step
integer :: ns ! loop variable for species
integer :: iday =1 ! actual day of simulation
integer :: ip ! loop variable for site_nr
integer :: time ! yearly loop variable in simulation_4c(from 1 to year)
integer :: monat
integer :: woche
integer :: flag_adapm = 0 ! flag for adaptive managemen:0/1(carried out last time step)
integer :: flag_bc = 0 ! flag for application of biochar (0 - no application)
integer :: flag_bc_add = 0 ! flag for output to file ...soil.ini for changes of soil parameters
! after addition of biochar (0 - no output)
integer :: flag_clim = 0 ! climate data for each site?(yes/no)
integer :: flag_climnam= 0 ! kind of generation of climate scenario names (flag_multi=8)
integer :: flag_co2 = 0 ! choice of amospheric CO2 scenario
integer :: flag_cohout = 1 ! flag for cohort output
integer :: flag_cohoutd= 1 ! flag for cohort output daily
integer :: flag_cohouty= 1 ! flag for cohort output yearly
integer :: flag_cond = 0 ! choice of heat conductance function
integer :: flag_cum = 0 ! internal flag of cumulativ calculations for output
integer :: flag_dayout = 0 ! flag of daily output
integer :: flag_decomp = 0 ! decomposition model
integer :: flag_depo = 0 ! deposition (set after reading file) 1 - mg/m2, 2 - mg/l
integer :: flag_dis = 0 ! choice of disturbance modus (1=on)
integer :: flag_hum = 0 ! internal flag for recalculation of field capcity etc. depending on humus
integer :: flag_end = 0 ! stop in partitio
integer :: flag_eva = 0 ! choice of evapotranspiration function
integer :: flag_folhei = 1 ! choice of foliage-height relationship
integer :: flag_lambda = 0 ! variable lambda time series/ FORSKA environmental factors and regeneration on/off(0)
integer :: flag_int = 0 ! choice of interception function
integer :: flag_inth = 0 ! internal flag for choice of interception function
integer :: flag_light = 3 ! flag for light absorption algorithm
integer :: flag_limi = 3 ! choice of limitations taken into account
integer :: flag_lit = 0 ! input of litter initialisation (internal control) (0 - no)
integer :: flag_mg = 0 ! choice of management (yes/no)
integer :: flag_mistle = 0 ! internal flag (1 = disturbance by mistletoe)
integer :: flag_mort = 1 ! mortality on/off
integer :: flag_multi = 0 ! Multiple run choice
integer :: flag_reg = 0 ! regeneration on/off
integer :: flag_resp = 0 ! choice of respiration modelling
integer :: flag_seedgr = 0 ! flag for weekly seedling growth
integer :: flag_sign = 0 ! choice of mode of calculation for sigman
integer :: flag_sens = 0 ! flag for sensitivity analysis (no input, derived from flag_multi)
integer :: flag_soilin = 0 ! internal flag for soil input version
integer :: flag_stand = 1 ! choice of initialization
integer :: flag_standup= 0 ! stand structure changed (1 - removal of trees, 2 - neww trees)
integer :: flag_stat = 0 ! flag for comparison with measurements
integer :: flag_sum = 0 ! flag for summation output
integer :: flag_sveg = 0 ! flag for soilvegetation (0 = no, 1 = intialis.)
integer :: flag_volfunc= 1 ! choice of volume function for trunc
integer :: flag_wred = 1 ! choice of soil water uptake function
integer :: flag_wurz = 0 ! choice of root distribution function
integer :: flag_wpm = 0 ! wpm flag
integer :: time_out = 1 ! time step of yearly output; compressed output if < 0
integer :: flag_cumNPP = 0 ! time step of summation of yearly NPP for mean yearly NPP in compressed output
logical :: flag_tree = .TRUE. ! internal flag : .TRUE. - all cohorts are trees
logical :: flag_redn =.FALSE. ! internal flag : .TRUE. - Redn<0 for at least one species
logical :: flag_mult9 = .TRUE. ! internal flag : .TRUE. - first run with flag_multi=9
logical :: flag_mult910 = .TRUE. ! internal flag : .TRUE. - runs with flag_multi=9 or flag_multi=10
logical :: flag_mult8910 = .TRUE. ! internal flag : .TRUE. - runs with flag_multi=8 or flag_multi=9 or flag_multi=10
logical :: flag_trace = .TRUE. ! internal flag : .TRUE. - output of trace.log
logical :: lmulti = .FALSE. ! stand initialisation file with several stands
logical :: lcomp1 = .TRUE. ! compressed output with start values
logical :: leaves_on = .false. ! detection of periods with lai > 0
integer :: all_leaves_on = 0 ! detection of periods with maximal lai
real :: thr_height = 50. ! threshold of height for ingrowth
integer :: n_T_downsteps = 0 ! number of steps to decrease temperature in multi-run 2
integer :: n_T_upsteps = 0 ! number of steps to increase temperature in multi-run 2
integer :: n_P_downsteps = 0 ! number of steps to decrease precipitation in multi-run 2
integer :: n_P_upsteps = 0 ! number of steps to increase precipitation in multi-run 2
real :: step_sum_T = 0. ! additive step for temperature change in multi-run 2
real :: step_fac_P = 0. ! factorial step for precipitation change in multi-run 2
real :: deltaT = 0. ! additive change of temperature
real :: deltaPrec = 1. ! factorial change of precipitation
integer :: jpar ! number (array size) of changed parameter (multi run)
real, dimension(200) :: vpar = -99.0 ! store of parameter changes (multi run)
character(30), dimension(50) :: outy_file ! name of yearly output files
integer :: nyvar ! number of yearly output files
character(30), dimension(50) :: outd_file ! name of daily output files
integer :: ndvar ! number of daily output files
character(30), dimension(50) :: outc_file ! name of cohort output files
integer :: ncvar ! number of cohort output files
integer :: ncdvar ! number of daily cohort output files
character(100), dimension(200) :: simpar ! name of changed parameter (multi run)
character(30), dimension(50) :: outvar ! name of output variables (multi run 4, 8, 9, 10)
integer :: nvar ! number of output variables (multi run 4, 8, 9, 10)
integer :: output_unit_all ! output unit number of all selected yearly variables (multi run 9, 10)
integer :: output_unit_all_m ! output unit number of all selected monthly variables (multi run 9, 10)
integer :: output_unit_all_w ! output unit number of all selected weekly variables (multi run 9, 10)
real,allocatable,save,dimension(:,:,:) :: output_var ! value array of output variables (multi run 4, 8, 9, 10)
! (number of output variable, site ip, year)
real,allocatable,save,dimension(:,:,:,:):: output_varm ! value array of monthly output variables (multi run 4, 8, 9, 10)
! (number of output variable, site ip, year, month)
real,allocatable,save,dimension(:,:,:,:):: output_varw ! value array of weekly output variables (multi run 4, 8, 9, 10)
! (number of output variable, site ip, year, week)
integer,allocatable,save,dimension(:) :: output_unit ! array of output unit numbers (multi run 9, 10)
integer,allocatable,save,dimension(:) :: output_unit_mon ! array of output unit numbers for monthly values
character(10), dimension(10) :: typeclim ! array of type of climate scenarios (multi run 9)
real,allocatable,save,dimension(:,:,:,:) :: climszenres ! data file with results from climate scenarios (flag_multi=9, 10)
! (number of output variable, site ip, climate scenario type, realization)
real,allocatable,save,dimension(:,:,:,:,:):: climszenyear ! data file with yearly results from climate scenarios (flag_multi=9, 10)
! (number of output variable, site ip, climate scenario type, realization, year)
real,allocatable,save,dimension(:,:,:,:,:):: climszenmon ! data file with monthly results from climate scenarios (flag_multi=9, 10)
! (number of output variable, site ip, climate scenario type, realization, month)
real,allocatable,save,dimension(:,:,:,:,:):: climszenweek ! data file with weekly results from climate scenarios (flag_multi=9, 10)
! (number of output variable, site ip, climate scenario type, realization, week)
character(150),allocatable,save,dimension(:) :: site_name ! names of simulation sites
character(150) :: site_name1 ! name of first simulation site (multi run 9)
integer :: allunit = 10 ! variable for function getunit
character(150):: actdir ! actual directory
character(150):: dirout = 'output/' ! directory of output files
character(150):: dirin = 'input/' ! directory of input files
character(150) :: simfile = 'test0.sim' ! default simulation parameter file
character(300),allocatable,save,dimension(:) :: climfile ! climate data file
character(300),allocatable,save,dimension(:,:,:) :: climszenfile ! data file from climate scenarios (flag_multi=9)
character(150),allocatable,save,dimension(:) :: sitefile ! site specific parameter file
character(150),allocatable,save,dimension(:) :: valfile ! soil start value file
character(150),allocatable,save,dimension(:) :: treefile ! tree initialization file
character(150),allocatable,save,dimension(:) :: manfile ! management file
character(150),allocatable,save,dimension(:) :: wpmfile ! wpm spinup file
character(150),allocatable,save,dimension(:) :: specfile ! species parameter file
character(150),allocatable,save,dimension(:) :: depofile ! deposition file
character(150),allocatable,save,dimension(:) :: redfile ! file of redN for each species
character(150),allocatable,save,dimension(:) :: litfile ! file of litter initialisation for each fraction and species
integer,allocatable,save,dimension(:) :: fl_co2 ! flag_co2 for flag_multi = 7
character(50),allocatable,save,dimension(:) :: standid ! stand identifier
character(50), allocatable, dimension(:) :: standid_list ! List of stand identifier in input file
real, allocatable, dimension(:,:) :: redN_list ! List of of RedN per species in con-file with flag_multi=8,9
integer :: anz_standid
logical :: lstandid
integer :: nrreal ! number of realizations of climate scenarios (flag_multi=9)
integer :: nrclim ! number of types of climate scenarios (flag_multi=9)
integer :: iclim ! actual number of climate scenario type (flag_multi=9)
integer :: site_anz ! number of all simulation runs for flag_multi=9
integer,dimension(12) :: monrec ! Anzahl Tage im Monat
integer :: dclass_w = 5 ! class width for diameter classification
!----------------------------------------------------------------------
contains
integer function getunit()
logical logo
inquire(allunit, opened=logo)
if(logo) allunit = allunit+1
if(allunit==5.or.allunit==6) allunit=7
getunit = allunit
end function getunit
!----------------------------------------------------------------------
subroutine testfile (infile,ex)
! test whether the file exists
character a
character(len=*),intent(inout) ::infile
logical, intent(out):: ex
ex = .false.
do
inquire (File = infile, exist = ex)
if (ex .eqv. .false.) then
print *, ' >>>foresee message: File ',trim(infile),' not exists !'
write (*,'(A)') ' (0)STOP program'
write(*,'(A)') ' (1) Repeat filename input (def)'
write(*,'(A)',advance='no') ' (2) Return to input choice: '
read (*,'(A)') a
select case(a)
case('0')
stop
case(' ','1')
write(*,'(A)',ADVANCE='NO') ' New filename: ';read (*,'(A75)')infile
case('2')
ex = .false.; exit
end select
else
if (flag_multi .ne. 9) print *, ' >>>foresee message: Filetest - file ',trim(infile),' exists! '
exit
end if
end do
end subroutine testfile
!----------------------------------------------------------------------
subroutine errorfile (infile, ios, unitnum)
! error message during file reading
integer ios, unitnum
logical ex
character(150) infile
character a
if (ios .ne. 0) then
print *,' >>>foresee message: error during file ',trim(infile),' reading!'
ex = .false.
write(*,'(A)',advance='no')' STOP program (y/n)? '
read *, a
if (a .eq. 'y' .or. a .eq. 'Y') then
print *,' Program will stop!'
stop
end if
else
if (flag_multi .ne. 9) print *,' >>>foresee message: reading file ',trim(infile),' completed'
endif
close (unitnum)
if (flag_multi .ne. 9) print *,' '
end subroutine errorfile
end module data_simul
source_code/version_2.3_windows/amod_site.f 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* 4C (FORESEE) Simulation Model *!
!* *!
!* *!
!* data module for site data *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************! *!
MODULE data_site
INTEGER :: patch_id ! Patch identifier
character(50) :: stand_id ! Stand identifier
REAL :: xlat ! latitude in radians
REAL :: lat = 52.24 ! Default Potsdam coordinates
REAL :: long = 13.04
REAL, DIMENSION(:), ALLOCATABLE :: latitude ! array of latitudes for multi run 8
REAL, ALLOCATABLE, DIMENSION(:) :: NHdep ! yearly deposition
REAL, ALLOCATABLE, DIMENSION(:) :: NOdep ! yearly deposition
INTEGER, ALLOCATABLE, DIMENSION(:) :: gwtable ! groundwater level class
! 1: 0 - 0.5 m
! 2: 0.5 - 1.0 m
! 3: 1.0 - 1.5 m
! 4: 1.5 - 2.0 m
! 5: > 2.0 m
character(50),ALLOCATABLE, DIMENSION(:) :: sitenum
! KLara
character(50),ALLOCATABLE, DIMENSION(:) :: clim_id
! WK
CHARACTER(13),ALLOCATABLE, DIMENSION(:) :: soilid
END module data_site
source_code/version_2.3_windows/amod_soil.f 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* 4C (FORESEE) Simulation Model *!
!* *!
!* *!
!* data modules of soil submodels *!
!* *!
!* containes: *!
!* DATA_SOIL *!
!* DATA_SOIL_CN *!
!* HELP_SOIL_CN *!
!* DATA_SOIL_T *!
!* DATA_SOIL_PARAM *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
module data_soil
! Variables and parameters of soil model
integer :: soil_id = -1 ! soil type identification
integer :: nlay = -1 ! number of soil layers
integer :: nroot_max = 1 ! number of rooting layers
integer :: s_typen = -1 ! soil type number: 1 - sand, 2 - loam,
! 3 - silt, 4 - clay
integer :: nlgrw ! number of layer with ground water
real :: grwlev ! groundwater level
real :: rmass1 ! rest of dry mass , 1. layer
! arrays with dimension nlay
real, allocatable, save, dimension(:) :: &
! Description of soil layers
thick, & ! thickness of the layer cm
mid, & ! middle of the layer cm
depth, & ! depth of the layer cm
! soil parameter
pv, & ! pore volume mm
pv_v, & ! pore volume vol%
dens, & ! soil density g/cm3
field_cap ,& ! field capacity mm
wilt_p ,& ! wilting point mm
f_cap_v ,& ! field capacity vol-%
wilt_p_v ,& ! wilting point vol%
spheat, & ! specific heat capacity J/(g K)
phv, & ! pH-value
quarzv, & ! content of quarz (Vol%)
sandv, & ! content of sand (Vol%, input: Mass%)
clayv, & ! content of clay (Vol%, input: Mass%)
siltv, & ! content of silt (Vol%, input: Mass%)
humusv, & ! content of humus (Vol%, input: Mass%)
skelv, & ! content of skeleton Vol%
skelfact, & ! skeleton factor for water calculation
vol, & ! volume of layer (cm3)
dmass, & ! dry mass of layer (g/m2)
! model parameter
wlam, & ! Lambda parameter for percolation
! soil state variables
wats, & ! water content mm
wats_1, & ! water content of previous day mm
watvol, & ! water content in vol%
wat_res, & ! water uptake resistance
perc, & ! percolation water mm
wupt_r, & ! water uptake by roots mm
wupt_ev, & ! water taking by evaporation mm
temps, & ! soil temperature ¡C
! soil help variables
fcaph, & ! field capacity without humus vol%
wiltph, & ! wilting point without humus vol%
pvh, & ! pore volume without humus vol%
! soil stress variables
BDopt, & ! optimum bulk density for root growth
fr_loss, & ! yearly fine root loss [%]
redis ! yearly part of redistribution [%]
integer, allocatable, save, dimension(:) :: &
s_drought ! number of drought days per layer
! other scalar state variables and parameter
integer :: snow_day = 0 ! days with continious snow cover day
real :: snow = 0. ! water equivalent of snow mm
real :: snow_m = 0. ! water from melting of snow mm
real :: cover = -99. ! percent of covering
real :: grwsup ! groundwater supply per day
real :: bucks_root ! bucket size (mm) of rooting zone
real :: bucks_100 ! bucket size (mm) of 1 m depth
real :: thick_1 ! thickness of first layer (old value)
! disturbance variable if xylem disturbance influence water uptake
real :: xylem_dis ! percentage of root water uptake reduction by xylem disturbance (flag_dis=1)
! yearly cumulative quantities
real :: perc_cum = 0. ! cumulative percolation water from last layer
real :: perc_sum = 0. ! sum of percolation water from last layer for weeks or months
real :: wupt_r_c = 0. ! cumulative water uptake by roots
real :: wupt_e_c = 0. ! cumulative soil evaporation
real :: wupt_cum = 0. ! cumulative whole water uptake
real :: wat_tot = 0. ! total water content of the soil profile
real :: grwsup_cum=0. ! groundwater supply per year
real, dimension(12) :: perc_mon ! monthly percolation water from last layer
real, dimension(53) :: perc_week ! wekkly percolation water from last layer
! mean quantities (per year)
real :: perc_m = 0. ! mean yearly percolation water from last layer
real :: wupt_r_m = 0. ! mean yearly water uptake by roots
! parameter
real :: fakt = 0.4 ! percolation factor
real :: w_ev_d = 7. ! depth of water taking out by evaporation (cm)
integer :: n_ev_d = 1 ! corresponding number of layer for w_ev_d
real, allocatable, save, dimension(:,:) :: xwatupt ! temp. aux. field of water uptake per cohort and layer
! arrays of given root distribution (defined input)
real, allocatable, save, dimension(:) :: root_fr ! root fraction per soil layer
! yearly fine root loss after Rasse et al. 2001
integer :: rdepth_kind ! kind of calculation of root depth
real, allocatable, dimension(:) :: wat_left ! auxiliary variable for coh%watleft to determin annual sum of available water in soil layer boardering on root zone
real, allocatable, dimension(:) :: wat_root ! auxiliary variable for coh%watleft to determin annual sum of availabel water in soil layer boardering on root zone
integer, allocatable, dimension(:) :: root_lay ! auxiliary variable for coh%nroot to determin root zone layer
real, allocatable, dimension(:) :: gr_depth ! auxiliary variable for coh%x_rdpt to determin annual sum of root growth
end module data_soil
!------------------------------------------------------------------------
module data_soil_cn
! Variables and parameters of soil_cn-model
integer :: nspeclit = 5 ! number of species-litter for decomposition and min.
integer :: kmint = 1 ! kind of reduction function of min. for temp.
integer :: knitt = 1 ! kind of reduction function of nit. for temp.
integer :: kminw = 1 ! kind of reduction function of min. for water
integer :: knitw = 1 ! kind of reduction function of nit. for water
! arrays with dimension nlay
real, allocatable, save, dimension(:) :: &
! C and N pools per layer
C_opm, & ! whole C-content of dead biomass per layer without stems / g/m2
C_hum, & ! C-content of humus per layer / g/m2
N_opm, & ! whole N-content of dead biomass per layer without stems / g/m2
N_hum, & ! N-content of humus per layer / g/m2
C_opmfrt, & ! C-content of dead fine roots per layer / g/m2
N_opmfrt, & ! N-content of dead fine roots per layer / g/m2
C_opmcrt, & ! C-content of dead coarse roots per layer / g/m2
N_opmcrt, & ! N-content of dead coarse roots per layer / g/m2
C_bc, & ! C-content of biochar per layer / g/m2
N_bc, & ! N-content of biochar per layer / g/m2
NH4, & ! NH4-content of the soil layer / g/m2
NO3, & ! NO3-content of the soil layer / g/m2
Nupt, & ! N uptake from the soil layer / g/m2
Nmin, & ! N mineralisation per day and soil layer / g/m2
! model parameter
rmin_phv, & ! reduction of mineralization depending on pH-value
rnit_phv, & ! reduction of nitrification depending on pH-value
cnv_opm, & ! C/N-ratio of dead biomass
cnv_hum, & ! C/N-ratio of humus
cnv_bc, & ! C/N-ratio of biochar
cpart_bc, & ! part of C in biochar
dens_bc ! density of biochar
real, allocatable, save, dimension(:) :: &
C_bc_appl,& ! C-content of biochar application per layer / g/m2
N_bc_appl ! C/N-ratio of biochar application per layer / g/m2
integer, allocatable, save, dimension(:) :: &
y_bc, & ! year of application of biochar
bc_appl_lay ! layer of biochar application
real :: Nleach ! N leaching from last layer per day / g/m2
real :: Nupt_d ! total daily N uptake / g/m2
real :: NH4_in, NO3_in ! input of NH4 and NO3 into the actual layer as
! deposition or transport / g/m2
real :: respsoil ! daily heterotrophic respiration / gC/m2
! Model parameter
real :: k_nit =0.0025 ! nitrification constant / per day
real :: pNH4f =0.1 ! part of free available NH4-N
real :: pNO3f =1.0 ! part of free available NO3-N
real :: k_hum_r=0.0003 ! mineralization constant of humus in mineral soil / per day
real :: k_hum =0.0002 ! mineralization constant of humus in humus layer / per day
real :: k_bc =0.00001 ! mineralization constant of biochar / per day
real :: k_syn_bc =0.003 ! synthesis coefficient of biochar / per day
integer :: y_bc_n ! actual array number of list of biochar application
integer :: n_appl_bc ! number of biochar applications
type species_litter
character (len=20) :: species_name
! soil C- and N-pools of primary organic matter per species and fraction
real :: C_opm_fol ! C-content of foliage litter pool / g/m2
real :: N_opm_fol ! N-content of foliage litter pool / g/m2
real :: C_opm_tb ! C-content of twigs and branches litter pool / g/m2
real :: N_opm_tb ! N-content of twigs and branches litter pool / g/m2
real :: C_opm_stem ! C-content of stemwood litter pool / g/m2
real :: N_opm_stem ! N-content of stemwood litter pool / g/m2
real,dimension(50):: C_opm_frt ! C-content of fine root litter pool / g/m2
real,dimension(50):: N_opm_frt ! N-content of fine root litter pool / g/m2
real,dimension(50):: C_opm_crt ! C-content of coarse root litter pool / g/m2
real,dimension(50):: N_opm_crt ! N-content of coarse root litter pool / g/m2
! C/N-ratios of organic primary matter fractions
real :: cnv_opm_fol ! C/N-ratio of foliage litter pool
real :: cnv_opm_tb ! C/N-ratio of twigs, branches litter pool
real :: cnv_opm_stem ! C/N-ratio of stemwood litter pool
real :: cnv_opm_frt ! C/N-ratio of fine root litter pool
real :: cnv_opm_crt ! C/N-ratio of coarse root litter pool
end type species_litter
type (species_litter),allocatable,dimension(:),target :: slit, slit_1
! yearly and cumulative quantities
real :: N_min = 0. ! cumulative netto mineralisation per year
real :: N_min_m = 0. ! mean cumulative netto mineralisation of all years
real :: N_tot = 0. ! total N content of the soil profil at the end of the year
real :: C_tot = 0. ! total C content of the soil profil at the end of the year
real :: N_lit = 0. ! N content of total litter per year
real :: C_lit = 0. ! C content of total litter per year
real :: N_lit_m = 0. ! mean cumulative N content of total litter of all years
real :: C_lit_m = 0. ! mean cumulative C content of total litter of all years
real :: N_lit_fol = 0. ! N content of foliage litter per year
real :: C_lit_fol = 0. ! C content of foliage litter per year
real :: N_lit_frt = 0. ! N content of fine root litter per year
real :: C_lit_frt = 0. ! C content of fine root litter per year
real :: N_lit_crt = 0. ! N content of coarse root litter per year
real :: C_lit_crt = 0. ! C content of coarse root litter per year
real :: N_lit_tb = 0. ! N content of litter from twigs and branches per year
real :: C_lit_tb = 0. ! C content of litter from twigs and branches per year
real :: N_lit_stem = 0. ! N content of new dead stems per year
real :: C_lit_stem = 0. ! C content of new dead stems per year
real :: N_hum_tot = 0. ! N content of total humus
real :: C_hum_tot = 0. ! C content of total humus
real :: N_an_tot = 0. ! total anorganic N
real :: Nupt_c = 0. ! total N uptake per year / g N/m2
real :: Nupt_m = 0. ! mean total N uptake per year
real :: Nleach_c = 0. ! cumul. N leaching from last layer per year
real :: Nleach_m = 0. ! mean cumulative N leaching from last layer of all years
real :: resps_c = 0. ! yearly soil respiration / gC/m2
real :: resps_c_m = 0. ! mean yearly soil respiration / gC/m2
real :: C_opm_fol ! C-content of total foliage litter pool / g/m2
real :: N_opm_fol ! N-content of total foliage litter pool / g/m2
real :: C_opm_stem ! C-content of total stemwood litter pool / g/m2
real :: N_opm_stem ! N-content of total stemwood litter pool / g/m2
real :: C_opm_tb ! C-content of total twigs, branches root litter pool / g/m2
real :: N_opm_tb ! N-content ofv twigs, branches litter pool / g/m2
real :: C_opm_frt ! C-content of total fine root litter pool / g/m2
real :: N_opm_frt ! N-content of total fine root litter pool / g/m2
real :: C_opm_crt ! C-content of total coarse root litter pool / g/m2
real :: N_opm_crt ! N-content of total coarse root litter pool / g/m2
real :: C_accu = 0. ! C accumulation (new C_tot - old C_tot) / t C/ha
! (mean of all years at the end of simulation)
real :: C_hum_1 ! C content in humus of the litter layer / t C/ha
real :: C_tot_1 ! total C content of the litter layer / t C/ha
real :: C_hum_40 ! C content in humus of the soil profil up to 40cm depth / t C/ha
real :: C_tot_40 ! total C content of the soil profil up to 40cm depth / t C/ha
real :: C_hum_80 ! C content in humus of the soil profil up to 80cm depth / t C/ha
real :: C_tot_80 ! total C content of the soil profil up to 80cm depth / t C/ha
real :: C_hum_100 ! C content in humus of the soil profil up to 100cm depth / t C/ha
real :: C_tot_100 ! total C content of the soil profil up to 100cm depth / t C/ha
real :: C_bc_tot ! total C content of biochar / g C/m2
real :: N_bc_tot ! total N content of biochar / g N/m2
real, dimension(12) :: resps_mon ! mean monthly soil respiration / gC/m2
real, dimension(53) :: resps_week ! mean weekly soil respiration / gC/m2
real, allocatable, save, dimension(:,:) :: xNupt ! temp. aux. field of N uptake per cohort and layer
integer unit_litter
end module data_soil_cn
!------------------------------------------------------------------------
module help_soil_cn
! internal variables for decomposition calculation
real khr, knr, ks, kbc ! reduced humif., nitr. and syth. coeff.
real remin ! reduction function of mineralisation
real reptermc, reptermn ! reprod. terms of C-/ N-pools
real term1, term2, term3, term4 ! parts of equ. III
real hexph, hexpn ! exponential parts
real cnvh ! reciprocal C/N-ratio of humus
end module help_soil_cn
!------------------------------------------------------------------------
module data_soil_t
! Variables and parameters for soil temperature calculation
integer :: flag_surf = 0 ! calculation of soil surface temperature
! 0 - surface temperature equals temperature of first layer
! 1 - with explicit surface temperature
real temps_surf ! soil surface temperature
real hflux_surf ! soil heat flux at soil surface
! model parameters
real :: C0 = 0.76, & ! coefficients for calculation of surface temperature
C1 = 0.05, &
C2 = 0.3
! arrays with dimension nlay2
real, allocatable, save, dimension(:) :: &
t_cond, & ! thermal conductivity J/(cm s K)
t_cb , & ! weighted mean of thermal conductivity (term of values b)
h_cap, & ! heat capacity J/(cm3 K)
t_diff ! thermal diffusivity cm2/s
! internal variables for calculation of thermal conductivity
type therm_par ! parameter of soil fractions (particles)
real:: vf ! volume fraction
real:: hc ! heat capacity J/(cm3 K)
real:: tc ! thermal conductivity J/(cm s K)
real:: kwa ! weighting factor k for continous medium air
real:: kww ! weighting factor k for continous medium water
real:: ga ! shape factor of particles
end type therm_par
type (therm_par):: water
type (therm_par):: quarz
type (therm_par):: clay
type (therm_par):: silt
type (therm_par):: humus
type (therm_par):: air
type (therm_par):: ice
type (therm_par):: stone
! internal variables for the numerical solution
integer :: nlay1, nlay2 ! number of 2 additional layers
! diagonals of the matrix
! arrays with dimension nlay2
real, allocatable, save, dimension(:) :: &
sb, & ! term of values b (reciprocal mean of thickness)
sv, & ! thickness times time step
sh, & ! thickness
sbt, & ! aux. array of soil temperature
sxx, & ! right side and result (soil temperature)
svv, & ! thickness times heat capacity
svva,& ! svv from previous time step
soh ! Hauptdiagonale
! array with dimension nlay2+1
real, allocatable, save, dimension(:) :: son ! Nebendiagonale
integer mfirst ! first elemet number of matrix
logical lfirst ! .true for the first time
! variables for Fourier analysis
integer :: NK ! Anzahl der Fourier-Koeffizienten
real, dimension(200) :: FTA, FTO ! Fourier-Koeffizienten
real, dimension(366) :: Four_sp ! Stuetzstellen
real :: TQ ! mittlere Temp.
integer :: it = 1 ! Starttag fuer Temp.-Profil
end module data_soil_t
!------------------------------------------------------------------------
module data_soil_param
! soil type parameters
real, dimension(13):: grwdist ! distance groundwater level to root depth
type soiltype
character(10) :: stype ! soil type
real :: lambda ! percolation coefficient lambda
real, dimension(13):: rate ! supply of groundwater to root
end type soiltype
type(soiltype), dimension(40):: soil ! parameter setting in subroutine soil_ini_param
DATA grwdist / 20, 30, 40, 50, 60, 70, 80, 90, 100, 120, 140, 170, 200/
DATA soil%stype / 'Ss','gS','mS','fS','Su2','St2','Sl2','Su3','St3','Sl3','Su4','Slu','Sl4','Ls2', &
'Ls4','Lt2','Ts3','Ts4','Lts','Lt3','Tu3','Tu4','Tt','Tu2','Ts2','Tl','Lu', &
'Ut4','Us','Uls','Ut2','Ul2','Ut3','Ul3','Uu','Hum','Hh','Hu','Hn','' /
DATA soil%lambda / 1.50, 1.50, 1.50, 1.15, 0.90, 0.67, 0.60, 0.50, 0.30, 0.38, 0.37, 0.27, 0.30, &
0.30, 0.24, 0.23, 0.23, 0.22, 0.22, 0.22, 0.24, 0.26, 0.30, 0.15, 0.15, 0.15, &
0.15, 0.27, 0.25, 0.29, 0.29, 0.27, 0.27, 0.25, 0.25, 0.27, -99., -99., -99., -99. /
DATA soil(1)%rate / 5.2, 5.0, 1.5, 0.5, 0.2, 0.1, 0, 0, 0, 0, 0, 0, 0.0 /
DATA soil(2)%rate / 5.2, 5.0, 1.5, 0.5, 0.2, 0.1, 0, 0, 0, 0, 0, 0, 0.0 /
DATA soil(3)%rate / 5.8, 5.5, 5.3, 3, 1.2, 0.5, 0.2, 0.1, 0, 0, 0, 0, 0 /
DATA soil(4)%rate / 5.8, 5.5, 5.3, 5.1, 3, 1.5, 0.7, 0.3, 0.15, 0.1, 0, 0, 0 /
DATA soil(5)%rate / 5.8, 5.5, 5.3, 5.1, 4.5, 2.5, 1.5, 0.7, 0.4, 0.1, 0.08, 0, 0 /
DATA soil(6)%rate / 5.8, 5.5, 5.3, 5.1, 4.5, 2.5, 1.5, 0.7, 0.4, 0.1, 0.08, 0, 0 /
DATA soil(7)%rate / 5.8, 5.5, 5.3, 5.1, 4.5, 2.5, 1.5, 0.7, 0.4, 0.1, 0.08, 0, 0 /
! 6 > 5.0;> 5.0;> 5.0;> 5.0;4.5;2.5;1.5;0.7;0.4;0.1;< 0.1;0;0;;;;;;;;;;;;;;;;;;;;;;;;;;;;
! 7 > 5.0;> 5.0;> 5.0;> 5.0;4.5;2.5;1.5;0.7;0.4;0.1;< 0.1;0;0;;;;;;;;;;;;;;;;;;;;;;;;;;;;
! 8 > 5.0;> 5.0;> 5.0;> 5.0;5;3.5;2;1.5;0.8;0.3;0.1;< 0.1;0;;;;;;;;;;;;;;;;;;;;;;;;;;;;
! 9 > 5.0;> 5.0;> 5.0;> 5.0;3;2;1;0.7;0.4;0.15;< 0.1;0;0
! 10 > 5.0;> 5.0;> 5.0;> 5.0;5;3.5;2;1.5;0.8;0.3;0.1;< 0.1;0
! 11 > 5.0;> 5.0;> 5.0;> 5.0;> 5.0;> 5.0;5;3;2;1;0.5;0.15;0
! 12 > 5.0;> 5.0;> 5.0;> 5.0;> 5.0;> 5.0;5;3;2;1;0.5;0.15;0
! 13 > 5.0;> 5.0;> 5.0;> 5.0;3;2;1;0.7;0.4;0.15;< 0.1;0;0
! 14
! 15 > 5.0;> 5.0;> 5.0;3.5;2;1.3;0.8;0.5;0.3;0.15;< 0.1;0;0
! 16 > 5.0;> 5.0;> 5.0;3.5;2;1.3;0.8;0.5;0.3;0.15;< 0.1;0;0
! 17 > 5.0;> 5.0;> 5.0;3.5;2;1.3;0.8;0.5;0.3;0.15;< 0.1;0;0
! 18 > 5.0;> 5.0;4;2;1;0.7;0.5;0.3;0.2;0.1;< 0.1;0;0
! 19
! 20
! 21 > 5.0;> 5.0;2.5;1.2;0.7;0.5;0.3;0.2;0.15;< 0.1;0;0;0
! 22 > 5.0;> 5.0;2.5;1.2;0.7;0.5;0.3;0.2;0.15;< 0.1;0;0;0
! 23 > 5.0;> 5.0;4;2;1;0.7;0.5;0.3;0.2;0.1;< 0.1;0;0
! 24 > 5.0;> 5.0;> 5.0;> 5.0;4.5;3.5;2.5;2;1.5;0.8;0.4;0.2;< 0.1
! 25 4;2;1.1;0.7;0.5;0.4;0.35;0.3;0.22;0.17;0.14;0.1;< 0.1
! 26 4;2;1.1;0.7;0.5;0.4;0.35;0.3;0.22;0.17;0.14;0.1;< 0.1
! 27
! 28 4;2;1.1;0.7;0.5;0.4;0.35;0.3;0.22;0.17;0.14;0.1;< 0.1
! 29 > 5.0;> 5.0;> 5.0;> 5.0;4.5;3.5;2.5;2;1.5;0.8;0.4;0.2;< 0.1
! 30 > 5.0;> 5.0;> 5.0;> 5.0;4.5;3.5;2.5;2;1.5;0.8;0.4;0.2;< 0.1
! 31 > 5.0;> 5.0;> 5.0;> 5.0;> 5.0;> 5.0;> 5.0;5;3.5;2;1;0.5;0.15
! 32 > 5.0;> 5.0;> 5.0;> 5.0;> 5.0;> 5.0;4.5;3;2.5;1.5;0.7;0.3;0.1
! 33 > 5.0;> 5.0;> 5.0;> 5.0;> 5.0;> 5.0;4.5;3;2.5;1.5;0.7;0.3;0.1
! 34
! 35 > 5.0;> 5.0;> 5.0;> 5.0;> 5.0;> 5.0;4.5;3;2.5;1.5;0.7;0.3;0.1
! 36
! 37 > 5.0;> 5.0;> 5.0;> 5.0;> 5.0;> 5.0;> 5.0;5;3.5;2;1;0.5;0.15
end module data_soil_param
source_code/version_2.3_windows/amod_spec.f 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* 4C Simulation Model: Module data_species *!
!* *!
!* *!
!* module for species parameters *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
MODULE data_species
! general parameters
INTEGER :: nspecies ! number of all species (incl. ground vegetation)
INTEGER :: nspec_tree ! number of tree species
INTEGER :: spec_help = 1 ! aux var for species number
REAL :: weibal = 1.5 ! mortality parameter (NOT species-specific)
REAL :: weibal_int = 0.1 ! mortality parameter of intrinsic mortality
REAL :: NPP_demand_mistletoe !helping var. to substract demand of mistletoe from pine cohort
! species-specific parameters
TYPE species_par
CHARACTER (len=30) :: species_name
CHARACTER (len=15) :: species_short_name
! mortality parameters
INTEGER :: max_age ! maximum tree age [yr]
INTEGER :: yrec ! stress recovery time [yr]
INTEGER :: stol ! shade tolerance class [1=intol, 5=tol]
REAL :: intr ! intrinsic mortality rate [?]
REAL :: weibla ! lambda parameter of Weibull distribution [?]
! photosynthesis parameters
REAL :: psla_min ! minimum specific one-sided leaf area [m2/kg DW]
REAL :: psla_a ! light dep. specific one-sided leaf area [m2/kg DW]
REAL :: phic ! efficiency parameter, different for everg/decid [-]
REAL :: pnc ! leaf N content [mg/g]
REAL :: kco2_25 ! Michaelis constant for CO2 (base 25 °C) [Pa]
REAL :: ko2_25 ! inhibition constant of O2 (base 25 °C) [kPa]
REAL :: pc_25 ! CO2/O2 specificity ratio (base 25 °C) [-]
REAL :: q10_kco2 ! Q10 coefficients (acclimated to 25 °C) [-]
REAL :: q10_ko2 ! [-]
REAL :: q10_pc ! [-]
REAL :: pb ! Rd to Vm ratio [-]
REAL :: Nresp ! slope of photosynthesis response to Nitrogen [yr/kg/ha]
! NPP parameters
REAL :: respcoeff ! respiration coefficient
REAL :: prg ! growth respiration [/day]
REAL :: prms ! maintenance resp. (base 15 °C): sapwood, [/day]
REAL :: prmr ! fine roots [/day]
REAL :: q10_prms ! Q10 coefficients (acclimated to 15 °C) [-]
REAL :: q10_prmr ! [-]
! allocation parameters
REAL :: pfext ! extinction coefficient
REAL :: sigman ! root activity rate (N uptake) [/yr]
REAL :: psf ! senescence rates: foliage, [/yr]
REAL :: pss ! sapwood, [/yr]
REAL :: psr ! fine roots [/yr]
REAL :: pcnr ! N/C ratio of biomass [kg N/kg C]
REAL :: cnr_fol ! C/N ratio of foliage [kg C/kg N]
REAL :: cnr_frt ! C/N ratio of fine roots [kg C/kg N]
REAL :: cnr_crt ! C/N ratio of coarse roots [kg C/kg N]
REAL :: cnr_tbc ! C/N ratio of twigs and branches [kg C/kg N]
REAL :: cnr_stem ! C/N ratio of stemwood [kg C/kg N]
REAL :: ncon_fol ! N concentration of foliage [mg/g]
REAL :: ncon_frt ! N concentration of fine roots [mg/g]
REAL :: ncon_crt ! N concentration of coarse roots [mg/g]
REAL :: ncon_tbc ! N concentration of twigs and branches [mg/g]
REAL :: ncon_stem ! N concentration of stemwood [mg/g]
REAL :: reallo_fol ! reallocation parameter of foliage
REAL :: reallo_frt ! reallocation parameter of fine root
REAL :: prhos ! sapwood density [kg/cm3]
REAL :: pnus ! foliage to sapwood area relationship [kg/cm2]
REAL :: alphac ! (twigs, branches & coarse roots) to sapwood ratio [-]
REAL :: cr_frac ! fraction of tbc (twigs, branches, roots) that is coarse roots [-]
REAL :: pha ! height growth rate [cm/kg]
REAL :: pha_coeff1 ! " coefficient 1
REAL :: pha_coeff2 ! " coefficient 2
REAL :: pha_v1 ! parameter for non-linear height-foliage relationship
REAL :: pha_v2 ! "
REAL :: pha_v3 ! "
REAL :: crown_a ! parameter to calculate crown radius from DHB [m/cm]
REAL :: crown_b ! parameter to calculate crown radius from DHB [m]
REAL :: crown_c ! parameter to calculate crown radius from DHB [m]
! decomposition parameters per fraction
REAL :: k_opm_fol ! mineralization constant of foliage litter / per day
REAL :: k_syn_fol ! synthesis coefficient of foliage litter / fraction
REAL :: k_opm_tb ! mineralization constant of twigs and branches litter / per day
REAL :: k_syn_tb ! synthesis coefficient of twigs and branches litter / fraction
REAL :: k_opm_stem ! mineralization constant of stemwood / per day
REAL :: k_syn_stem ! synthesis coefficient of stemwood / fraction
REAL :: k_opm_frt ! mineralization constant of fine root / per day
REAL :: k_syn_frt ! synthesis coefficient of fine root / fraction
REAL :: k_opm_crt ! mineralization constant of coarse root / per day
REAL :: k_syn_crt ! synthesis coefficient of coarse root / fraction
! phenology parameters
! PIM: Promotor-Inhibitor model
! CSM: Cannel and Smoth model
! TSM: linear temperature sum model
REAL :: PItmin ! PIM: Inhibitor min temp. [°C]
REAL :: PItopt ! PIM: Inhibitor opt temp. [°C]
REAL :: PItmax ! PIM: Inhibitor max temp. [°C]
REAL :: PIa ! PIM: Inhibitor scaling factor [-]
REAL :: PPtmin ! PIM: Promotor min temp. [°C]
REAL :: PPtopt ! PIM: Promotor opt temp. [°C]
REAL :: PPtmax ! PIM: Promotor max temp. [°C]
REAL :: PPa ! PIM: Promotor scaling factor [-]
REAL :: PPb ! PIM: Promotor scaling factor [-]
REAL :: CSTbC ! CSM: chilling base temp. [°C]
REAL :: CSTbT ! CSM: base temp. [°C]
REAL :: CSa ! CSM: scaling factor [-]
REAL :: CSb ! CSM: scaling factor [-]
REAL :: LTbT ! TSM: base temp. [°C]
REAL :: LTcrit ! TSM: critical temperature sum [°C]
integer :: Lstart ! TSM: start day after 1.11.
integer :: Phmodel ! used pheno model 0: no model, 1: PIM, 2: CSM, 3: TSM
REAL :: end_bb ! last day for vegetation period
integer :: flag_endbb = 0
! Canopy parameters
REAL :: ceppot_spec ! species parameter for pot. intercept. [mm/m2 leaf area]
REAL :: fpar_mod ! Parameter in canopy_geom (Petra) temp?
! regeneration parameter
REAL :: regflag ! flag for regenration control
REAL :: seedrate ! maximum seed rate per m2
REAL :: seedmass ! mass of single seed [g DW], mean value
REAL :: seedsd ! standard deviation of seed mass
REAL :: seeda ! parameter of shoot biomass - foliage mass emp. relation
REAL :: seedb ! ------------"-------------
REAL :: pheight1 ! parameter of shoot biomass - height emp. relation
REAL :: pheight2 ! ---------"--------------
REAL :: pheight3 ! ---------"--------------
REAL :: pdiam1 ! parameter of shoot biomass -diameter emp. relation
REAL :: pdiam2 ! -------------"-----------
REAL :: pdiam3 ! -------------"-----------
! parameter for root growth model
REAL :: spec_rl ! specific root length [m/g DW]
REAL :: tbase ! minimum temperature for root growth [°C]
REAL :: topt ! optimum temperature for root growth [°C]
REAL :: bdmax_coef ! for equation of maximum bulk density for root growth []
REAL :: porcrit_coef ! for equation critical pore space for aeration []
REAL :: ph_opt_max ! maximum pH-value for optimal root growth
REAL :: ph_opt_min ! minimum pH-value for optimal root growth
REAL :: ph_max ! maximum pH-value for root growth
REAL :: ph_min ! minimum pH-value for root growth
REAL :: v_growth ! maximum velocity of coarse root growth [cm/day]
END type species_par
TYPE (species_par),allocatable,save,dimension(:),target :: spar
END MODULE data_species
source_code/version_2.3_windows/amod_stand.f 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* ForeSee Simulation Model *!
!* *!
!* *!
!* Declaration of species and cohort variables *!
!* data_stand *!
!* Subroutines: *!
!* del_cohort *!
!* test_cohort *!
!* list_cohort *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
MODULE data_stand
INTEGER :: anz_coh = 0 ! current amount of cohortes
INTEGER :: max_coh = 0 ! max. amount of cohortes
REAL :: kpatchsize = 200 ! patch size [m^2]
REAL :: dz = 50 ! thickness of a crown layer [cm]
INTEGER :: waldtyp ! forest type
! variables for the whole stand
INTEGER,allocatable,save,dimension(:):: nrspec ! actual kind numbers of species
REAL,dimension(0:300) :: Irelpool ! relative light intensitiy of the crown space which is not
! occupied by trees (pool). This is the light intensitiy
! at the top of each layer. Irelpool(0)=light unto ground
REAL,dimension(1:301) :: BGpool ! fraction of patch covered by 'free crown space' for
! the next layer respectivley.
REAL,dimension(0:300) :: precpool ! relative precipitation intensitiy of the crown space which is not
! occupied by trees (pool). This is the precipitation intensitiy
! at the top of each layer
REAL :: Irelpool_ll ! relative light intensitiy at the lowest layer
REAL :: bgpool_ll ! fraction of patch covered by 'free crown space'
REAL :: totFPARsum ! fraction of absorbed light for the whole patch
REAL :: totFPARcan ! fraction of absorbed light for the whole canopy
REAL :: LAI ! leaf area index of the patch [m^2/m^2]
REAL :: LAI_can ! leaf area index of the canopy [m^2/m^2]
REAL :: LAI_sveg ! leaf area index of the ground vegetation [m^2/m^2]
REAL :: LAImax ! leaf area index of the patch in period when all trees carry leaves [m^2/m^2]
REAL :: LAI_in ! leaf area index of new trees [m^2/m^2]
REAL :: LAI_out ! leaf area index of removed trees [m^2/m^2]
REAL :: crown_area ! projected crown area [m**2] for the whole canopy,
REAL :: gp_tot ! unstressed stomatal conductance of the total vegetation (canopy + ground vegetation) [mol/(m2*d)]
REAL :: gp_can ! unstressed stomatal conductance of the canopy [mol/(m2*d)]
REAL :: gp_can_mean ! yearly mean of unstressed stomatal conductance of the canopy [mol/(m2*d)]
REAL :: gp_can_min ! yearly minimum of unstressed stomatal conductance of the canopy [mol/(m2*d)]
REAL :: gp_can_max ! yearly maximum of unstressed stomatal conductance of the canopy [mol/(m2*d)]
REAL :: drIndd ! daily drought index for the whole stand [-], weighted by ntree
REAL :: drIndAl ! drought index for allocation calculation (cum.) for the whole stand [-],
! weighted by NPP
REAL :: mean_drIndAl ! mean drought index for allocation calculation (cum.) for the whole stand [-],
REAL :: RedN_mean ! mean RedN of all species
INTEGER :: anz_RedN ! number of RedN for calculation of RedN_mean
REAL :: sumbio ! biomass of all cohorts and all tree-species [kg DW/ha]
REAL :: sumbio_sv ! biomass of all cohorts and all ground-vegetation-species [kg DW/ha]
REAL :: sumbio_in ! biomass of new trees [kg DW/ha]
REAL :: sumbio_out ! biomass of removed trees [kg DW/ha]
REAL :: cumsteminc ! total cumulated sum of all stem increments [kg/ha]
REAL :: cumsumvsab ! cumulated total sum of volume of removed stems by management [kg/ha]
REAL :: cumsumvsdead ! cumulated total sum of volume of dead stems [kg/ha]
REAL :: sumvsab ! total sum of volume of removed stems by management [kg/ha]
REAL :: sumvsab_m3 ! total sum of volume of removed stems by management [m³/ha]
REAL :: sumvsdead ! total sum of volume of dead stems [kg/ha]
REAL :: sumvsdead_m3 ! total sum of volume of dead stems [m³/ha]
REAL :: totfol ! total biomass of foliage [kg DW/ha]
REAL :: totfol_in ! total biomass of foliage of new trees [kg DW/ha]
REAL :: totfol_out ! total biomass of foliage of removed trees [kg DW/ha]
REAL :: totsap ! total biomass of sapwood [kg DW/ha]
REAL :: totfrt ! total fine root biomass of all cohorts and all species [kg DW/ha]
REAL :: totfrt_p ! total fine root biomass of all cohorts and all species per patch [kg DW/patchsize]
REAL :: totfrt_1 ! reciprocal of total fine root biomass of all cohorts and all species per patch [kg DW/patchsize]
REAL :: tottb ! total twigs, branches biomass of all cohorts and all species [kg DW/ha]
REAL :: totcrt ! total coarse root biomass of all cohorts and all species [kg DW/ha]
REAL :: seedlfrt ! total fine root biomass of all cohorts with height < thr_height [kg DW]
REAL :: tothrt ! total biomass of heartwood [kg DW/ha]
REAL :: sumNPP ! total NPP of all cohorts and species
REAL :: cum_sumNPP ! cumulative total NPP of all cohorts and species
REAL :: sumGPP ! total GPP of all cohorts and species [g C/m2 --> t C/ha]
REAL :: totfol_lit ! total foliage litter [kg DW / ha / year]
REAL :: totfol_lit_tree ! total foliage litter of trees [kg DW / ha / year]
REAL :: totfrt_lit ! total fine root litter [kg DW / ha / year]
REAL :: totfrt_lit_tree ! total fine root litter of trees [kg DW / ha / year]
REAL :: tottb_lit ! total litter of twigs, and branches [kg DW / ha / year]
REAL :: totcrt_lit ! total litter of coarse roots [kg DW / ha / year]
REAL :: totstem_lit ! total dead biomass of stems [kg DW / ha / year]
REAL :: totsteminc ! total stem increment of patch [kg DW/ha]
REAL :: totsteminc_m3 ! total stem increment of patch in m3
REAL :: totstem_m3 ! total stem volume [m3/ha]
REAL :: Ndem ! total N demand of the stand per year [g/m2]
REAL :: autresp ! total autotroph resp of all cohorts and species
REAL :: autresp_m ! mean total autotroph resp of all cohorts and species (mean over all years)
REAL :: sumTER ! total ecosystem respiration of all cohorts and species [g C/m2 --> t C/ha]
INTEGER :: coh_ident_max ! actual maximum ident number of cohorts
INTEGER :: anz_coh_in ! number of new cohorts
INTEGER :: anz_coh_out ! number of removed cohorts
INTEGER :: anz_coh_act ! number of cohorts of the actual year
INTEGER :: anz_spec ! number of current existing tree species
INTEGER :: anrspec ! number of all current existing species
INTEGER :: anz_spec_in ! number of new tree species
INTEGER :: anz_spec_out ! number of removed tree species
INTEGER :: anz_tree_dbh ! number of trees with dbh
INTEGER :: anz_tree ! total number of trees /patch
INTEGER :: anz_tree_ha ! total number of trees /ha
INTEGER :: anz_tree_in ! number of new trees /ha
INTEGER :: anz_tree_out ! number of removed trees /ha
INTEGER :: anz_sveg ! total number of soil vegetation cohorts
REAL :: med_diam ! medium diameter of stand (Dg)
REAL :: med_diam_in ! medium diameter of new trees (Dg)
REAL :: med_diam_out ! medium diameter of removed trees (Dg)
REAL :: hdom ! medium height of 2 dominant trees
REAL :: hmean_in ! mean height of all new trees
REAL :: hmean_out ! mean height of all removed trees
REAL :: mean_height ! mean height of stand [cm]
REAL :: mean_diam ! mean diameter of stand [cm]
REAL :: basal_area ! basal area [m²]
INTEGER :: highest_layer ! highest foliage layer of the stand
INTEGER :: lowest_layer ! lowest foliage layer of the stand.
! lowest_layer=0: bare ground
INTEGER :: lm3layer ! light model 4: layer from that on light model 3 is used
REAL :: GRASS_day
REAL :: NETASS_day
REAL :: GPP_day ! daily GPP of all cohorts and species after scaling by temperature
REAL, dimension(12) :: GPP_mon ! monthly GPP of all cohorts and species
REAL, dimension(53) :: GPP_week ! weekly GPP of all cohorts and species
REAL :: GPP_dec ! sum of GPP of all cohorts and species of last december
REAL, dimension(12) :: NEE_mon ! monthly NEE of all cohorts and species
REAL :: NEE_dec ! sum of NEE of all cohorts and species of last december
REAL :: NPP_day ! daily NPP of all cohorts and species after scaling by temperature
REAL, dimension(12) :: NPP_mon ! monthly NPP of all cohorts and species
REAL, dimension(53) :: NPP_week ! weekly NPP of all cohorts and species
REAL :: NPP_dec ! sum of NPP of all cohorts and species of last december
REAL :: TER_day ! daily TER of all cohorts and species after scaling by temperature
REAL, dimension(12) :: TER_mon ! monthly total ecosystem respiration of all cohorts and species
REAL, dimension(53) :: TER_week ! weekly total ecosystem respiration of all cohorts and species
REAL :: TER_dec ! sum of TER of all cohorts and species of last december
REAL :: respr_day ! daily root respiration of all cohorts and species after scaling by temperature
REAL, dimension(12) :: respr_mon ! monthly total root respiration of all cohorts and species (fine and coarse roots)
REAL, dimension(53) :: respr_week ! weekly total root respiration of all cohorts and species
REAL,allocatable, save, dimension(:) :: dayfract ! daily fraction of fluxes (depending on temperature)
REAL :: dailyNPP_C, & ! daily net production [gC/m2]
dailypotNPP_C, & ! daily potential (= no water and nutrient limitation) net primary production [gC/m2]
dailyautresp_C, & ! daily autotrophic respiration [gC/m2]
dailygrass_C, & ! daily gross assimilation [gC/m2]
dailynetass_C, & ! daily net assimilation [gC/m2]
dailyrespfol_C, & ! daily maintenance leaf respiration [gC/m2]
phot_C, & ! daily gross photosynthesis [gC/m2]
precsum
REAL :: ceppot_can ! pot. intercept. whole canopy
REAL :: ceppot_sveg ! pot. intercept. whole ground vegetation
INTEGER :: phen_flag=0 ! phenology flag, =1 if canopy changes due to
! phenological events
REAL :: basal_area_tot ! basal area of the whole stand [cm²]
! variables used in sum-output
REAL :: photsum,nppsum, &
npppotsum,resosum, &
lightsum, &
abslightsum,nee, &
gppsum, &
tersum, & ! total ecosystem respiration
resautsum, & ! autotrophe respiratiom
aet_sum, pet_sum, &
tempmean, tempmeanh !summation variable for output *_sum
! variables for representation index calculation
REAL :: rindex1, &
rindex2
! variable for ground-vegetation
REAL :: M_avail ! mass available for allocation to organs in soil veg. initialisation [kg DM m-2]
REAL :: NPP_est ! NPP estimated for soil veg. initialisation [g DM m-2]
! Variables for disturbances
REAL :: phlo_feed ! Percentage loss of carbon due to phloem feeders
REAL :: stem_rot ! Percentage loss of stems due to stem rot
! variables for classification of trees
INTEGER :: num_class=29 ! number of diameter and height classes
INTEGER,allocatable, save, dimension(:,:) :: diam_class, diam_classm, diam_class_t, diam_class_age
REAL ,allocatable, save, dimension(:,:) :: diam_class_h, diam_classm_h, diam_class_mvol
INTEGER,allocatable, save, dimension(:) :: height_class
! ! variables per species
INTEGER,allocatable,save,dimension(:) :: height_rank ! number of trees per species
INTEGER,allocatable,save,dimension(:) :: dbh_rank ! number of trees per species
type species_var
! variables per species
INTEGER :: daybb ! day of bud burst per species [julian day of year]
INTEGER :: ext_daybb ! externally prescribed day of bud burst per species [julian day of year]
INTEGER :: sum_nTreeA ! number of trees per species [per ha]
INTEGER :: sum_nTreeD ! number of all dead trees per species [per ha]
INTEGER :: anz_coh ! number of cohorts per species
REAL :: RedN ! photosynthesis nitrogen reduction factor [-]
REAL :: RedNm ! mean annual photosynthesis nitrogen reduction factor [-]
REAL :: med_diam ! medium diameter per species (squared average) [cm]
REAL :: mean_diam ! average diameter per species [cm]
REAL :: mean_jrb ! average year ring width [mm]
REAL :: dom_height ! dominant height per species [cm]
REAL :: mean_height ! average height per species [cm]
REAL :: basal_area ! basal area per species [m²]
REAL :: drIndAl ! drought index for allocation calculation (cum.) per species [-]
! weighted by NPP
REAL :: sumNPP ! total NPP of all cohorts per species
REAL :: sum_bio ! total biomass per species [kg DW/ha]
REAL :: sum_lai ! maximum annual LAI per species
REAL :: act_sum_lai ! LAI per species
REAL :: fol ! total foliage mass per species [kg DW/ha]
REAL :: hrt ! total heartwood mass per species [kg DW/ha]
REAL :: sap ! totalsapwood mass per species [kg DW/ha]
REAL :: frt ! total fine root mass per species [kg DW/ha]
REAL :: totsteminc ! total stem increment per species [kg DW/ha]
REAL :: totsteminc_m3 ! total stem increment per species [m3/ha]
REAL :: totstem_m3 ! total stem volume per species [m³/ha]
REAL :: sumvsab ! total sum of volume of harvested stem mass of species [kg/ha]
REAL :: sumvsdead ! total sum of volume of dead stems [kg/ha]
REAL :: sumvsdead_m3 ! total sum of volume of dead stems [m3/ha]
REAL :: crown_area ! species specific crown area
REAL :: Ndem ! total N demand per species and year [g/m2]
REAL :: Nupt ! total N uptake per species and year [g/m2]
REAL :: Ndemp ! total N demand per species and potosynthesis period [g/m2]
REAL :: Nuptp ! total N uptake per species and potosynthesis period [g/m2]
! Phenology parameters
REAL :: Pro ! Depending on phenomodel: Promotor or Temperature sum
REAL :: Inh ! Depending on phenomodel: Inhibitor or chill days
REAL :: Tcrit ! Critical temperature sum for Cannel-Smith model [°C]
REAL,pointer,dimension(:) :: BDmax ! species specific maximum bulk density for root growth in soil layers
REAL,pointer,dimension(:) :: tstress ! species specific temperature stress for root growth in soil layers
REAL,pointer,dimension(:) :: sstr ! species specific soil strength stress for root growth in soil layers
REAL,pointer,dimension(:) :: BDstr ! species specific bulk density stress for root growth in soil layers
REAL,pointer,dimension(:) :: porcrit ! species specific critical pore space for root growth in soil layers
REAL,pointer,dimension(:) :: airstr ! species specific aeration stress for root growth in soil layers
REAL,pointer,dimension(:) :: phstr ! species specific pH stress for root growth in soil layers
REAL,pointer,dimension(:) :: Rstress ! species specific total daily stress for root growth in soil layers
REAL,pointer,dimension(:) :: Smean ! species specific total yearly stress for root growth in soil layers
end type species_var
type(species_var),allocatable,dimension(:),target :: svar
type cohort
INTEGER :: ident ! identification of cohort
INTEGER :: species ! number of species parameter set in spar (type)
! state variables for population dynamics
REAL :: nTreeA ! number of alive trees (output) integer [-]
REAL :: nTreeD ! number of dead trees integer [-]
REAL :: nTreeM ! number of trees harvested by Management
REAL :: nTreet ! number of trees tended by Management
REAL :: nta ! number of alive trees (internal) REAL [-]
INTEGER :: mistletoe ! cohort has / has no mistletoe infection
! all variables are values of single trees !!!
! tree state variables; DW = dry weight (i.e., dry biomass)
INTEGER :: x_age ! tree age [yr]
REAL :: x_fol ! foliage biomass [kg DW / tree]
REAL :: x_fol_loss ! loss of foliage biomass [kg DW / tree] by disturbance (flag_dis=1)
REAL :: x_sap ! sapwood biomass [kg DW / tree]
REAL :: x_frt ! fine root biomass [kg DW / tree]
REAL :: x_frt_loss ! loss of fine root biomass [kg DW / tree] by disturbance (flag_dis=1)
REAL :: x_hrt ! heartwood biomass [kg DW / tree]
REAL :: x_rdpt ! rooting depth [cm]
REAL :: x_crt ! coarse root biomass [kg DW / tree]
REAL :: x_tb ! twigs and branches biomass [kg DW / tree]
REAL :: x_hsap ! sapwood height [cm]
REAL :: x_hbole ! bole height [cm]
REAL :: x_Ahb ! cross sectional area of heart wood at stem base [cm**2]
INTEGER :: x_stress ! number of stress years [-]
INTEGER :: x_health ! number of years without stress [-]
REAL :: x_nsc_sap ! sapwood nsc-pool [kg C / tree]
REAL :: x_nsc_tb ! twigs and branch nsc-pool [kg C / tree]
REAL :: x_nsc_crt ! coarse root nsc-pool [kg C / tree]
REAL :: x_nsc_sap_max !maximum amount sapwood nsc-pool [kg C / tree]
REAL :: x_nsc_tb_max !maximum amount twigs and branch nsc-pool [kg C / tree]
REAL :: x_nsc_crt_max !maximum amount coarse root nsc-pool [kg C / tree]
REAL :: biocost_all !biosynthesis costs for refilling process [kg DW / tree]
! auxiliary variables
REAL :: bes ! avarage beset or press of cohort
REAL :: med_sla ! average cohort specific leaf area [m²/kg]
REAL :: Fmax ! maximum foliage biomass [kg DW]
REAL :: totBio ! total tree biomass [kg DW]
REAL :: Dbio ! total dead biomass per cohort [kg DW]
REAL :: height ! total tree height [cm]
REAL :: deltaB ! change in bole height [cm]
REAL :: Ahc ! cross sectional area of heart wood at crown base [cm**2]
REAL :: dcrb ! trunc diameter at crown base [cm]
REAL :: diam ! diameter at breast height [cm]
real :: jrb ! year ring width [mm]
REAL :: assi ! optimum gross assimilation rate [kg DW/d/patch] !!! not a tree variable
REAL :: LUE ! light use efficiency [gC/micromole]
REAL :: resp ! leaf respiration rate [kg DW/d/patch] !!! not a tree variable
REAL :: netAss ! realized net assimilation rate [kg DW/d]
REAL :: NPP ! NPP [kg DW/yr]
REAL :: weekNPP ! weekly NPP [kg DW/yr]
REAL :: NPPpool
REAL :: t_leaf ! leaf area per tree [m2]
REAL :: geff ! growth efficiency [kg stem DM/(yr*m2)]
REAL :: Asapw ! tree sapwood cross sectional area in bole space [cm2]
REAL :: crown_area ! projected crown area [m**2],
! is the same in each layer; maximal proj. crown area,
! when enough space available crown_area
REAL,dimension(301) :: BG ! fraction of the patch covered by the
! tree in each layer, may change through the layers.
REAL,dimension(0:300) :: leafArea ! leaf area per layer [m2]
REAL,dimension(0:300) :: sleafArea ! leaf area per layer [m2], stocked
REAL,dimension(0:300) :: FPAR ! light version 1-3 : fraction of PAR
! absorbed by each layer per crown coverage area [-]
! light version 4 : fraction of PAR absorbed until(!)
! each layer per patch [-]
REAL,dimension(0:300) :: antFPAR ! fraction of totFPAR per crown layer
REAL,dimension(0:300) :: Irel ! relative incident radiation
! intensitiy at the top of a given layer
REAL :: totFPAR ! total fraction of PAR absorbed [-],
! per m² patch area!
REAL :: IrelCan ! the relative light regime in the
! middle of the cohort's canopy
INTEGER :: botLayer ! number of bottom layer of crown [-]
INTEGER :: topLayer ! number of top layer of crown [-]
REAL :: survp ! survival probability first 5 years of simulation
REAL :: rel_fol ! relative part foliage of cohort
REAL :: gfol ! gross growth rate foliage
REAL :: gfrt ! gross growth rate fine root
REAL :: gsap ! gross growth rate sap wood
REAL :: sfol ! senescence rate foliage
REAL :: sfrt ! senescence rate fine root
REAL :: ssap ! senescence rate sap wood
REAL :: grossass ! gross assimilation rate [kg DW/yr]
REAL :: maintres ! cumulative maintenance respiration (sap + frt) [kg DW/yr]
REAL :: respsap ! daily respiration rate sapwood [kg DW/d]
REAL :: respfrt ! daily respiration rate fine root [kg DW/d]
REAL :: respfol ! maintenance daily leaf respiration [kg DW/d]
REAL :: respbr ! daily respiration rate branches, c. roots .... [kg DW/d]
REAL :: respaut ! daily autotrophic respiration rate of tree .... [kg DW/d]
REAL :: resphet ! daily hetrotrophic respiration rate of tree .... [kg DW/d]
!
! aux. variables for calculation of crown_area of new established trees
REAL :: height_ini ! initial value of height of a new established tree cohort by ingrowth [cm]
REAL :: ca_ini ! initial value of crown area of a new established tree cohort by ingrowth [m2]
! new aux. variables for mAustrian management by relative diamter class
INTEGER :: rel_dbh_cl ! relative DBH class
INTEGER :: underst ! 0 = overstorey, 1 = seedling cohort, 2 = understorey
INTEGER :: sprout ! 0 = tree is no sprout, 1 = sprout
INTEGER :: fl_sap ! sapling = 0, tree = 1
! growth-mortality coupling variables
REAL :: fol_inc ! foliage increment [kg DW/yr]
REAL :: fol_inc_old ! foliage increment of last year[kg DW/yr]
REAL :: bio_inc ! net biomass increment [kg DW/yr]
REAL :: stem_inc ! stem wood increment [kg DW/yr]
REAL :: frt_inc ! fine root wood increment [kg DW/yr]
logical :: notViable ! .TRUE. if non-biological tree dimensions occur
integer :: flag_vegend=0
! plant-soil water coupling variables
REAL,dimension(0:300):: intcap ! precipitation absorbed by
! each layer per m² patch area [mm]
REAL,dimension(0:300):: prel ! precipitation
! at the top of a given layer [mm] per m² patch area
REAL :: interc ! total intercepted precipitation [mm],
! per m² patch area!
REAL :: prelCan ! the relative precipitaion regime
! in the middle of the cohort's canopy
REAL :: interc_st ! interception storage [mm/m2]
REAL :: aev_i ! actual evaporation of intercepted water [mm]
REAL :: demand ! daily demand for soil water of cohort [mm/day]
REAL :: supply ! daily uptake of soil water by roots of cohort [mm/day]
REAL :: watuptc ! yearly total uptake of soil water by roots [mm/day]
REAL :: watleft ! yearly total water left in soil layer next to last rooted soil layer [mm]
REAL :: gp ! unstressed stomatal conductance [mol/(m2*d)]
REAL :: drIndd ! daily drought index [-]
REAL :: drIndPS ! drought index for photosynthesis calculation (cum.) [-]
REAL :: nDaysPS ! number of growing season days per time step of PS model [-]
REAL :: drIndAl ! drought index for allocation calculation (cum.) [-]
INTEGER :: nDaysGr ! number of growing season days per year [#]
logical :: isGrSDay ! is the current day a growing season day?
! plant-soil C/N coupling variables in kg per cohort
REAL :: litC_fol ! foliage litter C pool [kg/cohort]
REAL :: litC_fold ! foliage litter C pool [kg/cohort] of dead trees
REAL :: litN_fol ! foliage litter N pool [kg/cohort]
REAL :: litN_fold ! foliage litter N pool [kg/cohort] of dead trees
REAL :: litC_frt ! fine root litter C pool [kg/cohort]
REAL :: litC_frtd ! fine root litter C pool [kg/cohort] of dead trees
REAL :: litN_frt ! fine root litter N pool [kg/cohort]
REAL :: litN_frtd ! fine root litter N pool [kg/cohort] of dead trees
REAL :: litC_stem ! stemwood litter C pool [kg/cohort]
REAL :: litN_stem ! stemwood litter N pool [kg/cohort]
REAL :: litC_tb ! twig, and branch litter C pool [kg/cohort]
REAL :: litC_crt ! coarse root litter C pool [kg/cohort]
REAL :: litC_tbcd ! twigs, branches, and coarse root litter C pool [kg/cohort] of dead trees
REAL :: litN_tb ! twig, and branch litter N pool [kg/cohort]
REAL :: litN_crt ! coarse root litter N pool [kg/cohort]
REAL :: litN_tbcd ! twigs, branches, and coarse root litter N pool [kg/cohort] of dead trees
REAL :: Nuptc_c ! N uptake per tree and year [g/yr]
REAL :: Ndemc_c ! N demand per tree and year [g/yr]
REAL :: Nuptc_d ! daily N uptake per tree [g/d]
REAL :: Ndemc_d ! daily N demand per tree [g/d]
REAL :: RedNc ! tree specific RedN (photosynthesis nitrogen reduction factor) [-]
REAL :: N_pool ! N pool per tree [g]
REAL :: N_fol ! N content of foliage per tree [g]
REAL :: wat_mg ! cohort water uptake (flag_wred=9)
! root distribution
REAL,pointer,dimension(:) :: frtrel ! relative part of fine root mass of tree per soil layer
REAL,pointer,dimension(:) :: frtrelc ! relative part of fine root mass of cohort of total layer fine root mass per soil layer
REAL,pointer,dimension(:) :: rld ! root length [cm per cm3]
REAL,pointer,dimension(:) :: rooteff ! root uptake efficiency per soil layer
INTEGER :: nroot ! nroot soil layer with max. root depth
! pseudo parameter (used as an index for field spar with species-specific parameters)
INTEGER :: shelter ! Überhaelter
! Phenology parameters
INTEGER :: day_bb ! day_bb day of bud burst [julian day of year]
! day_bb
REAL :: P ! Depending on phenomodel: Promotor or Temperature sum
REAL :: I ! Depending on phenomodel: Inhibitor or chill days
REAL :: Tcrit ! Critical temperature sum for Cannel-Smith model [°C]
end type cohort
type coh_obj
type(cohort) :: coh ! cohort data structure
type(coh_obj), pointer :: next ! pointer to next cohort
end type coh_obj
type coh_list
type(coh_obj), pointer :: first ! List of cohorts
end type coh_list
type(coh_list) :: pt ! variable for whole stand, all cohorts
type(cohort), pointer, dimension(:) :: coh_save ! pointer to variables for saving intialisation of all cohorts
type(coh_obj), pointer :: zeig ! pointer variable for manipulating cohorts
INTEGER :: anz_coh_save
type vert_struct
REAL :: LA ! leaf area in a given layer [m²]
REAL :: cumLAI ! cumulative leaf area index at the bottom of a given layer [m²/m²]
REAL :: radFrac ! fraction of total radiation absorbed in a given layer [-]
REAL :: sumBG ! sum of all crown areas in a layer [m²]
REAL :: Irel ! light version 1,2 : relative incident radiation at the top of a given layer [-]
! light version 3,4 : average relative incident radiation at the bottom of a given layer [-]. For test reasons only
end type vert_struct
type(vert_struct),dimension(0:300) :: vStruct ! field with vertical patch structure
! variables for litter retention
type dead_litter
INTEGER :: specnr ! species number
! arrays of dead stem and twigs/branches
REAL,pointer,dimension(:) :: C_tb
REAL,pointer,dimension(:) :: N_tb
REAL,pointer,dimension(:) :: C_stem
REAL,pointer,dimension(:) :: N_stem
end type dead_litter
INTEGER :: lit_year = 5 ! number of years of retention
type(dead_litter),allocatable,dimension(:),target :: dead_wood ! delay over 5 years []
!----------------------------------------------------------------------------------------
contains
function neu() result (stand_neu) ! Create a new pointer list = new stand without any cohort
implicit none
type(coh_list) :: stand_neu
nullify(stand_neu%first)
end function neu
!----------------------------------------------------------------------------------------
subroutine del_cohort
use data_species
use data_simul
implicit none
type(coh_obj), pointer :: nachlauf
zeig => pt%first
do while (associated(zeig))
if (zeig%coh%nTreeA < 0.1.or. (zeig%coh%species.gt.nspec_tree.and.zeig%coh%x_fol.le. 1.E-6)) then
pt%first => zeig%next
deallocate(zeig%coh%frtrel)
deallocate(zeig%coh%frtrelc)
deallocate(zeig%coh%rooteff)
if (flag_wred .eq. 9) deallocate(zeig%coh%rld)
deallocate(zeig)
zeig => pt%first
anz_coh=anz_coh-1
else
nachlauf => zeig
zeig => zeig%next
exit
end if
end do
do while (associated(zeig))
if (zeig%coh%nTreeA < 0.1.or. (zeig%coh%species.gt.nspec_tree.and.zeig%coh%x_fol.le. 1.E-6)) then
nachlauf%next => zeig%next
deallocate(zeig%coh%frtrel)
deallocate(zeig%coh%frtrelc)
deallocate(zeig%coh%rooteff)
if (flag_wred .eq. 9) deallocate(zeig%coh%rld)
deallocate(zeig)
zeig => nachlauf%next
anz_coh=anz_coh-1
else
nachlauf => zeig
zeig => zeig%next
end if
end do
end subroutine del_cohort
!----------------------------------------------------------------------------------------
subroutine list_cohort ! Output of cohort list
implicit none
INTEGER :: i
zeig => pt%first
i = 0
do while (associated(zeig))
i = i + 1
zeig => zeig%next
end do
end subroutine list_cohort
!----------------------------------------------------------------------------------------
subroutine test_cohort(ts)
implicit none
INTEGER, intent(out):: ts
zeig => pt%first
if (.not. associated(zeig)) then
print *,' No existing cohort!'
ts = 1
else
ts = 0
end if
end subroutine test_cohort
end module data_stand
source_code/version_2.3_windows/amod_tisort.f 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* Post Processing for 4C (FORESEE) *!
!* *!
!* *!
!* Modules and Subroutines: *!
!* *!
!* data_tsort: module to store timber assortments *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*************************************************************** *!
module data_tsort
! species specific parameter for sorting of harvested timber
! fagus, picea, pinus, quercus, betula
real, dimension(11) :: stoh=(/10.,10.,10.,10.,10.,10.,10.,10.,10.,10.,10./)
real, dimension(5) :: lmin=(/400.,400.,400.,400.,400./)
real, dimension(5) :: ldmin=(/30.,30., 30., 30.,35./)
real, dimension(5) :: lzmin=(/20.,14.,14.,20.,20./)
real, dimension(5) :: lasfixl1=(/400.,400.,400.,400.,400./)
real, dimension(5) :: lasfixl2= (/300.,300.,300.,300.,300./)
real, dimension(5) :: lasdmin= (/20.,15.,15.,20.,20./)
real, dimension(5) :: las1zmin= (/0.,0.,11.,0.,0./)
real, dimension(5) :: las1dmin= (/0.,0.,11.,0.,0./)
real, dimension(5) :: laszmin= (/11.,11.,11.,11.,11./)
real, dimension(5) :: isfixl1= (/200.,200.,200.,200.,200./)
real, dimension(5) :: isfixl2= (/100.,100.,100.,100.,100./)
real, dimension(5) :: isdmin= (/10.,10.,10.,10.,10./)
real, dimension(5) :: iszmin= (/7.,7.,7.,7.,7./)
real rabth(5,2)
real,dimension(5,3) :: rabz
real :: zug =10 ! addition [cm]
real, allocatable,save, dimension(:,:,:,:) :: sort ! per year and species for different cohorts:
integer, parameter :: dg=kind(0.0D0) ! identifier, lenght, diamter, volume, number of pieces
integer :: anz_list
integer :: flag_sort= 1 ! 0: with stem timber; 1: without stem timber, 2:only LAS 3m + Ind +Fuel
! 3: only LAS 4m * Ind + Fuel
integer :: flag_deadsort =0
type timber
integer :: year
integer :: count
character(4):: ttype
character(2):: stype ! stand type (vb or ab)
integer :: specnr
real :: zapfd ! diameter at the top
real :: zapfdor ! without bark
real :: length
real :: dia ! diameter at thre middle
real :: diaor ! without bark
real(kind =dg) :: vol
real :: tnum
real ::hei_tree
real :: hbo_tree
real :: diab ! diameter at base
real :: dcrb
end type timber
type tim_obj
type(timber) :: tim ! cohort data structure
type(tim_obj), pointer :: next ! pointer to next cohort
end type tim_obj
type tim_list
type(tim_obj), pointer :: first ! List of cohorts
end type tim_list
type(tim_list) :: st ! variable for whole stand, all cohorts
type(tim_obj), pointer :: ztim ! pointer variable for manipulating cohorts
DATA rabth /35.,25.,20.,40.,40.,0.,40.,30.,60.,0./
DATA rabz /1.,1.,1.,3.,2.,2.,2.,2.,5.,4.,2.,3.,4.,6.,4./
end module data_tsort
source_code/version_2.3_windows/amod_wpm.f 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* Post Processing for 4C (FORESEE) *!
!* *!
!* *!
!* Modules and Subroutines: *!
!* *!
!* data_mansort: module to store the mansort, manrec input *!
!* wood_processing: module to store wood processing infos *!
!* wpm_output: module to store simulation output *!
!* lifespan_par: module to store lifespan parameters *!
!* ini_input: initialize the values of the modules *!
!* allocate_in_output: allocates module values *!
!* deallocate_in_output: deallocates module values *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
! module contains informations from mansort file: "removals"
! module contains information for "roundwood" and "after processing" steps
! module contains lifespan function parameters
! module contains wmp output
module data_wpm
!***************************************************************
! module contains informations from mansort file: "removals"
! cm cm cm cm cm m³/ha kg C/ha
!# year count spec type len diam diam wob top_d t_d wob Volume DW number
type mansort_type
integer :: year, count, spec, number
character(4) :: typus
real :: diam, volume, dw, diam_wob
end type mansort_type
type manrec_type
integer :: year, measure
character(28) :: management
end type manrec_type
type mansort_obj
type(mansort_type) :: mansort
type(mansort_obj), pointer :: next
end type mansort_obj
type manrec_obj
type(manrec_type) :: manrec
type(manrec_obj), pointer :: next
end type manrec_obj
! pointer to the the mansort, manrec lists, sea list
type(mansort_obj), pointer :: first_mansort
type(manrec_obj) , pointer :: first_manrec
type(mansort_obj), pointer :: first_standsort
! pointer variable for manipulating mansort, manrec lists, sea list
type(mansort_obj), pointer :: act_mansort
type(manrec_obj) , pointer :: act_manrec
type(mansort_obj), pointer :: act_standsort
! years from the manrec file with needed management
integer, allocatable, save, dimension(:) :: management_years
integer :: nr_pr_ln
! number of simulation years, management (manrec) years and wpm relevant management years
integer :: nr_years
integer :: nr_management_years
integer :: wpm_manag_years
! sea: number of timber grades, number of tree species
integer :: nr_timb_grades
integer :: nr_spec
!***************************************************************
! module contains information for "roundwood" and "after processing" steps
!***************************************************************
! value: carbon per simulation year
! proc_par: parameters for the processing
! use_par: parameters for the "use categories" distribution
type wood_type
real, pointer, dimension(:) :: value
real, dimension(3,7) :: proc_par
real, dimension(7) :: use_par
end type wood_type
! for each simulation year
! product lines: sawntimber_sw, sawntimber_hw (softwood, hardwood),
! plywood, particle_board, chem_pulpwood, mech_pulpwood, fuelwood
type(wood_type), allocatable, save, dimension(:) :: product_lines
! save the results by the procentual sorting of product lines
! three sortings, product lines, years
real, allocatable, save, dimension(:,:,:) :: pl
! with or without wob
logical :: wob
!***************************************************************
! module contains lifespan function parameters
!***************************************************************
type lifespan_type
real hl
real a, b, c, d
end type lifespan_type
type(lifespan_type) :: short_lifespan
type(lifespan_type) :: medium_short_lifespan
type(lifespan_type) :: medium_long_lifespan
type(lifespan_type) :: long_lifespan
!***************************************************************
! module contains wmp output
!***************************************************************
integer, allocatable, save, dimension(:) :: years
integer :: nr_use_cat
integer, allocatable, dimension(:) :: max_age
! use_categories: building_materials, other_building_materials, structural_support,
! furnishing, packing_materials, long_life_paper, short_life_paper
! per simulation year
! rec_par: recycling, landfill, burning parameter of use
type use_categories_type
type(lifespan_type) :: lifespan_function
real, pointer, dimension(:) :: value
real, dimension(3) :: rec_par
real, dimension(7) :: rec_use_par
! spin up values
real, pointer, dimension(:) :: spinup
end type use_categories_type
! spin up value
real :: landfill_spinup
! spinup_on
logical :: spinup_on
! debug and spinup output
logical :: debug
logical :: output_spinup
! list of use_cateories, sum of use categories per year, use_cat at the beginning
type(use_categories_type), allocatable, save, dimension(:) :: use_categories
real, allocatable, save, dimension(:) :: sum_use_cat
real, allocatable, save, dimension(:) :: sum_input
real, allocatable, save, dimension(:,:) :: use_cat
real, allocatable, save, dimension(:) :: burning
real, allocatable, save, dimension(:) :: landfill
! atmosphere per year, atmosphere cummulative
real, allocatable, save, dimension(:) :: atmo_year
real, allocatable, save, dimension(:) :: atmo_cum
!******************** substitution ********************
real, allocatable, save, dimension(:) :: emission_har, sub_energy, sub_material, sub_sum
real, dimension (3) :: sub_par
!********************** sea ****************************
! sea timber grades:
! _tg(tree species, timber grade, year)
real, allocatable, save, dimension(:,:,:) :: mansort_tg
real, allocatable, save, dimension(:,:,:) :: standsort_tg
! prices (spec, timber grades)
real, allocatable, save, dimension(:,:) :: chainsaw_prices
real, allocatable, save, dimension(:,:) :: harvester_prices
real, allocatable, save, dimension(:) :: planting_prices
real, allocatable, save, dimension(:,:) :: planting_sub
real, allocatable, save, dimension(:,:) :: fence
real, dimension(2) :: fix
real, dimension(2) :: brushing
real, dimension(2) :: tending_prices
real, dimension(2,2) :: ext_for
real, dimension(4) :: int_rate
real, allocatable, save, dimension(:,:) :: sum_costs
real, allocatable, save, dimension(:,:) :: subsidy
real, allocatable, save, dimension(:,:) :: npv
real, allocatable, save, dimension(:,:) :: net_prices
! percentual of chainsaw to harvester methods
real, dimension(2) :: hsystem = (/0.8, 0.2/)
! percentual of decidious wood in a forest
real :: dec_per
! planting year
integer :: plant_year = 0
integer :: flag_plant = 0
! costs, assets (spec, year)
real, allocatable, save, dimension(:,:) :: ms_costs
real, allocatable, save, dimension(:,:) :: ms_assets
real, allocatable, save, dimension(:,:) :: st_costs
real, allocatable, save, dimension(:,:) :: st_assets
end ! module data_wpm
!***************************************************************
!************* functions ***************************************
!***************************************************************
! initializes the inputfiles and fills the parameters
subroutine ini_input
use data_simul
use data_wpm
implicit none
integer i
!******************* ini wpm and sea **************************
do i =1,nr_years
years(i) = i
enddo
management_years(:) = 0
!******************* ini wpm **************************
! parameters for the round wood => product lines
do i=1,nr_pr_ln
product_lines(i)%value(:) = 0.
end do
! distribution of round wood to product lines
! redistribution of timber grades:
! wiener model
! product_lines(1)%proc_par(1,:) = (/0.6, 0., 0., 0., 0.4, 0., 0./)
! product_lines(2)%proc_par(1,:) = (/0., 0.6, 0., 0., 0.4, 0., 0./)
! product_lines(3)%proc_par(1,:) = (/0., 0., 0.6, 0., 0.4, 0., 0./)
! product_lines(4)%proc_par(1,:) = (/0., 0., 0., 0.6, 0.4, 0., 0./)
! product_lines(5)%proc_par(1,:) = (/0., 0., 0., 0., 1., 0., 0./)
! product_lines(6)%proc_par(1,:) = (/0., 0., 0., 0., 0., 1., 0./)
! product_lines(7)%proc_par(1,:) = (/0., 0., 0., 0., 0., 0., 1./)
! distribution of timber: industrial lines to product lines
! product_lines(1)%proc_par(2,:) = (/0.6, 0., 0.12, 0., 0.14, 0., 0.12/)
! product_lines(2)%proc_par(2,:) = (/0.6, 0., 0.12, 0., 0.14, 0., 0.12/)
! product_lines(3)%proc_par(2,:) = (/0., 0., 0.61, 0., 0.16, 0., 0.23/)
! product_lines(4)%proc_par(2,:) = (/0., 0., 0.61, 0., 0.16, 0., 0.23/)
! product_lines(5)%proc_par(2,:) = (/0., 0., 0., 0., 0.70, 0., 0.30/)
! product_lines(6)%proc_par(2,:) = (/0., 0., 0., 0., 0.71, 0., 0.30/)
! product_lines(7)%proc_par(2,:) = (/0., 0., 0., 0., 0., 0., 1.00/)
! 40% of 1st,2nd,3rd,4th timber grades must go to the 5th timber grade (industrial wood)
product_lines(1)%proc_par(1,:) = (/0.6, 0., 0., 0., 0.4, 0., 0./)
product_lines(2)%proc_par(1,:) = (/0., 0.6, 0., 0., 0.4, 0., 0./)
product_lines(3)%proc_par(1,:) = (/0., 0., 0.6, 0., 0.4, 0., 0./)
product_lines(4)%proc_par(1,:) = (/0., 0., 0., 0.6, 0.4, 0., 0./)
product_lines(5)%proc_par(1,:) = (/0., 0., 0., 0., 1., 0., 0./)
product_lines(6)%proc_par(1,:) = (/0., 0., 0., 0., 0., 1., 0./)
product_lines(7)%proc_par(1,:) = (/0., 0., 0., 0., 0., 0., 1./)
! distribution of timber grades to industrial lines - Brandenburg
product_lines(1)%proc_par(2,:) = (/0.97, 0., 0.03, 0., 0., 0., 0./)
product_lines(2)%proc_par(2,:) = (/0., 0.83, 0.17, 0., 0. , 0., 0./)
product_lines(3)%proc_par(2,:) = (/0.86, 0., 0.01, 0., 0.13, 0., 0./)
product_lines(4)%proc_par(2,:) = (/0., 0.53, 0.10, 0., 0.37, 0., 0./)
product_lines(5)%proc_par(2,:) = (/0., 0., 0., 0.66, 0.34, 0., 0./)
product_lines(6)%proc_par(2,:) = (/0., 0., 0., 0., 0., 0., 0./)
product_lines(7)%proc_par(2,:) = (/0., 0., 0., 0., 0., 0., 1./)
!distribution of timber into industrial lines - Germany
! product_lines(1)%proc_par(2,:) = (/0.97, 0., 0.03, 0., 0., 0., 0./)
! product_lines(2)%proc_par(2,:) = (/0., 0.83, 0.17, 0., 0. , 0., 0./)
! product_lines(3)%proc_par(2,:) = (/0.86, 0., 0.01, 0., 0.07, 0.06, 0./)
! product_lines(4)%proc_par(2,:) = (/0., 0.53, 0.10, 0., 0.20, 0.17, 0./)
! product_lines(5)%proc_par(2,:) = (/0., 0., 0., 0.66, 0.18, 0.16, 0./)
! product_lines(6)%proc_par(2,:) = (/0., 0., 0., 0., 0., 0., 0./)
! product_lines(7)%proc_par(2,:) = (/0., 0., 0., 0., 0., 0., 1./)
! distribution of timber: industrial lines to product lines
select case (flag_wpm)
! central europe
case (1:10)
product_lines(1)%proc_par(3,:) = (/0.610, 0., 0., 0.152, 0.141, 0., 0.097/)
product_lines(2)%proc_par(3,:) = (/0., 0.670, 0., 0.152, 0.119, 0., 0.082/)
product_lines(3)%proc_par(3,:) = (/0., 0., 0.530, 0.095, 0., 0., 0.375/)
product_lines(4)%proc_par(3,:) = (/0., 0., 0., 0.690, 0.080, 0., 0.230/)
product_lines(5)%proc_par(3,:) = (/0., 0., 0., 0., 0.472, 0., 0.528/)
product_lines(6)%proc_par(3,:) = (/0., 0., 0., 0., 0., 0.928, 0.072/)
product_lines(7)%proc_par(3,:) = (/0., 0., 0., 0., 0., 0., 1.000/)
! nothern europe
case (11:20)
product_lines(1)%proc_par(3,:) = (/0.435, 0., 0., 0.270, 0.435, 0., 0.130/)
product_lines(2)%proc_par(3,:) = (/0., 0.435, 0., 0.270, 0.435, 0., 0.130/)
product_lines(3)%proc_par(3,:) = (/0., 0., 0.384, 0., 0.339, 0., 0.277/)
product_lines(4)%proc_par(3,:) = (/0., 0., 0., 0.690, 0.080, 0., 0.230/)
product_lines(5)%proc_par(3,:) = (/0., 0., 0., 0., 0.472, 0., 0.528/)
product_lines(6)%proc_par(3,:) = (/0., 0., 0., 0., 0., 0.928, 0.072/)
product_lines(7)%proc_par(3,:) = (/0., 0., 0., 0., 0., 0., 1.000/)
! southern europe
case (21:30)
product_lines(1)%proc_par(3,:) = (/0.610, 0., 0.152, 0., 0.141, 0., 0.097/)
product_lines(2)%proc_par(3,:) = (/0., 0.670, 0.129, 0., 0.119, 0., 0.082/)
product_lines(3)%proc_par(3,:) = (/0., 0., 0.530, 0., 0., 0., 0.375/)
product_lines(4)%proc_par(3,:) = (/0., 0., 0., 0.095, 0.080, 0., 0.230/)
product_lines(5)%proc_par(3,:) = (/0., 0., 0., 0.690, 0.472, 0., 0.528/)
product_lines(6)%proc_par(3,:) = (/0., 0., 0., 0., 0., 0.928, 0.072/)
product_lines(7)%proc_par(3,:) = (/0., 0., 0., 0., 0., 0., 1.000/)
case (31:40)
!central europe
product_lines(1)%proc_par(3,:) = (/0.610, 0., 0., 0.152, 0.141, 0., 0.097/)
product_lines(2)%proc_par(3,:) = (/0., 0.670, 0., 0.152, 0.119, 0., 0.082/)
product_lines(3)%proc_par(3,:) = (/0., 0., 0.530, 0.095, 0., 0., 0.375/)
product_lines(4)%proc_par(3,:) = (/0., 0., 0., 0.690, 0.080, 0., 0.230/)
product_lines(5)%proc_par(3,:) = (/0., 0., 0., 0., 0.472, 0., 0.528/)
product_lines(6)%proc_par(3,:) = (/0., 0., 0., 0., 0., 0.928, 0.072/)
product_lines(7)%proc_par(3,:) = (/0., 0., 0., 0., 0., 0., 1.000/)
!distribution of timber into industrial lines - Germany
! product_lines(1)%proc_par(2,:) = (/0.97, 0., 0.03, 0., 0., 0., 0./)
! product_lines(2)%proc_par(2,:) = (/0., 0.83, 0.17, 0., 0. , 0., 0./)
! product_lines(3)%proc_par(2,:) = (/0.86, 0., 0.01, 0., 0.07, 0.06, 0./)
! product_lines(4)%proc_par(2,:) = (/0., 0.53, 0.10, 0., 0.20, 0.17, 0./)
! product_lines(5)%proc_par(2,:) = (/0., 0., 0., 0.66, 0.18, 0.16, 0./)
! product_lines(6)%proc_par(2,:) = (/0., 0., 0., 0., 0., 0., 0./)
! product_lines(7)%proc_par(2,:) = (/0., 0., 0., 0., 0., 0., 1./)
end select
!**************************************************************************************************************
! parameters for the product lines => "use categories"
product_lines(1)%use_par = (/0.35, 0.30, 0.10, 0.15, 0.10, 0., 0./)
product_lines(2)%use_par = (/0.35, 0.30, 0.10, 0.15, 0.10, 0., 0./)
product_lines(3)%use_par = (/0.05, 0.05, 0.30, 0.30, 0.30, 0., 0./)
product_lines(4)%use_par = (/0.20, 0.30, 0.10, 0.20, 0.20, 0., 0./)
product_lines(5)%use_par = (/0., 0., 0., 0., 0.33, 0.33, 0.34/)
product_lines(6)%use_par = (/0., 0., 0., 0., 0.34, 0.33, 0.33/)
product_lines(7)%use_par = (/0., 0., 0., 0., 0., 0., 0./)
!******************* ini lifespan **************************
short_lifespan%hl = 1.
short_lifespan%a = 120.
short_lifespan%b = 5.
short_lifespan%c = 3.
short_lifespan%d = 120.
medium_short_lifespan%hl = 4.
medium_short_lifespan%a = 120.
medium_short_lifespan%b = 5.
medium_short_lifespan%c = 0.5
medium_short_lifespan%d = 120.
medium_long_lifespan%hl = 16.
medium_long_lifespan%a = 120.
medium_long_lifespan%b = 5.
medium_long_lifespan%c = 0.12
medium_long_lifespan%d = 120.
long_lifespan%hl = 50.
long_lifespan%a = 120.
long_lifespan%b = 5.
long_lifespan%c = 0.04
long_lifespan%d = 120.
!************** ini use categories **************************
do i=1,nr_use_cat
use_categories(i)%value(:) = 0.
end do
use_categories(1)%lifespan_function = long_lifespan
use_categories(2)%lifespan_function = medium_long_lifespan
use_categories(3)%lifespan_function = short_lifespan
use_categories(4)%lifespan_function = medium_long_lifespan
use_categories(5)%lifespan_function = short_lifespan
use_categories(6)%lifespan_function = medium_short_lifespan
use_categories(7)%lifespan_function = short_lifespan
! recycling, landfill, burning
use_categories(1)%rec_par = (/0.30, 0.35, 0.35/)
use_categories(2)%rec_par = (/0.25, 0.50, 0.25/)
use_categories(3)%rec_par = (/0.15, 0.45, 0.40/)
use_categories(4)%rec_par = (/0.25, 0.50, 0.25/)
use_categories(5)%rec_par = (/0.72, 0.14, 0.14/)
use_categories(6)%rec_par = (/0.72, 0.14, 0.14/)
use_categories(7)%rec_par = (/0.72, 0.14, 0.14/)
! recycling parameters
! test parameters like in the wien model
! use_categories(1)%rec_use_par = (/1.00, 0., 0., 0., 0., 0., 0./)
! use_categories(2)%rec_use_par = (/0., 1.00, 0., 0., 0., 0., 0./)
! use_categories(3)%rec_use_par = (/0., 0., 1.00, 0., 0., 0., 0./)
! use_categories(4)%rec_use_par = (/0., 0., 0., 1.00, 0., 0., 0./)
! use_categories(5)%rec_use_par = (/0., 0., 0., 0., 1.00, 0., 0./)
! use_categories(6)%rec_use_par = (/0., 0., 0., 0., 0., 1.00, 0./)
! use_categories(7)%rec_use_par = (/0., 0., 0., 0., 0., 0., 1.00/)
! real parameters
use_categories(1)%rec_use_par = (/0.33, 0.34, 0.33, 0., 0., 0., 0./)
use_categories(2)%rec_use_par = (/0., 0.50, 0.50, 0., 0., 0., 0./)
use_categories(3)%rec_use_par = (/0., 0., 1.00, 0., 0., 0., 0./)
use_categories(4)%rec_use_par = (/0., 0., 0.5, 0.5, 0., 0., 0./)
use_categories(5)%rec_use_par = (/0., 0., 0., 0., 0.5, 0., 0.5/)
use_categories(6)%rec_use_par = (/0., 0., 0., 0., 0.5, 0., 0.5/)
use_categories(7)%rec_use_par = (/0., 0., 0., 0., 0.5, 0., 0.5/)
! test parameters
! use_categories(1)%rec_use_par = (/1.00, 0., 0., 0., 0., 0., 0./)
! use_categories(2)%rec_use_par = (/0., 1.00, 0., 0., 0., 0., 0./)
! use_categories(3)%rec_use_par = (/0., 0., 1.00, 0., 0., 0., 0./)
! use_categories(4)%rec_use_par = (/0., 0., 0., 1.00, 0., 0., 0./)
! use_categories(5)%rec_use_par = (/0., 0., 0., 0., 0.5, 0.5, 0./)
! use_categories(6)%rec_use_par = (/0., 0., 0., 0., 0., 1.00, 0./)
! use_categories(7)%rec_use_par = (/0., 0., 0., 0., 0., 0., 1.00/)
! wood_pieces containes the wood_pieces of different age
do i=1, nr_use_cat
max_age(i) = use_categories(i)%lifespan_function%hl * 3
end do
! allocation of spinup values
do i=1, nr_use_cat
allocate(use_categories(i)%spinup(max_age(i)))
end do
do i=1, nr_use_cat
use_categories(i)%spinup(:) = 0.
end do
burning(:) = 0.
atmo_cum(:) = 0.
atmo_year(:) = 0.
landfill(:) = 0.
sum_use_cat(:) = 0.
sum_input(:) = 0.
pl(:,:,:) = 0.
use_cat(:,:) = 0.
!******************* ini substitution **************************
emission_har = 0.
sub_energy = 0.
sub_material = 0.
sub_sum = 0.
sub_par (1) = -0.013 ! Emission from harvest
sub_par (2) = 0.601
sub_par (3) = 0.2651
end subroutine
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine ini_input_sea
use data_simul
use data_wpm
implicit none
!************************ ini sea ***********************
mansort_tg(:,:,:) = 0.
standsort_tg(:,:,:) = 0.
chainsaw_prices(:,:) = 0.
harvester_prices(:,:) = 0.
fence(:,:) = 0.
planting_prices(:) = 0.
planting_sub(:,:) = 0.
net_prices(:,:) = 0.
ms_costs(:,:) = 0.
st_costs(:,:) = 0.
ms_assets(:,:) = 0.
st_assets(:,:) = 0.
sum_costs(:,:) = 0.
subsidy(:,:) = 0.
npv(:,:) = 0.
brushing(:) = 0.
fix(:) = 0.
tending_prices(:) = 0.
dec_per = 0.
end subroutine
!********************** FLAGS **********************************
! set flags for the run
subroutine setFlags
use data_wpm
implicit none
! calculate product lines with or without bark
! wob = .FALSE.
wob = .TRUE.
! spin up flag: true - read and add the spin up values
spinup_on = .FALSE.
! spinup_on = .TRUE.
! debug and spinup outputs
debug = .FALSE.
! debug = .TRUE.
output_spinup = .FALSE.
! output_spinup = .TRUE.
end subroutine
!***************************************************************
subroutine allocate_in_output
use data_simul
use data_wpm
implicit none
! integer mansort_lines, nr_years, nr_management_years
integer i
! set some informations for wpm / sea
nr_years = year
! allocate output
if(flag_wpm.eq.5 .or.flag_wpm.eq.4 .or. flag_wpm.eq.6) then
nr_years = nr_management_years
end if
if (.not. allocated(years)) allocate(years(nr_years))
if (.not. allocated(management_years)) allocate(management_years(nr_management_years))
! only wpm
if (flag_wpm == 1 .or. flag_wpm == 3 .or. flag_wpm == 21 .or. flag_wpm == 11.or. flag_wpm == 5 .or. flag_wpm == 4 .or. flag_wpm == 6) then
nr_pr_ln = 7
nr_use_cat = 7
! allocate wood processing
if (.not. allocated(product_lines)) then
allocate(product_lines(nr_pr_ln))
do i=1,nr_pr_ln
allocate(product_lines(i)%value(nr_management_years))
end do
end if
! allocate pl: save results of the product lines sorting
if (.not. allocated(pl))allocate(pl(3, nr_pr_ln, nr_years))
! 6 use categories per simulation year
if (.not. allocated(use_categories)) then
allocate(use_categories(nr_use_cat))
do i=1,nr_use_cat
allocate(use_categories(i)%value(nr_years))
end do
end if
if (.not. allocated(max_age))allocate(max_age(nr_use_cat))
if (.not. allocated(burning))allocate(burning(nr_years))
if (.not. allocated(landfill))allocate(landfill(nr_years))
if (.not. allocated(atmo_cum))allocate(atmo_cum(nr_years))
if (.not. allocated(atmo_year))allocate(atmo_year(nr_years))
if (.not. allocated(sum_use_cat))allocate(sum_use_cat(nr_years))
if (.not. allocated(sum_input))allocate(sum_input(nr_years))
if (.not. allocated(use_cat))allocate(use_cat(nr_use_cat, nr_years))
! Substitution
if (.not. allocated(emission_har))allocate(emission_har(nr_years))
if (.not. allocated(sub_energy))allocate(sub_energy(nr_years))
if (.not. allocated(sub_material))allocate(sub_material(nr_years))
if (.not. allocated(sub_sum))allocate(sub_sum(nr_years))
end if
! only sea
if (flag_wpm == 2 .or. flag_wpm == 3.or.flag_wpm.eq.5 .or. flag_wpm.eq.6) then
nr_spec = 5
nr_timb_grades = 10
if (.not. allocated(mansort_tg)) allocate(mansort_tg(nr_spec, nr_timb_grades, nr_years))
if (.not. allocated(standsort_tg)) allocate(standsort_tg(nr_spec, nr_timb_grades, nr_years))
if (.not. allocated(chainsaw_prices)) allocate(chainsaw_prices(nr_spec, nr_timb_grades))
if (.not. allocated(harvester_prices)) allocate(harvester_prices(nr_spec, nr_timb_grades))
if (.not. allocated(planting_prices)) allocate(planting_prices(nr_spec))
if (.not. allocated(fence)) allocate(fence(2,nr_spec))
if (.not. allocated(planting_sub)) allocate(planting_sub(2,nr_spec))
if (.not. allocated(net_prices)) allocate(net_prices(nr_spec, nr_timb_grades))
if (.not. allocated(ms_costs)) allocate(ms_costs(nr_spec, nr_years))
if (.not. allocated(st_costs)) allocate(st_costs(nr_spec, nr_years))
if (.not. allocated(sum_costs)) allocate(sum_costs(5, nr_years))
if (.not. allocated(subsidy)) allocate(subsidy(2, nr_years))
if (.not. allocated(npv)) allocate(npv(12, nr_years))
if (.not. allocated(ms_assets)) allocate(ms_assets(nr_spec, nr_years))
if (.not. allocated(st_assets)) allocate(st_assets(nr_spec, nr_years))
end if
end subroutine
!***************************************************************
subroutine deallocate_wpm
use data_wpm
use data_simul
implicit none
integer i
! deallocate mansort and manrec lists
if ( associated(first_manrec)) then
act_manrec => first_manrec
do while ( associated(act_manrec))
first_manrec => act_manrec%next
deallocate(act_manrec)
act_manrec => first_manrec
end do
endif
if ( associated(first_mansort)) then
act_mansort => first_mansort
do while ( associated(act_mansort))
first_mansort => act_mansort%next
deallocate(act_mansort)
act_mansort => first_mansort
end do
endif
! deallocate wood processing
if (allocated(management_years)) deallocate(management_years)
do i=1,nr_pr_ln
if (associated(product_lines(i)%value)) deallocate(product_lines(i)%value)
end do
if (allocated(product_lines)) deallocate(product_lines)
if (allocated(pl)) deallocate(pl)
! deallocate output
if (allocated(years)) deallocate(years)
do i=1,nr_use_cat
if (associated(use_categories(i)%value)) deallocate(use_categories(i)%value)
if (associated(use_categories(i)%spinup)) deallocate(use_categories(i)%spinup)
end do
if (allocated(use_categories)) deallocate(use_categories)
if (allocated(max_age)) deallocate(max_age)
if (allocated(burning)) deallocate(burning)
if (allocated(landfill)) deallocate(landfill)
if (allocated(atmo_cum)) deallocate(atmo_cum)
if (allocated(atmo_year)) deallocate(atmo_year)
if (allocated(sum_use_cat)) deallocate(sum_use_cat)
if (allocated(sum_input)) deallocate(sum_input)
if (allocated(use_cat)) deallocate(use_cat)
! Sustitution
if (allocated(emission_har)) deallocate(emission_har)
if (allocated(sub_energy)) deallocate(sub_energy)
if (allocated(sub_material)) deallocate(sub_material)
if (allocated(sub_sum)) deallocate(sub_sum)
!sea
if (flag_wpm == 2 .or. flag_wpm == 3) then
if ( associated(first_standsort)) then
act_standsort => first_standsort
do while ( associated(act_standsort))
first_standsort => act_standsort%next
deallocate(act_standsort)
act_standsort => first_standsort
end do
endif
if (allocated(mansort_tg)) deallocate(mansort_tg)
if (allocated(standsort_tg)) deallocate(standsort_tg)
if (allocated(chainsaw_prices)) deallocate(chainsaw_prices)
if (allocated(harvester_prices)) deallocate(harvester_prices)
if (allocated(planting_prices)) deallocate(planting_prices)
if (allocated(fence)) deallocate(fence)
if (allocated(planting_sub)) deallocate(planting_sub)
if (allocated(net_prices)) deallocate(net_prices)
if (allocated(ms_costs)) deallocate(ms_costs)
if (allocated(st_costs)) deallocate(st_costs)
if (allocated(ms_assets)) deallocate(ms_assets)
if (allocated(st_assets)) deallocate(st_assets)
if (allocated(sum_costs)) deallocate(sum_costs)
if (allocated(subsidy)) deallocate(subsidy)
if (allocated(npv)) deallocate(npv)
end if
end subroutine
source_code/version_2.3_windows/aspen_manag.f 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* 4C (FORESEE) *!
!* *!
!* *!
!* Subroutines for: *!
!* Aspen management *!
!* contains: *!
!* SR aspman_ini *!
!* SR asp_manag *!
!* SR asp_sprout *!
!* SR asp_pruning *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
subroutine aspman_ini
use data_manag
use data_species
use data_simul
use data_stand
use data_par
implicit none
integer :: manag_unit,i, ios
character(len=150) :: filename
logical :: ex
character ::text
manag_unit=getunit()
filename = manfile(ip)
allocate(thin_flag1(nspec_tree))
thin_flag1 = -1
allocate(yman(100))
allocate(rel_part(100))
yman = 0
rel_part = 0
call testfile(filename,ex)
open(manag_unit,file=trim(filename))
! read head of data-file
do
read(manag_unit,*) text
if(text .ne. '#')then
backspace(manag_unit);exit
endif
enddo
i = 1
do
read(manag_unit,*,iostat=ios) yman(i), rel_part(i)
if(ios < 0) exit
i = i+1
end do
num_man = i-1
close(manag_unit)
end subroutine aspman_ini
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine asp_manag
use data_manag
use data_simul
implicit none
integer :: i
do i=1,num_man
if(yman(i).eq.time) then
call asp_pruning
if(i.ne.num_man) then
call asp_sprout
flag_sprout = 1
end if
end if
end do
end subroutine asp_manag
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine asp_sprout
use data_manag
use data_species
use data_simul
use data_stand
use data_par
use data_help
use data_soil
use data_tsort
implicit none
integer :: taxnr, i, j, nsp, acoh
REAL :: shoot
real :: faktor
REAL :: x1,x2,xacc,h_root, root
REAL :: rtflsp, stump_dw, stump_v, rtbis
TYPE(cohort) ::tree_ini
real, dimension(:), save, allocatable :: treea, crt, frt, stumpw
integer, dimension(:), save, allocatable :: spectyp, cohid
! distribution of coarse root matter of coppice shoots
real, dimension(6) :: fac_rob=(/0.0666, 0.1332, 0.1998, 0.2664,0.334, 0./)
external weight1
external rtflsp
external rtbis
allocate ( treea(anz_coh), crt(anz_coh), frt(anz_coh), spectyp(anz_coh), cohid(anz_coh), stumpw(anz_coh))
if(flag_reg.eq.18) then
nsprout = 5
end if
i = 1
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if(zeig%coh%ntreem.ne.0.and. zeig%coh%ntreea.eq.0.and. zeig%coh%x_crt.ne.0) then
treea(i) = zeig%coh%ntreem
taxnr = zeig%coh%species
crt(i) = zeig%coh%x_crt
frt(i) = zeig%coh%x_frt
spectyp(i) = zeig%coh%species
cohid(i) = zeig%coh%ident
call stump( zeig%coh%x_ahb, zeig%coh%asapw,zeig%coh%dcrb,zeig%coh%x_hbole, &
zeig%coh%height, taxnr,stump_v, stump_dw)
stumpw(i) = stump_dw
i = i+1
end if
zeig=>zeig%next
end do
acoh = i-1
do i =1, acoh
if(flag_reg.eq.15) then
faktor = 0.25
else
faktor = fac_rob(1)
end if
do j = 1, nsprout
tree_ini%species = spectyp(i)
nsp = spectyp(i)
hnspec = nsp
h_root = faktor * (crt(i)*0.3 + stumpw(i)* 0.5)
max_coh= max_coh +1
call coh_initial (tree_ini)
tree_ini%ident = max_coh
tree_ini%x_age = 1
tree_ini%ntreea = treea(i)
tree_ini%nta = treea(i)
mschelp = h_root
x1 = 0.
x2 = 0.1
xacc = (1.0e-10) * (x1+x2)/2
root = rtbis(weight1,x1,x2,xacc)
tree_ini%x_sap = root
shoot = root*1000. ! [g]
tree_ini%x_fol= (spar(nsp)%seeda*(tree_ini%x_sap** spar(nsp)%seedb)) ![kg] ! [kg]
tree_ini%x_frt = faktor * frt(i) ! [kg]
tree_ini%med_sla = spar(nsp)%psla_min + spar(nsp)%psla_a*0.5
tree_ini%t_leaf = tree_ini%med_sla* tree_ini%x_fol ! [m-2]
tree_ini%ca_ini = tree_ini%t_leaf
IF(spar(tree_ini%species)%Phmodel==1) THEN
tree_ini%P=0
tree_ini%I=1
ELSE
tree_ini%P=0
tree_ini%I=0
tree_ini%Tcrit=0
END IF
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if(zeig%coh%ident.eq. cohid(i)) then
tree_ini%rooteff = zeig%coh%rooteff
exit
end if
zeig=>zeig%next
end do
! tranformation of shoot biomass kg --> mg
if(nsp.ne.2)tree_ini%height = spar(nsp)%pheight1*(shoot*1000.)**spar(nsp)%pheight2 ! [cm] calculated from shoot biomass (mg)
if(tree_ini%height.eq.0.) then
nsp = nsp
end if
! bole height from stump
tree_ini%x_hbole = stoh(nsp)
IF(tree_ini%ntreea.ne.0.) then
IF (.not. associated(pt%first)) THEN
ALLOCATE (pt%first)
pt%first%coh = tree_ini
NULLIFY(pt%first%next)
ELSE
ALLOCATE(zeig)
zeig%coh = tree_ini
zeig%next => pt%first
pt%first => zeig
END IF
anz_coh=anz_coh+1
END IF
if(flag_reg.eq.15) then
faktor = faktor + 0.0833333
else
faktor = fac_rob(j+1)
end if
end do ! j, nsprouts
end do ! i
deallocate ( treea, crt, frt, spectyp,cohid, stumpw)
end subroutine asp_sprout
subroutine asp_pruning
use data_manag
use data_species
use data_simul
use data_stand
use data_par
implicit none
integer :: taxnr, j
zeig=>pt%first
do
if(.not.associated(zeig)) exit
zeig%coh%ntreem = zeig%coh%ntreea
zeig%coh%ntreea = 0
zeig%coh%nta = 0.
zeig=>zeig%next
end do
! calculation of total dry mass of all harvested trees (stem + twigs and branches)
sumNPP = 0
sumvsab = 0.
sumvsab_m3 = 0.
svar%sumvsab = 0.
zeig=>pt%first
do
if(.not.associated(zeig)) exit
ns = zeig%coh%species
sumvsab = sumvsab + zeig%coh%ntreem*(zeig%coh%x_sap + zeig%coh%x_hrt + zeig%coh%x_tb)
sumvsab_m3 = sumvsab_m3 + zeig%coh%ntreem*(zeig%coh%x_sap + zeig%coh%x_hrt+zeig%coh%x_tb)/(spar(ns)%prhos*1000000)
svar(ns)%sumvsab = svar(ns)%sumvsab + zeig%coh%ntreem*(zeig%coh%x_sap + zeig%coh%x_hrt + zeig%coh%x_tb)
sumnpp = sumnpp + zeig%coh%ntreem*zeig%coh%npp
zeig=>zeig%next
end do
sumvsab_m3 = sumvsab_m3 * 10000./kpatchsize ! kg/ha
sumvsab = sumvsab * 10000./kpatchsize ! kg/ha
do j = 1, nspec_tree
svar(j)%sumvsab = svar(j)%sumvsab * 10000./kpatchsize
end do
! cumulative harvested stem mass
cumsumvsab = cumsumvsab + sumvsab
! litter pools
! adding biomasses to litter pools depending on stage of stand
zeig=>pt%first
do
if(.not.associated(zeig)) exit
taxnr=zeig%coh%species
if(zeig%coh%ntreem>0)then
! all parts without stems of trees are input for litter
zeig%coh%litC_fol = zeig%coh%litC_fol + zeig%coh%ntreem*(1.-spar(taxnr)%psf)*zeig%coh%x_fol*cpart
zeig%coh%litN_fol = zeig%coh%litN_fol + zeig%coh%ntreem*((1.-spar(taxnr)%psf)*zeig%coh%x_fol*cpart)/spar(taxnr)%cnr_fol
endif
zeig=>zeig%next
enddo
end subroutine asp_pruning
source_code/version_2.3_windows/aust_manag.f 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* 4C (FORESEE) *!
!* *!
!* *!
!* Subroutines for: *!
!* Austrian management *!
!* contains: *!
!* SR aust_ini *!
!* SR aust_manag *!
!* SR plant_aust *!
!* SR calc_rel_class *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
SUBROUTINE aust_ini
use data_manag
use data_species
use data_simul
use data_stand
implicit none
integer :: manag_unit,i, ih1,ih2,ios,ih4, flp , flag_help
character(len=150) :: filename
logical :: ex
character ::text
real :: hp, ih3
manag_unit=getunit()
filename = manfile(ip)
allocate(thin_flag1(nspec_tree))
flag_help = 0
thin_flag1=-1
thin_dead = 1
allocate(yman(1000))
allocate(dbh_clm(1000))
allocate(rem_clm(1000))
allocate(spec_man(1000))
allocate(act(1000))
allocate(rel_part(1000))
yman = 0
dbh_clm = 0
rem_clm = 0.
spec_man = 0
act = 0
rel_part = 0
flp = 0
call testfile(filename,ex)
open(manag_unit,file=trim(filename))
! read head of data-file
do
read(manag_unit,*) text
if(text .ne. 's')then
backspace(manag_unit);exit
endif
enddo
i=1
do
read(manag_unit,*,iostat=ios) ih1,ih2, ih3, hp,ih4
if(ios<0) exit
yman(i) = ih1 ! year of treatment
if(ih2.eq.1) then
! Fichte/ Spruce
spec_man(i) = 2
else if(ih2.eq.2) then
! Kiefer/ Pine
spec_man(i) = 3
else if(ih2.eq.3) then
! Eiche/ oak
spec_man(i) = 4
else if(ih2.eq.4) then
spec_man(i) = 1
end if
! species number
act(i) = ih4
if(ih1.ne.-999 ) then
if(flp.eq.0) then
dbh_clm(i) = int(ih3) ! dbh-cluss number for treatment
rem_clm(i) = hp ! removal of biomass
i = i+1
else
act(i) = ih4
rel_part(i) = ih3
rem_clm(i) = 0
i = i+1
end if
else
if(i.eq.1) thin_dead = 0
flp = 1
backspace(manag_unit)
end if
end do
num_man = i-1
close(manag_unit)
END SUBROUTINE aust_ini
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE aust_manag
use data_manag
use data_stand
use data_simul
use data_species
use data_par
implicit none
integer :: i,j,hcl, ha, taxnr,k,l, help_fl,helpz, helps
real, dimension(5) :: rel_biom, harv_biom
real, dimension(5) :: num_ccl, contr
real,dimension(5) :: help_rem_clm
integer,dimension(5) :: help_rel_dbh, hrd
real :: stump_dw, stump_v, hrb
ha =0
rel_biom = 0.
num_ccl =0
harv_biom = 0.
help_rel_dbh = 0
help_rem_clm = 0.
hrd = 0
helpz = 0
helps = 0
call calc_rel_class
! calculation of stem biomass of relative dbh-class
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if(zeig%coh%diam.ne.0) then
hcl = zeig%coh%rel_dbh_cl
if(hcl.ne.0) then
num_ccl(hcl)= num_ccl(hcl) +1
rel_biom(hcl)= rel_biom(hcl) + (zeig%coh%x_sap + zeig%coh%x_hrt)*zeig%coh%ntreea
end if
end if
zeig=>zeig%next
end do
do l=1,nspecies
help_rel_dbh = 0
help_rem_clm = 0.
helpz = 0
helps = 0
! calculation of stem biomass of relative dbh-class
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if(zeig%coh%diam.ne.0.and.zeig%coh%species.eq.l) then
hcl = zeig%coh%rel_dbh_cl
if(hcl.ne.0) then
num_ccl(hcl)= num_ccl(hcl) +1
rel_biom(hcl)= rel_biom(hcl) + (zeig%coh%x_sap + zeig%coh%x_hrt)*zeig%coh%ntreea
end if
end if
zeig=>zeig%next
end do
hrd=0
do i=1,num_man
if(yman(i).eq.time) then
if(act(i) .eq.1.and.spec_man(i).eq.l) then
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if(zeig%coh%diam.ne.0) then
if(zeig%coh%species.eq.l) then
hrd(zeig%coh%rel_dbh_cl)= 1
end if
end if
zeig=>zeig%next
end do
help_rel_dbh(dbh_clm(i)) = 1
help_rem_clm(dbh_clm(i)) = rem_clm(i)
end if ! act(i)
end if !yman(i)
end do ! num_man
do j=1,5
if(help_rel_dbh(j).eq.1.and.hrd(j).eq.0) then
if(j.eq.1.) then
do k=2,5
if(hrd(k).ne.0) then
help_rem_clm(k) = help_rem_clm(k) + help_rem_clm(j)
help_rel_dbh(k)=1
exit
end if
end do
else if (j.eq.5.) then
do k= 4,1,-1
if(hrd(k).eq.1) then
help_rem_clm(k) = help_rem_clm(k) + help_rem_clm(j)
help_rel_dbh(k) = 1
exit
endif
end do
else
do k=j,5
if(hrd(k).eq.1) then
help_rem_clm(k) = help_rem_clm(k) + help_rem_clm(j)*0.5
help_rel_dbh(k) = 1
exit
end if
end do
do k=j,1,-1
if(hrd(k).eq.1) then
help_rem_clm(k) = help_rem_clm(k) + help_rem_clm(j)*0.5
help_rel_dbh(k) = 1
exit
end if
end do
end if
help_rel_dbh(j) = 0
help_rem_clm(j) = 0.
end if
end do
! thinning
help_fl = 0
do i=1,num_man
if(yman(i).eq.time.and.help_fl.eq.0) then
do k=1,5
helps = helps + help_rel_dbh(k)
end do
help_fl=1
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if(zeig%coh%diam.ne.0.and.zeig%coh%species.eq.l) then
do k=1,5
if(zeig%coh%rel_dbh_cl.eq.k.and.help_rel_dbh(k).eq.1) then
if(help_rem_clm(k).gt.1.) help_rem_clm(k) = 1.
if( help_rem_clm(k) .eq. 1.)then
if(zeig%coh%underst.eq.0.and.zeig%coh%x_age.gt. 20) ha=int(help_rem_clm(k)* zeig%coh%ntreea+0.5)
helpz = helpz +1
else
ha=int(help_rem_clm(k)* zeig%coh%ntreea+0.5)
end if
if(ha.lt.1) ha = 1
if(help_rem_clm(k) .ne.1) then
harv_biom(k) = harv_biom(k) + ha* (zeig%coh%x_sap + zeig%coh%x_hrt)
hrb = help_rem_clm(k)* rel_biom(k)
if(harv_biom(k).eq.rel_biom(k)) then
ha = ha -1
end if
end if
zeig%coh%ntreea = zeig%coh%ntreea - ha
zeig%coh%nta = zeig%coh%ntreea
zeig%coh%ntreem = zeig%coh%ntreem + ha
end if
end do ! k loop
end if
zeig=>zeig%next
end do ! zeig loop
end if
end do ! num_man
if(helps.gt.0.and.helpz.ge.helps) then
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if(zeig%coh%species.eq.l.and.zeig%coh%underst.eq.1) then
zeig%coh%underst = 0
end if
zeig => zeig%next
end do
end if
write(9898,*) time, 'totbio', rel_biom
write(9898,*) time, 'harvbio', harv_biom
do i=1,5
if(rel_biom(i).ne.0.) then
contr(i) = harv_biom(i)/rel_biom(i)
else
contr(i) = 0.
end if
end do
write(9898,*) time,l, contr
rel_biom = 0.
harv_biom = 0.
end do ! nspecies
! planting
do i=1,num_man
if(yman(i).eq.time.and.act(i).ne.1) then
call plant_aust(i)
end if ! act
end do
stump_sum = 0
zeig=>pt%first
do
if(.not.associated(zeig)) exit
taxnr=zeig%coh%species
if(zeig%coh%ntreem>0)then
! all parts without stems of trees are input for litter
zeig%coh%litC_fol = zeig%coh%litC_fol + zeig%coh%ntreem*(1.-spar(taxnr)%psf)*zeig%coh%x_fol*cpart
zeig%coh%litN_fol = zeig%coh%litN_fol + zeig%coh%ntreem*((1.-spar(taxnr)%psf)*zeig%coh%x_fol*cpart)/spar(taxnr)%cnr_fol
zeig%coh%litC_frt = zeig%coh%litC_frt + zeig%coh%ntreem*zeig%coh%x_frt*cpart
zeig%coh%litN_frt = zeig%coh%litN_frt + zeig%coh%ntreem*zeig%coh%x_frt*cpart/spar(taxnr)%cnr_frt
zeig%coh%litC_tb = zeig%coh%litC_tb + zeig%coh%ntreem*zeig%coh%x_tb*cpart
zeig%coh%litN_tb = zeig%coh%litN_tb + zeig%coh%ntreem*zeig%coh%x_tb*cpart/spar(taxnr)%cnr_tbc
zeig%coh%litC_crt = zeig%coh%litC_crt + zeig%coh%ntreem*zeig%coh%x_crt*cpart
zeig%coh%litN_crt = zeig%coh%litN_crt + zeig%coh%ntreem*zeig%coh%x_crt*cpart/spar(taxnr)%cnr_crt
! stumps into stem litter
call stump( zeig%coh%x_ahb, zeig%coh%asapw,zeig%coh%dcrb,zeig%coh%x_hbole, &
zeig%coh%height, taxnr,stump_v, stump_dw)
zeig%coh%litC_stem = zeig%coh%litC_stem + zeig%coh%ntreem*stump_dw*cpart
zeig%coh%litN_stem = zeig%coh%litC_stem/spar(taxnr)%cnr_stem
stump_sum = stump_sum + zeig%coh%ntreem*stump_dw
endif
zeig=>zeig%next
enddo
sumvsab = 0.
sumvsab_m3 = 0.
svar%sumvsab = 0.
zeig=>pt%first
do while (associated(zeig))
ns = zeig%coh%species
sumvsab = sumvsab + zeig%coh%ntreem*(zeig%coh%x_sap + zeig%coh%x_hrt)
sumvsab_m3 = sumvsab_m3 + zeig%coh%ntreem*(zeig%coh%x_sap + zeig%coh%x_hrt)/(spar(ns)%prhos*1000000)
svar(ns)%sumvsab = svar(ns)%sumvsab + zeig%coh%ntreem*(zeig%coh%x_sap + zeig%coh%x_hrt)
zeig=>zeig%next
end do
sumvsab = sumvsab * 10000./kpatchsize ! kg/ha
sumvsab_m3 = sumvsab_m3 * 10000./kpatchsize ! kg/ha
do k = 1, nspec_tree
svar(k)%sumvsab = svar(k)%sumvsab * 10000./kpatchsize ! kg/ha
end do
! cumulative harvested stem mass
cumsumvsab = cumsumvsab + sumvsab
if(thin_dead.ne.0) then
call class_man
end if
END SUBROUTINE aust_manag
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE plant_aust(mp)
use data_manag
use data_plant
use data_species
use data_stand
implicit none
integer :: fl_plant, i, nplant,taxid,mp
real :: age, &
pl_height, &
sdev, &
plhmin
infspec = 0
npl_mix = 0
fl_plant = act(mp)
select case(fl_plant)
case(2)
infspec(2) = 1
npl_mix(2) = 2500
case(3)
infspec(2) = 1
npl_mix(2) = 10000
case(4)
infspec(3) = 1
npl_mix(3) = 5000
case(5)
infspec(3) = 1
npl_mix(3) = 2000
case(6)
infspec(1) = 1
npl_mix(1) = 500
case(7)
infspec(1) = 1
npl_mix(1) = 5000
case(8)
infspec(4) = 1
npl_mix(4) = 5000
case(9)
infspec(1) = 1
npl_mix(1) = 1000
infspec(4) = 1
npl_mix(4) = 3500
case(10)
infspec(3) = 1
npl_mix(3) = 2500
infspec(4) = 1
npl_mix(4) = 2500
case(11)
infspec(3) = 1
npl_mix(3) = 2500
infspec(1) = 1
npl_mix(1) = 2500
case(12)
infspec(3) = 1
npl_mix(3) = 7000
case(13)
infspec(4) = 1
npl_mix(4) = 2500
end select
do i = 1,nspec_tree
if (infspec(i).eq.1) then
taxid = i
! data for Austria
age = pl_age(taxid)
pl_height = plant_height(taxid)
plhmin = plant_hmin(taxid)
nplant = rel_part(mp)*nint(npl_mix(taxid)*kpatchsize/10000)
sdev = hsdev(taxid)
call gener_coh(taxid, age, pl_height, plhmin, nplant,sdev)
end if
end do ! i
END SUBROUTINE plant_aust
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE calc_rel_class
use data_manag
use data_stand
use data_species
implicit none
integer :: nrmax, i, j, k, adm
real,dimension(10) :: maxdbh, mindbh,class_wd
integer :: nrmin
real :: help, help_h1
class_wd =0.
maxdbh = 0.
mindbh = 0.
do j= 1,nspecies
call max_dbh(nrmax,help,adm, j)
call min_dbh(nrmin,help_h1,adm, j)
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if(zeig%coh%ident.eq.nrmax.and.zeig%coh%species.eq.j) then
maxdbh(j) = help
else if(zeig%coh%ident.eq.nrmin.and.zeig%coh%species.eq.j) then
mindbh(j) = help_h1
end if
zeig=>zeig%next
end do
end do
do j=1,nspecies
class_wd(j) = (maxdbh(j)-mindbh(j))/5
k = 5
zeig=>pt%first
do
if(.not.associated(zeig)) exit
if(zeig%coh%species.eq.j.and. zeig%coh%diam.gt.0) then
do i=1,k
if(zeig%coh%diam.ge.(mindbh(j)+class_wd(j)*(i-1)).and.zeig%coh%diam.lt.(mindbh(j)+class_wd(j)*i)) then
zeig%coh%rel_dbh_cl = i
exit
else if (zeig%coh%diam.eq.maxdbh(j)) then
zeig%coh%rel_dbh_cl = 5
end if
end do
end if
zeig=>zeig%next
end do
end do
END SUBROUTINE calc_rel_class
source_code/version_2.3_windows/calc_climdriv.f 0 → 100644
View file @ 82df1085
!*****************************************************************!
!* *!
!* 4C (FORESEE) Simulation Model *!
!* *!
!* *!
!* SR photoper *!
!* *!
!* contains follow global units: *!
!* photoper function for calculation of photoperiod *!
!* daylength calculation of day length *!
!* avg_sun_incl Calculates average sun declination for *!
! the season at the given latitude in degrees *!
!* fixclimscen subroutine for calculation of delta T and P *!
!* glob_rad Estimation of global radiation from sunshine *!
!* frost_index_total subroutine for calculation of frost index *!
!* *!
!* Copyright (C) 1996-2018 *!
!* Potsdam Institute for Climate Impact Reserach (PIK) *!
!* Authors and contributors see AUTHOR file *!
!* This file is part of 4C and is licensed under BSD-2-Clause *!
!* See LICENSE file or under: *!
!* http://www.https://opensource.org/licenses/BSD-2-Clause *!
!* Contact: *!
!* https://gitlab.pik-potsdam.de/foresee/4C *!
!* *!
!*****************************************************************!
REAL FUNCTION PHOTOPER(d,xlatitude)
! by Thomas Kartschall 8.7.92
!
! PhotoPeriod -Potential daily Sun Shine Period [h]
! d -Ordinal Number of Julian Date [Real!4]
! latitude -Latitude by Radiant [Real!4]
! Northern L>0; Southern L<0
!
! Polarkreis bei je 66.55 bzw 6633'36'' N/SL
!
USE data_par
USE data_simul
real d, xlatitude, del, ws, ws2
!
! Equator from 0,2 respectively 012'
!
IF (abs(xlatitude).lt.0.0024) then
photoper=12.0
return
ENDIF
!
!pole surrounding ab 89,8 bzw 8948'
!
IF (xlatitude.ge. 1.567305668)xlatitude= 1.567305668
IF (xlatitude.le.-1.567305668) xlatitude=-1.567305668
g=2*pi*(d-1.0)/365.25
del=0.006918-0.399912*cos(g)
del=del+0.070257*sin(g)-0.006758*cos(g+g)
del=del+0.000907*sin(g+g)-0.002697*cos(g+g+g)
del=del+0.00148*sin(g+g+g)
ws=sin(xlatitude)*sin(del)
ws2=cos(xlatitude)*cos(del)
!
!polar night duration per day no longer than 24h
!
IF (ws/ws2.ge.1.0) ws=ws2
IF (ws/ws2.le.-1.0) ws=-ws2
ws=acos(ws/ws2)
ws=12.*(1.-ws/pi)
!day length is dopple the time between HighNoon and SunRise
PHOTOPER=2.*(ws)
RETURN
END FUNCTION photoper
!*******************************************************************
FUNCTION DAYLENGTH(doy,hlat)
USE data_par
IMPLICIT NONE
REAL :: hlat
REAL :: daylength
INTEGER :: doy
REAL :: decl,arg
decl = -23.45*(PI/180)*COS(2.*PI/365.*(doy+10))
! latitude is converted to rad
arg = -TAN(hlat*PI/180.)*TAN(decl);
IF( arg < -1. ) THEN
daylength = 24.
ELSE IF ( arg > 1. ) THEN
daylength = 0.
ELSE
daylength = (24./PI)*ACOS(arg)
ENDIF
END FUNCTION DAYLENGTH
!*******************************************************************
FUNCTION AVG_SUN_INCL(hlat)
!Calculates average sun declination for the season
! at the given latitude in degrees
use data_par
implicit none
REAL :: avg_sun_incl
REAL :: hlat, h1, h2, h3
REAL :: decl, sumbeta, dl, sumdl
INTEGER :: i, j
REAL, EXTERNAL :: daylength
sumdl = 0
sumbeta = 0
h1 = sin(PI*hlat/180)
h2 = cos(PI*hlat/180)
DO i=120,280,+1
decl = -23.45*(PI/180)*COS(2.*PI/365.*(i+10))
dl = DAYLENGTH(i,hlat)
! sun declination at noon
h3 = h1*sin(decl)+h2*cos(decl)
if(h3.gt.1.) h3 = 1
avg_sun_incl = 180/PI*asin(h3);
sumbeta = sumbeta + avg_sun_incl*dl;
sumdl = sumdl + dl;
END DO
avg_sun_incl = sumbeta/sumdl
END FUNCTION AVG_SUN_INCL
!*******************************************************************
SUBROUTINE fixclimscen
! fixclimscen calculates deltaT and deltaPrec for climate change scenarios with
! fixed offsets in temperature and precipitation
USE data_simul
IMPLICIT NONE
INTEGER :: dimTsteps, dimPsteps
! calculations
dimTsteps = 1 + n_T_downsteps + n_T_upsteps
dimPsteps = 1 + n_P_downsteps + n_P_upsteps
deltaT = ((ip-1)/dimPsteps-n_T_downsteps)*step_sum_T
deltaPrec = 1.+((ip-1)-((ip-1)/dimPsteps)*dimPsteps-n_P_downsteps)*step_fac_P
CALL out_scen
END SUBROUTINE fixclimscen
!****************************************************************************
SUBROUTINE glob_rad(sd, iday, xlat, rad)
! Estimation of global radiation from sunshine duration
! (calculation after Angstrom)
implicit none
! input:
integer :: iday ! actual day
real :: sd ! sunshine duration (h)
real :: xlat ! latitude
! output:
real :: rad ! global radiation (J/cm2)
! internal variables
real :: rad_ex , & ! extraterrestrical radiation (J/cm2)
dayl , & ! daylength
dec , & ! declination of sun angle
sinld, cosld, tanld, dsinb, dsinbe, &
sc, radi, seas
real :: pi = 3.141592654
real :: solc = 1367. ! solar constant (J/(m2*s)
! after P. Hupfer: "Klimasystem der Erde", 1991
! change of units from degree to radians
pi = 3.141592654
radi = pi/180.
! term of seasonality (10 days in front of calendar)
seas = (iday+10.)/365.
! declination of sun angle
! (Spitters et al. 1986, equations transformed for use or radians)
dec = -asin(sin(23.45*radi)*cos(2.*pi*seas))
! some intermediate values
sinld = sin(xlat*radi)*sin(dec)
cosld = cos(xlat*radi)*cos(dec)
tanld = amax1(-1., amin1(1., sinld/cosld))
! daylength
dayl = 12.*(1.+2.*asin(tanld)/pi)
! integral of sun elevation
dsinb = 3600.*(dayl*sinld+24.*cosld*sqrt(1.-tanld*tanld)/pi)
! corrected integral of sun elevation
dsinbe = 3600.*(dayl*(sinld+0.4*(sinld*sinld+cosld*cosld*0.5)) &
+12.*cosld*(2.+3.*0.4*sinld)*sqrt(1.-tanld*tanld)/pi)
! intensity of radiation outside the atmosphere
sc = solc/(1.-0.016729*cos((360./365.)*(iday-4.)*radi))**2.
rad_ex = sc*(1.+0.033*cos(2.*pi*iday/365.))*dsinbe
! unit conversion in MJ/m2: rad_ex = rad_ex/1000000.
! unit conversion in J/cm2
rad_ex = rad_ex * 0.0001
if (sd.ge.0.) then
rad = (0.231+0.539*sd/dayl)*rad_ex
else
write (*, '(A, I3, A)') ' RAD is out of range at day ', iday , &
' , RAD will be = 1000 J/cm2!'
end if
END SUBROUTINE glob_rad
!****************************************************************************
subroutine frost_index_total
use data_frost
use data_simul
use data_stand
implicit none
integer :: zaehl=0
integer :: i
integer :: zaehl1 =0
integer :: t,m,j
real :: mean_dnlf
real :: mean_tminmay
integer :: mean_date_lf
integer :: mean_date_lftot
real :: mean_dnlf_sp
real :: mean_tminmay_sp
integer :: mean_date_lf_sp
real :: mean_anzdlf
real :: mean_sumtlf
integer :: ind1, ind2, ind3, ind4, ind5
integer :: ind1_sp
zaehl=0
mean_tminmay = 0.
mean_date_lf = 0
mean_date_lftot = 0
mean_dnlf = 0
mean_dnlf_sp = 0
mean_anzdlf = 0
mean_sumtlf = 0
do i =1,year
if(tminmay_ann(i).ne.0) then
zaehl = zaehl +1
mean_tminmay= mean_tminmay+tminmay_ann(i)
end if
end do
if(zaehl.ne.0) then
mean_tminmay = mean_tminmay/zaehl
else
mean_tminmay = 0.
end if
do i=1,year
mean_anzdlf = mean_anzdlf + anzdlf(i)
mean_sumtlf = mean_sumtlf + sumtlf(i)
end do
mean_anzdlf = mean_anzdlf/year
mean_sumtlf = mean_sumtlf/year
zaehl=0
do i =1,year
if(date_lftot(i).ne.0) then
zaehl = zaehl +1
mean_date_lftot = mean_date_lftot + date_lftot(i)
end if
end do
if(zaehl.ne.0) then
mean_date_lftot = mean_date_lftot/zaehl
else
mean_date_lftot = 0.
end if
mean_dnlf = 0.
zaehl=0
do i =1,year
if(dnlf(i).ne.0) then
mean_dnlf = mean_dnlf + dnlf(i)
zaehl = zaehl +1
end if
end do
if(zaehl.ne.0) then
mean_dnlf = mean_dnlf/zaehl
else
mean_dnlf = 0
endif
zaehl=0
do i =1,year
if(date_lf(i).ne.0) then
mean_date_lf = mean_date_lf + date_lf(i)
zaehl = zaehl +1
end if
enddo
if(zaehl.ne.0) then
mean_date_lf = mean_date_lf/zaehl
else
mean_date_lf = 0
end if
zaehl1=0
do i =1,year
if(dnlf_sp(i).ne.0) then
zaehl1 = zaehl1 +1
mean_dnlf_sp = mean_dnlf_sp + dnlf_sp(i)
end if
enddo
if (zaehl1.ne.0) then
mean_dnlf_sp = mean_dnlf_sp/zaehl1
else
mean_dnlf_sp = 0
endif
if (mean_dnlf.le.2.5 .and. mean_tminmay.ge. -1.5 .and.tminmay.ge.-5.0 .and. mean_date_lf.lt.130 .and. dlfabs .lt. 156) lfind=1
if (mean_dnlf.ge.2.6 .and. mean_dnlf .le.3.5 .and. mean_tminmay.ge. -2.0 .and. mean_tminmay.lt.-1.5 .and. tminmay .ge.-6. .and. mean_date_lf .lt.135 .and. dlfabs .lt.161) lfind=2
if (mean_dnlf.gt.3.5 .and. mean_dnlf .le.4.5 .and. mean_tminmay.ge. -2.5 .and. mean_tminmay.lt.-2.0 .and. tminmay .ge.-6. .and. mean_date_lf .ge.135 .and. mean_date_lf .le. 140 .and. dlfabs .ge.162 .and. dlfabs.le.166) lfind=3
if (mean_dnlf.gt.4.5 .and. mean_dnlf .le.5.0 .and. mean_tminmay.ge. -3.0 .and. mean_tminmay.lt.-2.5 .and. tminmay .ge.-7. .and. mean_date_lf .ge.141 .and. mean_date_lf .le. 145 .and. dlfabs .ge.167 .and. dlfabs.le.171) lfind=4
if (mean_dnlf.gt.5.10 .and. mean_dnlf .le.5.5 .and. mean_tminmay.ge. -3.5 .and. mean_tminmay.lt.-3.0 .and. tminmay .ge.-8. .and. mean_date_lf .ge.141 .and. mean_date_lf .le. 145 .and. dlfabs .ge.172 .and. dlfabs.le.176) lfind=5
if (mean_dnlf.gt.5.5 .and. mean_tminmay.lt.-3.5 .and. tminmay .le.-8. .and. mean_date_lf .gt.145 .and. dlfabs .gt.176) lfind=6
! index of number of late frost days since beginning of vegetation period
if (mean_dnlf.le.2.5) then
ind1 = 1
else if(mean_dnlf.le.3.5) then
ind1 = 2
else if (mean_dnlf.le.4.5) then
ind1 = 3
else if (mean_dnlf.le.5.0) then
ind1 = 4
else if (mean_dnlf.le.5.5) then
ind1 = 5
else
ind1 = 6
endif
! index of number of late frost days since beginning of bud burst
if (mean_dnlf_sp .le. 2.5) then
ind1_sp= 1
else if(mean_dnlf_sp.le.3.5) then
ind1_sp = 2
else if (mean_dnlf_sp.le.4.5) then
ind1_sp = 3
else if (mean_dnlf.le.5.0) then
ind1_sp = 4
else if (mean_dnlf_sp.le.5.5) then
ind1_sp = 5
else
ind1_sp = 6
endif
! index of mean minimum may temperature
if(mean_tminmay.ge. -1.5) then
ind2 = 1
else if (mean_tminmay.ge. -2.0) then
ind2 = 2
else if (mean_tminmay.ge. -2.5) then
ind2 = 3
else if (mean_tminmay.ge. -3.0) then
ind2 = 4
else if (mean_tminmay.ge. -3.5) then
ind2 = 5
else
ind2 =6
endif
! index of absolute minimum may temperature
if(tminmay.ge.-5.0) then
ind3 = 1
else if(tminmay.ge.-6.0 .and. ind2 .le.2) then
ind3 = 2
else if (tminmay.ge.-6.0 .and. ind2 .le.3) then
ind3 =3
else if (tminmay.ge.-7.0) then
ind3 = 4
else if (tminmay.ge.-8.0) then
ind3 = 5
else
ind3 = 6
end if
! index of mean date(number of the year) of late frost
if (mean_date_lf.lt.130) then
ind4 = 1
else if (mean_date_lf.lt.135) then
ind4 = 2
else if (mean_date_lf.le.140 ) then
ind4 = 3
else if (mean_date_lf.le.145 .and. ind2.le.4) then
ind4 = 4
else if(mean_date_lf.le.145 .and. ind2.le.5) then
ind4 = 5
else
ind4 = 6
endif
! absolute last late frost (numbedr of the year)
if (dlfabs .lt. 156) then
ind5 = 1
else if (dlfabs .lt. 161) then
ind5 = 2
else if (dlfabs .le. 162) then
ind5 =3
else if (dlfabs .le. 171) then
ind5 = 4
else if (dlfabs .le. 176) then
ind5 = 5
else
ind5 =6
endif
mlfind = real((ind1 + ind2 + ind3 + ind4 + ind5)/5)
mlfind_sp = (ind1_sp + ind2 + ind3 + ind4 + ind5)/5
if(waldtyp.eq. 10 .or. waldtyp .eq. 40 .or. waldtyp .eq.90) mlfind_sp = 0
end subroutine frost_index_total