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