SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
vegetation_evol.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 ! #########
6  SUBROUTINE vegetation_evol(HISBA, HPHOTO, HRESPSL, HALBEDO, OAGRIP, &
7  otr_ml, onitro_dilu, oagri_to_grass, &
8  oimp_veg, oimp_z0, oimp_emis, &
9  ptstep, kmonth, kday, kspinw, &
10  ptime, plat, prhoa, &
11  pdg, pdzg, kwg_layer, &
12  ptg, palbnir_veg, palbvis_veg, palbuv_veg, &
13  palbnir_soil, palbvis_soil, palbuv_soil, &
14  pvegtype, psefold, panmax, ph_tree, pbslai,&
15  plaimin, p_co2, pce_nitro, pcf_nitro, &
16  pcna_nitro, pbslai_nitro, pgmes, ptau_wood,&
17  tpseed, tpreap, paosip, paosim, paosjp, &
18  paosjm, pho2ip, pho2im, pho2jp, pho2jm, &
19  pz0effip, pz0effim, pz0effjp, pz0effjm, &
20  plai, pveg, pz0, palbnir, palbvis, palbuv, &
21  pemis, panfm, panday, pbiomass, presp_biomass,&
22  presp_biomass_inst, pincrease, pturnover, &
23  pswdir)
24 ! ###############################################################
25 !!**** *VEGETATION EVOL*
26 !!
27 !! PURPOSE
28 !! -------
29 !
30 ! performs the time evolution of vegetation parameters
31 ! at solar midnight in the case of interactive vegetation (ISBA-Ags)
32 !
33 !!** METHOD
34 !! ------
35 !!
36 !! EXTERNAL
37 !! --------
38 !! none
39 !!
40 !! IMPLICIT ARGUMENTS
41 !! ------------------
42 !!
43 !! none
44 !!
45 !! REFERENCE
46 !! ---------
47 !!
48 !!
49 !! AUTHOR
50 !! ------
51 !!
52 !! V. Masson * Meteo-France *
53 !!
54 !! MODIFICATIONS
55 !! -------------
56 !! Original 01/03/03
57 !! P. Le Moigne 12/2004 : NIT version
58 !! P Le Moigne 09/2005 : AGS modifs of L. Jarlan
59 !! A.L. Gibelin 04/2009 : BIOMASS and RESP_BIOMASS arrays
60 !! A.L. Gibelin 04/2009 : Add NCB option
61 !! D. Carrer 01/2012 : representation of nitrogen dilution fct of CO2 (from Calvet et al. 2008)
62 !! B. Decharme 05/2012 : Optimization and ISBA-DIF coupling
63 !! C. Delire 01/2014 : IBIS respiration for tropical evergreen
64 !! R. Seferian 05/2015 : expanding of Nitrogen dilution option to the complete formulation proposed by Yin et al. GCB 2002
65 !!Seferian & Delire 06/2015 : accouting for living woody biomass respiration (expanding work of E Joetzjer to all woody PFTs)
66 !! B. Decharme 01/16 : Bug when vegetation veg, z0 and emis are imposed whith interactive vegetation
67 !-------------------------------------------------------------------------------
68 !
69 !* 0. DECLARATIONS
70 ! ------------
71 !
72 USE modd_co2v_par, ONLY : xmc, xmco2, xpcco2, xrespfactor_nit, &
73  xcoeff_maint_resp_zero, xslope_maint_resp, &
74  xparam, xparcf, xdiludec
75 USE modd_csts, ONLY : xday, xtt, xmd
76 !
77 USE modi_albedo
78 USE modi_laigain
79 USE modi_lailoss
80 USE modi_nitro_decline
86 USE modd_data_cover_par, ONLY : nvt_tebd, nvt_trbe, nvt_bone, &
87  nvt_trbd, nvt_tebe, nvt_tene, &
88  nvt_bobd, nvt_bond, nvt_shrb, &
89  nvt_trbe, nvt_c3, nvt_c4, &
90  nvt_irr, nvt_gras
91 !
92 USE modd_surf_par
93 !
94 USE yomhook ,ONLY : lhook, dr_hook
95 USE parkind1 ,ONLY : jprb
96 !
97 IMPLICIT NONE
98 !
99 !* 0.1 declarations of arguments
100 !
101 !
102  CHARACTER(LEN=3), INTENT(IN) :: hisba ! type of ISBA version:
103 ! ! '2-L' (default)
104 ! ! '3-L'
105 ! ! 'DIF'
106  CHARACTER(LEN=3), INTENT(IN) :: hphoto ! type of photosynthesis
107 ! ! 'NON'
108 ! ! 'AGS'
109 ! ! 'LAI'
110  CHARACTER(LEN=3), INTENT(IN) :: hrespsl ! Soil Respiration
111 ! ! 'DEF' = Norman 1992
112 ! ! 'PRM' = Rivalland PhD Thesis (2003)
113 ! ! 'CNT' = CENTURY model (Gibelin 2008)
114  CHARACTER(LEN=4), INTENT(IN) :: halbedo ! albedo type
115 ! ! 'DRY '
116 ! ! 'EVOL'
117 ! ! 'WET '
118 ! ! 'USER'
119 LOGICAL, INTENT(IN) :: oagrip ! agricultural practices
120 LOGICAL, INTENT(IN) :: otr_ml ! new radiative transfert
121 LOGICAL, INTENT(IN) :: onitro_dilu ! nitrogen dilution fct of CO2 (Calvet et al. 2008)
122 LOGICAL, INTENT(IN) :: oagri_to_grass
123 !
124 LOGICAL, INTENT(IN) :: oimp_veg
125 LOGICAL, INTENT(IN) :: oimp_z0
126 LOGICAL, INTENT(IN) :: oimp_emis
127 !
128 REAL, INTENT(IN) :: ptstep ! time step
129 INTEGER, INTENT(IN) :: kmonth ! current month
130 INTEGER, INTENT(IN) :: kday ! current day
131 INTEGER, INTENT(IN) :: kspinw ! spinup wood
132 REAL, INTENT(IN) :: ptime ! current time since midnight
133 REAL, DIMENSION(:), INTENT(IN) :: plat ! latitude of each grid point
134 REAL, DIMENSION(:), INTENT(IN) :: prhoa ! air density
135 !
136 REAL, DIMENSION(:,:), INTENT(IN) :: pdg ! Depth of Bottom of Soil layers (m)
137 REAL, DIMENSION(:,:), INTENT(IN) :: pdzg ! soil layers thicknesses (DIF option) (m)
138 INTEGER, DIMENSION(:),INTENT(IN) :: kwg_layer ! Number of soil moisture layers (DIF option)
139 !
140 REAL, DIMENSION(:,:), INTENT(IN) :: ptg ! soil layer average temperatures (K)
141 REAL, DIMENSION(:), INTENT(IN) :: palbvis_veg ! visible, near infra-red and UV
142 REAL, DIMENSION(:), INTENT(IN) :: palbnir_veg ! albedo of the vegetation
143 REAL, DIMENSION(:), INTENT(IN) :: palbuv_veg !
144 REAL, DIMENSION(:), INTENT(IN) :: palbvis_soil! visible, near infra-red and UV
145 REAL, DIMENSION(:), INTENT(IN) :: palbnir_soil! soil albedo
146 REAL, DIMENSION(:), INTENT(IN) :: palbuv_soil !
147 !
148 REAL, DIMENSION(:,:), INTENT(IN) :: pvegtype! fraction of each vegetation type
149 REAL, DIMENSION(:), INTENT(IN) :: psefold ! e-folding time for senescence (s)
150 REAL, DIMENSION(:), INTENT(IN) :: panmax ! maximum photosynthesis rate
151 REAL, DIMENSION(:), INTENT(IN) :: ph_tree ! height of trees
152 REAL, DIMENSION(:), INTENT(IN) :: pbslai ! ratio of biomass to LAI
153 REAL, DIMENSION(:), INTENT(IN) :: plaimin ! minimum LAI
154 !
155 REAL, DIMENSION(:), INTENT(IN) :: p_co2 ! CO2 concentration [ppmm]
156 !
157 REAL, DIMENSION(:), INTENT(IN) :: pce_nitro ! leaf aera ratio sensibility to nitrogen
158 ! concentration (10**2 m2 kg-1)
159 REAL, DIMENSION(:), INTENT(IN) :: pcf_nitro ! lethal minimum value of leaf aera ratio
160 ! (m2 kg-1)
161 REAL, DIMENSION(:), INTENT(IN) :: pcna_nitro ! nitrogen concentration of active biomass (%)
162 REAL, DIMENSION(:), INTENT(IN) :: pbslai_nitro ! ratio of biomass to LAI
163 !
164 REAL, DIMENSION(:), INTENT(IN) :: pgmes ! mesophyll conductance (m s-1)
165 REAL, DIMENSION(:), INTENT(IN) :: ptau_wood ! residence time in wood (s)
166 !
167 !
168 TYPE (date_time), DIMENSION(:), INTENT(IN) :: tpseed ! seeding date
169 TYPE (date_time), DIMENSION(:), INTENT(IN) :: tpreap ! reaping date
170 !
171 REAL, DIMENSION(:), INTENT(IN) :: paosip ! A/S for increasing x
172 REAL, DIMENSION(:), INTENT(IN) :: paosim ! A/S for decreasing x
173 REAL, DIMENSION(:), INTENT(IN) :: paosjp ! A/S for increasing y
174 REAL, DIMENSION(:), INTENT(IN) :: paosjm ! A/S for decreasing y
175 REAL, DIMENSION(:), INTENT(IN) :: pho2ip ! h/2 for increasing x
176 REAL, DIMENSION(:), INTENT(IN) :: pho2im ! h/2 for decreasing x
177 REAL, DIMENSION(:), INTENT(IN) :: pho2jp ! h/2 for increasing y
178 REAL, DIMENSION(:), INTENT(IN) :: pho2jm ! h/2 for decreasing y
179 !
180 REAL, DIMENSION(:), INTENT(INOUT) :: pz0effip! roughness length for increasing x
181 REAL, DIMENSION(:), INTENT(INOUT) :: pz0effim! roughness length for decreasing x
182 REAL, DIMENSION(:), INTENT(INOUT) :: pz0effjp! roughness length for increasing y
183 REAL, DIMENSION(:), INTENT(INOUT) :: pz0effjm! roughness length for decreasing y
184 !
185 REAL, DIMENSION(:), INTENT(INOUT) :: plai ! leaf area index (LAI)
186 REAL, DIMENSION(:), INTENT(INOUT) :: pveg ! vegetation fraction
187 REAL, DIMENSION(:), INTENT(INOUT) :: pz0 ! roughness length: momentum
188 REAL, DIMENSION(:), INTENT(INOUT) :: palbnir ! snow-free near-infra-red albedo
189 REAL, DIMENSION(:), INTENT(INOUT) :: palbvis ! snow-free visible albedo
190 REAL, DIMENSION(:), INTENT(INOUT) :: palbuv ! snow-free UV albedo
191 REAL, DIMENSION(:), INTENT(INOUT) :: pemis ! snow-free emissivity
192 !
193 REAL, DIMENSION(:), INTENT(INOUT) :: panfm ! maximum leaf assimilation
194 REAL, DIMENSION(:), INTENT(INOUT) :: panday ! daily net CO2 assimilation
195 REAL, DIMENSION(:,:), INTENT(INOUT) :: pbiomass ! biomass of day-1
196 REAL, DIMENSION(:,:), INTENT(INOUT) :: presp_biomass ! daily cumulated respiration of biomass (kgDM/m2/day)
197 REAL, DIMENSION(:,:), INTENT(INOUT) :: presp_biomass_inst ! instantaneous respiration of biomass (kgCO2/kgair m/s)
198 !
199 REAL, DIMENSION(:,:), INTENT(OUT) :: pincrease ! increment of biomass (gC m-2 s-1)
200 REAL, DIMENSION(:,:), INTENT(OUT) :: pturnover ! biomass turnover going into litter (gC m-2 s-1)
201 !
202 REAL, DIMENSION(:), INTENT(IN), OPTIONAL :: pswdir ! Global incoming shortwave radiation (W m-2)
203 !
204 !* 0.2 declarations of local parameter
205 !
206 REAL, PARAMETER :: zcoef1 = 10.0
207 REAL, PARAMETER :: zcoef2 = 25.0
208 REAL, PARAMETER :: zdepth = 1.0 !Temp depth m
209 !
210 REAL, PARAMETER :: zwood_ibis=0.0125
211 REAL, PARAMETER :: zroot_ibis=1.25
212 REAL, PARAMETER :: zcibis1 =3500.
213 REAL, PARAMETER :: zcibis2 =1./288.
214 REAL, PARAMETER :: znday =365.
215 !
216 REAL, PARAMETER :: zcdilu1 = -0.048
217 REAL, PARAMETER :: zcdilu2 = 6.3
218 REAL, PARAMETER :: zcdilu3 = 371.
219 ! Required for Yin et al., nitrogen dilu param
220 REAL, PARAMETER :: zphoton = 2.010402e-3 ! conversion coef for W m-2 in photon m-2
221 REAL, PARAMETER :: zdepth_veg = 0.40 !Depth in meters for daily temperature
222 REAL, PARAMETER :: ztemp_veg = 23. !Average temperature of the vegetation
223 REAL, PARAMETER :: zdecidus = 0.75 !Coef for decidus trees
224 !
225 !* 0.3 declarations of local variables
226 !
227 REAL, DIMENSION(SIZE(PRESP_BIOMASS,1),SIZE(PRESP_BIOMASS,2)) :: zresp_biomass_last ! biomass at t-1 (kg_DM/m2/day)
228 REAL, DIMENSION(SIZE(PLAI)) :: zbiomass_leaf ! temporary leaf biomass
229 REAL, DIMENSION(SIZE(PLAI)) :: zbslai_nitro ! (Calvet et al. 2008) ratio of biomass to LAI
230  ! with representation of nitrogen dilution
231 REAL, DIMENSION(SIZE(PLAI)) :: zco2, zcna_nitro ! fct of CO2
232 REAL, DIMENSION(SIZE(PLAI)) :: zparam
233 REAL, DIMENSION(SIZE(PLAI)) :: zhtree, zsapfrac ! tree height & sap fraction used for estimation of
234  ! sapwood fraction
235 !
236 REAL :: zlog2, zwork
237 !
238 REAL, DIMENSION(SIZE(PTG,1)) :: ztg_veg ! surface temperature (C)
239 REAL, DIMENSION(SIZE(PTG,1)) :: ztg_soil ! soil temperature (C)
240 REAL, DIMENSION(SIZE(PTG,1)) :: zdg_soil ! soil depth for DIF (m)
241 REAL :: zwght_soil ! Weight for DIF (m)
242 !
243 LOGICAL, DIMENSION(SIZE(PLAI)) :: gwood,gherb
244 LOGICAL, DIMENSION(SIZE(PLAI)) :: gmask_agri
245 LOGICAL :: gmask
246 INTEGER :: ini, inl, ji, jl, idepth, jtype
247 !
248 REAL, DIMENSION(SIZE(PVEGTYPE,1),SIZE(PVEGTYPE,2)) :: zparam_type
249 !
250 ! * Azote
251 REAL, DIMENSION(SIZE(PLAI)) :: zfert
252 !
253 REAL(KIND=JPRB) :: zhook_handle
254 !
255 !-----------------------------------------------------------------
256 !
257 !* 1. Preliminaries
258 ! -------------
259 !
260 IF (lhook) CALL dr_hook('VEGETATION_EVOL',0,zhook_handle)
261 !
262 ini=SIZE(ptg,1)
263 inl=SIZE(ptg,2)
264 !
265 zlog2 = log(2.0)
266 !
267 ztg_soil(:) = 0.0
268 ztg_veg(:) = 0.0
269 !
270 ! Define herbaceous and woody patches
271 gherb(:) = ( pvegtype(:,nvt_tebd) + pvegtype(:,nvt_trbe) + pvegtype(:,nvt_bone) &
272 & + pvegtype(:,nvt_trbd) + pvegtype(:,nvt_tebe) + pvegtype(:,nvt_tene) &
273 & + pvegtype(:,nvt_bobd) + pvegtype(:,nvt_bond) + pvegtype(:,nvt_shrb)<0.5)
274 gwood(:) = (.NOT.gherb(:))
275 !
276 ! Mask where vegetation evolution is performed (just before solar midnight)
277 gmask = ( ptime - ptstep < 0. ) .AND. ( ptime >= 0. )
278 !
279 ! Save RESP_BIOMASS at t-1
280 IF (gmask) THEN
281  presp_biomass(:,1) = 0.0
282  zresp_biomass_last(:,:) = 0.0
283 ELSE
284  presp_biomass(:,1) = presp_biomass(:,1) + presp_biomass_inst(:,1) * (ptstep*prhoa(:)*xmc)/(xpcco2*xmco2)
285  zresp_biomass_last(:,:) = presp_biomass(:,:)
286 ENDIF
287 !
288 !* 2. Interactive vegetation
289 ! ----------------------
290 !
291 ! LAI daily mortality and assimilation
292 !
293 zbiomass_leaf(:) = pbiomass(:,1)
294 !
295 IF (gmask) THEN
296 !
297  IF (hphoto=='LAI' .OR. hphoto=='LST')THEN
298 !
299  CALL lailoss(pveg, psefold, panmax, panday, panfm, zbiomass_leaf)
300  CALL laigain(pbslai, plaimin, pveg, zbiomass_leaf, plai, panday)
301  pbiomass(:,1) = zbiomass_leaf(:)
302 !
303  ELSE IF (hphoto=='NIT' .OR. hphoto=='NCB') THEN
304 !
305  pincrease(:,:) = 0.0
306  pturnover(:,:) = 0.0
307  zbslai_nitro(: ) = pbslai_nitro(:)
308 !
309  IF(onitro_dilu)THEN
310 !
311 ! * Compute Vegetation temperature
312 ! We use the temperature of the second layer of the soil (<40cm)
313 ! since the parametrization employs a daily temperature
314 !
315  IF(hisba/='DIF')THEN
316  ztg_veg(:) = ptg(:,2)
317  ELSE
318  DO ji=1,ini
319  idepth=kwg_layer(ji)
320  zdg_soil(ji)=min(zdepth_veg,pdg(ji,idepth))
321  ENDDO
322  DO jl=1,inl
323  DO ji=1,ini
324  zwght_soil=min(pdzg(ji,jl),max(0.0,zdg_soil(ji)-pdg(ji,jl)+pdzg(ji,jl)))
325  ztg_veg(ji)=ztg_veg(ji)+ptg(ji,jl)*zwght_soil/zdg_soil(ji)
326  ENDDO
327  ENDDO
328  ENDIF
329 !
330  zparam(:) = 0.0
331  zfert(:) = 0.0
332  DO jtype=1,SIZE(pvegtype,2)
333  DO ji = 1,ini
334  zparam_type(ji,jtype) = xdiludec(jtype) * (zdecidus + 1.1 * zphoton * xparcf * pswdir(ji) &
335  + (ztg_veg(ji)-xtt)/ztemp_veg - 0.33 * zfert(ji)) &
336  + (1 - xdiludec(jtype)) * ( 1.1 * zphoton * xparcf * pswdir(ji) &
337  + (ztg_veg(ji)-xtt)/ztemp_veg - 0.33 * zfert(ji))
338  zparam(ji) = zparam(ji) + zparam_type(ji,jtype) * pvegtype(ji,jtype)
339  ENDDO
340  ENDDO
341 
342  WHERE((pce_nitro(:)*pcna_nitro(:)+pcf_nitro(:))/=0.0.AND.pcna_nitro(:)/=0.0)
343  zco2(:) = p_co2(:)*(xmd/(1.e-6*xmco2)) ! (ppmm -> ppm)
344  zcna_nitro(:) = pcna_nitro(:)*exp(zcdilu1*exp(zparam(:)-pcna_nitro(:)/zcdilu2)*alog(max(1.,zco2(:)/zcdilu3)))
345  zbslai_nitro(:) = 1. / (pce_nitro(:)*zcna_nitro(:)+pcf_nitro(:))
346  ENDWHERE
347 !
348  ENDIF
349 !
350  IF(any(plai(:)/=xundef))THEN
351  CALL nitro_decline(hphoto, hrespsl, otr_ml, kspinw, &
352  zbslai_nitro, psefold, pgmes, panmax, panday, &
353  plat, plaimin, pvegtype, ptau_wood, &
354  panfm, plai, pbiomass, presp_biomass, zbiomass_leaf, &
355  pincrease, pturnover )
356  CALL laigain(zbslai_nitro, plaimin, pveg, zbiomass_leaf, plai, panday)
357  ENDIF
358 !
359  ENDIF
360 !
361 ! CASE CPHOTO=AST reinitialise PANDAY and PANFM
362  panday=0.0
363  panfm =0.0
364 !
365 ENDIF
366 !
367 !
368 IF (hphoto == 'NIT' .OR. hphoto=='NCB') THEN
369  !
370  ! * soil temperature in K (over 1m depth for DIF)
371  !
372  ztg_veg(:) = ptg(:,1)
373  !
374  IF(hisba/='DIF')THEN
375  ztg_soil(:) = ptg(:,2)
376  ELSE
377  DO ji=1,ini
378  idepth=kwg_layer(ji)
379  zdg_soil(ji)=min(zdepth,pdg(ji,idepth))
380  ENDDO
381  DO jl=1,inl
382  DO ji=1,ini
383  zwght_soil=min(pdzg(ji,jl),max(0.0,zdg_soil(ji)-pdg(ji,jl)+pdzg(ji,jl)))
384  ztg_soil(ji)=ztg_soil(ji)+ptg(ji,jl)*zwght_soil/zdg_soil(ji)
385  ENDDO
386  ENDDO
387  ENDIF
388  !
389  !
390  ! * Respiration of structural biomass pools
391  !
392  WHERE(gwood(:))
393  ! IBIS respiration with either respiration factor rwood=0.0125 - otherwise rroot=1.25
394  ! (Kucharik et al, 2000, eq 6-8) Soil temp in K
395  presp_biomass(:,2) = presp_biomass(:,2) + pbiomass(:,2) * ptstep &
396  * max(0.,zroot_ibis*exp(zcibis1*(zcibis2-1./ztg_veg(:)))/(znday*xday))
397  ELSEWHERE
398  presp_biomass(:,2) = presp_biomass(:,2) + pbiomass(:,2) * xrespfactor_nit &
399  * exp((zlog2/zcoef1)*(ztg_veg(:)-xtt-zcoef2)) * ptstep
400  ! before optimization * 2.0**((PTG(:,2)-XTT-ZCOEF2)/ZCOEF1) * PTSTEP
401  ENDWHERE
402  !
403  IF (hphoto == 'NIT') THEN
404  !
405  presp_biomass(:,3) = presp_biomass(:,3) + pbiomass(:,3) * xrespfactor_nit &
406  * exp((zlog2/zcoef1)*(ztg_soil(:)-xtt-zcoef2)) * ptstep
407  ! before optimization * 2.0**((PTG(:,2)-XTT-ZCOEF2)/ZCOEF1) * PTSTEP
408  !
409  ELSEIF (hphoto == 'NCB') THEN
410  !
411  presp_biomass(:,2) = min(presp_biomass(:,2), pbiomass(:,2))
412  !
413  presp_biomass(:,3) = presp_biomass(:,3) + pbiomass(:,3) * max( 0., &
414  xcoeff_maint_resp_zero * (1. + xslope_maint_resp*(ztg_veg(:)-xtt))) * ptstep
415  presp_biomass(:,3) = min(presp_biomass(:,3), pbiomass(:,3))
416  !
417  WHERE(gwood(:))
418  ! Resp IBIS (Soil temp in K)
419  presp_biomass(:,4) = presp_biomass(:,4) + pbiomass(:,4) * ptstep &
420  * max(0.,zroot_ibis * exp(zcibis1*(zcibis2-1./ztg_soil(:)))/(znday*xday))
421  ELSEWHERE
422  presp_biomass(:,4) = presp_biomass(:,4) + pbiomass(:,4) * max( 0., &
423  xcoeff_maint_resp_zero * (1. + xslope_maint_resp*(ztg_soil(:)-xtt))) * ptstep
424  ENDWHERE
425  !
426  presp_biomass(:,4) = min(presp_biomass(:,4), pbiomass(:,4))
427  !
428  WHERE( (gwood(:)).AND.(pbiomass(:,5)>0.) )
429  ! IBIS estimation of sapwood fraction based on the height of tree, sapspeed and
430  ! max transpiration rates. Conversion from DM to C. To be changed with DGVM. (Soil temp in K)
431  zhtree(:) = 2.5*0.75*(pbiomass(:,1)+pbiomass(:,2)+pbiomass(:,3)+pbiomass(:,4)+pbiomass(:,5)+pbiomass(:,6))*0.4
432  zsapfrac(:) = min(0.5, max(0.05,0.0025/25.*zhtree(:)*0.75*400/(pbiomass(:,5)*0.4)))
433  presp_biomass(:,5) = presp_biomass(:,5) + pbiomass(:,5) * zsapfrac(:) * ptstep &
434  * max(0.,zwood_ibis*exp(zcibis1*(zcibis2-1./ztg_veg(:)))/(znday*xday))
435  presp_biomass(:,5) = min(presp_biomass(:,5), pbiomass(:,5))
436  ELSEWHERE
437  presp_biomass(:,5) = 0.0
438  ENDWHERE
439 
440  !
441  ENDIF
442  !
443  ! * Instantaneous respiration (kgCO2/kgair m/s)
444  !
445  DO jl=2,SIZE(presp_biomass,2)
446  presp_biomass_inst(:,jl) = (presp_biomass(:,jl) - zresp_biomass_last(:,jl)) &
447  * xpcco2*xmco2/(ptstep*prhoa(:)*xmc)
448  ENDDO
449  !
450 ENDIF
451 
452 !* 3. Agricultural practices
453 ! ----------------------
454 !
455 IF (oagrip) THEN
456  !
457  gmask_agri(:) = .false.
458  WHERE ( tpseed(:)%TDATE%MONTH /= nundef .AND. ( kmonth < tpseed(:)%TDATE%MONTH .OR. &
459  (kmonth == tpseed(:)%TDATE%MONTH .AND. kday < tpseed(:)%TDATE%DAY) ) ) gmask_agri(:) = .true.
460  WHERE ( tpreap(:)%TDATE%MONTH /= nundef .AND. ( kmonth > tpreap(:)%TDATE%MONTH .OR. &
461  (kmonth == tpreap(:)%TDATE%MONTH .AND. kday >= tpreap(:)%TDATE%DAY) ) ) gmask_agri(:) = .true.
462  !
463  WHERE (gmask_agri(:))
464  plai(:) = plaimin(:)
465  zbiomass_leaf(:) = plai(:) * zbslai_nitro(:)
466  END WHERE
467 
468  IF (hphoto == 'NIT' .OR. hphoto == 'NCB') THEN
469  !
470  WHERE (gmask_agri(:))
471  pbiomass(:,1) = 0.0
472  pbiomass(:,2) = 0.0
473  pbiomass(:,3) = 0.0
474  presp_biomass(:,2) = 0.0
475  presp_biomass(:,3) = 0.0
476  END WHERE
477  !
478  IF (hphoto == 'NCB') THEN
479  !
480  WHERE (gmask_agri(:))
481  pbiomass(:,4) = 0.0
482  pbiomass(:,5) = 0.0
483  pbiomass(:,6) = 0.0
484  presp_biomass(:,4) = 0.0
485  END WHERE
486  !
487  ENDIF
488  !
489  ENDIF
490  !
491 ENDIF
492 !
493 !* 4. Physical parameters depending on vegetation
494 ! -------------------------------------------
495 !
496 IF (gmask) THEN
497  !
498  ! Evolution of vegetation fraction and roughness length due to LAI change
499  IF(.NOT.oimp_z0) THEN
500  WHERE( pveg(:) > 0. ) pz0(:) = z0v_from_lai(plai(:),ph_tree(:),pvegtype(:,:),oagri_to_grass)
501  ENDIF
502  IF(.NOT.oimp_veg) THEN
503  WHERE( pveg(:) > 0. ) pveg(:) = veg_from_lai(plai(:),pvegtype(:,:),oagri_to_grass)
504  ENDIF
505  !
506  ! Evolution of radiative parameters due to vegetation fraction change
507  IF(.NOT.oimp_emis) THEN
508  WHERE( pveg(:) > 0. ) pemis(:)= emis_from_veg(pveg(:),pvegtype(:,:))
509  ENDIF
510  !
511  CALL albedo(halbedo, &
512  palbvis_veg,palbnir_veg,palbuv_veg,pveg, &
513  palbvis_soil,palbnir_soil,palbuv_soil, &
514  palbvis,palbnir,palbuv )
515  !
516  ! Evolution of effective roughness length due to new surface roughness length
517  !
518  IF (SIZE(paosip)>0) &
519  CALL subscale_z0eff(paosip,paosim,paosjp,paosjm, &
520  pho2ip,pho2im,pho2jp,pho2jm,pz0, &
521  pz0effip,pz0effim,pz0effjp,pz0effjm )
522  !
523 ENDIF
524 !
525 IF (lhook) CALL dr_hook('VEGETATION_EVOL',1,zhook_handle)
526 !-----------------------------------------------------------------
527 !
528 END SUBROUTINE vegetation_evol
subroutine nitro_decline(HPHOTO, HRESPSL, OTR_ML, KSPINW, PBSLAI_NITRO, PSEFOLD, PGMES, PANMAX, PANDAY, PLAT, PLAIMIN, PVEGTYPE, PTAU_WOOD, PANFM, PLAI, PBIOMASS, PRESP_BIOMASS, PBIOMASS_LEAF, PINCREASE, PTURNOVER)
subroutine laigain(PBSLAI, PLAIMIN, PVEG, PBIOMASS, PLAI, PANDAY)
Definition: laigain.F90:6
subroutine lailoss(PVEG, PSEFOLD, PANMAX, PANDAY, PANFM, PBIOMASS)
Definition: lailoss.F90:6
subroutine vegetation_evol(HISBA, HPHOTO, HRESPSL, HALBEDO, OAGRIP, OTR_ML, ONITRO_DILU, OAGRI_TO_GRASS, OIMP_VEG, OIMP_Z0, OIMP_EMIS, PTSTEP, KMONTH, KDAY, KSPINW, PTIME, PLAT, PRHOA, PDG, PDZG, KWG_LAYER, PTG, PALBNIR_VEG, PALBVIS_VEG, PALBUV_VEG, PALBNIR_SOIL, PALBVIS_SOIL, PALBUV_SOIL, PVEGTYPE, PSEFOLD, PANMAX, PH_TREE, PBSLAI, PLAIMIN, P_CO2, PCE_NITRO, PCF_NITRO, PCNA_NITRO, PBSLAI_NITRO, PGMES, PTAU_WOOD, TPSEED, TPREAP, PAOSIP, PAOSIM, PAOSJP, PAOSJM, PHO2IP, PHO2IM, PHO2JP, PHO2JM, PZ0EFFIP, PZ0EFFIM, PZ0EFFJP, PZ0EFFJM, PLAI, PVEG, PZ0, PALBNIR, PALBVIS, PALBUV, PEMIS, PANFM, PANDAY, PBIOMASS, PRESP_BIOMASS, PRESP_BIOMASS_INST, PINCREASE, PTURNOVER, PSWDIR)