7 otr_ml, onitro_dilu, oagri_to_grass, &
8 oimp_veg, oimp_z0, oimp_emis, &
9 ptstep, kmonth, kday, kspinw, &
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, &
72 USE modd_co2v_par, ONLY : xmc, xmco2, xpcco2, xrespfactor_nit, &
73 xcoeff_maint_resp_zero, xslope_maint_resp, &
74 xparam, xparcf, xdiludec
80 USE modi_nitro_decline
87 nvt_trbd, nvt_tebe, nvt_tene, &
88 nvt_bobd, nvt_bond, nvt_shrb, &
89 nvt_trbe, nvt_c3, nvt_c4, &
94 USE yomhook
,ONLY : lhook, dr_hook
95 USE parkind1
,ONLY : jprb
102 CHARACTER(LEN=3),
INTENT(IN) :: hisba
106 CHARACTER(LEN=3),
INTENT(IN) :: hphoto
110 CHARACTER(LEN=3),
INTENT(IN) :: hrespsl
114 CHARACTER(LEN=4),
INTENT(IN) :: halbedo
119 LOGICAL,
INTENT(IN) :: oagrip
120 LOGICAL,
INTENT(IN) :: otr_ml
121 LOGICAL,
INTENT(IN) :: onitro_dilu
122 LOGICAL,
INTENT(IN) :: oagri_to_grass
124 LOGICAL,
INTENT(IN) :: oimp_veg
125 LOGICAL,
INTENT(IN) :: oimp_z0
126 LOGICAL,
INTENT(IN) :: oimp_emis
128 REAL,
INTENT(IN) :: ptstep
129 INTEGER,
INTENT(IN) :: kmonth
130 INTEGER,
INTENT(IN) :: kday
131 INTEGER,
INTENT(IN) :: kspinw
132 REAL,
INTENT(IN) :: ptime
133 REAL,
DIMENSION(:),
INTENT(IN) :: plat
134 REAL,
DIMENSION(:),
INTENT(IN) :: prhoa
136 REAL,
DIMENSION(:,:),
INTENT(IN) :: pdg
137 REAL,
DIMENSION(:,:),
INTENT(IN) :: pdzg
138 INTEGER,
DIMENSION(:),
INTENT(IN) :: kwg_layer
140 REAL,
DIMENSION(:,:),
INTENT(IN) :: ptg
141 REAL,
DIMENSION(:),
INTENT(IN) :: palbvis_veg
142 REAL,
DIMENSION(:),
INTENT(IN) :: palbnir_veg
143 REAL,
DIMENSION(:),
INTENT(IN) :: palbuv_veg
144 REAL,
DIMENSION(:),
INTENT(IN) :: palbvis_soil
145 REAL,
DIMENSION(:),
INTENT(IN) :: palbnir_soil
146 REAL,
DIMENSION(:),
INTENT(IN) :: palbuv_soil
148 REAL,
DIMENSION(:,:),
INTENT(IN) :: pvegtype
149 REAL,
DIMENSION(:),
INTENT(IN) :: psefold
150 REAL,
DIMENSION(:),
INTENT(IN) :: panmax
151 REAL,
DIMENSION(:),
INTENT(IN) :: ph_tree
152 REAL,
DIMENSION(:),
INTENT(IN) :: pbslai
153 REAL,
DIMENSION(:),
INTENT(IN) :: plaimin
155 REAL,
DIMENSION(:),
INTENT(IN) :: p_co2
157 REAL,
DIMENSION(:),
INTENT(IN) :: pce_nitro
159 REAL,
DIMENSION(:),
INTENT(IN) :: pcf_nitro
161 REAL,
DIMENSION(:),
INTENT(IN) :: pcna_nitro
162 REAL,
DIMENSION(:),
INTENT(IN) :: pbslai_nitro
164 REAL,
DIMENSION(:),
INTENT(IN) :: pgmes
165 REAL,
DIMENSION(:),
INTENT(IN) :: ptau_wood
168 TYPE (date_time),
DIMENSION(:),
INTENT(IN) :: tpseed
169 TYPE (date_time),
DIMENSION(:),
INTENT(IN) :: tpreap
171 REAL,
DIMENSION(:),
INTENT(IN) :: paosip
172 REAL,
DIMENSION(:),
INTENT(IN) :: paosim
173 REAL,
DIMENSION(:),
INTENT(IN) :: paosjp
174 REAL,
DIMENSION(:),
INTENT(IN) :: paosjm
175 REAL,
DIMENSION(:),
INTENT(IN) :: pho2ip
176 REAL,
DIMENSION(:),
INTENT(IN) :: pho2im
177 REAL,
DIMENSION(:),
INTENT(IN) :: pho2jp
178 REAL,
DIMENSION(:),
INTENT(IN) :: pho2jm
180 REAL,
DIMENSION(:),
INTENT(INOUT) :: pz0effip
181 REAL,
DIMENSION(:),
INTENT(INOUT) :: pz0effim
182 REAL,
DIMENSION(:),
INTENT(INOUT) :: pz0effjp
183 REAL,
DIMENSION(:),
INTENT(INOUT) :: pz0effjm
185 REAL,
DIMENSION(:),
INTENT(INOUT) :: plai
186 REAL,
DIMENSION(:),
INTENT(INOUT) :: pveg
187 REAL,
DIMENSION(:),
INTENT(INOUT) :: pz0
188 REAL,
DIMENSION(:),
INTENT(INOUT) :: palbnir
189 REAL,
DIMENSION(:),
INTENT(INOUT) :: palbvis
190 REAL,
DIMENSION(:),
INTENT(INOUT) :: palbuv
191 REAL,
DIMENSION(:),
INTENT(INOUT) :: pemis
193 REAL,
DIMENSION(:),
INTENT(INOUT) :: panfm
194 REAL,
DIMENSION(:),
INTENT(INOUT) :: panday
195 REAL,
DIMENSION(:,:),
INTENT(INOUT) :: pbiomass
196 REAL,
DIMENSION(:,:),
INTENT(INOUT) :: presp_biomass
197 REAL,
DIMENSION(:,:),
INTENT(INOUT) :: presp_biomass_inst
199 REAL,
DIMENSION(:,:),
INTENT(OUT) :: pincrease
200 REAL,
DIMENSION(:,:),
INTENT(OUT) :: pturnover
202 REAL,
DIMENSION(:),
INTENT(IN),
OPTIONAL :: pswdir
206 REAL,
PARAMETER :: zcoef1 = 10.0
207 REAL,
PARAMETER :: zcoef2 = 25.0
208 REAL,
PARAMETER :: zdepth = 1.0
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.
216 REAL,
PARAMETER :: zcdilu1 = -0.048
217 REAL,
PARAMETER :: zcdilu2 = 6.3
218 REAL,
PARAMETER :: zcdilu3 = 371.
220 REAL,
PARAMETER :: zphoton = 2.010402e-3
221 REAL,
PARAMETER :: zdepth_veg = 0.40
222 REAL,
PARAMETER :: ztemp_veg = 23.
223 REAL,
PARAMETER :: zdecidus = 0.75
227 REAL,
DIMENSION(SIZE(PRESP_BIOMASS,1),SIZE(PRESP_BIOMASS,2)) :: zresp_biomass_last
228 REAL,
DIMENSION(SIZE(PLAI)) :: zbiomass_leaf
229 REAL,
DIMENSION(SIZE(PLAI)) :: zbslai_nitro
231 REAL,
DIMENSION(SIZE(PLAI)) :: zco2, zcna_nitro
232 REAL,
DIMENSION(SIZE(PLAI)) :: zparam
233 REAL,
DIMENSION(SIZE(PLAI)) :: zhtree, zsapfrac
238 REAL,
DIMENSION(SIZE(PTG,1)) :: ztg_veg
239 REAL,
DIMENSION(SIZE(PTG,1)) :: ztg_soil
240 REAL,
DIMENSION(SIZE(PTG,1)) :: zdg_soil
243 LOGICAL,
DIMENSION(SIZE(PLAI)) :: gwood,gherb
244 LOGICAL,
DIMENSION(SIZE(PLAI)) :: gmask_agri
246 INTEGER :: ini, inl, ji, jl, idepth, jtype
248 REAL,
DIMENSION(SIZE(PVEGTYPE,1),SIZE(PVEGTYPE,2)) :: zparam_type
251 REAL,
DIMENSION(SIZE(PLAI)) :: zfert
253 REAL(KIND=JPRB) :: zhook_handle
260 IF (lhook) CALL dr_hook(
'VEGETATION_EVOL',0,zhook_handle)
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(:))
277 gmask = ( ptime - ptstep < 0. ) .AND. ( ptime >= 0. )
281 presp_biomass(:,1) = 0.0
282 zresp_biomass_last(:,:) = 0.0
284 presp_biomass(:,1) = presp_biomass(:,1) + presp_biomass_inst(:,1) * (ptstep*prhoa(:)*xmc)/(xpcco2*xmco2)
285 zresp_biomass_last(:,:) = presp_biomass(:,:)
293 zbiomass_leaf(:) = pbiomass(:,1)
297 IF (hphoto==
'LAI' .OR. hphoto==
'LST')
THEN
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(:)
303 ELSE IF (hphoto==
'NIT' .OR. hphoto==
'NCB')
THEN
307 zbslai_nitro(: ) = pbslai_nitro(:)
316 ztg_veg(:) = ptg(:,2)
320 zdg_soil(ji)=min(zdepth_veg,pdg(ji,idepth))
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)
332 DO jtype=1,
SIZE(pvegtype,2)
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)
342 WHERE((pce_nitro(:)*pcna_nitro(:)+pcf_nitro(:))/=0.0.AND.pcna_nitro(:)/=0.0)
343 zco2(:) = p_co2(:)*(xmd/(1.e-6*xmco2))
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(:))
350 IF(any(plai(:)/=xundef))
THEN
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)
368 IF (hphoto ==
'NIT' .OR. hphoto==
'NCB')
THEN
372 ztg_veg(:) = ptg(:,1)
375 ztg_soil(:) = ptg(:,2)
379 zdg_soil(ji)=min(zdepth,pdg(ji,idepth))
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)
395 presp_biomass(:,2) = presp_biomass(:,2) + pbiomass(:,2) * ptstep &
396 * max(0.,zroot_ibis*exp(zcibis1*(zcibis2-1./ztg_veg(:)))/(znday*xday))
398 presp_biomass(:,2) = presp_biomass(:,2) + pbiomass(:,2) * xrespfactor_nit &
399 * exp((zlog2/zcoef1)*(ztg_veg(:)-xtt-zcoef2)) * ptstep
403 IF (hphoto ==
'NIT')
THEN
405 presp_biomass(:,3) = presp_biomass(:,3) + pbiomass(:,3) * xrespfactor_nit &
406 * exp((zlog2/zcoef1)*(ztg_soil(:)-xtt-zcoef2)) * ptstep
409 ELSEIF (hphoto ==
'NCB')
THEN
411 presp_biomass(:,2) = min(presp_biomass(:,2), pbiomass(:,2))
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))
419 presp_biomass(:,4) = presp_biomass(:,4) + pbiomass(:,4) * ptstep &
420 * max(0.,zroot_ibis * exp(zcibis1*(zcibis2-1./ztg_soil(:)))/(znday*xday))
422 presp_biomass(:,4) = presp_biomass(:,4) + pbiomass(:,4) * max( 0., &
423 xcoeff_maint_resp_zero * (1. + xslope_maint_resp*(ztg_soil(:)-xtt))) * ptstep
426 presp_biomass(:,4) = min(presp_biomass(:,4), pbiomass(:,4))
428 WHERE( (gwood(:)).AND.(pbiomass(:,5)>0.) )
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))
437 presp_biomass(:,5) = 0.0
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)
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.
463 WHERE (gmask_agri(:))
465 zbiomass_leaf(:) = plai(:) * zbslai_nitro(:)
468 IF (hphoto ==
'NIT' .OR. hphoto ==
'NCB')
THEN
470 WHERE (gmask_agri(:))
474 presp_biomass(:,2) = 0.0
475 presp_biomass(:,3) = 0.0
478 IF (hphoto ==
'NCB')
THEN
480 WHERE (gmask_agri(:))
484 presp_biomass(:,4) = 0.0
499 IF(.NOT.oimp_z0)
THEN
500 WHERE( pveg(:) > 0. ) pz0(:) =
z0v_from_lai(plai(:),ph_tree(:),pvegtype(:,:),oagri_to_grass)
502 IF(.NOT.oimp_veg)
THEN
503 WHERE( pveg(:) > 0. ) pveg(:) =
veg_from_lai(plai(:),pvegtype(:,:),oagri_to_grass)
507 IF(.NOT.oimp_emis)
THEN
508 WHERE( pveg(:) > 0. ) pemis(:)=
emis_from_veg(pveg(:),pvegtype(:,:))
512 palbvis_veg,palbnir_veg,palbuv_veg,pveg, &
513 palbvis_soil,palbnir_soil,palbuv_soil, &
514 palbvis,palbnir,palbuv )
518 IF (
SIZE(paosip)>0) &
520 pho2ip,pho2im,pho2jp,pho2jm,pz0, &
521 pz0effip,pz0effim,pz0effjp,pz0effjm )
525 IF (lhook) CALL dr_hook(
'VEGETATION_EVOL',1,zhook_handle)
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)
subroutine lailoss(PVEG, PSEFOLD, PANMAX, PANDAY, PANFM, PBIOMASS)
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)