SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
convert_patch_isba.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 convert_patch_isba (DTCO, DTI, I, &
7  hisba,kdecade,kdecade2,pcover,ocover,&
8  hphoto,oagrip,operm,otr_ml,hsftype, &
9  pveg,plai,prsmin,pgamma,pwrmax_cf, &
10  prgl,pcv,psoilgrid,pdg,kwg_layer, &
11  pdroot,pdg2,pz0,pz0_o_z0h, &
12  palbnir_veg,palbvis_veg,palbuv_veg, &
13  pemis_eco,pvegtype,prootfrac, &
14  pgmes,pbslai,plaimin,psefold,pgc, &
15  pdmax, pf2i, ostress, ph_tree, pre25, &
16  pce_nitro, pcf_nitro, pcna_nitro, &
17  pd_ice, pwg1, &
18  palbnir_soil,palbvis_soil,palbuv_soil, &
19  tpseed, tpreap, pwatsup, pirrig, &
20  pgndlitter, prglgv, &
21  pgammagv, prsmingv, prootfracgv, &
22  pwrmax_cfgv, plaigv, pz0litter, ph_veg )
23 ! ##############################################################
24 !
25 !!**** *CONVERT_PATCH_ISBA*
26 !!
27 !! PURPOSE
28 !! -------
29 !!
30 !! METHOD
31 !! ------
32 !!
33 !
34 !! EXTERNAL
35 !! --------
36 !!
37 !! IMPLICIT ARGUMENTS
38 !! ------------------
39 !!
40 !! REFERENCE
41 !! ---------
42 !!
43 !! AUTHOR
44 !! ------
45 !!
46 !! S. Faroux Meteo-France
47 !!
48 !! MODIFICATION
49 !! ------------
50 !!
51 !! Original 16/11/10
52 !! V. Masson 04/14 Garden and Greenroofs can only be initialized by ecoclimap
53 !! in this routine (not from user specified parameters from
54 !! the nature tile, as the number of points is not the same)
55 !! B. Decharme 04/2013 Add CDGAVG (method to average depth)
56 !! Soil depth = Root depth with ISBA-DF
57 !! except for bare soil pft (but limited to 1m)
58 !! With TR_ML (new radiative transfert) and modis
59 !! albedo, UV albedo not defined (conserv nrj when
60 !! coupled to atmosphere)
61 !! P Samuelsson 10/2014 MEB
62 !!
63 !----------------------------------------------------------------------------
64 !
65 !* 0. DECLARATION
66 ! -----------
67 !
68 !
69 USE modd_data_cover_n, ONLY : data_cover_t
70 USE modd_data_isba_n, ONLY : data_isba_t
71 USE modd_isba_n, ONLY : isba_t
72 !
73 USE modd_data_cover_par, ONLY : nvegtype, nvt_no, nvt_rock, nvt_snow
74 !
75 USE modd_type_date_surf
76 !
77 !
78 USE modd_data_cover, ONLY : xdata_lai, xdata_h_tree, &
79  xdata_veg, xdata_z0, xdata_z0_o_z0h, &
80  xdata_emis_eco, xdata_gamma, xdata_cv, &
81  xdata_rgl, xdata_rsmin, &
82  xdata_albnir_veg, xdata_albvis_veg, &
83  xdata_albuv_veg, &
84  xdata_alb_veg_nir, xdata_alb_veg_vis, &
85  xdata_alb_soil_nir, xdata_alb_soil_vis, &
86  xdata_gmes, xdata_bslai, xdata_laimin, &
87  xdata_sefold, xdata_gc, xdata_wrmax_cf, &
88  xdata_stress, &
89  xdata_dmax, xdata_f2i, xdata_re25, &
90  xdata_ce_nitro, xdata_cf_nitro, &
91  xdata_cna_nitro, xdata_dice, &
92  xdata_gmes_st, xdata_bslai_st, &
93  xdata_sefold_st, xdata_gc_st, &
94  xdata_dmax_st, xdata_watsup, &
95  xdata_gndlitter, &
96  xdata_rglgv, xdata_gammagv, &
97  xdata_rsmingv, xdata_root_depthgv, &
98  xdata_wrmax_cfgv, xdata_laigv, &
99  xdata_z0litter, xdata_h_veg, &
100  xdata_root_extinctiongv, &
101  tdata_seed, tdata_reap,xdata_irrig, &
102  xdata_root_depth, xdata_ground_depth, &
103  xdata_root_extinction, xdata_root_lin
104 !
105 !
106 USE modd_treedrag, ONLY : ltreedrag
107 !
108 USE modi_av_pgd_param
109 USE modi_av_pgd
110 USE modi_soil_albedo
111 !
112 USE yomhook ,ONLY : lhook, dr_hook
113 USE parkind1 ,ONLY : jprb
114 !
115 IMPLICIT NONE
116 !
117 !* 0.1 Declaration of arguments
118 ! ------------------------
119 !
120 !
121 TYPE(data_cover_t), INTENT(INOUT) :: dtco
122 TYPE(data_isba_t), INTENT(INOUT) :: dti
123 TYPE(isba_t), INTENT(INOUT) :: i
124 !
125  CHARACTER(LEN=*), INTENT(IN) :: hisba ! type of soil (Force-Restore OR Diffusion)
126 INTEGER, INTENT(IN) :: kdecade
127 INTEGER, INTENT(IN) :: kdecade2
128 REAL, DIMENSION(:,:), INTENT(IN) :: pcover
129 LOGICAL, DIMENSION(:), INTENT(IN) :: ocover
130  CHARACTER(LEN=*), INTENT(IN) :: hphoto ! type of photosynthesis
131 LOGICAL, INTENT(IN) :: oagrip
132 LOGICAL, INTENT(IN) :: operm
133 LOGICAL, INTENT(IN) :: otr_ml
134  CHARACTER(LEN=*), INTENT(IN) :: hsftype ! nature / garden
135 !
136 REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: pwg1
137 !
138 REAL, DIMENSION(:) , OPTIONAL, INTENT(IN) :: psoilgrid
139 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pveg
140 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: plai
141 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: prsmin
142 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pgamma
143 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pwrmax_cf
144 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: prgl
145 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pcv
146 REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: pdg
147 INTEGER, DIMENSION(:,:),OPTIONAL, INTENT(OUT) :: kwg_layer
148 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pdroot
149 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pdg2
150 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pz0
151 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pz0_o_z0h
152 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: palbnir_veg
153 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: palbvis_veg
154 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: palbuv_veg
155 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pemis_eco
156 !
157 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pvegtype
158 REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: prootfrac
159 !
160 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pgmes
161 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pbslai
162 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: plaimin
163 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: psefold
164 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pgc
165 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pdmax
166 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pf2i
167 LOGICAL, DIMENSION(:,:),OPTIONAL, INTENT(OUT) :: ostress
168 !
169 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: ph_tree
170 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pre25
171 !
172 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pce_nitro
173 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pcf_nitro
174 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pcna_nitro
175 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pd_ice
176 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: palbnir_soil
177 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: palbvis_soil
178 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: palbuv_soil
179 !
180 TYPE(date_time), DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: tpseed
181 TYPE(date_time), DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: tpreap
182 !
183 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pwatsup
184 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pirrig
185 !
186 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pgndlitter
187 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: prglgv
188 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pgammagv
189 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: prsmingv
190 REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: prootfracgv
191 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pwrmax_cfgv
192 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: plaigv
193 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pz0litter
194 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: ph_veg
195 !
196 !* 0.2 Declaration of local variables
197 ! ------------------------------
198 !
199  CHARACTER(LEN=3) :: ytree, ynat, ylai, yveg, ybar, ydif
200 !
201 INTEGER :: jlayer ! loop counter on layers
202 INTEGER :: jvegtype ! loop counter on vegtypes
203 !
204 LOGICAL :: gdata ! Flag where initialization can be done
205 ! ! either with ecoclimap of data fields specified
206 ! ! by user on the natural points (GDTA=T)
207 ! ! For fields in town, only ecoclimap option
208 ! ! is treated in this routine (GDATA=F)
209 INTEGER :: jj ! loop counter
210 !
211 INTEGER :: isize_lmeb_patch ! Number of patches with MEB=true
212 !
213 REAL, ALLOCATABLE, DIMENSION(:) :: zh_veg
214 !
215 !
216 !* 0.3 Declaration of namelists
217 ! ------------------------
218 !
219 REAL(KIND=JPRB) :: zhook_handle
220 !-------------------------------------------------------------------------------
221 !
222 !* 1. Initializations
223 ! ---------------
224 !
225 IF (lhook) CALL dr_hook('CONVERT_PATCH_ISBA',0,zhook_handle)
226 !
227 IF (ASSOCIATED(dtco%XDATA_WEIGHT)) DEALLOCATE(dtco%XDATA_WEIGHT)
228 !
229 IF (hsftype=='NAT') THEN
230  ynat='NAT'
231  ytree='TRE'
232  ylai='LAI'
233  yveg='VEG'
234  ybar='BAR'
235  ydif='DVG'
236  gdata=.true.
237  isize_lmeb_patch = count(i%LMEB_PATCH(:))
238 ELSEIF (hsftype=='GRD') THEN
239  ynat='GRD'
240  ytree='GRT'
241  ylai='GRL'
242  yveg='GRV'
243  ybar='GRB'
244  ydif='GDV'
245  gdata=.false.
246  isize_lmeb_patch = 0
247 ENDIF
248 !
249 ! vegtypes fraction
250 ! -----------------
251 !
252 IF (present(pvegtype)) THEN
253  IF (gdata .AND. dti%LDATA_VEGTYPE) THEN
254  pvegtype=dti%XPAR_VEGTYPE
255  ELSE
256  !classical ecoclimap case
257  DO jvegtype=1,nvegtype
258  CALL av_pgd(dtco, &
259  pvegtype(:,jvegtype),pcover ,dtco%XDATA_VEGTYPE(:,jvegtype),ynat,'ARI',ocover)
260  END DO
261  ENDIF
262 ENDIF
263 !
264 ! VEG
265 ! ----
266 IF (present(pveg)) THEN
267  IF (gdata .AND. dti%LDATA_VEG) THEN
268  CALL av_pgd_param(dti, &
269  pveg,dti%XPAR_VEGTYPE,dti%XPAR_VEG(:,kdecade2,:),ynat,'ARI')
270  ELSE
271  CALL av_pgd(dtco, &
272  pveg,pcover,xdata_veg(:,kdecade,:),ynat,'ARI',ocover,kdecade=kdecade)
273  ENDIF
274 ENDIF
275 !
276 ! GNDLITTER
277 ! ---------
278 IF (present(pgndlitter)) THEN
279  IF (gdata .AND. dti%LDATA_GNDLITTER) THEN
280  CALL av_pgd_param(dti, &
281  pgndlitter,dti%XPAR_VEGTYPE,dti%XPAR_GNDLITTER(:,kdecade2,:),ynat,'ARI',kdecade=kdecade2)
282  ELSE
283  CALL av_pgd(dtco, &
284  pgndlitter,pcover,xdata_gndlitter(:,kdecade,:),ynat,'ARI',ocover,kdecade=kdecade)
285  ENDIF
286 ENDIF
287 !
288 ! LAI
289 ! ----
290 IF (present(plai)) THEN
291  IF (gdata .AND. dti%LDATA_LAI) THEN
292  CALL av_pgd_param(dti, &
293  plai,dti%XPAR_VEGTYPE,dti%XPAR_LAI(:,kdecade2,:),yveg,'ARI',kdecade=kdecade2)
294  ELSE
295  CALL av_pgd(dtco, &
296  plai,pcover,xdata_lai(:,kdecade,:),yveg,'ARI',ocover,kdecade=kdecade)
297  ENDIF
298 ENDIF
299 !
300 ! LAIGV
301 ! ----
302 IF (present(plaigv)) THEN
303  IF (gdata .AND. dti%LDATA_LAIGV) THEN
304  CALL av_pgd_param(dti, &
305  plaigv,dti%XPAR_VEGTYPE,dti%XPAR_LAIGV(:,kdecade2,:),yveg,'ARI',kdecade=kdecade2)
306  ELSE
307  CALL av_pgd(dtco, &
308  plaigv,pcover,xdata_laigv(:,kdecade,:),yveg,'ARI',ocover,kdecade=kdecade)
309  ENDIF
310 ENDIF
311 !
312 ! EMIS
313 ! ----
314 !emis needs VEG by vegtypes is changed at this step
315 IF (present(pemis_eco)) THEN
316  IF (gdata .AND. dti%LDATA_EMIS) THEN
317  CALL av_pgd_param(dti, &
318  pemis_eco,dti%XPAR_VEGTYPE,dti%XPAR_EMIS(:,kdecade2,:),ynat,'ARI')
319  ELSE
320  CALL av_pgd(dtco, &
321  pemis_eco ,pcover ,xdata_emis_eco(:,kdecade,:),ynat,'ARI',ocover,kdecade=kdecade)
322  ENDIF
323 ENDIF
324 ! H_VEG
325 ! -----
326 IF (present(ph_veg)) THEN
327  IF (gdata .AND. dti%LDATA_H_VEG) THEN
328  CALL av_pgd_param(dti, &
329  ph_veg,dti%XPAR_VEGTYPE,dti%XPAR_H_VEG(:,kdecade2,:),yveg,'ARI',kdecade=kdecade2)
330  ELSE
331  CALL av_pgd(dtco, &
332  ph_veg,pcover,xdata_h_veg(:,kdecade,:),yveg,'ARI',ocover,kdecade=kdecade)
333  ENDIF
334 ! In case of MEB, force 0<PH_VEG<XUNDEF for those patches where LMEB_PATCH=.T.
335  IF (isize_lmeb_patch>0)THEN
336  ALLOCATE(zh_veg(SIZE(ph_veg,1)))
337  DO jj=1,SIZE(i%LMEB_PATCH)
338  IF(i%LMEB_PATCH(jj))THEN
339  zh_veg=ph_veg(:,jj)
340  WHERE(zh_veg>1000.) zh_veg=0.
341  zh_veg=max(zh_veg,1.0e-3)
342  ph_veg(:,jj)=zh_veg
343  ENDIF
344  ENDDO
345  ENDIF
346 ENDIF
347 !
348 !
349 ! Z0V
350 ! ----
351 IF (present(pz0)) THEN
352  IF (gdata .AND. dti%LDATA_Z0) THEN
353  CALL av_pgd_param(dti, &
354  pz0,dti%XPAR_VEGTYPE,dti%XPAR_Z0(:,kdecade2,:),ynat,'CDN')
355  ELSE
356  CALL av_pgd(dtco, &
357  pz0 ,pcover ,xdata_z0(:,kdecade,:),ynat,'CDN',ocover,kdecade=kdecade)
358  ENDIF
359 ENDIF
360 !
361 ! Z0LITTER
362 ! --------
363 IF (present(pz0litter)) THEN
364  IF (gdata .AND. dti%LDATA_Z0LITTER) THEN
365  CALL av_pgd_param(dti, &
366  pz0litter,dti%XPAR_VEGTYPE,dti%XPAR_Z0LITTER(:,kdecade2,:),ynat,'CDN')
367  ELSE
368  CALL av_pgd(dtco, &
369  pz0litter ,pcover ,xdata_z0litter(:,kdecade,:),ynat,'CDN',ocover)
370  ENDIF
371 ENDIF
372 !
373 !
374 !* soil layers and root fraction
375 ! -----------------------------
376 !
377 IF ( present(pdg)) THEN
378  !
379  ! compute soil layers (and root fraction if DIF)
380  !
381  CALL set_grid_param(SIZE(pdg,1),SIZE(pdg,2),SIZE(pdg,3),present(pdg2), &
382  present(pdroot),present(kwg_layer),present(prootfrac), &
383  present(prootfracgv).AND.(isize_lmeb_patch>0) )
384  !
385 ENDIF
386 !
387 ! D ICE
388 ! -----
389 !
390 IF (present(pd_ice).AND.hisba/='DIF') THEN
391  IF (gdata .AND. dti%LDATA_DICE) THEN
392  CALL av_pgd_param(dti, &
393  pd_ice,dti%XPAR_VEGTYPE,dti%XPAR_DICE,ynat,'ARI')
394  ELSE
395  CALL av_pgd(dtco, &
396  pd_ice,pcover,xdata_dice(:,:),ynat,'ARI',ocover,kdecade=kdecade)
397  ENDIF
398 ENDIF
399 !
400 ! Other parameters
401 ! ----------------
402 IF (present(prsmin)) THEN
403  IF( SIZE(prsmin)>0) THEN
404  IF (gdata .AND. dti%LDATA_RSMIN) THEN
405  CALL av_pgd_param(dti, &
406  prsmin,dti%XPAR_VEGTYPE,dti%XPAR_RSMIN,ylai,'INV',kdecade=kdecade2)
407  ELSE
408  CALL av_pgd(dtco, &
409  prsmin,pcover,xdata_rsmin,ylai,'INV',ocover,kdecade=kdecade)
410  ENDIF
411  ENDIF
412 ENDIF
413 !
414 IF (present(prsmingv)) THEN
415  IF( SIZE(prsmingv)>0) THEN
416  IF (gdata .AND. dti%LDATA_RSMINGV) THEN
417  CALL av_pgd_param(dti, &
418  prsmingv,dti%XPAR_VEGTYPE,dti%XPAR_RSMINGV,ylai,'INV',kdecade=kdecade2)
419  ELSE
420  CALL av_pgd(dtco, &
421  prsmingv,pcover,xdata_rsmingv,ylai,'INV',ocover,kdecade=kdecade)
422  ENDIF
423  ENDIF
424 ENDIF
425 !
426 IF (present(pgamma)) THEN
427  IF (gdata .AND. dti%LDATA_GAMMA) THEN
428  CALL av_pgd_param(dti, &
429  pgamma,dti%XPAR_VEGTYPE,dti%XPAR_GAMMA,yveg,'ARI',kdecade=kdecade2)
430  ELSE
431  CALL av_pgd(dtco, &
432  pgamma,pcover,xdata_gamma,yveg,'ARI',ocover,kdecade=kdecade)
433  ENDIF
434 ENDIF
435 !
436 IF (present(pgammagv)) THEN
437  IF (gdata .AND. dti%LDATA_GAMMAGV) THEN
438  CALL av_pgd_param(dti, &
439  pgammagv,dti%XPAR_VEGTYPE,dti%XPAR_GAMMAGV,yveg,'ARI',kdecade=kdecade2)
440  ELSE
441  CALL av_pgd(dtco, &
442  pgammagv,pcover,xdata_gammagv,yveg,'ARI',ocover,kdecade=kdecade)
443  ENDIF
444 ENDIF
445 !
446 IF (present(pwrmax_cf)) THEN
447  IF (gdata .AND. dti%LDATA_WRMAX_CF) THEN
448  CALL av_pgd_param(dti, &
449  pwrmax_cf,dti%XPAR_VEGTYPE,dti%XPAR_WRMAX_CF,yveg,'ARI',kdecade=kdecade2)
450  ELSE
451  CALL av_pgd(dtco, &
452  pwrmax_cf,pcover,xdata_wrmax_cf,yveg,'ARI',ocover,kdecade=kdecade)
453  ENDIF
454 ENDIF
455 !
456 IF (present(pwrmax_cfgv)) THEN
457  IF (gdata .AND. dti%LDATA_WRMAX_CFGV) THEN
458  CALL av_pgd_param(dti, &
459  pwrmax_cfgv,dti%XPAR_VEGTYPE,dti%XPAR_WRMAX_CFGV,yveg,'ARI',kdecade=kdecade2)
460  ELSE
461  CALL av_pgd(dtco, &
462  pwrmax_cfgv,pcover,xdata_wrmax_cfgv,yveg,'ARI',ocover,kdecade=kdecade)
463  ENDIF
464 ENDIF
465 !
466 IF (present(prgl)) THEN
467  IF (gdata .AND. dti%LDATA_RGL) THEN
468  CALL av_pgd_param(dti, &
469  prgl,dti%XPAR_VEGTYPE,dti%XPAR_RGL,yveg,'ARI',kdecade=kdecade2)
470  ELSE
471  CALL av_pgd(dtco, &
472  prgl,pcover,xdata_rgl,yveg,'ARI',ocover,kdecade=kdecade)
473  ENDIF
474 ENDIF
475 !
476 IF (present(prglgv)) THEN
477  IF (gdata .AND. dti%LDATA_RGLGV) THEN
478  CALL av_pgd_param(dti, &
479  prglgv,dti%XPAR_VEGTYPE,dti%XPAR_RGLGV,yveg,'ARI',kdecade=kdecade2)
480  ELSE
481  CALL av_pgd(dtco, &
482  prglgv,pcover,xdata_rglgv,yveg,'ARI',ocover,kdecade=kdecade)
483  ENDIF
484 ENDIF
485 !
486 IF (present(pcv)) THEN
487  IF (gdata .AND. dti%LDATA_CV) THEN
488  CALL av_pgd_param(dti, &
489  pcv,dti%XPAR_VEGTYPE,dti%XPAR_CV,yveg,'INV',kdecade=kdecade2)
490  ELSE
491  CALL av_pgd(dtco, &
492  pcv,pcover,xdata_cv,yveg,'INV',ocover,kdecade=kdecade)
493  ENDIF
494 ENDIF
495 
496 IF (present(pz0_o_z0h)) THEN
497  IF (gdata .AND. dti%LDATA_Z0_O_Z0H) THEN
498  CALL av_pgd_param(dti, &
499  pz0_o_z0h,dti%XPAR_VEGTYPE,dti%XPAR_Z0_O_Z0H,ynat,'ARI')
500  ELSE
501  CALL av_pgd(dtco, &
502  pz0_o_z0h,pcover,xdata_z0_o_z0h,ynat,'ARI',ocover,kdecade=kdecade)
503  ENDIF
504 ENDIF
505 !
506 IF (present(palbnir_veg)) THEN
507  IF (gdata .AND. dti%LDATA_ALBNIR_VEG) THEN
508  CALL av_pgd_param(dti, &
509  palbnir_veg,dti%XPAR_VEGTYPE,dti%XPAR_ALBNIR_VEG,yveg,'ARI',kdecade=kdecade2)
510  ELSEIF (i%CALBEDO=='CM13') THEN
511  CALL av_pgd(dtco, &
512  palbnir_veg,pcover,xdata_alb_veg_nir(:,kdecade,:),yveg,'ARI',&
513  ocover,kdecade=kdecade)
514  ELSE
515  CALL av_pgd(dtco, &
516  palbnir_veg,pcover,xdata_albnir_veg,yveg,'ARI',ocover,kdecade=kdecade)
517  ENDIF
518 ENDIF
519 !
520 IF (present(palbvis_veg)) THEN
521  IF (gdata .AND. dti%LDATA_ALBVIS_VEG) THEN
522  CALL av_pgd_param(dti, &
523  palbvis_veg,dti%XPAR_VEGTYPE,dti%XPAR_ALBVIS_VEG,yveg,'ARI',kdecade=kdecade2)
524  ELSEIF (i%CALBEDO=='CM13') THEN
525  CALL av_pgd(dtco, &
526  palbvis_veg,pcover,xdata_alb_veg_vis(:,kdecade,:),yveg,'ARI',&
527  ocover,kdecade=kdecade)
528  ELSE
529  CALL av_pgd(dtco, &
530  palbvis_veg,pcover,xdata_albvis_veg,yveg,'ARI',ocover,kdecade=kdecade)
531  ENDIF
532 ENDIF
533 !
534 IF (present(palbuv_veg)) THEN
535  IF ((i%CALBEDO=='CM13'.OR.otr_ml).AND.present(palbvis_veg)) THEN
536  palbuv_veg(:,:)=palbvis_veg(:,:)
537  ELSE
538  IF (gdata .AND. dti%LDATA_ALBUV_VEG) THEN
539  CALL av_pgd_param(dti, &
540  palbuv_veg,dti%XPAR_VEGTYPE,dti%XPAR_ALBUV_VEG,yveg,'ARI',kdecade=kdecade2)
541  ELSE
542  CALL av_pgd(dtco, &
543  palbuv_veg,pcover,xdata_albuv_veg,yveg,'ARI',ocover,kdecade=kdecade)
544  ENDIF
545  ENDIF
546 ENDIF
547 !
548 IF (isize_lmeb_patch>0 .OR. hphoto/='NON') THEN
549 
550  IF (present(pbslai)) THEN
551  IF( SIZE(pbslai)>0) THEN
552  IF (gdata .AND. dti%LDATA_BSLAI) THEN
553  CALL av_pgd_param(dti, &
554  pbslai,dti%XPAR_VEGTYPE,dti%XPAR_BSLAI,yveg,'ARI',kdecade=kdecade2)
555  ELSE
556  IF (hphoto == 'AST' .OR. hphoto == 'LST' .OR. hphoto == 'NIT' .OR. hphoto == 'NCB') THEN
557  CALL av_pgd(dtco, &
558  pbslai,pcover,xdata_bslai_st,yveg,'ARI',ocover,kdecade=kdecade)
559  ELSE
560  CALL av_pgd(dtco, &
561  pbslai,pcover,xdata_bslai,yveg,'ARI',ocover,kdecade=kdecade)
562  ENDIF
563  ENDIF
564  ENDIF
565  ENDIF
566 
567 ENDIF
568 !
569 IF (hphoto/='NON'.OR.ltreedrag) THEN
570  !
571  IF (present(ph_tree)) THEN
572  IF (gdata .AND. dti%LDATA_H_TREE) THEN
573  CALL av_pgd_param(dti, &
574  ph_tree,dti%XPAR_VEGTYPE,dti%XPAR_H_TREE,ytree,'ARI')
575  ELSE
576  CALL av_pgd(dtco, &
577  ph_tree,pcover,xdata_h_tree(:,:),ytree,'ARI',ocover,kdecade=kdecade)
578  ENDIF
579  ENDIF
580  !
581 ENDIF
582 !
583 IF (hphoto/='NON') THEN
584  IF (present(pre25)) THEN
585  IF (SIZE(pre25)>0) THEN
586  IF (gdata .AND. dti%LDATA_RE25) THEN
587  CALL av_pgd_param(dti, &
588  pre25,dti%XPAR_VEGTYPE,dti%XPAR_RE25,ynat,'ARI')
589  ELSE
590  CALL av_pgd(dtco, &
591  pre25,pcover,xdata_re25,ynat,'ARI',ocover,kdecade=kdecade)
592  ENDIF
593  ENDIF
594  ENDIF
595  !
596  IF (present(plaimin)) THEN
597  IF (SIZE(plaimin)>0) THEN
598  IF (gdata .AND. dti%LDATA_LAIMIN) THEN
599  CALL av_pgd_param(dti, &
600  plaimin,dti%XPAR_VEGTYPE,dti%XPAR_LAIMIN,yveg,'ARI',kdecade=kdecade2)
601  ELSE
602  CALL av_pgd(dtco, &
603  plaimin,pcover,xdata_laimin,yveg,'ARI',ocover,kdecade=kdecade)
604  ENDIF
605  ENDIF
606  ENDIF
607  !
608  IF (present(psefold)) THEN
609  IF (SIZE(psefold)>0) THEN
610  IF (gdata .AND. dti%LDATA_SEFOLD) THEN
611  CALL av_pgd_param(dti, &
612  psefold,dti%XPAR_VEGTYPE,dti%XPAR_SEFOLD,yveg,'ARI',kdecade=kdecade2)
613  ELSE
614  IF (hphoto == 'AST' .OR. hphoto == 'LST' .OR. hphoto == 'NIT' .OR. hphoto == 'NCB') THEN
615  CALL av_pgd(dtco, &
616  psefold,pcover,xdata_sefold_st,yveg,'ARI',ocover,kdecade=kdecade)
617  ELSE
618  CALL av_pgd(dtco, &
619  psefold,pcover,xdata_sefold,yveg,'ARI',ocover,kdecade=kdecade)
620  ENDIF
621  ENDIF
622  ENDIF
623  ENDIF
624  !
625  IF (present(pgmes)) THEN
626  IF ( SIZE(pgmes)>0) THEN
627  IF (gdata .AND. dti%LDATA_GMES) THEN
628  CALL av_pgd_param(dti, &
629  pgmes,dti%XPAR_VEGTYPE,dti%XPAR_GMES,yveg,'ARI',kdecade=kdecade2)
630  ELSE
631  IF (hphoto == 'AST' .OR. hphoto == 'LST' .OR. hphoto == 'NIT' .OR. hphoto == 'NCB') THEN
632  CALL av_pgd(dtco, &
633  pgmes,pcover,xdata_gmes_st,yveg,'ARI',ocover,kdecade=kdecade)
634  ELSE
635  CALL av_pgd(dtco, &
636  pgmes,pcover,xdata_gmes,yveg,'ARI',ocover,kdecade=kdecade)
637  ENDIF
638  ENDIF
639  ENDIF
640  ENDIF
641  !
642  IF (present(pgc)) THEN
643  IF ( SIZE(pgc)>0) THEN
644  IF (gdata .AND. dti%LDATA_GC) THEN
645  CALL av_pgd_param(dti, &
646  pgc,dti%XPAR_VEGTYPE,dti%XPAR_GC,yveg,'ARI',kdecade=kdecade2)
647  ELSE
648  IF (hphoto == 'AST' .OR. hphoto == 'LST' .OR. hphoto == 'NIT' .OR. hphoto == 'NCB') THEN
649  CALL av_pgd(dtco, &
650  pgc,pcover,xdata_gc_st,yveg,'ARI',ocover,kdecade=kdecade)
651  ELSE
652  CALL av_pgd(dtco, &
653  pgc,pcover,xdata_gc,yveg,'ARI',ocover,kdecade=kdecade)
654  ENDIF
655  ENDIF
656  ENDIF
657  ENDIF
658  !
659  IF (present(pdmax)) THEN
660  IF (SIZE(pdmax)>0) THEN
661  IF (gdata .AND. dti%LDATA_DMAX) THEN
662  CALL av_pgd_param(dti, &
663  pdmax,dti%XPAR_VEGTYPE,dti%XPAR_DMAX,ytree,'ARI')
664  ELSE
665  IF (hphoto == 'AST' .OR. hphoto == 'LST' .OR. hphoto == 'NIT' .OR. hphoto == 'NCB') THEN
666  CALL av_pgd(dtco, &
667  pdmax,pcover,xdata_dmax_st,ytree,'ARI',ocover,kdecade=kdecade)
668  ELSE
669  CALL av_pgd(dtco, &
670  pdmax,pcover,xdata_dmax,ytree,'ARI',ocover,kdecade=kdecade)
671  ENDIF
672  ENDIF
673  ENDIF
674  ENDIF
675  !
676  IF (hphoto/='AGS' .AND. hphoto/='LAI') THEN
677  !
678  IF (present(pf2i)) THEN
679  IF (SIZE(pf2i)>0) THEN
680  IF (gdata .AND. dti%LDATA_F2I) THEN
681  CALL av_pgd_param(dti, &
682  pf2i,dti%XPAR_VEGTYPE,dti%XPAR_F2I,yveg,'ARI',kdecade=kdecade2)
683  ELSE
684  CALL av_pgd(dtco, &
685  pf2i,pcover,xdata_f2i,yveg,'ARI',ocover,kdecade=kdecade)
686  ENDIF
687  ENDIF
688  ENDIF
689  !
690  IF (hphoto=='NIT' .OR. hphoto=='NCB') THEN
691  !
692  IF (present(pce_nitro)) THEN
693  IF (SIZE(pce_nitro)>0) THEN
694  IF (gdata .AND. dti%LDATA_CE_NITRO) THEN
695  CALL av_pgd_param(dti, &
696  pce_nitro,dti%XPAR_VEGTYPE,dti%XPAR_CE_NITRO,yveg,'ARI',kdecade=kdecade2)
697  ELSE
698  CALL av_pgd(dtco, &
699  pce_nitro,pcover,xdata_ce_nitro,yveg,'ARI',ocover,kdecade=kdecade)
700  ENDIF
701  ENDIF
702  ENDIF
703  !
704  IF (present(pcf_nitro)) THEN
705  IF (SIZE(pcf_nitro)>0) THEN
706  IF (gdata .AND. dti%LDATA_CF_NITRO) THEN
707  CALL av_pgd_param(dti, &
708  pcf_nitro,dti%XPAR_VEGTYPE,dti%XPAR_CF_NITRO,yveg,'ARI',kdecade=kdecade2)
709  ELSE
710  CALL av_pgd(dtco, &
711  pcf_nitro,pcover,xdata_cf_nitro,yveg,'ARI',ocover,kdecade=kdecade)
712  ENDIF
713  ENDIF
714  ENDIF
715  !
716  IF (present(pcna_nitro)) THEN
717  IF (SIZE(pcna_nitro)>0) THEN
718  IF (gdata .AND. dti%LDATA_CNA_NITRO) THEN
719  CALL av_pgd_param(dti, &
720  pcna_nitro,dti%XPAR_VEGTYPE,dti%XPAR_CNA_NITRO,yveg,'ARI',kdecade=kdecade2)
721  ELSE
722  CALL av_pgd(dtco, &
723  pcna_nitro,pcover,xdata_cna_nitro,yveg,'ARI',ocover,kdecade=kdecade)
724  ENDIF
725  ENDIF
726  ENDIF
727  !
728  ENDIF
729  ENDIF
730  !
731 ENDIF
732 !
733 IF ((hphoto == 'LAI' .OR. hphoto == 'LST' .OR. hphoto == 'NIT' .OR. hphoto=='NCB') .AND. oagrip) THEN
734  !
735  ! date of seeding
736  ! ---------------
737  !
738  IF (present(tpseed)) THEN
739  IF(SIZE(tpseed)>0) THEN
740  CALL av_pgd(tpseed ,pcover,tdata_seed(:,:),yveg,'MAJ',ocover,kdecade=kdecade)
741  ENDIF
742  END IF
743  !
744  ! date of reaping
745  ! ---------------
746  !
747  IF (present(tpreap)) THEN
748  IF (SIZE(tpreap)>0) THEN
749  CALL av_pgd(tpreap ,pcover,tdata_reap(:,:),yveg,'MAJ',ocover,kdecade=kdecade)
750  ENDIF
751  END IF
752  !
753  IF (present(pirrig)) THEN
754  IF (SIZE(pirrig)>0) THEN
755  IF (gdata .AND. dti%LDATA_IRRIG) THEN
756  CALL av_pgd_param(dti, &
757  pirrig,dti%XPAR_VEGTYPE,dti%XPAR_IRRIG(:,kdecade2,:),yveg,'ARI',kdecade=kdecade2)
758  ELSE
759  CALL av_pgd(dtco, &
760  pirrig,pcover,xdata_irrig,yveg,'ARI',ocover,kdecade=kdecade)
761  ENDIF
762  ENDIF
763  ENDIF
764 
765  IF (present(pwatsup)) THEN
766  IF (SIZE(pwatsup)>0) THEN
767  IF (gdata .AND. dti%LDATA_WATSUP) THEN
768  CALL av_pgd_param(dti, &
769  pwatsup,dti%XPAR_VEGTYPE,dti%XPAR_WATSUP(:,kdecade2,:),yveg,'ARI',kdecade=kdecade2)
770  ELSE
771  CALL av_pgd(dtco, &
772  pwatsup,pcover,xdata_watsup,yveg,'ARI',ocover,kdecade=kdecade)
773  ENDIF
774  ENDIF
775  ENDIF
776 
777 ENDIF
778 !
779 IF (present(palbnir_soil)) THEN
780  IF (gdata .AND. dti%LDATA_ALBNIR_SOIL) THEN
781  CALL av_pgd_param(dti, &
782  palbnir_soil,dti%XPAR_VEGTYPE,dti%XPAR_ALBNIR_SOIL,ybar,'ARI',kdecade=kdecade2)
783  ELSEIF (i%CALBEDO=='CM13') THEN
784  CALL av_pgd(dtco, &
785  palbnir_soil,pcover,xdata_alb_soil_nir(:,kdecade,:),ybar,'ARI',&
786  ocover,kdecade=kdecade)
787  ELSE
788  CALL soil_albedo(i%CALBEDO, i%XWSAT(:,1),pwg1, i%XALBVIS_DRY,i%XALBNIR_DRY,i%XALBUV_DRY, &
789  i%XALBVIS_WET,i%XALBNIR_WET,i%XALBUV_WET, palbnir_soil=palbnir_soil )
790  ENDIF
791 ENDIF
792 !
793 IF (present(palbvis_soil)) THEN
794  IF (gdata .AND. dti%LDATA_ALBVIS_SOIL) THEN
795  CALL av_pgd_param(dti, &
796  palbvis_soil,dti%XPAR_VEGTYPE,dti%XPAR_ALBVIS_SOIL,ybar,'ARI',kdecade=kdecade2)
797  ELSEIF (i%CALBEDO=='CM13') THEN
798  CALL av_pgd(dtco, &
799  palbvis_soil,pcover,xdata_alb_soil_vis(:,kdecade,:),ybar,'ARI',&
800  ocover,kdecade=kdecade)
801  ELSE
802  CALL soil_albedo(i%CALBEDO, i%XWSAT(:,1),pwg1, i%XALBVIS_DRY,i%XALBVIS_DRY,i%XALBUV_DRY, &
803  i%XALBVIS_WET,i%XALBNIR_WET,i%XALBUV_WET, palbvis_soil=palbvis_soil )
804  ENDIF
805 ENDIF
806 !
807 IF (present(palbuv_soil)) THEN
808  IF ((i%CALBEDO=='CM13'.OR.otr_ml).AND.present(palbvis_soil)) THEN
809  palbuv_soil(:,:)=palbvis_soil(:,:)
810  ELSE
811  IF (gdata .AND. dti%LDATA_ALBUV_SOIL) THEN
812  CALL av_pgd_param(dti, &
813  palbuv_soil,dti%XPAR_VEGTYPE,dti%XPAR_ALBUV_SOIL,ynat,'ARI',kdecade=kdecade2)
814  ELSE
815  CALL soil_albedo(i%CALBEDO, i%XWSAT(:,1),pwg1, i%XALBVIS_DRY,i%XALBUV_DRY,i%XALBUV_DRY, &
816  i%XALBVIS_WET,i%XALBNIR_WET,i%XALBUV_WET,palbuv_soil=palbuv_soil )
817  ENDIF
818  ENDIF
819 ENDIF
820 !
821 ! STRESS
822 ! --------
823 IF (present(ostress)) THEN
824  IF (SIZE(ostress)>0) THEN
825  CALL set_stress(SIZE(ostress,1),SIZE(ostress,2))
826  ENDIF
827 ENDIF
828 !
829 IF (ASSOCIATED(dtco%XDATA_WEIGHT)) DEALLOCATE(dtco%XDATA_WEIGHT)
830 !
831 IF (lhook) CALL dr_hook('CONVERT_PATCH_ISBA',1,zhook_handle)
832 !
833 !-------------------------------------------------------------------------------
834  CONTAINS
835 !-------------------------------------------------------------------------------
836 !
837 SUBROUTINE set_stress(KSIZE1,KSIZE2)
838 !
839 IMPLICIT NONE
840 !
841 INTEGER, INTENT(IN) :: ksize1
842 INTEGER, INTENT(IN) :: ksize2
843 !
844 REAL, DIMENSION(KSIZE1,KSIZE2) :: zwork
845 REAL, DIMENSION(KSIZE1,NVEGTYPE) :: zstress
846 REAL(KIND=JPRB) :: zhook_handle
847 !
848 IF (lhook) CALL dr_hook('CONVERT_PATCH_ISBA:SET_STRESS',0,zhook_handle)
849 !
850 IF (gdata .AND. dti%LDATA_STRESS) THEN
851  zstress(:,:)=0.
852  DO jvegtype=1,nvegtype
853  WHERE (dti%LPAR_STRESS(:,jvegtype)) zstress(:,jvegtype)=1.
854  ENDDO
855  CALL av_pgd_param(dti, &
856  zwork,dti%XPAR_VEGTYPE,zstress,yveg,'ARI',kdecade=kdecade2)
857 ELSE
858  CALL av_pgd(dtco, &
859  zwork,pcover,xdata_stress(:,:),yveg,'ARI',ocover,kdecade=kdecade)
860 ENDIF
861 !
862 WHERE (zwork(:,:)<0.5)
863  ostress(:,:) = .false.
864 ELSEWHERE
865  ostress(:,:) = .true.
866 END WHERE
867 !
868 IF (lhook) CALL dr_hook('CONVERT_PATCH_ISBA:SET_STRESS',1,zhook_handle)
869 END SUBROUTINE set_stress
870 !
871 !-------------------------------------------------------------------------------
872 SUBROUTINE set_grid_param(KNI,KGROUND,KPATCH,LDG2,LDROOT,LWG_LAYER,LROOTFRAC, &
873  lrootfracgv )
874 !
875 USE modd_surf_par, ONLY : xundef, nundef
876 USE modd_isba_par, ONLY : xpermfrac
877 !
878 USE modd_reprod_oper, ONLY : cdgavg, cdgdif
879 !
880 USE modi_ini_data_rootfrac
881 USE modi_ini_data_soil
882 USE modi_permafrost_depth
883 USE modi_abor1_sfx
884 !
885 IMPLICIT NONE
886 !
887 REAL, PARAMETER :: zprec=1.0e+6
888 !
889 INTEGER, INTENT(IN) :: kni
890 INTEGER, INTENT(IN) :: kground
891 INTEGER, INTENT(IN) :: kpatch
892 LOGICAL, INTENT(IN) :: ldg2
893 LOGICAL, INTENT(IN) :: ldroot
894 LOGICAL, INTENT(IN) :: lwg_layer
895 LOGICAL, INTENT(IN) :: lrootfrac
896 LOGICAL, INTENT(IN) :: lrootfracgv
897 !
898 REAL, DIMENSION (SIZE(XDATA_GROUND_DEPTH,1),NVEGTYPE) :: zdata_ground_depth
899 !
900 REAL, DIMENSION (KNI,KGROUND,KPATCH) :: zrootfrac
901 REAL, DIMENSION (KNI,KPATCH) :: zdtot, zdg2, zroot_ext, zroot_lin
902 INTEGER, DIMENSION (KNI,KPATCH) :: iwg_layer
903 !
904 INTEGER :: jj, jl, jpatch
905 !
906 ! flags taking general surface type flag into account
907 LOGICAL :: gdata_dg, gdata_ground_depth, gdata_root_depth, gdata_rootfrac, &
908  gdata_rootfracgv, gnoeco
909 !-------------------------------------------------------------------------!
910 REAL(KIND=JPRB) :: zhook_handle
911 !
912 IF (lhook) CALL dr_hook('CONVERT_PATCH_ISBA:SET_GRID_PARAM',0,zhook_handle)
913 !
914 IF(hisba=='DIF')THEN
915  IF(.NOT.lwg_layer) CALL abor1_sfx('CONVERT_PATCH_ISBA: SET_GRID_PARAM: KWG_LAYER must be present with DIF')
916  IF(.NOT.ldroot ) CALL abor1_sfx('CONVERT_PATCH_ISBA: SET_GRID_PARAM: PDROOT must be present with DIF')
917  IF(.NOT.ldg2 ) CALL abor1_sfx('CONVERT_PATCH_ISBA: SET_GRID_PARAM: PDG2 must be present with DIF')
918 ENDIF
919 !
920 zrootfrac(:,:,:) = xundef
921 zdtot(:,:) = xundef
922 zdg2(:,:) = xundef
923 iwg_layer(:,:) = nundef
924 !
925 zdata_ground_depth(:,:) = xdata_ground_depth(:,:)
926 !
927 gdata_dg = gdata .AND. dti%LDATA_DG
928 gdata_ground_depth = gdata .AND. dti%LDATA_GROUND_DEPTH
929 gdata_root_depth = gdata .AND. dti%LDATA_ROOT_DEPTH
930 gdata_rootfrac = gdata .AND. dti%LDATA_ROOTFRAC
931 gdata_rootfracgv = gdata .AND. dti%LDATA_ROOTFRACGV
932 !
933 !####################################################################################
934 !
935 !CDGAVG : old for reprod = 'ARI' Arithmetic average for all depth
936 ! recommended = 'INV' Harmonic average for all depth (default)
937 !
938 !CDGDIF : old for reprod = 'SOIL' d3 soil depth from ecoclimap for isba-df
939 ! recommended = 'ROOT' d2 soil depth from ecoclimap for isba-df (default)
940 !
941 !####################################################################################
942 !
943 !DG IN NAMELIST => GROUND_DEPTH KNOWN, ROOT_DEPTH UNKNOWN
944 IF (gdata_dg) THEN
945  !
946  DO jlayer=1,kground
947  CALL av_pgd_param(dti, &
948  pdg(:,jlayer,:),dti%XPAR_VEGTYPE,dti%XPAR_DG(:,jlayer,:),ynat,cdgavg)
949  ENDDO
950  !
951 ENDIF
952 !
953 IF(.NOT.gdata_ground_depth.AND.hisba=='DIF'.AND.cdgdif=='ROOT')THEN
954  DO jvegtype=1,nvegtype
955  IF(jvegtype==nvt_no)THEN
956  WHERE(xdata_ground_depth(:,jvegtype)/=xundef)
957  zdata_ground_depth(:,jvegtype) = min(1.0,xdata_ground_depth(:,jvegtype))
958  ENDWHERE
959  ELSEIF(jvegtype/=nvt_rock.AND.jvegtype/=nvt_snow)THEN
960  zdata_ground_depth(:,jvegtype) = max(1.0,xdata_root_depth(:,jvegtype))
961  ELSE
962  zdata_ground_depth(:,jvegtype) = xdata_root_depth(:,jvegtype)
963  ENDIF
964  ENDDO
965 ENDIF
966 !
967 !CALCULATION OF GROUND_DEPTH IN ZDTOT : ECOCLIMAP OR LDATA_GROUND_DEPTH
968 IF (hisba/='2-L') THEN
969  !
970  IF (gdata_ground_depth .AND. (hisba=='DIF' .OR. .NOT.gdata_dg)) THEN
971  !GROUND DEPTH IN NAMELIST
972  CALL av_pgd_param(dti, &
973  zdtot(:,:),dti%XPAR_VEGTYPE,dti%XPAR_GROUND_DEPTH(:,:),ynat,cdgavg)
974  !Error Due to machine precision
975  WHERE(zdtot(:,:)/=xundef)
976  zdtot(:,:)=int(zdtot(:,:)*zprec)/zprec
977  ENDWHERE
978  !CONSISTENCY CHECK
979  IF (gdata_dg) zdtot(:,:) = min(zdtot(:,:),pdg(:,kground,:))
980  ELSEIF (gdata_dg) THEN
981  !GROUND DEPTH FROM NAMELIST DG
982  zdtot(:,:) = pdg(:,kground,:)
983  ELSE
984  !GROUND DEPTH FROM ECOCLIMAP
985  CALL av_pgd(dtco, &
986  zdtot(:,:),pcover,zdata_ground_depth(:,:),ynat,cdgavg,ocover,kdecade=kdecade)
987  IF(hisba=='DIF'.AND.cdgdif=='ROOT')zdg2(:,:)=zdtot(:,:)
988  ENDIF
989  !
990 ENDIF
991 !
992 !CALCULATION OF GROUND_DEPTH : Permafrost depth put to 12m
993 IF(hisba=='DIF'.AND.operm)THEN
994  CALL permafrost_depth(kni,kpatch,i%XPERM,zdtot)
995 ENDIF
996 !
997 !IN BOTH CASES, ROOT_DEPTH IS NEEDED: PUT IN DG2
998 IF (hisba=='DIF' .OR. .NOT.gdata_dg) THEN
999  !
1000  gnoeco=(gdata_root_depth .AND. .NOT.gdata_rootfrac)
1001  IF (gnoeco) THEN
1002  !ROOT_DEPTH IN NAMELIST
1003  CALL av_pgd_param(dti, &
1004  zdg2(:,:),dti%XPAR_VEGTYPE,dti%XPAR_ROOT_DEPTH(:,:),ynat,cdgavg)
1005  !Error Due to machine precision
1006  WHERE(zdg2(:,:)/=xundef)
1007  zdg2(:,:)=int(zdg2(:,:)*zprec)/zprec
1008  ENDWHERE
1009  !CONSISTENCY CHECKS
1010  IF (dti%LDATA_DG) zdg2(:,:) = min(zdg2(:,:),pdg(:,kground,:))
1011  zdtot(:,:) = max(zdg2(:,:),zdtot(:,:))
1012  IF (hisba=='DIF') THEN
1013  CALL av_pgd_param(dti, &
1014  pdroot(:,:),dti%XPAR_VEGTYPE,dti%XPAR_ROOT_DEPTH(:,:),ydif,cdgavg)
1015  !error due to machine precision
1016  WHERE(pdroot(:,:)/=xundef)
1017  pdroot(:,:)=int(pdroot(:,:)*zprec)/zprec
1018  ENDWHERE
1019  IF(cdgdif=='ROOT')THEN
1020  WHERE(pdroot(:,:).NE.xundef) zdtot(:,:) = max(pdroot(:,:),zdtot(:,:))
1021  WHERE(pdroot(:,:).NE.xundef) zdg2(:,:) = max(pdroot(:,:),zdg2(:,:))
1022  ELSE
1023  CALL av_pgd(dtco, &
1024  zdg2(:,:),pcover,xdata_root_depth(:,:),ynat,cdgavg,ocover,kdecade=kdecade)
1025  ENDIF
1026  !consistency checks
1027  IF (gdata_dg) WHERE (pdroot(:,:).NE.xundef) pdroot(:,:) = min(pdroot(:,:),pdg(:,kground,:))
1028  ENDIF
1029  ELSE
1030  !ROOT_DEPTH FROM ECOCLIMAP
1031  IF (hisba=='DIF')THEN
1032  CALL av_pgd(dtco, &
1033  pdroot(:,:),pcover,xdata_root_depth(:,:),ydif,cdgavg,ocover,kdecade=kdecade)
1034  IF(cdgdif=='ROOT')THEN
1035  WHERE(pdroot(:,:).NE.xundef) zdtot(:,:) = max(pdroot(:,:),zdtot(:,:))
1036  WHERE(pdroot(:,:).NE.xundef) zdg2(:,:) = max(pdroot(:,:),zdg2(:,:))
1037  ELSE
1038  CALL av_pgd(dtco, &
1039  zdg2(:,:),pcover,xdata_root_depth(:,:),ynat,cdgavg,ocover,kdecade=kdecade)
1040  ENDIF
1041  ELSE
1042  CALL av_pgd(dtco, &
1043  zdg2(:,:),pcover,xdata_root_depth(:,:),ynat,cdgavg,ocover,kdecade=kdecade)
1044  ENDIF
1045  IF ( gdata_ground_depth .OR. gdata_dg ) THEN
1046  zdg2(:,:) = min(zdg2(:,:),zdtot(:,:))
1047  IF (hisba=='DIF') WHERE (pdroot(:,:).NE.xundef) pdroot(:,:) = min(pdroot(:,:),zdtot(:,:))
1048  ENDIF
1049  ENDIF
1050  !
1051  !CALCULATION OF DG IF NOT IN NAMELIST
1052  IF (.NOT.gdata_dg) THEN
1053  !
1054  IF (hisba=='DIF') THEN
1055  IF( maxval(zdtot,zdtot/=xundef)>psoilgrid(kground) ) THEN
1056  CALL abor1_sfx('CONVERT_PATCH_ISBA: not enough soil layer with optimized grid')
1057  ENDIF
1058  ENDIF
1059  !
1060  WHERE(zdg2(:,:)==xundef.AND.zdtot(:,:)/=xundef) zdg2(:,:)=0.0 !No vegetation
1061  !
1062  !IF CISBA=DIF CALCULATES ALSO KWG_LAYER WITH USE OF SOILGRID $
1063  CALL ini_data_soil(hisba, pdg,prootdepth=zdg2, psoildepth=zdtot,&
1064  psoilgrid=psoilgrid, kwg_layer=iwg_layer )
1065  IF (hisba=='DIF'.AND.cdgdif=='ROOT')THEN
1066  DO jpatch=1,kpatch
1067  DO jj=1,kni
1068  IF(operm.AND.iwg_layer(jj,jpatch)/=nundef)THEN
1069  IF(i%XPERM(jj)<xpermfrac) zdg2(jj,jpatch)=pdg(jj,iwg_layer(jj,jpatch),jpatch)
1070  ELSEIF(iwg_layer(jj,jpatch)/=nundef)THEN
1071  zdg2(jj,jpatch)=pdg(jj,iwg_layer(jj,jpatch),jpatch)
1072  ELSE
1073  zdg2(jj,jpatch)=xundef
1074  ENDIF
1075  ENDDO
1076  ENDDO
1077  ENDIF
1078 
1079  !
1080  ELSEIF ( hisba=='DIF') THEN
1081  !
1082  !CALCULATION OF KWG_LAYER IF DG IN NAMELIST
1083  IF(gdata_ground_depth)THEN
1084  DO jpatch=1,kpatch
1085  DO jj=1,kni
1086  DO jl=1,kground
1087  IF( pdg(jj,jl,jpatch) <= zdtot(jj,jpatch) .AND. zdtot(jj,jpatch) < xundef ) &
1088  iwg_layer(jj,jpatch) = jl
1089  ENDDO
1090  ENDDO
1091  ENDDO
1092  ELSE
1093  iwg_layer(:,:) = kground
1094  ENDIF
1095  !
1096  ENDIF
1097  !
1098  ! DROOT AND DG2 LIMITED BY KWG_LAYER
1099  IF (hisba=='DIF' .AND. .NOT.dti%LDATA_ROOTFRAC) THEN
1100  !
1101  DO jpatch=1,kpatch
1102  DO jj=1,kni
1103  IF(iwg_layer(jj,jpatch)/=nundef) THEN
1104  jl = iwg_layer(jj,jpatch)
1105  zdg2(jj,jpatch)=min(zdg2(jj,jpatch),pdg(jj,jl,jpatch))
1106  IF (pdroot(jj,jpatch)/=xundef) pdroot(jj,jpatch)=min(pdroot(jj,jpatch),pdg(jj,jl,jpatch))
1107  ENDIF
1108  ENDDO
1109  ENDDO
1110  !
1111  ENDIF
1112  !
1113 ENDIF
1114 !
1115 !CALCULATION OF ROOTFRAC
1116 IF (hisba=='DIF') THEN
1117  !
1118  IF ( (gdata_rootfrac .OR. gdata_rootfracgv) .AND. (ldg2 .OR. ldroot .OR. lrootfrac .OR. lrootfracgv)) THEN
1119  !
1120  !ROOTFRACGV IN NAMELIST
1121  IF(lrootfracgv)THEN
1122  DO jl=1,kground
1123  CALL av_pgd_param(dti, &
1124  prootfracgv(:,jl,:),dti%XPAR_VEGTYPE,dti%XPAR_ROOTFRACGV(:,jl,:),ynat,'ARI')
1125  ENDDO
1126  ENDIF
1127  !
1128  !ROOTFRAC IN NAMELIST
1129  DO jl=1,kground
1130  CALL av_pgd_param(dti, &
1131  zrootfrac(:,jl,:),dti%XPAR_VEGTYPE,dti%XPAR_ROOTFRAC(:,jl,:),ynat,'ARI',kdecade=kdecade)
1132  ENDDO
1133  IF (lrootfrac) prootfrac(:,:,:) = zrootfrac(:,:,:)
1134  !
1135  zdg2(:,:)=0.0
1136  pdroot(:,:)=0.0
1137  DO jpatch=1,kpatch
1138  DO jj=1,kni
1139  !
1140  !DROOT DEPENDS ON ROOTFRAC
1141  DO jl=kground,1,-1
1142  IF( zrootfrac(jj,jl,jpatch)>=1.0 )THEN
1143  zdg2(jj,jpatch) = pdg(jj,jl,jpatch)
1144  pdroot(jj,jpatch) = pdg(jj,jl,jpatch)
1145  ELSEIF (jl<kground.AND.zrootfrac(jj,jl,jpatch)>0.0) THEN
1146  IF (iwg_layer(jj,jpatch)<=jl) iwg_layer(jj,jpatch) = jl+1
1147  EXIT
1148  ENDIF
1149  ENDDO
1150  !
1151  IF(pdroot(jj,jpatch)==0.0.AND.zdg2(jj,jpatch)==0.0)THEN
1152  jl=iwg_layer(jj,jpatch)
1153  zdg2(jj,jpatch)=min(0.6,pdg(jj,jl,jpatch))
1154  ENDIF
1155  !
1156  ENDDO
1157  ENDDO
1158  !
1159  ELSEIF (lrootfrac .OR. lrootfracgv) THEN
1160  !
1161  !DEPENDS ON DROOT
1162  IF (gdata .AND. dti%LDATA_ROOT_LIN) THEN
1163  CALL av_pgd_param(dti, &
1164  zroot_lin(:,:),dti%XPAR_VEGTYPE,dti%XPAR_ROOT_LIN(:,:),ydif,'ARI')
1165  ELSE
1166  CALL av_pgd(dtco, &
1167  zroot_lin(:,:),pcover,xdata_root_lin(:,:),ydif,'ARI',ocover,kdecade=kdecade)
1168  ENDIF
1169  !
1170  IF(lrootfrac)THEN
1171  IF (gdata .AND. dti%LDATA_ROOT_EXTINCTION) THEN
1172  CALL av_pgd_param(dti, &
1173  zroot_ext(:,:),dti%XPAR_VEGTYPE,dti%XPAR_ROOT_EXTINCTION(:,:),ydif,'ARI')
1174  ELSE
1175  CALL av_pgd(dtco, &
1176  zroot_ext(:,:),pcover,xdata_root_extinction(:,:),ydif,'ARI',ocover,kdecade=kdecade)
1177  ENDIF
1178  !
1179  CALL ini_data_rootfrac(pdg,pdroot,zroot_ext,zroot_lin,prootfrac)
1180  ENDIF
1181  IF(lrootfracgv)THEN
1182  IF (gdata .AND. dti%LDATA_ROOT_EXTINCTIONGV) THEN
1183  CALL av_pgd_param(dti, &
1184  zroot_ext(:,:),dti%XPAR_VEGTYPE,dti%XPAR_ROOT_EXTINCTIONGV(:,:),ydif,'ARI')
1185  ELSE
1186  CALL av_pgd(dtco, &
1187  zroot_ext(:,:),pcover,xdata_root_extinctiongv(:,:),ydif,'ARI',ocover,kdecade=kdecade)
1188  ENDIF
1189  !
1190  CALL ini_data_rootfrac(pdg,pdroot,zroot_ext,zroot_lin, &
1191  prootfracgv,ogv=lrootfracgv)
1192  !
1193  ENDIF
1194  !
1195  ENDIF
1196  !
1197  IF (ldg2) pdg2(:,:) = zdg2(:,:)
1198  IF (lwg_layer) kwg_layer(:,:) = iwg_layer(:,:)
1199  !
1200 ENDIF
1201 !
1202 IF (lhook) CALL dr_hook('CONVERT_PATCH_ISBA:SET_GRID_PARAM',1,zhook_handle)
1203 !
1204 END SUBROUTINE set_grid_param
1205 !
1206 !-------------------------------------------------------------------------------
1207 END SUBROUTINE convert_patch_isba
modd_isba_par
Definition: modd_isba_par.F90:6
modd_treedrag
Definition: modd_treedrag.F90:7
modd_isba_n
Definition: modd_isban.F90:6
permafrost_depth
subroutine permafrost_depth(KNI, KPATCH, PPERM, PSOILDEPTH)
Definition: permafrost_depth.F90:6
ini_data_rootfrac
subroutine ini_data_rootfrac(PDG, PROOTDEPTH, PROOT_EXT, PROOT_LIN, PROOTFRAC, OGV)
Definition: ini_data_rootfrac.F90:6
modd_data_cover_n
Definition: modd_data_covern.F90:6
av_pgd_param
subroutine av_pgd_param(DTI, PFIELD, PVEGTYPE, PDATA, HSFTYPE, HATYPE, PDZ, KDECADE)
Definition: av_pgd_param.F90:6
modd_data_cover_par
Definition: modd_data_cover_par.F90:6
modi_av_pgd::av_pgd
Definition: av_pgd.F90:8
ini_data_soil
subroutine ini_data_soil(HISBA, PDG_OUT, PSURF, PSURF2, PROOTDEPTH, PSOILDEPTH, PSOILGRID, KWG_LAYER)
Definition: ini_data_soil.F90:6
modi_soil_albedo
Definition: soil_albedo.F90:6
abor1_sfx
subroutine abor1_sfx(YTEXT)
Definition: abor1_sfx.F90:6
modd_data_isba_n
Definition: modd_data_isban.F90:6
modi_av_pgd
Definition: av_pgd.F90:6
modd_data_isba_n::data_isba_t
Definition: modd_data_isban.F90:42
modd_data_cover
Definition: modd_data_cover.F90:6
modd_type_date_surf::date_time
Definition: modd_type_date_surf.F90:46
modd_data_cover_n::data_cover_t
Definition: modd_data_covern.F90:43
modd_surf_par
Definition: modd_surf_par.F90:6
set_stress
subroutine set_stress(KSIZE1, KSIZE2)
Definition: convert_patch_isba.F90:837
modd_type_date_surf
Definition: modd_type_date_surf.F90:6
set_grid_param
subroutine set_grid_param(KNI, KGROUND, KPATCH, LDG2, LDROOT, LWG_LAYER, LROOTFRAC, LROOTFRACGV)
Definition: convert_patch_isba.F90:872
modi_soil_albedo::soil_albedo
Definition: soil_albedo.F90:9
modd_reprod_oper
Definition: modd_reprod_oper.F90:6
convert_patch_isba
subroutine convert_patch_isba(DTCO, DTI, I, HISBA, KDECADE, KDECADE2, PCOVER, OCOVER, HPHOTO, OAGRIP, OPERM, OTR_ML, HSFTYPE, PVEG, PLAI, PRSMIN, PGAMMA, PWRMAX_CF, PRGL, PCV, PSOILGRID, PDG, KWG_LAYER, PDROOT, PDG2, PZ0, PZ0_O_Z0H, PALBNIR_VEG, PALBVIS_VEG, PALBUV_VEG, PEMIS_ECO, PVEGTYPE, PROOTFRAC, PGMES, PBSLAI, PLAIMIN, PSEFOLD, PGC, PDMAX, PF2I, OSTRESS, PH_TREE, PRE25, PCE_NITRO, PCF_NITRO, PCNA_NITRO, PD_ICE, PWG1, PALBNIR_SOIL, PALBVIS_SOIL, PALBUV_SOIL, TPSEED, TPREAP, PWATSUP, PIRRIG, PGNDLITTER, PRGLGV, PGAMMAGV, PRSMINGV, PROOTFRACGV, PWRMAX_CFGV, PLAIGV, PZ0LITTER, PH_VEG)
Definition: convert_patch_isba.F90:6
Generated on Fri May 13 2016 09:31:01 for SURFEX by   doxygen 1.8.5