SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
convert_cover_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_cover_isba (DTCO, I, &
7  hisba,kdecade,pcover,ocover,hphoto, &
8  hsftype,pveg, &
9  plai,prsmin,pgamma,pwrmax_cf, &
10  prgl,pcv,psoilgrid,pperm, &
11  pdg,kwg_layer,pdroot,pdg2, &
12  pd_ice,pz0,pz0_o_z0h, &
13  palbnir_veg,palbvis_veg,palbuv_veg, &
14  pemis_eco, &
15  pvegtype,prootfrac, &
16  pgmes,pbslai,plaimin,psefold,pgc, &
17  pdmax, pf2i, ostress, ph_tree,pre25,&
18  pce_nitro, pcf_nitro, pcna_nitro, &
19  tpseed, tpreap, pwatsup, pirrig, &
20  pgndlitter, plaigv, prsmingv, &
21  pgammagv, &
22  pwrmax_cfgv, prglgv, prootfracgv, &
23  pz0litter, ph_veg )
24 ! ##############################################################
25 !
26 !!**** *CONVERT_COVER* convert surface cover classes into secondary
27 !! physiographic variables for ISBA
28 !!
29 !! PURPOSE
30 !! -------
31 !!
32 !! METHOD
33 !! ------
34 !!
35 !! EXTERNAL
36 !! --------
37 !!
38 !! IMPLICIT ARGUMENTS
39 !! ------------------
40 !!
41 !! REFERENCE
42 !! ---------
43 !!
44 !! AUTHOR
45 !! ------
46 !!
47 !! V. Masson Meteo-France
48 !!
49 !! MODIFICATION
50 !! ------------
51 !!
52 !! Original 01/2004
53 !!
54 !! P Le Moigne 09/2005 AGS modifs of L. Jarlan
55 !! B. Decharme 04/2013 Add CDGAVG (average depth)
56 !! Soil depth = Root depth with ISBA-DF
57 !! except for bare soil pft (but limited to 1m)
58 !! P Samuelsson 10/2014 MEB
59 !----------------------------------------------------------------------------
60 !
61 !* 0. DECLARATION
62 ! -----------
63 !
64 !
65 USE modd_data_cover_n, ONLY : data_cover_t
66 USE modd_isba_n, ONLY : isba_t
67 !
68 USE modd_data_cover, ONLY : xdata_lai, xdata_h_tree, &
69  xdata_veg, xdata_z0, xdata_z0_o_z0h, &
70  xdata_emis_eco, xdata_gamma, xdata_cv, &
71  xdata_rgl, xdata_rsmin, &
72  xdata_albnir_veg, xdata_albvis_veg, &
73  xdata_albuv_veg, xdata_dice, &
74  xdata_alb_veg_nir, xdata_alb_veg_vis, &
75  xdata_alb_soil_nir, xdata_alb_soil_vis, &
76  xdata_gmes, xdata_bslai, xdata_laimin, &
77  xdata_sefold, xdata_gc, xdata_wrmax_cf, &
78  xdata_stress, &
79  xdata_dmax, xdata_f2i, xdata_re25, &
80  xdata_ce_nitro, xdata_cf_nitro, &
81  xdata_cna_nitro, &
82  xdata_gmes_st, xdata_bslai_st, &
83  xdata_sefold_st, xdata_gc_st, &
84  xdata_dmax_st, xdata_watsup, &
85  tdata_seed, tdata_reap,xdata_irrig, &
86  xdata_root_depth, xdata_ground_depth, &
87  xdata_root_extinction, xdata_root_lin, &
88  xdata_gndlitter, &
89  xdata_rglgv, xdata_gammagv, &
90  xdata_rsmingv, xdata_wrmax_cfgv, &
91  xdata_laigv, xdata_z0litter, &
92  xdata_root_depthgv, xdata_h_veg, &
93  xdata_root_extinctiongv
94 
95 USE modd_data_cover_par, ONLY : nvegtype, jpcover, nvt_no, nvt_rock, nvt_snow
96 USE modd_type_date_surf
97 !
98 !
99 USE modi_av_pgd
100 !
101 !
102 USE yomhook ,ONLY : lhook, dr_hook
103 USE parkind1 ,ONLY : jprb
104 !
105 IMPLICIT NONE
106 !
107 !* 0.1 Declaration of arguments
108 ! ------------------------
109 !
110 !
111 TYPE(data_cover_t), INTENT(INOUT) :: dtco
112 TYPE(isba_t), INTENT(INOUT) :: i
113 !
114  CHARACTER(LEN=*), INTENT(IN) :: hisba ! type of soil (Force-Restore OR Diffusion)
115 INTEGER, INTENT(IN) :: kdecade
116 REAL, DIMENSION(:,:), INTENT(IN) :: pcover
117 LOGICAL, DIMENSION(:), INTENT(IN) :: ocover
118  CHARACTER(LEN=*), INTENT(IN) :: hphoto ! type of photosynthesis
119  CHARACTER(LEN=*), INTENT(IN) :: hsftype ! nature / garden
120 !
121 REAL, DIMENSION(:) , OPTIONAL, INTENT(IN) :: psoilgrid
122 REAL, DIMENSION(:) , OPTIONAL, INTENT(IN) :: pperm
123 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pveg
124 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: plai
125 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: prsmin
126 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pgamma
127 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pwrmax_cf
128 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: prgl
129 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pcv
130 REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: pdg
131 INTEGER, DIMENSION(:,:),OPTIONAL, INTENT(OUT) :: kwg_layer
132 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pdroot
133 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pdg2
134 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pd_ice
135 REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: prootfrac
136 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pz0
137 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pz0_o_z0h
138 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: palbnir_veg
139 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: palbvis_veg
140 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: palbuv_veg
141 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pemis_eco
142 !
143 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pgndlitter
144 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: plaigv
145 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: prsmingv
146 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pgammagv
147 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pwrmax_cfgv
148 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: prglgv
149 REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: prootfracgv
150 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pz0litter
151 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: ph_veg
152 !
153 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pvegtype
154 !
155 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pgmes
156 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pre25
157 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pbslai
158 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: plaimin
159 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: psefold
160 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pgc
161 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pdmax
162 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pf2i
163 LOGICAL, DIMENSION(:,:),OPTIONAL, INTENT(OUT) :: ostress
164 !
165 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: ph_tree
166 !
167 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pce_nitro
168 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pcf_nitro
169 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pcna_nitro
170 !
171 TYPE(date_time), DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: tpseed
172 TYPE(date_time), DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: tpreap
173 !
174 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pwatsup
175 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: pirrig
176 !
177 !* 0.2 Declaration of local variables
178 ! ------------------------------
179 ! calculation of veg from lai in the pixel
180 !
181 REAL, DIMENSION (:,:), ALLOCATABLE :: zwork ! work array
182 !
183  CHARACTER(LEN=3) :: ytree, ynat, ylai, yveg, ydif
184 !
185 INTEGER :: jlayer ! loop counter on surface layers
186 INTEGER :: jveg ! loop counter on vegetation types
187 !
188 REAL(KIND=JPRB) :: zhook_handle
189 !-------------------------------------------------------------------------------
190 !
191 !* 2. SECONDARY VARIABLES
192 ! -------------------
193 !
194 IF (lhook) CALL dr_hook('CONVERT_COVER_ISBA',0,zhook_handle)
195 !
196 IF (ASSOCIATED(dtco%XDATA_WEIGHT)) DEALLOCATE(dtco%XDATA_WEIGHT)
197 !
198 IF (hsftype=='NAT') THEN
199  ynat='NAT'
200  ytree='TRE'
201  ylai='LAI'
202  yveg='VEG'
203  ydif='DVG'
204 ELSEIF (hsftype=='GRD') THEN
205  ynat='GRD'
206  ytree='GRT'
207  ylai='GRL'
208  yveg='GRV'
209  ydif='GDV'
210 ENDIF
211 !
212 !* 2.1 fields on natural surfaces only, taking into account patches/
213 ! -------------------------------
214 !
215 !
216 ! Leaf Aera Index
217 ! ---------------
218 !
219 IF (present(plai)) THEN
220  CALL av_pgd(dtco, &
221  plai ,pcover ,xdata_lai(:,kdecade,:),yveg,'ARI',ocover,kdecade=kdecade)
222 ENDIF
223 !
224 IF (present(plaigv)) THEN
225  CALL av_pgd(dtco, &
226  plaigv ,pcover ,xdata_laigv(:,kdecade,:),yveg,'ARI',ocover,kdecade=kdecade)
227 ENDIF
228 !
229 !
230 !* 1/Rsmin
231 !
232 IF (present(prsmin)) THEN
233  IF (SIZE(prsmin)>0) &
234  CALL av_pgd(dtco, &
235  prsmin,pcover ,xdata_rsmin,ylai,'INV',ocover,kdecade=kdecade)
236 END IF
237 !
238 IF (present(prsmingv)) THEN
239  IF (SIZE(prsmingv)>0) &
240  CALL av_pgd(dtco, &
241  prsmingv,pcover ,xdata_rsmingv,ylai,'INV',ocover,kdecade=kdecade)
242 END IF
243 !
244 IF (present(ph_tree)) &
245  CALL av_pgd(dtco, &
246  ph_tree ,pcover ,xdata_h_tree(:,:) ,ytree,'ARI',ocover)
247 !
248 DO jveg=1,nvegtype
249  IF (present(pvegtype)) &
250  CALL av_pgd(dtco, &
251  pvegtype(:,jveg),pcover ,dtco%XDATA_VEGTYPE(:,jveg),ynat,'ARI',ocover)
252 END DO
253 !
254 !
255 ! vegetation fraction
256 ! -------------------
257 !
258 IF (present(pveg)) &
259  CALL av_pgd(dtco, &
260  pveg ,pcover ,xdata_veg(:,kdecade,:),ynat,'ARI',ocover)
261 !
262 !
263 IF (present(pgndlitter)) &
264  CALL av_pgd(dtco, &
265  pgndlitter ,pcover ,xdata_gndlitter(:,kdecade,:),ynat,'ARI',ocover)
266 !
267 ! roughness length
268 ! ----------------
269 !
270 IF (present(pz0)) &
271  CALL av_pgd(dtco, &
272  pz0 ,pcover ,xdata_z0(:,kdecade,:),ynat,'CDN',ocover)
273 !
274 IF (present(pz0_o_z0h)) &
275  CALL av_pgd(dtco, &
276  pz0_o_z0h ,pcover ,xdata_z0_o_z0h(:,:),ynat,'ARI',ocover)
277 !
278 IF (present(pz0litter)) &
279  CALL av_pgd(dtco, &
280  pz0litter ,pcover ,xdata_z0litter(:,kdecade,:),ynat,'CDN',ocover)
281 !
282 !emis-eco
283 !--------
284 !
285 IF (present(pemis_eco)) &
286  CALL av_pgd(dtco, &
287  pemis_eco ,pcover ,xdata_emis_eco(:,kdecade,:),ynat,'ARI',ocover)
288 !
289 !---------------------------------------------------------------------------------
290 !
291 !* other vegetation parameters
292 !
293 IF (present(pgamma)) &
294  CALL av_pgd(dtco, &
295  pgamma ,pcover ,xdata_gamma(:,:),yveg,'ARI',ocover,kdecade=kdecade)
296 IF (present(pgammagv)) &
297  CALL av_pgd(dtco, &
298  pgammagv ,pcover ,xdata_gammagv(:,:),yveg,'ARI',ocover,kdecade=kdecade)
299 IF (present(pwrmax_cf)) &
300  CALL av_pgd(dtco, &
301  pwrmax_cf ,pcover ,xdata_wrmax_cf(:,:),yveg,'ARI',ocover,kdecade=kdecade)
302 IF (present(pwrmax_cfgv)) &
303  CALL av_pgd(dtco, &
304  pwrmax_cfgv ,pcover ,xdata_wrmax_cfgv(:,:),yveg,'ARI',ocover,kdecade=kdecade)
305 !
306 !
307 IF (present(prgl)) &
308  CALL av_pgd(dtco, &
309  prgl ,pcover ,xdata_rgl(:,:),yveg,'ARI',ocover,kdecade=kdecade)
310 IF (present(prglgv)) &
311  CALL av_pgd(dtco, &
312  prglgv ,pcover ,xdata_rglgv(:,:),yveg,'ARI',ocover,kdecade=kdecade)
313 IF (present(pcv)) &
314  CALL av_pgd(dtco, &
315  pcv ,pcover ,xdata_cv(:,:),yveg,'INV',ocover,kdecade=kdecade)
316 !
317 IF (present(ph_veg)) THEN
318  CALL av_pgd(dtco, &
319  ph_veg,pcover,xdata_h_veg(:,kdecade,:),yveg,'ARI',ocover,kdecade=kdecade)
320 ENDIF
321 !
322 
323 !
324 !---------------------------------------------------------------------------------
325 !
326 !* soil layers
327 ! -----------
328 !
329 IF (present(pdg)) THEN
330 !
331 !* soil layers (and cumulative root fraction for DIF only)
332 !
333  CALL set_cover_dg(SIZE(pdg,1),SIZE(pdg,2),SIZE(pdg,3),present(pperm),&
334  present(pdg2),present(pdroot),present(kwg_layer), &
335  present(prootfrac),present(prootfracgv) )
336 !
337 END IF
338 !
339 !---------------------------------------------------------------------------------
340 !
341 !* soil ice for runoff
342 ! -------------------
343 !
344 IF (present(pd_ice)) &
345  CALL av_pgd(dtco, &
346  pd_ice,pcover ,xdata_dice(:,:),ynat,'ARI',ocover)
347 !
348 !---------------------------------------------------------------------------------
349 !
350 IF (present(palbnir_veg)) THEN
351  IF (i%CALBEDO=='CM13') THEN
352  CALL av_pgd(dtco, &
353  palbvis_veg,pcover,xdata_alb_veg_nir(:,kdecade,:),yveg,'ARI',ocover,kdecade=kdecade)
354  ELSE
355  CALL av_pgd(dtco, &
356  palbnir_veg,pcover ,xdata_albnir_veg(:,:),yveg,'ARI',ocover,kdecade=kdecade)
357  ENDIF
358 ENDIF
359 !
360 IF (present(palbvis_veg)) THEN
361  IF (i%CALBEDO=='CM13') THEN
362  CALL av_pgd(dtco, &
363  palbvis_veg,pcover,xdata_alb_veg_vis(:,kdecade,:),yveg,'ARI',ocover,kdecade=kdecade)
364  ELSE
365  CALL av_pgd(dtco, &
366  palbvis_veg,pcover ,xdata_albvis_veg(:,:),yveg,'ARI',ocover,kdecade=kdecade)
367  ENDIF
368 ENDIF
369 !
370 IF (present(palbuv_veg)) THEN
371  IF ((i%CALBEDO=='CM13'.OR.i%LTR_ML).AND.present(palbvis_veg)) THEN
372  palbuv_veg(:,:)=palbvis_veg(:,:)
373  ELSE
374  CALL av_pgd(dtco, &
375  palbuv_veg, pcover ,xdata_albuv_veg(:,:),yveg,'ARI',ocover,kdecade=kdecade)
376  ENDIF
377 ENDIF
378 !
379 ! parameters for "stress option"
380 IF (hphoto == 'AST' .OR. hphoto == 'LST' .OR. hphoto == 'NIT' .OR. hphoto == 'NCB') THEN
381 
382  IF (present(pgmes)) THEN
383  IF (SIZE(pgmes)>0) &
384  CALL av_pgd(dtco, &
385  pgmes ,pcover ,xdata_gmes_st(:,:),yveg,'ARI',ocover,kdecade=kdecade)
386  END IF
387 
388  IF (present(pbslai)) THEN
389  IF (SIZE(pbslai)>0) &
390  CALL av_pgd(dtco, &
391  pbslai ,pcover ,xdata_bslai_st(:,:),yveg,'ARI',ocover,kdecade=kdecade)
392  END IF
393 
394  IF (present(psefold)) THEN
395  IF (SIZE(psefold)>0) &
396  CALL av_pgd(dtco, &
397  psefold,pcover ,xdata_sefold_st(:,:),yveg,'ARI',ocover,kdecade=kdecade)
398  END IF
399 
400  IF (present(pgc)) THEN
401  IF (SIZE(pgc)>0) &
402  CALL av_pgd(dtco, &
403  pgc ,pcover ,xdata_gc_st(:,:),yveg,'ARI',ocover,kdecade=kdecade)
404  END IF
405 
406  IF (present(pdmax)) THEN
407  IF (SIZE(pdmax)>0) &
408  CALL av_pgd(dtco, &
409  pdmax ,pcover ,xdata_dmax_st(:,:),ytree,'ARI',ocover,kdecade=kdecade)
410  END IF
411 
412 ELSE
413  IF (present(pgmes)) THEN
414  IF (SIZE(pgmes)>0) &
415  CALL av_pgd(dtco, &
416  pgmes ,pcover ,xdata_gmes(:,:),yveg,'ARI',ocover,kdecade=kdecade)
417  END IF
418  IF (present(pbslai)) THEN
419  IF (SIZE(pbslai)>0) &
420  CALL av_pgd(dtco, &
421  pbslai ,pcover ,xdata_bslai(:,:),yveg,'ARI',ocover,kdecade=kdecade)
422  END IF
423  IF (present(psefold)) THEN
424  IF (SIZE(psefold)>0) &
425  CALL av_pgd(dtco, &
426  psefold,pcover ,xdata_sefold(:,:),yveg,'ARI',ocover,kdecade=kdecade)
427  END IF
428  IF (present(pgc)) THEN
429  IF (SIZE(pgc)>0) &
430  CALL av_pgd(dtco, &
431  pgc ,pcover ,xdata_gc(:,:),yveg,'ARI',ocover,kdecade=kdecade)
432  END IF
433  IF (present(pdmax)) THEN
434  IF (SIZE(pdmax)>0) &
435  CALL av_pgd(dtco, &
436  pdmax ,pcover ,xdata_dmax(:,:),ytree,'ARI',ocover,kdecade=kdecade)
437  END IF
438 
439 ENDIF
440 
441 IF (present(pre25)) THEN
442  IF (SIZE(pre25)>0) &
443  CALL av_pgd(dtco, &
444  pre25 ,pcover ,xdata_re25(:,:),ynat,'ARI',ocover,kdecade=kdecade)
445 END IF
446 
447 IF (present(plaimin)) THEN
448  IF (SIZE(plaimin)>0) &
449  CALL av_pgd(dtco, &
450  plaimin,pcover ,xdata_laimin(:,:),yveg,'ARI',ocover,kdecade=kdecade)
451 END IF
452 IF (present(pce_nitro)) THEN
453  IF (SIZE(pce_nitro)>0) &
454  CALL av_pgd(dtco, &
455  pce_nitro ,pcover ,xdata_ce_nitro(:,:),yveg,'ARI',ocover,kdecade=kdecade)
456 END IF
457 IF (present(pcf_nitro)) THEN
458  IF (SIZE(pcf_nitro)>0) &
459  CALL av_pgd(dtco, &
460  pcf_nitro ,pcover ,xdata_cf_nitro(:,:),yveg,'ARI',ocover,kdecade=kdecade)
461 END IF
462 IF (present(pcna_nitro)) THEN
463  IF (SIZE(pcna_nitro)>0) &
464  CALL av_pgd(dtco, &
465  pcna_nitro ,pcover ,xdata_cna_nitro(:,:),yveg,'ARI',ocover,kdecade=kdecade)
466 END IF
467 IF (present(pf2i)) THEN
468  IF (SIZE(pf2i)>0) &
469  CALL av_pgd(dtco, &
470  pf2i ,pcover ,xdata_f2i(:,:),yveg,'ARI',ocover,kdecade=kdecade)
471 END IF
472 !
473 IF (present(ostress)) THEN
474  IF (SIZE(ostress)>0) THEN
475  ALLOCATE(zwork(SIZE(ostress,1),SIZE(ostress,2)))
476  CALL av_pgd(dtco, &
477  zwork,pcover ,xdata_stress(:,:),yveg,'ARI',ocover,kdecade=kdecade)
478  WHERE (zwork<0.5)
479  ostress = .false.
480  ELSEWHERE
481  ostress = .true.
482  END WHERE
483  DEALLOCATE(zwork)
484  END IF
485 END IF
486 !
487 IF (hphoto == 'LAI' .OR. hphoto == 'LST' .OR. hphoto == 'NIT') THEN
488  !
489  ! date of seeding
490  ! ---------------
491  !
492  IF (present(tpseed)) THEN
493  IF (SIZE(tpseed)>0) &
494  CALL av_pgd(tpseed ,pcover ,tdata_seed(:,:),yveg,'MAJ',ocover,kdecade=kdecade)
495  END IF
496  !
497  ! date of reaping
498  ! ---------------
499  !
500  IF (present(tpreap)) THEN
501  IF (SIZE(tpreap)>0) &
502  CALL av_pgd(tpreap ,pcover ,tdata_reap(:,:),yveg,'MAJ',ocover,kdecade=kdecade)
503  END IF
504  !
505  ! fraction of irrigated surface
506  ! ---------------------------
507  !
508  IF (present(pirrig)) THEN
509  IF (SIZE(pirrig)>0) &
510  CALL av_pgd(dtco, &
511  pirrig ,pcover ,xdata_irrig(:,:),yveg,'ARI',ocover,kdecade=kdecade)
512  END IF
513  !
514  ! water supply for irrigation
515  ! ---------------------------
516  !
517  IF (present(pwatsup)) THEN
518  IF (SIZE(pwatsup)>0) &
519  CALL av_pgd(dtco, &
520  pwatsup ,pcover ,xdata_watsup(:,:),yveg,'ARI',ocover,kdecade=kdecade)
521  END IF
522 !
523 END IF
524 !
525 IF (ASSOCIATED(dtco%XDATA_WEIGHT)) DEALLOCATE(dtco%XDATA_WEIGHT)
526 !
527 IF (lhook) CALL dr_hook('CONVERT_COVER_ISBA',1,zhook_handle)
528 !
529 !-------------------------------------------------------------------------------
530  CONTAINS
531 !-------------------------------------------------------------------------------
532 !
533 SUBROUTINE set_cover_dg(KNI,KGROUND,KPATCH,LPERM,LDG2,LDROOT,LWG_LAYER,LROOTFRAC, &
534  lrootfracgv )
535 !
536 USE modd_surf_par, ONLY : xundef, nundef
537 !
538 USE modd_reprod_oper, ONLY : cdgavg, cdgdif
539 !
540 USE modi_ini_data_rootfrac
541 USE modi_ini_data_soil
542 USE modi_permafrost_depth
543 !
544 IMPLICIT NONE
545 !
546 INTEGER, INTENT(IN) :: kni
547 INTEGER, INTENT(IN) :: kground
548 INTEGER, INTENT(IN) :: kpatch
549 LOGICAL, INTENT(IN) :: lperm
550 LOGICAL, INTENT(IN) :: ldg2
551 LOGICAL, INTENT(IN) :: ldroot
552 LOGICAL, INTENT(IN) :: lwg_layer
553 LOGICAL, INTENT(IN) :: lrootfrac
554 LOGICAL, INTENT(IN) :: lrootfracgv
555 !
556 REAL, DIMENSION (SIZE(XDATA_GROUND_DEPTH,1),SIZE(XDATA_GROUND_DEPTH,2)) :: zdata_ground_depth
557 REAL, DIMENSION (SIZE(XDATA_ROOT_DEPTH ,1),3,SIZE(XDATA_ROOT_DEPTH,2)) :: zdata_dg
558 !
559 INTEGER, DIMENSION (KNI,KPATCH) :: iwg_layer
560 REAL, DIMENSION (KNI,KPATCH) :: zdtot, zdroot ! work array
561 REAL, DIMENSION (KNI,KPATCH) :: zroot_ext ! "
562 REAL, DIMENSION (KNI,KPATCH) :: zroot_lin ! "
563 !
564 INTEGER :: jpatch, jj, jvegtype
565 !
566 REAL(KIND=JPRB) :: zhook_handle
567 !
568 IF (lhook) CALL dr_hook('CONVERT_COVER_ISBA:SET_COVER_DG',0,zhook_handle)
569 !
570 zdtot(:,:) = xundef
571 zdroot(:,:) = xundef
572 zroot_ext(:,:) = xundef
573 zroot_lin(:,:) = xundef
574 iwg_layer(:,:) = nundef
575 !
576 zdata_ground_depth(:,:) = xdata_ground_depth(:,:)
577 !
578 !####################################################################################
579 !
580 !CDGAVG : old for reprod = 'ARI' Arithmetic average for all depth
581 ! recommended = 'INV' Harmonic average for all depth (default)
582 !
583 !CDGDIF : old for reprod = 'SOIL' d3 soil depth from ecoclimap for isba-df
584 ! recommended = 'ROOT' d2 soil depth from ecoclimap for isba-df (default)
585 !
586 !####################################################################################
587 !
588 IF(hisba/='DIF')THEN
589  !
590  CALL ini_data_soil(hisba, zdata_dg, &
591  psurf = dtco%XDATA_NATURE, &
592  psurf2 = dtco%XDATA_GARDEN, &
593  prootdepth = xdata_root_depth, &
594  psoildepth = xdata_ground_depth )
595  !
596  DO jlayer=1,kground
597  CALL av_pgd(dtco, &
598  pdg(:,jlayer,:),pcover,zdata_dg(:,jlayer,:),ynat,'ARI',ocover,kdecade=kdecade)
599  ENDDO
600  !
601 ELSE
602 !
603  IF(cdgdif=='ROOT')THEN
604  DO jvegtype=1,nvegtype
605  IF(jvegtype==nvt_no)THEN
606  WHERE(xdata_ground_depth(:,jvegtype)/=xundef)
607  zdata_ground_depth(:,jvegtype) = min(1.0,xdata_ground_depth(:,jvegtype))
608  ENDWHERE
609  ELSEIF(jvegtype/=nvt_rock.AND.jvegtype/=nvt_snow)THEN
610  zdata_ground_depth(:,jvegtype) = max(1.0,xdata_root_depth(:,jvegtype))
611  ELSE
612  zdata_ground_depth(:,jvegtype) = xdata_root_depth(:,jvegtype)
613  ENDIF
614  ENDDO
615  ENDIF
616 !
617  CALL av_pgd(dtco, &
618  zdtot(:,:),pcover,zdata_ground_depth,ynat,cdgavg,ocover,kdecade=kdecade)
619 !
620 ! CALCULATION OF GROUND_DEPTH over Permafrost area
621  IF(lperm)THEN
622  CALL permafrost_depth(kni,kpatch,pperm,zdtot)
623  ENDIF
624 !
625  IF (ldg2) THEN
626  IF(cdgdif=='ROOT')THEN
627  CALL av_pgd(dtco, &
628  pdg2(:,:),pcover,zdata_ground_depth,ynat,cdgavg,ocover)
629  ELSE
630  CALL av_pgd(dtco, &
631  pdg2(:,:),pcover,xdata_root_depth,ynat,cdgavg,ocover)
632  ENDIF
633  ENDIF
634  IF (ldroot .OR. lrootfrac .OR. lrootfracgv .OR. (cdgdif=='ROOT')) THEN
635  CALL av_pgd(dtco, &
636  zdroot(:,:),pcover,xdata_root_depth,ydif,cdgavg,ocover,kdecade=kdecade)
637  IF (ldroot) pdroot(:,:) = zdroot(:,:)
638  IF (cdgdif=='ROOT') WHERE(zdroot(:,:).NE.xundef) zdtot(:,:) = max(zdroot(:,:),zdtot(:,:))
639  ENDIF
640 !
641  CALL ini_data_soil(hisba, pdg, psoildepth=zdtot, psoilgrid=psoilgrid, &
642  kwg_layer=iwg_layer )
643  IF (lwg_layer) kwg_layer(:,:) = iwg_layer(:,:)
644 !
645  IF (lrootfrac .OR. lrootfracgv) THEN
646 !
647  CALL av_pgd(dtco, &
648  zroot_lin(:,:),pcover,xdata_root_lin(:,:),ydif,'ARI',ocover,kdecade=kdecade)
649  IF (lrootfrac) THEN
650  CALL av_pgd(dtco, &
651  zroot_ext(:,:),pcover,xdata_root_extinction(:,:),ydif,'ARI',ocover,kdecade=kdecade)
652  CALL ini_data_rootfrac(pdg,pdroot,zroot_ext,zroot_lin,prootfrac)
653  ENDIF
654  IF (lrootfracgv) THEN
655  CALL av_pgd(dtco, &
656  zroot_ext(:,:),pcover,xdata_root_extinctiongv(:,:),ydif,'ARI',ocover,kdecade=kdecade)
657  CALL ini_data_rootfrac(pdg,pdroot,zroot_ext,zroot_lin, &
658  prootfracgv,ogv=lrootfracgv)
659  ENDIF
660 !
661  ENDIF
662 !
663 ENDIF
664 !
665 IF (lhook) CALL dr_hook('CONVERT_COVER_ISBA:SET_COVER_DG',1,zhook_handle)
666 END SUBROUTINE set_cover_dg
667 !
668 !-------------------------------------------------------------------------------
669 !
670 END SUBROUTINE convert_cover_isba
modd_isba_n
Definition: modd_isban.F90:6
permafrost_depth
subroutine permafrost_depth(KNI, KPATCH, PPERM, PSOILDEPTH)
Definition: permafrost_depth.F90:6
set_cover_dg
subroutine set_cover_dg(KNI, KGROUND, KPATCH, LPERM, LDG2, LDROOT, LWG_LAYER, LROOTFRAC, LROOTFRACGV)
Definition: convert_cover_isba.F90:533
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
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_av_pgd
Definition: av_pgd.F90:6
convert_cover_isba
subroutine convert_cover_isba(DTCO, I, HISBA, KDECADE, PCOVER, OCOVER, HPHOTO, HSFTYPE, PVEG, PLAI, PRSMIN, PGAMMA, PWRMAX_CF, PRGL, PCV, PSOILGRID, PPERM, PDG, KWG_LAYER, PDROOT, PDG2, PD_ICE, 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, TPSEED, TPREAP, PWATSUP, PIRRIG, PGNDLITTER, PLAIGV, PRSMINGV, PGAMMAGV, PWRMAX_CFGV, PRGLGV, PROOTFRACGV, PZ0LITTER, PH_VEG)
Definition: convert_cover_isba.F90:6
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
modd_type_date_surf
Definition: modd_type_date_surf.F90:6
modd_reprod_oper
Definition: modd_reprod_oper.F90:6
Generated on Fri May 13 2016 09:31:01 for SURFEX by   doxygen 1.8.5