Module vegmod
116 :
117 : ! ******************************************************************
118 : ! * Module defining variables and parameters for the vegetation
119 : ! * model (transpmodel).
120 : ! ******************************************************************
121 :
122 : module vegmod
123 : implicit none
124 :
125 : INTEGER :: optmode ! Indicator of optimisation mode
126 : REAL*8 :: time ! Seconds of hour
127 : REAL*8 :: error ! Cumulative error in water balance
128 : INTEGER :: finish ! flag to finish all loops
129 :
130 : REAL*8, ALLOCATABLE :: output_mat(:,:)
131 :
132 : REAL*8, PARAMETER :: p_a = 1.6d0 ! Ratio of diffusivities of water vapour to CO2 in air
133 : REAL*8, PARAMETER :: p_pi = 3.14159d0 ! Pi-constant
134 : REAL*8, PARAMETER :: p_mpbar = 10.2d0 ! Conversion factor from MPa to bar
135 : REAL*8, PARAMETER :: p_E = 2.7182818d0 ! Eurler's number
136 : REAL*8, PARAMETER :: p_R_ = 8.314d0 ! Molar gas konstant
137 : REAL*8, PARAMETER :: l_E_ = 2.45d0 ! Latent heat of vaporization (MJ/kg)
138 : REAL*8, PARAMETER :: srad2par_h = 2.0699d0 ! Conversion from srad to par hourly (mol/MJ)
139 : REAL*8, PARAMETER :: srad2par_d = 2.0804d0 ! Conversion from srad to par daily (mol/MJ)
140 : REAL*8, PARAMETER :: rho_wat = 1000.0d0 ! Density of water (kg/m3)
141 :
142 : INTEGER :: nyear ! Year
143 : INTEGER :: nday ! Day since start of run
144 : INTEGER :: nhour ! Hour of day
145 : INTEGER :: th_ ! Hour since start of run
146 : INTEGER :: c_testday ! Number of days for initial check if netass>0
147 :
148 : INTEGER, ALLOCATABLE :: fyear(:) ! Year for each day
149 : INTEGER, ALLOCATABLE :: fmonth(:) ! Month for each day
150 : INTEGER, ALLOCATABLE :: fday(:) ! Day of month
151 : INTEGER, ALLOCATABLE :: dayyear(:) ! Day of year
152 :
153 : ! * climate
154 :
155 : REAL*8, ALLOCATABLE :: tair_h(:) ! Hourly air temperature (K)
156 : REAL*8, ALLOCATABLE :: tairmin_d(:) ! Daily minimum temperature (K)
157 : REAL*8, ALLOCATABLE :: tairmax_d(:) ! Daily maximum temperature (K)
158 :
159 : REAL*8 :: topt_ ! Optimal temperature in temperature response curve
160 :
161 : REAL*8, ALLOCATABLE :: press_d(:) ! Daily air pressure (Pa)
162 :
163 : REAL*8, ALLOCATABLE :: par_h(:) ! Hourly photosynthetically active radiation (mol/m2/s)
164 : REAL*8, ALLOCATABLE :: par_d(:) ! Daily photosynthetically active radiation
165 : REAL*8 :: par_y ! Annual photosynthetically active radiation
166 :
167 : REAL*8, ALLOCATABLE :: srad_d(:) ! Daily shortwave radiation
168 : REAL*8 :: srad_y ! Annual shortwave radiation
169 :
170 : REAL*8, ALLOCATABLE :: ca_h(:) ! Hourly atmospheric CO2 mole fraction
171 : REAL*8, ALLOCATABLE :: ca_d(:) ! Daily atmospheric CO2 mole fraction
172 :
173 : REAL*8, ALLOCATABLE :: vp_d(:) ! Daily absolute vapour pressure (Pa)
174 :
175 : REAL*8, ALLOCATABLE :: vd_h(:) ! Hourly atmospheric vapour deficit (VPD/air pressure)
176 : REAL*8 :: vd_d ! Mean daily atmospheric vapour deficit
177 : REAL*8 :: vd_y ! Mean annual atmospheric vapour deficit
178 :
179 : REAL*8, ALLOCATABLE :: rain_h(:) ! Hourly rainfall rate (m/s)
180 : REAL*8, ALLOCATABLE :: rain_d(:) ! Daily rainfall
181 : REAL*8 :: rain_y ! Annual rainfall
182 :
183 : ! * soil
184 :
185 : REAL*8, ALLOCATABLE :: c_hhydrst(:) ! Hydrostatic head in each layer relative to soil surface
186 :
187 : REAL*8 :: gammastar ! CO2 compensation point
188 :
189 : REAL*8 :: wsnew ! Total soil water store at next time step
190 : REAL*8 :: wsold ! Previous total soil water storage
191 :
192 : REAL*8 :: o_cai ! Projected cover perennial vegetation (0-1)
193 : REAL*8 :: pcg_d(3) ! Projected cover seasonal vegetation (pcg_d(2) is actual value)
194 : REAL*8 :: c_pcgmin ! Minimum grass pc; initial point for growth
195 :
196 : ! * leaf
197 :
198 : REAL*8 :: o_wstexp ! Exponent for calculating lambdat_d
199 : REAL*8 :: o_wsgexp ! Exponent for calculating lambdag
200 : REAL*8 :: o_lambdatf ! Factor for calculating lambdat_d
201 : REAL*8 :: o_lambdagf ! Factor for calculating lambdag_d
202 : REAL*8 :: lambdat_d ! Target dE/dA for calculating gstomt
203 : REAL*8 :: lambdag_d ! Target dE/dA for calculating gstomg
204 : REAL*8 :: gstomt ! Tree stomatal conductance
205 : REAL*8 :: gstomg(3,3,3) ! Grass stomatal conductance
206 :
207 : REAL*8 :: rlt_h(3,3) ! Tree leaf respiration for different values of Jmax (rlt_h(2) is actual value)
208 : REAL*8 :: rlt_d ! Daily tree leaf respiration
209 : REAL*8 :: rlt_y ! Annual tree leaf respiration
210 : REAL*8 :: rlg_h(3,3,3) ! Grass leaf respiration
211 : REAL*8 :: rlg_d ! Daily grass leaf respiration
212 : REAL*8 :: rlg_y ! Annual grass leaf respiration
213 :
214 : REAL*8 :: transpt ! Tree transpiration rate
215 : REAL*8 :: transpg(3,3,3) ! Grass transpiration rate (mol/m2/s)
216 :
217 : REAL*8 :: q_tct_d(3) ! Tree foliage turnover costs
218 : REAL*8 :: tct_y ! Annual tree foliage turnover costs
219 : REAL*8 :: tcg_d(3, 3) ! Grass foliage turnover costs
220 : REAL*8 :: tcg_y ! Annual grass foliage turnover costs
221 :
222 : REAL*8 :: jactt(3,3) ! Electron transport rates for different values of Jmax (jactt(2) is actual value)
223 : REAL*8 :: jactg(3,3,3) ! Grass electron transport rate
224 :
225 : REAL*8 :: jmaxt_h(3) ! Tree photosynthetic electron transport capacity
226 : REAL*8 :: jmaxg_h(3) ! Grass electron transport capacity
227 :
228 : REAL*8 :: jmax25t_d(3) ! Tree photosynthetic electron transport capacity at 25oC
229 : REAL*8 :: jmax25g_d(3) ! Grass photosynthetic electron transport capacity at 25oC
230 :
231 : REAL*8 :: lai_lt(3) ! Local leaf area index trees
232 : REAL*8 :: lai_lg(3) ! Local leaf area index grasses
233 :
234 : ! * plant water
235 :
236 : REAL*8 :: asst_h(3,3) ! Tree hourly assimilation rate for different values of Jmax (asst_h(2) is actual value)
237 : REAL*8 :: asst_d(3,3) ! Daily tree assimilation
238 : REAL*8 :: asst_y ! Annual tree assimilation
239 : REAL*8 :: assg_h(3,3,3) ! Hourly grass assimilation
240 : REAL*8 :: assg_d(3,3,3) ! Daily grass assimilation
241 : REAL*8 :: assg_y ! Annual grass assimilation
242 :
243 : REAL*8 :: q_cpcct_d ! Tree water transport costs as a function of projected cover and rooting depth (mol/m2/s)
244 : REAL*8 :: cpcct_y ! Annual tree water transport costs
245 : REAL*8 :: cpccg_d(3) ! Grass water transport costs
246 : REAL*8 :: cpccg_y ! Annual grass water transport costs
247 :
248 : REAL*8 :: etmt__ ! Transpiration rate (m/s)
249 : REAL*8 :: etmt_h ! Hourly transpiration
250 : REAL*8 :: etmt_d ! Daily transpiration rate
251 : REAL*8 :: etmt_y ! Annual tree transpiration
252 : REAL*8 :: etmg__(3,3,3) ! Grass transpiration rate (m/s)
253 : REAL*8 :: etmg_h ! Hourly grass transpiration
254 : REAL*8 :: etmg_d ! Daily grass transpiration
255 : REAL*8 :: etmg_y ! Annual grass transpiration
256 : REAL*8 :: etm_y ! Annual total transpiration
257 :
258 : REAL*8 :: mqt_ ! Tree water content
259 : REAL*8 :: mqtnew ! Tree water content in next time step
260 : REAL*8 :: mqtold ! Previous tree water content
261 : REAL*8 :: dmqt ! Rate of change in tree water content
262 : REAL*8 :: q_mqx ! Tree maximum water content per ground area
263 : REAL*8 :: mqsst_ ! Tree water content at steady state
264 : REAL*8 :: mqsstmin ! Tree water content at turgor loss point
265 :
266 : REAL*8 :: q_md ! Tree dry mass per unit ground area
267 : REAL*8 :: o_mdstore ! Wood water storage parameter of trees
268 :
269 : ! * roots
270 :
271 : REAL*8 :: o_rtdepth ! Tree rooting depth (m)
272 : REAL*8 :: o_rgdepth ! Grass rooting depth
273 :
274 : INTEGER :: pos_slt ! Lowest soil layer containing tree roots
275 : INTEGER :: pos_slg ! Lowest soil layer containing grass roots
276 : INTEGER :: pos_ult ! Lowest soil layer containing tree roots within unsaturated zone
277 : INTEGER :: pos_ulg ! Lowest soil layer containing grass roots within unsaturated zone
278 :
279 : REAL*8 :: changef ! Change factor for adjusting root surface area
280 :
281 : REAL*8, ALLOCATABLE :: rsurft_(:) ! Root surface area of trees in each layer
282 : REAL*8, ALLOCATABLE :: rsurftnew(:) ! Adjusted root surface area of trees in each layer for next day
283 : REAL*8, ALLOCATABLE :: rsurfg_(:) ! Root surface area of grasses in each layer
284 : REAL*8, ALLOCATABLE :: rsurfgnew(:) ! Adjusted root surface area of grasses in each layer for next day
285 :
286 : REAL*8 :: rootlim(3,3,3) ! Indicator whether root surface are was limiting root water uptake
287 :
288 : REAL*8, ALLOCATABLE :: rsoil(:) ! Resistance to water flow towards roots in each soil layer
289 :
290 : REAL*8, ALLOCATABLE :: refft(:) ! Relative root water uptake efficiency for trees in each layer
291 : REAL*8, ALLOCATABLE :: reffg(:) ! Relative root water uptake efficiency for grasses in each layer
292 : INTEGER :: posmna(3) ! Pointer to variable values that achieved maximum net assimilation
293 :
294 : REAL*8 :: rrt_d ! Tree root respiration rate (mol/m2/s)
295 : REAL*8 :: rrt_y ! Annual tree root respiration
296 : REAL*8 :: rrg_d ! Grass root respiration
297 : REAL*8 :: rrg_y ! Annual grass root respiration
298 :
299 : REAL*8, ALLOCATABLE :: prootm(:) ! Root hydraulic head in each layer
300 :
301 : REAL*8 :: sumruptkt_h ! Hourly total tree root water uptake
302 : REAL*8, ALLOCATABLE :: ruptkt__(:) ! Root water uptake rate perennial veg (m/s)
303 : REAL*8, ALLOCATABLE :: ruptkt_h(:) ! Hourly root water uptake by trees in each layer
304 : REAL*8, ALLOCATABLE :: ruptkt_d(:) ! Daily root water uptake by trees in each layer
305 : REAL*8, ALLOCATABLE :: ruptkg__(:) ! Root water uptake rate seasonal veg (m/s)
306 : REAL*8, ALLOCATABLE :: ruptkg_h(:) ! Hourly root water uptake by grasses in each layer
307 : REAL*8, ALLOCATABLE :: ruptkg_d(:) ! Daily root water uptake by grasses in each layer
308 : REAL*8, ALLOCATABLE :: perc_cov_veg(:) ! Daily coverage of vegetation
309 :
310 :
311 : ! ****************************
312 : ! * input parameters input.par
313 : ! ****************************
314 :
315 : REAL*8 :: i_alpha ! Initial slope of electron transport curve
316 : REAL*8 :: i_cpccf ! Water transport costs per m root depth and m^2 cover
317 : REAL*8 :: i_tcf ! Turnover cost factor for foliage (tc=i_tcf*LAI)
318 : INTEGER :: i_maxyear ! Number of years to process
319 : INTEGER :: i_testyear ! Number of years after which to perform initial test of netass
320 : REAL*8 :: i_ha ! Temperature response parameter
321 : REAL*8 :: i_hd ! Temperature response parameter
322 : REAL*8 :: i_toptf ! Parameter to calculate adaptation of topt (range 0-1 for no to full adaptation)
323 : REAL*8 :: i_toptstart ! Start parameter for topt to calculate jmax(temp in K)
324 : REAL*8 :: i_rlratio ! Ratio of leaf respiration to photosynthetic capacity
325 :
326 : ! * Catchment parameters
327 :
328 : REAL*8 :: i_lat ! geogr. latitude
329 :
330 : ! * Soil parameters
331 :
332 : ! * Vertical Resolution
333 :
334 : ! * Vegetation Parameters
335 :
336 :
337 : REAL*8 :: i_mdtf ! Total dry mass of living tissues of trees per unit pc (g/m^2)
338 : REAL*8 :: i_mqxtf ! Total water storage capacity in living tissues of trees per unit md
339 : REAL*8 :: i_rrootm ! Root water uptake resistivity in soil
340 : REAL*8 :: i_rsurfmin ! Minimum root area per m^3 to be maintained
341 : REAL*8 :: i_rsurf_ ! Initial root surface area per m^3
342 : REAL*8 :: i_rootrad ! Average fine root radius
343 : REAL*8 :: i_prootmg ! Constant root balance pressure of 1.5 MPa in grasses
344 : REAL*8 :: i_growthmax ! Parameter determining maximum daily growth increment of root surface area
345 : REAL*8 :: i_incrcovg ! parameter determining maximum increment percentage of grass cover
346 : REAL*8 :: i_incrjmax ! parameter determining maximum increment percentage of jmax25
347 : REAL*8 :: i_incrlait ! parameter determining maximum increment percentage of lai trees
348 : REAL*8 :: i_incrlaig ! parameter determining maximum increment percentage of lai grasses
349 : REAL*8 :: i_extcoeffg ! extinction coefficient beer's law grasses
350 : REAL*8 :: i_extcoefft ! extinction coefficient beer's law trees
351 : REAL*8 :: i_trans_vegcov ! fraction of radiative energy reaching soil under full cover (0-1)
352 :
353 : INTEGER :: i_firstyear ! First year for the generation of hourly output in computation mode
354 : INTEGER :: i_lastyear ! Last year for the generation of hourly output in computation mode
355 :
356 : INTEGER :: i_write_h ! Flag to write out hourly input values after conversation from daily values
357 : INTEGER :: i_read_pc ! Flag to write out hourly input values after conversation from daily values
358 : INTEGER :: i_lai_function ! Switch to use 1) linear or 2) exponential LAI estimate, as function of cover
359 : INTEGER :: i_no_veg ! Flag to switch vegetation off (1=no vegetation)
360 :
361 :
362 : ! * Derived parameters
363 :
364 : REAL*8 :: c_epsln ! Soil porosity
365 :
366 : INTEGER :: c_maxhour ! Number of hours to process
367 : INTEGER :: c_maxday ! Number of days to process
368 :
369 : !$OMP threadprivate( time, error, finish, nyear, nday, nhour, th_, c_testday, &
370 : !$OMP topt_, par_y, srad_y, &
371 : !$OMP vd_d, vd_y, rain_y, gammastar, wsnew, wsold, o_cai, pcg_d, c_pcgmin, &
372 : !$OMP o_wstexp, o_wsgexp, o_lambdatf, o_lambdagf, lambdat_d, lambdag_d, gstomt, gstomg, &
373 : !$OMP rlt_h, rlt_d, rlt_y, rlg_h, rlg_d, rlg_y, transpt, transpg, q_tct_d, tct_y, tcg_d, &
374 : !$OMP tcg_y, jactt, jactg, jmaxt_h, jmaxg_h, jmax25t_d, jmax25g_d, &
375 : !$OMP asst_h, asst_d, asst_y, assg_h, assg_d, assg_y, &
376 : !$OMP q_cpcct_d, cpcct_y, cpccg_d, cpccg_y, etmt__, etmt_h, etmt_d, etmt_y, etmg__, etmg_h, &
377 : !$OMP etmg_d, etmg_y, etm_y, mqt_, mqtnew, mqtold, dmqt, q_mqx, mqsst_, mqsstmin, q_md, &
378 : !$OMP o_mdstore, o_rtdepth, o_rgdepth, pos_slt, pos_slg, pos_ult, pos_ulg, changef, &
379 : !$OMP rootlim, posmna, &
380 : !$OMP ruptkt__, rsurft_, rsurftnew, prootm, ruptkt_d, ruptkt_h, ruptkg_h, ruptkg_d, &
381 : !$OMP refft, reffg, ruptkg__, rsurfg_, rsurfgnew, rsoil, &
382 : !$OMP rrt_d, rrt_y, rrg_d, rrg_y, sumruptkt_h, output_mat)
383 :
384 :
385 : end module vegmod