Forked from
4C / FORESEE
191 commits behind the upstream repository.
-
Petra Lasch-Born authoredPetra Lasch-Born authored
amod_simul.f 15.06 KiB
!*****************************************************************!
!* *!
!* 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_forska = 0 ! 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