SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
pgd_isba_par.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 pgd_isba_par (DTCO, DGU, UG, U, USS, DTI, I, IG, &
7  hprogram)
8 ! ##############################################################
9 !
10 !!**** *PGD_ISBA_PAR* monitor for averaging and interpolations of cover fractions
11 !!
12 !! PURPOSE
13 !! -------
14 !!
15 !! METHOD
16 !! ------
17 !!
18 !
19 !! EXTERNAL
20 !! --------
21 !!
22 !! IMPLICIT ARGUMENTS
23 !! ------------------
24 !!
25 !! REFERENCE
26 !! ---------
27 !!
28 !! AUTHOR
29 !! ------
30 !!
31 !! V. Masson Meteo-France
32 !!
33 !! MODIFICATION
34 !! ------------
35 !!
36 !! Original 10/12/97
37 !!
38 !! Modified 08/12/05, P. Le Moigne: user defined fields
39 !! 05/2012 R. Alkama : 19 vegtypes rather than 12
40 !! Modified 02/2012, P. Samuelsson: MEB
41 !!
42 !----------------------------------------------------------------------------
43 !
44 !* 0. DECLARATION
45 ! -----------
46 !
47 !
48 !
49 USE modd_data_cover_n, ONLY : data_cover_t
50 USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
51 USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
52 USE modd_surf_atm_n, ONLY : surf_atm_t
53 USE modd_surf_atm_sso_n, ONLY : surf_atm_sso_t
54 USE modd_data_isba_n, ONLY : data_isba_t
55 USE modd_isba_n, ONLY : isba_t
56 USE modd_isba_grid_n, ONLY : isba_grid_t
57 !
58 !
59 USE modd_data_cover_par, ONLY : nvegtype
60 USE modd_surf_par, ONLY : xundef
61 !
62 USE modi_get_luout
63 USE modi_open_namelist
64 USE modi_close_namelist
65 USE modi_ini_var_from_data
66 USE modi_extrapol_fields
67 !
68 USE mode_pos_surf
69 !
70 !
71 USE yomhook ,ONLY : lhook, dr_hook
72 USE parkind1 ,ONLY : jprb
73 !
74 USE modi_abor1_sfx
75 !
76 IMPLICIT NONE
77 !
78 !* 0.1 Declaration of arguments
79 ! ------------------------
80 !
81 TYPE(data_cover_t), INTENT(INOUT) :: dtco
82 TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
83 TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
84 TYPE(surf_atm_t), INTENT(INOUT) :: u
85 TYPE(surf_atm_sso_t), INTENT(INOUT) :: uss
86 TYPE(data_isba_t), INTENT(INOUT) :: dti
87 TYPE(isba_t), INTENT(INOUT) :: i
88 TYPE(isba_grid_t), INTENT(INOUT) :: ig
89 !
90  CHARACTER(LEN=6), INTENT(IN) :: hprogram ! Type of program
91 !
92 !
93 !* 0.2 Declaration of local variables
94 ! ------------------------------
95 !
96 REAL, DIMENSION(IG%NDIM,NVEGTYPE) :: zrootfracgv,test,test2,test3
97 INTEGER :: iluout ! output listing logical unit
98 INTEGER :: ilunam ! namelist file logical unit
99 INTEGER :: ihground_layer ! Half number of NGROUND_LAYER
100 INTEGER :: iih ! Ground layer counter
101 LOGICAL :: gfound ! true if namelist is found
102 !
103 INTEGER :: jvegtype ! loop counter on patch
104 LOGICAL :: gpar_stress ! type of stress
105 !
106 INTEGER :: isize_lmeb_patch ! Number of patches with MEB=true
107 !
108 !* 0.3 Declaration of namelists
109 ! ------------------------
110 !
111 INTEGER :: ntime
112 INTEGER, PARAMETER :: ntime_max = 36
113 INTEGER, PARAMETER :: nground_max = 150
114 INTEGER, PARAMETER :: nvegtype_max = 19
115 !
116 REAL, DIMENSION(NVEGTYPE_MAX) :: xstress ! 1. if defensive /0. if offensive
117 !
118 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_vegtype ! fractions of each vegtypes
119 !
120 REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: xunif_veg ! vegetation fraction
121 REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: xunif_lai ! LAI
122 REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: xunif_z0 ! roughness length of vegetation
123 REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: xunif_emis ! emissivity
124 !
125 REAL, DIMENSION(NVEGTYPE_MAX,NGROUND_MAX) :: xunif_dg ! soil depths
126 REAL, DIMENSION(NVEGTYPE_MAX,NGROUND_MAX) :: xunif_rootfrac ! root fraction profiles
127 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_ground_depth! ground depth
128 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_root_depth ! root depth
129 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_root_extinction! root extinction parameter
130 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_root_lin ! root linear parameter
131 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_dice ! soil ice depth for runoff
132 !
133 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_rsmin ! minimal stomatal resistance
134 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_gamma ! gamma parameter
135 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_wrmax_cf ! coefficient for interception
136 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_rgl !Rgl
137 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_cv ! Cv
138 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_z0_o_z0h ! ratio of roughness lengths
139 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_albnir_veg ! albedo of vegetation (near-infra-red)
140 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_albvis_veg ! albedo of vegetation (visible)
141 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_albuv_veg ! albedo of vegetation (UV)
142 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_albnir_soil! albedo of soil (near-infra-red)
143 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_albvis_soil! albedo of soil (visible)
144 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_albuv_soil ! albedo of soil (UV)
145 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_gmes ! Gmes
146 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_bslai ! Biomass over LAI
147 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_laimin ! minimum LAI
148 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_sefold ! Sefold
149 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_gc ! Gc
150 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_dmax ! Dmax
151 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_f2i ! F2I
152 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_h_tree ! height of trees
153 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_re25 ! soil respiration parameter
154 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_ce_nitro ! CE for nitrogen
155 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_cf_nitro ! CF for nitrogen
156 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_cna_nitro ! CNA for nitrogen
157 !
158 REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: xunif_laigv
159 REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: xunif_z0litter
160 REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: xunif_gndlitter
161 REAL, DIMENSION(NVEGTYPE_MAX,NGROUND_MAX) :: xunif_rootfracgv
162 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_rsmingv
163 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_gammagv
164 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_wrmax_cfgv
165 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_rglgv
166 REAL, DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: xunif_h_veg
167 REAL, DIMENSION(NVEGTYPE_MAX) :: xunif_root_extinctiongv! root extinction parameter
168 !
169 LOGICAL, DIMENSION(NVEGTYPE_MAX) :: lunif_stress ! stress type
170 !
171 ! name of files containing data
172 !
173  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_vegtype ! fractions of each vegtypes
174 !
175  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: cfnam_veg ! vegetation fraction
176  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: cfnam_lai ! LAI
177  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: cfnam_z0 ! roughness length
178  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: cfnam_emis ! emissivity
179 !
180  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NGROUND_MAX) :: cfnam_dg ! soil depth
181  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NGROUND_MAX) :: cfnam_rootfrac ! root fraction profiles
182  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_ground_depth! ground depth
183  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_root_depth ! root depth
184  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_root_extinction! root extinction parameter
185  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_root_lin ! root linear parameter
186  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_dice ! soil ice depth for runoff (m)
187 !
188  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_rsmin ! minimal stomatal resistance
189  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_gamma ! gamma parameter
190  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_wrmax_cf ! coefficient for interception
191  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_rgl ! Rgl
192  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_cv ! Cv
193  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_z0_o_z0h ! ratio of roughness lengths
194  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_albnir_veg ! albedo of vegetation (near-infra-red)
195  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_albvis_veg ! albedo of vegetation (visible)
196  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_albuv_veg ! albedo of vegetation (UV)
197  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_albnir_soil! albedo of soil (near-infra-red)
198  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_albvis_soil! albedo of soil (visible)
199  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_albuv_soil ! albedo of soil (UV)
200  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_gmes ! Gmes
201  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_bslai ! Biomass over LAI
202  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_laimin ! minimum LAI
203  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_sefold ! e-folding time for senesence
204  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_gc ! cuticular conductance
205  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_dmax ! Dmax
206  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_f2i ! F2I
207  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_h_tree ! height of trees
208  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_re25 ! soil respiration parameter
209  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_ce_nitro ! CE for nitrogen
210  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_cf_nitro ! CF for nitrogen
211  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_cna_nitro ! CNA for nitrogen
212 !
213  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: cfnam_laigv
214  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: cfnam_z0litter
215  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: cfnam_gndlitter
216  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NGROUND_MAX) :: cfnam_rootfracgv
217  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_rsmingv
218  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_gammagv
219  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_wrmax_cfgv
220  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_rglgv
221  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: cfnam_h_veg
222  CHARACTER(LEN=28), DIMENSION(NVEGTYPE_MAX) :: cfnam_root_extinctiongv! root extinction parameter
223 !
224 ! types of file containing data
225 !
226  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_vegtype ! fractions of each vegtypes
227 !
228  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: cftyp_veg ! vegetation fraction
229  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: cftyp_lai ! LAI
230  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: cftyp_z0 ! roughness length
231  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: cftyp_emis ! emissivity
232 !
233  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NGROUND_MAX) :: cftyp_dg ! soil depth
234  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NGROUND_MAX) :: cftyp_rootfrac ! root fraction profiles
235  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_ground_depth! ground depth
236  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_root_depth ! root depth
237  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_root_extinction! root extinction parameter
238  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_root_lin ! root linear parameter
239  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_dice ! soil ice depth for runoff
240 !
241  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_rsmin ! minimal stomatal resistance
242  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_gamma ! gamma parameter
243  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_wrmax_cf ! coefficient for interception
244  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_rgl ! Rgl
245  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_cv ! Cv
246  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_z0_o_z0h ! ratio of roughness lengths
247  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_albnir_veg ! albedo of vegetation (near-infra-red)
248  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_albvis_veg ! albedo of vegetation (visible)
249  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_albuv_veg ! albedo of vegetation (UV)
250  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_albnir_soil! albedo of soil (near-infra-red)
251  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_albvis_soil! albedo of soil (visible)
252  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_albuv_soil ! albedo of soil (UV)
253  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_gmes ! Gmes
254  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_bslai ! Biomass over LAI
255  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_laimin ! minimum LAI
256  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_sefold ! e-folding time for senesence
257  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_gc ! cuticular conductance
258  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_dmax ! Dmax
259  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_f2i ! F2I
260  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_h_tree ! height of trees
261  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_re25 ! soil respiration parameter
262  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_ce_nitro ! CE for nitrogen
263  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_cf_nitro ! CF for nitrogen
264  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_cna_nitro ! CNA for nitrogen
265 !
266  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: cftyp_laigv
267  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: cftyp_z0litter
268  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: cftyp_gndlitter
269  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NGROUND_MAX) :: cftyp_rootfracgv
270  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_rsmingv
271  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_gammagv
272  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_wrmax_cfgv
273  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_rglgv
274  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX,NTIME_MAX) :: cftyp_h_veg
275  CHARACTER(LEN=6), DIMENSION(NVEGTYPE_MAX) :: cftyp_root_extinctiongv! root extinction parameter
276 !
277 REAL(KIND=JPRB) :: zhook_handle
278 !
279 namelist/nam_data_isba/ntime, xunif_vegtype, xunif_dg, xunif_rootfrac, xunif_dice, &
280  xunif_ground_depth, xunif_root_depth, xunif_root_extinction, &
281  xunif_root_lin, xunif_lai, xunif_veg, xunif_z0, xunif_emis, &
282  xunif_rsmin, xunif_gamma, xunif_wrmax_cf, xunif_rgl, &
283  xunif_cv, xunif_z0_o_z0h, &
284  xunif_albnir_veg, xunif_albvis_veg, xunif_albuv_veg, &
285  xunif_albnir_soil, xunif_albvis_soil, xunif_albuv_soil, &
286  xunif_gmes, xunif_bslai, xunif_laimin, xunif_sefold, &
287  xunif_gc, xunif_dmax, xunif_f2i, lunif_stress, xunif_h_tree, xunif_re25, &
288  xunif_ce_nitro, xunif_cf_nitro, xunif_cna_nitro, &
289  cfnam_veg,cfnam_lai,cfnam_rsmin,cfnam_gamma,cfnam_wrmax_cf, &
290  cfnam_rgl,cfnam_cv,cfnam_dg,cfnam_dice,cfnam_z0,cfnam_z0_o_z0h, &
291  cfnam_albnir_veg,cfnam_albvis_veg,cfnam_albuv_veg, &
292  cfnam_albnir_soil,cfnam_albvis_soil,cfnam_albuv_soil, &
293  cfnam_emis, &
294  cfnam_vegtype,cfnam_rootfrac, &
295  cfnam_ground_depth,cfnam_root_depth,cfnam_root_extinction,cfnam_root_lin, &
296  cfnam_gmes,cfnam_bslai,cfnam_laimin,cfnam_sefold,cfnam_gc, &
297  cfnam_dmax,cfnam_f2i, cfnam_h_tree,cfnam_re25, &
298  cfnam_ce_nitro,cfnam_cf_nitro,cfnam_cna_nitro, &
299  cftyp_veg,cftyp_lai,cftyp_rsmin,cftyp_gamma,cftyp_wrmax_cf, &
300  cftyp_rgl,cftyp_cv,cftyp_dg,cftyp_dice,cftyp_z0,cftyp_z0_o_z0h, &
301  cftyp_albnir_veg,cftyp_albvis_veg,cftyp_albuv_veg, &
302  cftyp_albnir_soil,cftyp_albvis_soil,cftyp_albuv_soil, &
303  cftyp_emis, &
304  cftyp_vegtype,cftyp_rootfrac, &
305  cftyp_ground_depth,cftyp_root_depth,cftyp_root_extinction,cftyp_root_lin, &
306  cftyp_gmes,cftyp_bslai,cftyp_laimin,cftyp_sefold,cftyp_gc, &
307  cftyp_dmax,cftyp_f2i, cftyp_h_tree,cftyp_re25, &
308  cftyp_ce_nitro,cftyp_cf_nitro,cftyp_cna_nitro, &
309  xunif_laigv, xunif_z0litter, xunif_rootfracgv, xunif_gndlitter, xunif_rsmingv, &
310  xunif_gammagv, xunif_wrmax_cfgv, xunif_rglgv, &
311  xunif_h_veg, xunif_root_extinctiongv, &
312  cfnam_laigv, cfnam_z0litter, cfnam_rootfracgv, cfnam_gndlitter, cfnam_rsmingv, &
313  cfnam_gammagv, cfnam_wrmax_cfgv, cfnam_rglgv, &
314  cfnam_h_veg, cfnam_root_extinctiongv, &
315  cftyp_laigv, cftyp_z0litter, cftyp_rootfracgv, cftyp_gndlitter, cftyp_rsmingv, &
316  cftyp_gammagv, cftyp_wrmax_cfgv, cftyp_rglgv, &
317  cftyp_h_veg, cftyp_root_extinctiongv
318 
319 DATA xstress /1.,1.,1.,0.,1.,0.,1.,0.,1.,0.,0.,0.,0.,0.,1.,0.,1.,0.,0./
320 !-------------------------------------------------------------------------------
321 !
322 !* 1. Initializations
323 ! ---------------
324 !
325 IF (lhook) CALL dr_hook('PGD_ISBA_PAR',0,zhook_handle)
326 ntime = 36
327 xunif_veg = xundef ! vegetation fraction
328 xunif_lai = xundef ! LAI
329 xunif_rsmin = xundef ! minimal stomatal resistance
330 xunif_gamma = xundef ! gamma parameter
331 xunif_wrmax_cf = xundef ! coefficient for interception
332 xunif_rgl = xundef ! Rgl
333 xunif_cv = xundef ! Cv
334 xunif_dg = xundef ! soil depths
335 xunif_dice = xundef ! soil ice depths for runoff
336 xunif_z0 = xundef ! roughness length of vegetation
337 xunif_z0_o_z0h = xundef ! ratio of roughness lengths
338 xunif_albnir_veg = xundef ! albedo of vegetation (near-infra-red)
339 xunif_albvis_veg = xundef ! albedo of vegetation (visible)
340 xunif_albuv_veg = xundef ! albedo of vegetation (UV)
341 xunif_albnir_soil = xundef ! albedo of soil (near-infra-red)
342 xunif_albvis_soil = xundef ! albedo of soil (visible)
343 xunif_albuv_soil = xundef ! albedo of soil (UV)
344 xunif_emis = xundef ! emissivity of vegetation
345 xunif_vegtype = xundef ! fractions of each vegtypes
346 xunif_rootfrac = xundef ! root fraction profiles
347 xunif_ground_depth = xundef ! ground depth
348 xunif_root_depth = xundef ! root depth
349 xunif_root_extinction = xundef ! root extinction parameter
350 xunif_root_lin = xundef ! root linear parameter
351 xunif_gmes = xundef ! Gmes
352 xunif_bslai = xundef ! Biomass over LAI
353 xunif_laimin = xundef ! minimum LAI
354 xunif_sefold = xundef ! Sefold
355 xunif_gc = xundef ! Gc
356 xunif_dmax = xundef ! Dmax
357 xunif_f2i = xundef ! F2I
358 lunif_stress = .true.! stress type
359 xunif_h_tree = xundef ! height of trees
360 xunif_re25 = xundef ! soil respiration parameter
361 xunif_ce_nitro = xundef ! CE for nitrogen
362 xunif_cf_nitro = xundef ! CF for nitrogen
363 xunif_cna_nitro = xundef ! CNA for nitrogen
364 !
365 xunif_laigv = xundef
366 xunif_z0litter = xundef
367 xunif_rootfracgv = xundef
368 xunif_gndlitter = xundef
369 xunif_rsmingv = xundef
370 xunif_gammagv = xundef
371 xunif_wrmax_cfgv = xundef
372 xunif_rglgv = xundef
373 xunif_h_veg = xundef
374 xunif_root_extinctiongv = xundef ! root extinction parameter
375 !
376  cfnam_vegtype(:) = ' '
377 !
378  cfnam_veg(:,:) = ' '
379  cfnam_lai(:,:) = ' '
380  cfnam_z0(:,:) = ' '
381  cfnam_emis(:,:) = ' '
382 !
383  cfnam_dg(:,:) = ' '
384  cfnam_rootfrac(:,:) = ' '
385  cfnam_dice(:) = ' '
386 !
387  cfnam_ground_depth(:) = ' '
388  cfnam_root_depth(:) = ' '
389  cfnam_root_extinction(:) = ' '
390  cfnam_root_lin(:) = ' '
391 !
392  cfnam_rsmin(:) = ' '
393  cfnam_gamma(:) = ' '
394  cfnam_wrmax_cf(:) = ' '
395  cfnam_rgl(:) = ' '
396  cfnam_cv(:) = ' '
397  cfnam_z0_o_z0h(:) = ' '
398  cfnam_albnir_veg(:) = ' '
399  cfnam_albvis_veg(:) = ' '
400  cfnam_albuv_veg(:) = ' '
401  cfnam_albnir_soil(:) = ' '
402  cfnam_albvis_soil(:) = ' '
403  cfnam_albuv_soil(:) = ' '
404  cfnam_gmes(:) = ' '
405  cfnam_bslai(:) = ' '
406  cfnam_laimin(:) = ' '
407  cfnam_sefold(:) = ' '
408  cfnam_gc(:) = ' '
409  cfnam_dmax(:) = ' '
410  cfnam_f2i(:) = ' '
411  cfnam_h_tree(:) = ' '
412  cfnam_re25(:) = ' '
413  cfnam_ce_nitro(:) = ' '
414  cfnam_cf_nitro(:) = ' '
415  cfnam_cna_nitro(:) = ' '
416 !
417  cfnam_laigv(:,:) = ' '
418  cfnam_z0litter(:,:) = ' '
419  cfnam_gndlitter(:,:) = ' '
420  cfnam_rootfracgv(:,:) = ' '
421  cfnam_rsmingv(:) = ' '
422  cfnam_gammagv(:) = ' '
423  cfnam_wrmax_cfgv(:) = ' '
424  cfnam_rglgv(:) = ' '
425  cfnam_h_veg(:,:) = ' '
426  cfnam_root_extinctiongv(:) = ' '
427 
428  cftyp_vegtype(:) = ' '
429 !
430  cftyp_veg(:,:) = ' '
431  cftyp_lai(:,:) = ' '
432  cftyp_z0(:,:) = ' '
433  cftyp_emis(:,:) = ' '
434 !
435  cftyp_dg(:,:) = ' '
436  cftyp_rootfrac(:,:) = ' '
437  cftyp_dice(:) = ' '
438 !
439  cftyp_ground_depth(:) = ' '
440  cftyp_root_depth(:) = ' '
441  cftyp_root_extinction(:) = ' '
442  cftyp_root_lin(:) = ' '
443 !
444  cftyp_rsmin(:) = ' '
445  cftyp_gamma(:) = ' '
446  cftyp_wrmax_cf(:) = ' '
447  cftyp_rgl(:) = ' '
448  cftyp_cv(:) = ' '
449  cftyp_z0_o_z0h(:) = ' '
450  cftyp_albnir_veg(:) = ' '
451  cftyp_albvis_veg(:) = ' '
452  cftyp_albuv_veg(:) = ' '
453  cftyp_albnir_soil(:) = ' '
454  cftyp_albvis_soil(:) = ' '
455  cftyp_albuv_soil(:) = ' '
456  cftyp_gmes(:) = ' '
457  cftyp_bslai(:) = ' '
458  cftyp_laimin(:) = ' '
459  cftyp_sefold(:) = ' '
460  cftyp_gc(:) = ' '
461  cftyp_dmax(:) = ' '
462  cftyp_f2i(:) = ' '
463  cftyp_h_tree(:) = ' '
464  cftyp_re25(:) = ' '
465  cftyp_ce_nitro(:) = ' '
466  cftyp_cf_nitro(:) = ' '
467  cftyp_cna_nitro(:) = ' '
468 !
469  cftyp_laigv(:,:) = ' '
470  cftyp_z0litter(:,:) = ' '
471  cftyp_gndlitter(:,:) = ' '
472  cftyp_rootfracgv(:,:) = ' '
473  cftyp_rsmingv(:) = ' '
474  cftyp_gammagv(:) = ' '
475  cftyp_wrmax_cfgv(:) = ' '
476  cftyp_rglgv(:) = ' '
477  cftyp_h_veg(:,:) = ' '
478  cftyp_root_extinctiongv(:) = ' '
479 !
480 isize_lmeb_patch=count(i%LMEB_PATCH(:))
481 !-------------------------------------------------------------------------------
482 !
483 !* 2. Input file for cover types
484 ! --------------------------
485 !
486  CALL get_luout(hprogram,iluout)
487  CALL open_namelist(hprogram,ilunam)
488 !
489  CALL posnam(ilunam,'NAM_DATA_ISBA',gfound,iluout)
490 IF (gfound) READ(unit=ilunam,nml=nam_data_isba)
491 !
492  CALL close_namelist(hprogram,ilunam)
493 !
494 dti%NTIME = ntime
495 !
496 !-------------------------------------------------------------------------------
497 IF (nvegtype_max < nvegtype) THEN
498  WRITE(iluout,*) '------------------------------------'
499  WRITE(iluout,*) 'Please update pgd_isba_par.f90 routine : '
500  WRITE(iluout,*) 'The maximum number of VEGTYPE '
501  WRITE(iluout,*) 'in the declaration of the namelist variables '
502  WRITE(iluout,*) 'must be increased to : ', nvegtype
503  WRITE(iluout,*) '------------------------------------'
504  CALL abor1_sfx('PGD_ISBA_PAR: MAXIMUM NUMBER OF VEGTYPE MUST BE INCREASED IN NAMELIST DECLARATION')
505 END IF
506 !-------------------------------------------------------------------------------
507 IF (nground_max < i%NGROUND_LAYER) THEN
508  WRITE(iluout,*) '------------------------------------'
509  WRITE(iluout,*) 'Please update pgd_isba_par.f90 routine : '
510  WRITE(iluout,*) 'The maximum number of soil layers '
511  WRITE(iluout,*) 'in the declaration of the namelist variables '
512  WRITE(iluout,*) 'must be increased to : ', i%NGROUND_LAYER
513  WRITE(iluout,*) '------------------------------------'
514  CALL abor1_sfx('PGD_ISBA_PAR: MAXIMUM NUMBER OF SOIL LAYERS MUST BE INCREASED IN NAMELIST DECLARATION')
515 END IF
516 !-------------------------------------------------------------------------------
517 !
518 IF (ntime/=36 .AND. ntime/=12 .AND. ntime/=2 .AND. ntime/=1) &
519  CALL abor1_sfx('PGD_ISBA_PAR: WRONG VALUE FOR NTIME (POSSIBLE VALUES ARE 1, 12 OR 36')
520 !
521 !-------------------------------------------------------------------------------
522 !
523 !* 3. Uniform fields are prescribed
524 ! -----------------------------
525 !
526 !-------------------------------------vegtypes-----------------------------------------
527 !
528 ALLOCATE(dti%XPAR_VEGTYPE (ig%NDIM,nvegtype))
529  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
530  hprogram,'ARI','VEGTYPE: vegetation type','NAT',cfnam_vegtype, &
531  cftyp_vegtype,xunif_vegtype,dti%XPAR_VEGTYPE,dti%LDATA_VEGTYPE)
532 !
533 IF (.NOT.i%LECOCLIMAP .AND. .NOT.dti%LDATA_VEGTYPE) THEN
534  !
535  WRITE(iluout,*) ' '
536  WRITE(iluout,*) '***********************************************************'
537  WRITE(iluout,*) '* Error in PGD field preparation of field VEGTYPE *'
538  WRITE(iluout,*) '* There is no prescribed value and no input file *'
539  WRITE(iluout,*) '* Without ECOCLIMAP, this field must be prescribed *'
540  WRITE(iluout,*) '***********************************************************'
541  WRITE(iluout,*) ' '
542  CALL abor1_sfx('PGD_ISBA_PAR: NO PRESCRIBED VALUE NOR INPUT FILE FOR VEGTYPE')
543  !
544 ELSEIF (dti%LDATA_VEGTYPE) THEN
545  !
546  WHERE (dti%XPAR_VEGTYPE(:,:)==xundef) dti%XPAR_VEGTYPE(:,:)=0.
547  WHERE (dti%XPAR_VEGTYPE(:,:)/=0.) dti%XPAR_VEGTYPE(:,:) = dti%XPAR_VEGTYPE(:,:) / &
548  spread(sum(dti%XPAR_VEGTYPE(:,:),2),2,nvegtype)
549  !
550 ENDIF
551 !
552 !--------------------------------temporal fields-----------------------------------
553 !
554 ALLOCATE(dti%XPAR_VEG (ig%NDIM,ntime,nvegtype))
555  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
556  hprogram,'ARI','VEG: vegetation fraction','NAT',cfnam_veg,cftyp_veg,xunif_veg, &
557  dti%XPAR_VEG,dti%LDATA_VEG)
558 IF (.NOT. dti%LDATA_VEG) DEALLOCATE(dti%XPAR_VEG)
559 !
560 ALLOCATE(dti%XPAR_LAI (ig%NDIM,ntime,nvegtype))
561  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
562  hprogram,'ARI','LAI: leaf area index','NAT',cfnam_lai,cftyp_lai,xunif_lai, &
563  dti%XPAR_LAI,dti%LDATA_LAI)
564 IF (.NOT. dti%LDATA_VEGTYPE .AND. .NOT. dti%LDATA_LAI) DEALLOCATE(dti%XPAR_LAI)
565 !
566 ALLOCATE(dti%XPAR_H_VEG (ig%NDIM,ntime,nvegtype))
567  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
568  hprogram,'ARI','H_VEG: vegetation height','NAT',cfnam_h_veg,cftyp_h_veg,xunif_h_veg, &
569  dti%XPAR_H_VEG,dti%LDATA_H_VEG)
570 IF (.NOT. dti%LDATA_H_VEG) DEALLOCATE(dti%XPAR_H_VEG)
571 !
572 ALLOCATE(dti%XPAR_Z0 (ig%NDIM,ntime,nvegtype))
573  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
574  hprogram,'CDN','Z0: roughness length','NAT',cfnam_z0,cftyp_z0,xunif_z0, &
575  dti%XPAR_Z0,dti%LDATA_Z0)
576 IF (.NOT. dti%LDATA_Z0) DEALLOCATE(dti%XPAR_Z0)
577 !
578 ALLOCATE(dti%XPAR_EMIS (ig%NDIM,ntime,nvegtype))
579  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
580  hprogram,'ARI','EMIS: emissivity','NAT',cfnam_emis,cftyp_emis,xunif_emis, &
581  dti%XPAR_EMIS,dti%LDATA_EMIS)
582 IF (.NOT. dti%LDATA_EMIS) DEALLOCATE(dti%XPAR_EMIS)
583 !
584 IF (.NOT.i%LECOCLIMAP .AND. .NOT.(dti%LDATA_VEG .AND. dti%LDATA_LAI .AND. dti%LDATA_Z0 .AND. dti%LDATA_EMIS)) THEN
585  !
586  WRITE(iluout,*) ' '
587  WRITE(iluout,*) '***********************************************************'
588  WRITE(iluout,*) '* Error in PGD field preparation of temporal fields *'
589  WRITE(iluout,*) '* There is no prescribed value and no input file : *'
590  IF (.NOT.dti%LDATA_VEG ) WRITE(iluout,*) '* for VEG *'
591  IF (.NOT.dti%LDATA_LAI ) WRITE(iluout,*) '* for LAI *'
592  IF (.NOT.dti%LDATA_Z0 ) WRITE(iluout,*) '* for Z0 *'
593  IF (.NOT.dti%LDATA_EMIS) WRITE(iluout,*) '* for EMIS *'
594  WRITE(iluout,*) '* Without ECOCLIMAP, these fields must be prescribed *'
595  WRITE(iluout,*) '***********************************************************'
596  WRITE(iluout,*) ' '
597  CALL abor1_sfx('PGD_ISBA_PAR: NO PRESCRIBED VALUE NOR INPUT FILE FOR TEMPORAL PARAMETERS')
598  !
599 ENDIF
600 !
601 ! ------------ Begin MEB parameters ---------------------
602 IF(isize_lmeb_patch>0) THEN
603  !
604  ALLOCATE(dti%XPAR_LAIGV (ig%NDIM,ntime,nvegtype))
605  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
606  hprogram,'ARI','LAIGV: GV leaf area index','NAT', &
607  cfnam_laigv,cftyp_laigv,xunif_laigv,dti%XPAR_LAIGV,dti%LDATA_LAIGV)
608  IF (.NOT. dti%LDATA_LAIGV) DEALLOCATE(dti%XPAR_LAIGV)
609  !
610  ALLOCATE(dti%XPAR_GNDLITTER (ig%NDIM,ntime,nvegtype))
611  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
612  hprogram,'ARI','GNDLITTER: ground litter fraction','NAT',&
613  cfnam_gndlitter,cftyp_gndlitter,xunif_gndlitter,dti%XPAR_GNDLITTER,dti%LDATA_GNDLITTER)
614  IF (.NOT. dti%LDATA_GNDLITTER) DEALLOCATE(dti%XPAR_GNDLITTER)
615  !
616  ALLOCATE(dti%XPAR_Z0LITTER (ig%NDIM,ntime,nvegtype))
617  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
618  hprogram,'CDN','Z0LITTER: ground litter roughness length','NAT', &
619  cfnam_z0litter,cftyp_z0litter,xunif_z0litter,dti%XPAR_Z0LITTER,dti%LDATA_Z0LITTER)
620  IF (.NOT. dti%LDATA_Z0LITTER) DEALLOCATE(dti%XPAR_Z0LITTER)
621  !
622 ENDIF
623 ! ------------ End MEB parameters ---------------------
624 !
625 !--------------------------------depths fields-----------------------------------
626 !
627 ALLOCATE(dti%XPAR_DG (ig%NDIM,i%NGROUND_LAYER,nvegtype))
628  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
629  hprogram,'ARI','DG: ground depth','NAT',cfnam_dg,cftyp_dg,xunif_dg,dti%XPAR_DG,dti%LDATA_DG)
630 IF (.NOT. dti%LDATA_VEGTYPE .AND. .NOT. dti%LDATA_DG) DEALLOCATE(dti%XPAR_DG)
631 !
632 ALLOCATE(dti%XPAR_ROOT_DEPTH (ig%NDIM,nvegtype))
633  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
634  hprogram,'ARI','ROOT_DEPTH: root depth','NAT',cfnam_root_depth,cftyp_root_depth,&
635  xunif_root_depth,dti%XPAR_ROOT_DEPTH,dti%LDATA_ROOT_DEPTH)
636 !
637 ALLOCATE(dti%XPAR_GROUND_DEPTH (ig%NDIM,nvegtype))
638  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
639  hprogram,'ARI','GROUND_DEPTH: ground depth','NAT',cfnam_ground_depth,cftyp_ground_depth,&
640  xunif_ground_depth,dti%XPAR_GROUND_DEPTH,dti%LDATA_GROUND_DEPTH)
641 !
642 IF(i%CISBA=='DIF')THEN
643  !
644  ALLOCATE(dti%XPAR_ROOTFRAC (ig%NDIM,i%NGROUND_LAYER,nvegtype))
645  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
646  hprogram,'ARI','ROOTFRAC: root fraction','NAT',cfnam_rootfrac,cftyp_rootfrac,&
647  xunif_rootfrac,dti%XPAR_ROOTFRAC,dti%LDATA_ROOTFRAC)
648  IF (.NOT. dti%LDATA_ROOTFRAC) DEALLOCATE(dti%XPAR_ROOTFRAC)
649  !
650  ALLOCATE(dti%XPAR_ROOT_EXTINCTION (ig%NDIM,nvegtype))
651  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
652  hprogram,'ARI','ROOT_EXTINCTION: root extinction','NAT',cfnam_root_extinction,cftyp_root_extinction,&
653  xunif_root_extinction,dti%XPAR_ROOT_EXTINCTION,dti%LDATA_ROOT_EXTINCTION)
654  IF (.NOT. dti%LDATA_ROOT_EXTINCTION) DEALLOCATE(dti%XPAR_ROOT_EXTINCTION)
655  !
656  ALLOCATE(dti%XPAR_ROOT_LIN (ig%NDIM,nvegtype))
657  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
658  hprogram,'ARI','ROOT_LIN: root linear','NAT',cfnam_root_lin,cftyp_root_lin,&
659  xunif_root_lin,dti%XPAR_ROOT_LIN,dti%LDATA_ROOT_LIN)
660  IF (.NOT. dti%LDATA_ROOT_LIN) DEALLOCATE(dti%XPAR_ROOT_LIN)
661  !
662  ! ------------ Begin MEB parameters ---------------------
663  IF(isize_lmeb_patch>0) THEN
664  !
665  ALLOCATE(dti%XPAR_ROOTFRACGV (ig%NDIM,i%NGROUND_LAYER,nvegtype))
666  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
667  hprogram,'ARI','ROOTFRACGV: GV root fraction','NAT',cfnam_rootfracgv,cftyp_rootfracgv,&
668  xunif_rootfracgv,dti%XPAR_ROOTFRACGV,dti%LDATA_ROOTFRACGV)
669  IF (.NOT. dti%LDATA_ROOTFRACGV) DEALLOCATE(dti%XPAR_ROOTFRACGV)
670  !
671  ! Apply a function of XPAR_ROOTFRAC on XPAR_ROOTFRACGV if XUNIF_ROOTFRACGV is undefined
672  IF (.NOT. dti%LDATA_ROOTFRACGV .AND. dti%LDATA_ROOTFRAC)THEN
673  ALLOCATE(dti%XPAR_ROOTFRACGV (ig%NDIM,i%NGROUND_LAYER,nvegtype))
674  ihground_layer=int(ceiling(REAL(i%nground_layer)/2.0))
675  dti%XPAR_ROOTFRACGV=0.
676  DO iih=1,ihground_layer
677  dti%XPAR_ROOTFRACGV(:,iih,:)=dti%XPAR_ROOTFRAC(:,iih,:)
678  ENDDO
679  zrootfracgv(:,:)=sum(dti%XPAR_ROOTFRACGV,dim=2)
680  DO iih=1,ihground_layer
681  test=reshape(dti%XPAR_ROOTFRACGV(:,iih,:),(/ig%NDIM,nvegtype/))
682  test2=1.
683  WHERE(zrootfracgv>0.)test2 = 1./zrootfracgv
684  test3=test * test2
685  dti%XPAR_ROOTFRACGV(:,iih,:)=test3
686  ENDDO
687  dti%LDATA_ROOTFRACGV = .true.
688  ENDIF
689  ! ' '
690  ALLOCATE(dti%XPAR_ROOT_EXTINCTIONGV(ig%NDIM,nvegtype))
691  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
692  hprogram,'ARI','ROOT_EXTINCTIONGV: root ext gv ','NAT',cfnam_root_extinctiongv,cftyp_root_extinctiongv,&
693  xunif_root_extinctiongv,dti%XPAR_ROOT_EXTINCTIONGV,dti%LDATA_ROOT_EXTINCTIONGV)
694  IF (.NOT. dti%LDATA_ROOT_EXTINCTIONGV) DEALLOCATE(dti%XPAR_ROOT_EXTINCTIONGV)
695  !
696  IF (.NOT. dti%LDATA_ROOT_EXTINCTIONGV .AND. dti%LDATA_ROOT_EXTINCTION)THEN
697  ALLOCATE(dti%XPAR_ROOT_EXTINCTIONGV(ig%NDIM,nvegtype))
698  dti%XPAR_ROOT_EXTINCTIONGV = dti%XPAR_ROOT_EXTINCTION
699  dti%LDATA_ROOT_EXTINCTIONGV = .true.
700  ENDIF
701  !
702  ENDIF
703  ! ------------ End MEB parameters ---------------------
704  !
705  IF (.NOT.i%LECOCLIMAP) THEN
706  IF(dti%LDATA_DG .AND. .NOT.dti%LDATA_ROOTFRAC .AND. &
707  (.NOT.dti%LDATA_ROOT_DEPTH.OR..NOT.dti%LDATA_ROOT_EXTINCTION.OR..NOT.dti%LDATA_ROOT_LIN)) THEN
708  WRITE(iluout,*) ' '
709  WRITE(iluout,*) '****************************************************************************'
710  WRITE(iluout,*) '* Without ECOCLIMAP, Error in PGD field preparation for ISBA-DIF *'
711  WRITE(iluout,*) '* There is no prescribed value and no input file *'
712  WRITE(iluout,*) '* (1) XUNIF_ROOTFRAC must be given. *'
713  WRITE(iluout,*) '* (2) Other solution, give all these fields: *'
714  WRITE(iluout,*) '* - XUNIF_ROOT_DEPTH (soil root depth) *'
715  WRITE(iluout,*) '* - XUNIF_ROOT_EXTINCTION (root extinction parameter [Jackson 1996]) *'
716  WRITE(iluout,*) '* - XUNIF_ROOT_LIN (0.05 usually; 1=uniform root distribution!!)*'
717  WRITE(iluout,*) '****************************************************************************'
718  WRITE(iluout,*) ' '
719  CALL abor1_sfx("PGD_ISBA_PAR: PROBLEM IN SOIL GRID COMPUTATION")
720  ELSEIF( .NOT.all(i%XSOILGRID(:)==xundef) .AND. &
721  (.NOT.dti%LDATA_GROUND_DEPTH .OR..NOT.dti%LDATA_ROOT_DEPTH.OR. &
722  .NOT.dti%LDATA_ROOT_EXTINCTION.OR..NOT.dti%LDATA_ROOT_LIN )) THEN
723  WRITE(iluout,*) ' '
724  WRITE(iluout,*) '****************************************************************************'
725  WRITE(iluout,*) '* Without ECOCLIMAP, Error in PGD field preparation for ISBA-DIF *'
726  WRITE(iluout,*) '* There is no prescribed value and no input file. *'
727  WRITE(iluout,*) '* When XSOILGRID is given, other field are needed : *'
728  WRITE(iluout,*) '* - XUNIF_GROUND_DEPTH (soil ground depth for moisture) *'
729  WRITE(iluout,*) '* - XUNIF_ROOT_DEPTH (soil root depth) *'
730  WRITE(iluout,*) '* - XUNIF_ROOT_LIN (0.05 usually; 1=uniform root distribution!!)*'
731  WRITE(iluout,*) '* - XUNIF_ROOT_EXTINCTION (root extinction parameter [Jackson 1996]) *'
732  WRITE(iluout,*) '****************************************************************************'
733  WRITE(iluout,*) ' '
734  CALL abor1_sfx("PGD_ISBA_PAR: PROBLEM IN SOIL GRID COMPUTATION")
735  ENDIF
736  IF(.NOT.dti%LDATA_DG .AND.all(i%XSOILGRID(:)==xundef))THEN
737  WRITE(iluout,*) ' '
738  WRITE(iluout,*) '****************************************************************************'
739  WRITE(iluout,*) '* Without ECOCLIMAP, Error in PGD field preparation for ISBA-DIF *'
740  WRITE(iluout,*) '* There is no prescribed value to compute vertical soil grid. *'
741  WRITE(iluout,*) '* 2 solutions: *'
742  WRITE(iluout,*) '* (1) Give XUNIF_DG in NAM_DATA_ISBA. *'
743  WRITE(iluout,*) '* OR *'
744  WRITE(iluout,*) '* (2) Give XSOILGRID in NAM_ISBA *'
745  WRITE(iluout,*) '****************************************************************************'
746  WRITE(iluout,*) ' '
747  CALL abor1_sfx("PGD_ISBA_PAR: PROBLEM IN SOIL GRID COMPUTATION")
748  ENDIF
749  ENDIF
750  !
751 ELSE
752  !
753  IF ( .NOT.i%LECOCLIMAP .AND. .NOT.dti%LDATA_DG .AND. &
754  (.NOT.dti%LDATA_GROUND_DEPTH.OR..NOT.dti%LDATA_ROOT_DEPTH) ) THEN
755  WRITE(iluout,*) ' '
756  WRITE(iluout,*) '****************************************************************************'
757  WRITE(iluout,*) '* Without ECOCLIMAP, Error in PGD field preparation *'
758  WRITE(iluout,*) '* There is no prescribed value and no input file *'
759  WRITE(iluout,*) '* XUNIF_DG or both XUNIF_GROUND_DEPTH and XUNIF_ROOT_DEPTH must be given. *'
760  WRITE(iluout,*) '****************************************************************************'
761  WRITE(iluout,*) ' '
762  CALL abor1_sfx("PGD_ISBA_PAR: PROBLEM IN SOIL GRID COMPUTATION")
763  ENDIF
764  !
765 ENDIF
766 !
767 ALLOCATE(dti%XPAR_DICE (ig%NDIM,nvegtype))
768  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
769  hprogram,'ARI','DICE: ice depth for runoff','NAT',cfnam_dice,cftyp_dice,&
770  xunif_dice,dti%XPAR_DICE,dti%LDATA_DICE)
771 !
772 IF (.NOT.i%LECOCLIMAP.AND..NOT. dti%LDATA_DICE) THEN
773  IF(i%CISBA/='DIF' .AND. (dti%LDATA_DG.OR.dti%LDATA_ROOT_DEPTH)) THEN
774  IF(dti%LDATA_DG)THEN
775  dti%XPAR_DICE(:,:) = max(0.2,0.8*dti%XPAR_DG(:,2,:))
776  ELSEIF(dti%LDATA_ROOT_DEPTH)THEN
777  dti%XPAR_DICE(:,:) = max(0.2,0.8*dti%XPAR_ROOT_DEPTH(:,:))
778  ENDIF
779  dti%LDATA_DICE=.true.
780  ELSEIF (i%CISBA=='DIF') THEN
781  dti%XPAR_DICE(:,:) = 0.0
782  dti%LDATA_DICE=.true.
783  ELSE
784  WRITE(iluout,*) ' '
785  WRITE(iluout,*) '***********************************************************'
786  WRITE(iluout,*) '* Error in PGD field preparation of field DICE *'
787  WRITE(iluout,*) '* There is no prescribed value and no input file *'
788  WRITE(iluout,*) '* Without ECOCLIMAP, this field must be prescribed *'
789  WRITE(iluout,*) '***********************************************************'
790  WRITE(iluout,*) ' '
791  CALL abor1_sfx('PGD_ISBA_PAR: NO PRESCRIBED VALUE NOR INPUT FILE FOR DICE')
792  ENDIF
793 ENDIF
794 !
795 !---------------------classical fields---------------------------------------------
796 !
797 ALLOCATE(dti%XPAR_RSMIN (ig%NDIM,nvegtype))
798  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
799  hprogram,'INV','RSMIN: minimal stomatal resistance','NAT',cfnam_rsmin, &
800  cftyp_rsmin,xunif_rsmin,dti%XPAR_RSMIN,dti%LDATA_RSMIN)
801 IF (.NOT. dti%LDATA_RSMIN) DEALLOCATE(dti%XPAR_RSMIN)
802 !
803 ALLOCATE(dti%XPAR_GAMMA (ig%NDIM,nvegtype))
804  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
805  hprogram,'ARI','GAMMA: gamma coefficient','NAT',cfnam_gamma, &
806  cftyp_gamma,xunif_gamma,dti%XPAR_GAMMA,dti%LDATA_GAMMA)
807 IF (.NOT. dti%LDATA_GAMMA) DEALLOCATE(dti%XPAR_GAMMA)
808 !
809 ALLOCATE(dti%XPAR_WRMAX_CF (ig%NDIM,nvegtype))
810  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
811  hprogram,'ARI','WRMAX_CF: coeff. for max WR','NAT',cfnam_wrmax_cf, &
812  cftyp_wrmax_cf,xunif_wrmax_cf,dti%XPAR_WRMAX_CF,dti%LDATA_WRMAX_CF)
813 IF (.NOT. dti%LDATA_WRMAX_CF) DEALLOCATE(dti%XPAR_WRMAX_CF)
814 !
815 ALLOCATE(dti%XPAR_RGL (ig%NDIM,nvegtype))
816  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
817  hprogram,'ARI','RGL: max SW rad. for photosynthesis','NAT',cfnam_rgl, &
818  cftyp_rgl,xunif_rgl,dti%XPAR_RGL,dti%LDATA_RGL)
819 IF (.NOT. dti%LDATA_RGL) DEALLOCATE(dti%XPAR_RGL)
820 !
821 ALLOCATE(dti%XPAR_CV (ig%NDIM,nvegtype))
822  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
823  hprogram,'INV','CV: thermal inertia for vegetation','NAT',cfnam_cv, &
824  cftyp_cv,xunif_cv,dti%XPAR_CV,dti%LDATA_CV)
825 IF (.NOT. dti%LDATA_CV) DEALLOCATE(dti%XPAR_CV)
826 !
827 ALLOCATE(dti%XPAR_Z0_O_Z0H (ig%NDIM,nvegtype))
828  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
829  hprogram,'ARI','Z0_O_Z0H: ratio of roughness lengths','NAT',cfnam_z0_o_z0h, &
830  cftyp_z0_o_z0h,xunif_z0_o_z0h,dti%XPAR_Z0_O_Z0H,dti%LDATA_Z0_O_Z0H)
831 IF (.NOT. dti%LDATA_Z0_O_Z0H) DEALLOCATE(dti%XPAR_Z0_O_Z0H)
832 !
833 ALLOCATE(dti%XPAR_ALBNIR_VEG (ig%NDIM,nvegtype))
834  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
835  hprogram,'ARI','ALBNIR_VEG: NIR albedo of vegetation','NAT',cfnam_albnir_veg, &
836  cftyp_albnir_veg,xunif_albnir_veg,dti%XPAR_ALBNIR_VEG,dti%LDATA_ALBNIR_VEG)
837 IF (.NOT. dti%LDATA_ALBNIR_VEG) DEALLOCATE(dti%XPAR_ALBNIR_VEG)
838 !
839 ALLOCATE(dti%XPAR_ALBVIS_VEG (ig%NDIM,nvegtype))
840  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
841  hprogram,'ARI','ALBVIS_VEG: VIS albedo of vegetation','NAT',cfnam_albvis_veg, &
842  cftyp_albvis_veg,xunif_albvis_veg,dti%XPAR_ALBVIS_VEG,dti%LDATA_ALBVIS_VEG)
843 IF (.NOT. dti%LDATA_ALBVIS_VEG) DEALLOCATE(dti%XPAR_ALBVIS_VEG)
844 !
845 ALLOCATE(dti%XPAR_ALBUV_VEG (ig%NDIM,nvegtype))
846  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
847  hprogram,'ARI','ALBUV_VEG: UV albedo of vegetation','NAT',cfnam_albuv_veg, &
848  cftyp_albuv_veg,xunif_albuv_veg,dti%XPAR_ALBUV_VEG,dti%LDATA_ALBUV_VEG)
849 IF (.NOT. dti%LDATA_ALBUV_VEG) DEALLOCATE(dti%XPAR_ALBUV_VEG)
850 !
851 ALLOCATE(dti%XPAR_ALBNIR_SOIL (ig%NDIM,nvegtype))
852  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
853  hprogram,'ARI','ALBNIR_SOIL: NIR albedo of SOIL','NAT',cfnam_albnir_soil, &
854  cftyp_albnir_soil,xunif_albnir_soil,dti%XPAR_ALBNIR_SOIL,dti%LDATA_ALBNIR_SOIL)
855 IF (.NOT. dti%LDATA_ALBNIR_SOIL) DEALLOCATE(dti%XPAR_ALBNIR_SOIL)
856 !
857 ALLOCATE(dti%XPAR_ALBVIS_SOIL (ig%NDIM,nvegtype))
858  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
859  hprogram,'ARI','ALBVIS_SOIL: VIS albedo of SOIL','NAT',cfnam_albvis_soil, &
860  cftyp_albvis_soil,xunif_albvis_soil,dti%XPAR_ALBVIS_SOIL,dti%LDATA_ALBVIS_SOIL)
861 IF (.NOT. dti%LDATA_ALBVIS_SOIL) DEALLOCATE(dti%XPAR_ALBVIS_SOIL)
862 !
863 ALLOCATE(dti%XPAR_ALBUV_SOIL (ig%NDIM,nvegtype))
864  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
865  hprogram,'ARI','ALBUV_SOIL: UV albedo of SOIL','NAT',cfnam_albuv_soil, &
866  cftyp_albuv_soil,xunif_albuv_soil,dti%XPAR_ALBUV_SOIL,dti%LDATA_ALBUV_SOIL)
867 IF (.NOT. dti%LDATA_ALBUV_SOIL) DEALLOCATE(dti%XPAR_ALBUV_SOIL)
868 !
869 IF (.NOT.i%LECOCLIMAP .AND. .NOT.(dti%LDATA_RSMIN.AND.dti%LDATA_GAMMA.AND.dti%LDATA_WRMAX_CF.AND.dti%LDATA_RGL &
870  .AND.dti%LDATA_CV.AND.dti%LDATA_Z0_O_Z0H.AND.dti%LDATA_ALBNIR_VEG.AND.dti%LDATA_ALBVIS_VEG.AND.&
871  dti%LDATA_ALBUV_VEG.AND.dti%LDATA_ALBNIR_SOIL.AND.dti%LDATA_ALBVIS_SOIL.AND.dti%LDATA_ALBUV_SOIL)) THEN
872  !
873  WRITE(iluout,*) ' '
874  WRITE(iluout,*) '***********************************************************'
875  WRITE(iluout,*) '* Error in PGD field preparation of classical fields *'
876  WRITE(iluout,*) '* There is no prescribed value and no input file : *'
877  IF (.NOT.dti%LDATA_RSMIN ) WRITE(iluout,*) '* for RSMIN *'
878  IF (.NOT.dti%LDATA_GAMMA ) WRITE(iluout,*) '* for GAMMA *'
879  IF (.NOT.dti%LDATA_WRMAX_CF ) WRITE(iluout,*) '* for WRMAX_CF *'
880  IF (.NOT.dti%LDATA_RGL ) WRITE(iluout,*) '* for RGL *'
881  IF (.NOT.dti%LDATA_CV ) WRITE(iluout,*) '* for CV *'
882  IF (.NOT.dti%LDATA_Z0_O_Z0H ) WRITE(iluout,*) '* for Z0_O_Z0H *'
883  IF (.NOT.dti%LDATA_ALBNIR_VEG ) WRITE(iluout,*) '* for ALBNIR_VEG *'
884  IF (.NOT.dti%LDATA_ALBVIS_VEG ) WRITE(iluout,*) '* for ALBVIS_VEG *'
885  IF (.NOT.dti%LDATA_ALBUV_VEG ) WRITE(iluout,*) '* for ALBUV_VEG *'
886  IF (.NOT.dti%LDATA_ALBNIR_SOIL ) WRITE(iluout,*) '* for ALBNIR_SOIL *'
887  IF (.NOT.dti%LDATA_ALBVIS_SOIL ) WRITE(iluout,*) '* for ALBVIS_SOIL *'
888  IF (.NOT.dti%LDATA_ALBUV_SOIL ) WRITE(iluout,*) '* for ALBUV_SOIL *'
889  WRITE(iluout,*) '* Without ECOCLIMAP, these fields must be prescribed *'
890  WRITE(iluout,*) '***********************************************************'
891  WRITE(iluout,*) ' '
892  CALL abor1_sfx('PGD_ISBA_PAR: NO PRESCRIBED VALUE NOR INPUT FILE FOR CLASSICAL PARAMETERS')
893  !
894 ENDIF
895 !
896 ! ------------ Begin MEB parameters ---------------------
897 IF(isize_lmeb_patch>0) THEN
898  !
899  ALLOCATE(dti%XPAR_RSMINGV (ig%NDIM,nvegtype))
900  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
901  hprogram,'INV','RSMINGV: GV min stomatal res','NAT',cfnam_rsmingv, &
902  cftyp_rsmingv,xunif_rsmingv,dti%XPAR_RSMINGV,dti%LDATA_RSMINGV)
903  IF (.NOT. dti%LDATA_RSMINGV) DEALLOCATE(dti%XPAR_RSMINGV)
904  ! ' '
905  ALLOCATE(dti%XPAR_GAMMAGV (ig%NDIM,nvegtype))
906  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
907  hprogram,'ARI','GAMMAGV: GV gamma coeff','NAT',cfnam_gammagv, &
908  cftyp_gammagv,xunif_gammagv,dti%XPAR_GAMMAGV,dti%LDATA_GAMMAGV)
909  IF (.NOT. dti%LDATA_GAMMAGV) DEALLOCATE(dti%XPAR_GAMMAGV)
910  ! ' '
911  ALLOCATE(dti%XPAR_WRMAX_CFGV (ig%NDIM,nvegtype))
912  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
913  hprogram,'ARI','WRMAX_CFGV: cff max GV WR','NAT',cfnam_wrmax_cfgv, &
914  cftyp_wrmax_cfgv,xunif_wrmax_cfgv,dti%XPAR_WRMAX_CFGV,dti%LDATA_WRMAX_CFGV)
915  IF (.NOT. dti%LDATA_WRMAX_CFGV) DEALLOCATE(dti%XPAR_WRMAX_CFGV)
916  ! ' '
917  ALLOCATE(dti%XPAR_RGLGV (ig%NDIM,nvegtype))
918  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
919  hprogram,'ARI','RGLGV: max GV SW photosynth','NAT',cfnam_rglgv, &
920  cftyp_rglgv,xunif_rglgv,dti%XPAR_RGLGV,dti%LDATA_RGLGV)
921  IF (.NOT. dti%LDATA_RGLGV) DEALLOCATE(dti%XPAR_RGLGV)
922  !
923 ENDIF
924 ! ------------ End MEB parameters ---------------------
925 !
926 !--------------------------------------AGS parameters----------------------------
927 !
928 IF (i%CPHOTO/='NON' .OR. (.NOT.dti%LDATA_Z0.AND.(dti%LDATA_LAI.OR.dti%LDATA_VEGTYPE)) .OR. isize_lmeb_patch>0) THEN
929  !
930  ALLOCATE(dti%XPAR_H_TREE (ig%NDIM,nvegtype))
931  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
932  hprogram,'ARI','H_TREE: height of trees','NAT',cfnam_h_tree, &
933  cftyp_h_tree,xunif_h_tree,dti%XPAR_H_TREE,dti%LDATA_H_TREE)
934  IF (.NOT. dti%LDATA_VEGTYPE .AND. .NOT. dti%LDATA_H_TREE) DEALLOCATE(dti%XPAR_H_TREE)
935  !
936 ENDIF
937 
938 IF (i%CPHOTO/='NON' .OR. isize_lmeb_patch>0) THEN
939  ALLOCATE(dti%XPAR_BSLAI (ig%NDIM,nvegtype))
940  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
941  hprogram,'ARI','BSLAI: biomass over LAI','NAT',cfnam_bslai, &
942  cftyp_bslai,xunif_bslai,dti%XPAR_BSLAI,dti%LDATA_BSLAI)
943  IF (.NOT. dti%LDATA_BSLAI) DEALLOCATE(dti%XPAR_BSLAI)
944 ENDIF
945 !
946 IF (.NOT.i%LECOCLIMAP .AND. isize_lmeb_patch>0 .AND. .NOT.(dti%LDATA_H_TREE &
947  .AND. dti%LDATA_GNDLITTER .AND. dti%LDATA_Z0LITTER &
948  .AND. dti%LDATA_BSLAI))THEN
949  WRITE(iluout,*) ' '
950  WRITE(iluout,*) '***********************************************************'
951  WRITE(iluout,*) '* Error in PGD field preparation of MEB fields *'
952  WRITE(iluout,*) '* There is no prescribed value and no input file : *'
953  IF (.NOT.dti%LDATA_GNDLITTER ) WRITE(iluout,*) '* for GNDLITTER *'
954  IF (.NOT.dti%LDATA_Z0LITTER ) WRITE(iluout,*) '* for Z0LITTER *'
955  IF (.NOT.dti%LDATA_H_TREE ) WRITE(iluout,*) '* for H_TREE *'
956  IF (.NOT.dti%LDATA_BSLAI ) WRITE(iluout,*) '* for BSLAI *'
957  WRITE(iluout,*) '* Without ECOCLIMAP, these fields must be prescribed *'
958  WRITE(iluout,*) '***********************************************************'
959  WRITE(iluout,*) ' '
960  CALL abor1_sfx('PGD_ISBA_PAR: NO PRESCRIBED VALUE NOR INPUT FILE FOR MEB PARAMETERS')
961  !
962 ENDIF
963 !
964 IF (i%CPHOTO/='NON') THEN
965  !
966  ALLOCATE(dti%XPAR_RE25 (ig%NDIM,nvegtype))
967  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
968  hprogram,'ARI','RE25: ecosystem respiration','NAT',cfnam_re25, &
969  cftyp_re25,xunif_re25,dti%XPAR_RE25,dti%LDATA_RE25)
970  IF (.NOT. dti%LDATA_RE25) DEALLOCATE(dti%XPAR_RE25)
971  !
972  ALLOCATE(dti%XPAR_LAIMIN (ig%NDIM,nvegtype))
973  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
974  hprogram,'ARI','LAIMIN: minimum LAI','NAT',cfnam_laimin, &
975  cftyp_laimin,xunif_laimin,dti%XPAR_LAIMIN,dti%LDATA_LAIMIN)
976  IF (.NOT. dti%LDATA_LAIMIN) DEALLOCATE(dti%XPAR_LAIMIN)
977  !
978  ALLOCATE(dti%XPAR_SEFOLD (ig%NDIM,nvegtype))
979  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
980  hprogram,'ARI','SEFOLD: e-folding time for senescence','NAT',cfnam_sefold, &
981  cftyp_sefold,xunif_sefold,dti%XPAR_SEFOLD,dti%LDATA_SEFOLD)
982  IF (.NOT. dti%LDATA_SEFOLD) DEALLOCATE(dti%XPAR_SEFOLD)
983  !
984  ALLOCATE(dti%XPAR_GMES (ig%NDIM,nvegtype))
985  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
986  hprogram,'ARI','GMES: mesophyl conductance','NAT',cfnam_gmes, &
987  cftyp_gmes,xunif_gmes,dti%XPAR_GMES,dti%LDATA_GMES)
988  IF (.NOT. dti%LDATA_GMES) DEALLOCATE(dti%XPAR_GMES)
989  !
990  ALLOCATE(dti%XPAR_GC (ig%NDIM,nvegtype))
991  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
992  hprogram,'ARI','GC: cuticular conductance','NAT',cfnam_gc, &
993  cftyp_gc,xunif_gc,dti%XPAR_GC,dti%LDATA_GC)
994  IF (.NOT. dti%LDATA_GC) DEALLOCATE(dti%XPAR_GC)
995  !
996  IF (.NOT.i%LECOCLIMAP .AND. .NOT.(dti%LDATA_H_TREE.AND.dti%LDATA_RE25.AND.dti%LDATA_LAIMIN.AND.&
997  dti%LDATA_BSLAI.AND.dti%LDATA_SEFOLD.AND.dti%LDATA_GMES.AND.dti%LDATA_GC)) THEN
998  !
999  WRITE(iluout,*) ' '
1000  WRITE(iluout,*) '***********************************************************'
1001  WRITE(iluout,*) '* Error in PGD field preparation of AGS fields *'
1002  WRITE(iluout,*) '* There is no prescribed value and no input file : *'
1003  IF (.NOT.dti%LDATA_H_TREE ) WRITE(iluout,*) '* for H_TREE *'
1004  IF (.NOT.dti%LDATA_RE25 ) WRITE(iluout,*) '* for RE25 *'
1005  IF (.NOT.dti%LDATA_LAIMIN ) WRITE(iluout,*) '* for LAIMIN *'
1006  IF (.NOT.dti%LDATA_BSLAI ) WRITE(iluout,*) '* for BSLAI *'
1007  IF (.NOT.dti%LDATA_SEFOLD ) WRITE(iluout,*) '* for SEFOLD *'
1008  IF (.NOT.dti%LDATA_GMES ) WRITE(iluout,*) '* for GMES *'
1009  IF (.NOT.dti%LDATA_GC ) WRITE(iluout,*) '* for GC *'
1010  WRITE(iluout,*) '* Without ECOCLIMAP, these fields must be prescribed *'
1011  WRITE(iluout,*) '***********************************************************'
1012  WRITE(iluout,*) ' '
1013  CALL abor1_sfx('PGD_ISBA_PAR: NO PRESCRIBED VALUE NOR INPUT FILE FOR AGS PARAMETERS')
1014  !
1015  ENDIF
1016  !
1017  !--------------------------------------AGS Stress parameters----------------------------
1018  !
1019  IF (i%CPHOTO/='AGS' .AND. i%CPHOTO/='LAI') THEN
1020  !
1021  ALLOCATE(dti%XPAR_F2I (ig%NDIM,nvegtype))
1022  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
1023  hprogram,'ARI','F2I: critical normalized soil water content (stress)','NAT',cfnam_f2i, &
1024  cftyp_f2i,xunif_f2i,dti%XPAR_F2I,dti%LDATA_F2I)
1025  IF (.NOT. dti%LDATA_F2I) DEALLOCATE(dti%XPAR_F2I)
1026  !
1027  ALLOCATE(dti%XPAR_DMAX (ig%NDIM,nvegtype))
1028  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
1029  hprogram,'ARI','DMAX: maximum air saturation deficit','NAT',cfnam_dmax, &
1030  cftyp_dmax,xunif_dmax,dti%XPAR_DMAX,dti%LDATA_DMAX)
1031  IF (.NOT. dti%LDATA_DMAX) DEALLOCATE(dti%XPAR_DMAX)
1032  !
1033  ALLOCATE(dti%LPAR_STRESS (ig%NDIM,nvegtype))
1034  DO jvegtype=1,nvegtype
1035  gpar_stress = lunif_stress(jvegtype)
1036  IF (xstress(jvegtype)<1.) gpar_stress = .false.
1037  IF (xstress(jvegtype)==1. .AND. .NOT.gpar_stress) dti%LDATA_STRESS=.true.
1038  dti%LPAR_STRESS(:,jvegtype) = gpar_stress
1039  ENDDO
1040  IF (.NOT. dti%LDATA_STRESS) DEALLOCATE(dti%LPAR_STRESS)
1041  !
1042  IF (.NOT.i%LECOCLIMAP .AND. .NOT.(dti%LDATA_F2I.AND.dti%LDATA_DMAX)) THEN
1043  !
1044  WRITE(iluout,*) ' '
1045  WRITE(iluout,*) '***********************************************************'
1046  WRITE(iluout,*) '* Error in PGD field preparation of AGS Stress fields *'
1047  WRITE(iluout,*) '* There is no prescribed value and no input file : *'
1048  IF (.NOT.dti%LDATA_F2I ) WRITE(iluout,*) '* for F2I *'
1049  IF (.NOT.dti%LDATA_DMAX ) WRITE(iluout,*) '* for DMAX *'
1050  WRITE(iluout,*) '* Without ECOCLIMAP, these fields must be prescribed *'
1051  WRITE(iluout,*) '***********************************************************'
1052  WRITE(iluout,*) ' '
1053  CALL abor1_sfx('PGD_ISBA_PAR: NO PRESCRIBED VALUE NOR INPUT FILE FOR AGS STRESS PARAMETERS')
1054  !
1055  ENDIF
1056  !
1057  !--------------------------------------AGS Nitrogen parameters----------------------------
1058  !
1059  IF (i%CPHOTO=='NIT' .OR. i%CPHOTO=='NCB') THEN
1060  !
1061  ALLOCATE(dti%XPAR_CE_NITRO (ig%NDIM,nvegtype))
1062  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
1063  hprogram,'ARI','CE_NITRO: leaf area ratio sensitivity to nitrogen ccion','NAT',&
1064  cfnam_ce_nitro, cftyp_ce_nitro,xunif_ce_nitro,dti%XPAR_CE_NITRO,dti%LDATA_CE_NITRO)
1065  IF (.NOT. dti%LDATA_CE_NITRO) DEALLOCATE(dti%XPAR_CE_NITRO)
1066  !
1067  ALLOCATE(dti%XPAR_CF_NITRO (ig%NDIM,nvegtype))
1068  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
1069  hprogram,'ARI','CF_NITRO: lethal minimum value of leaf area ratio','NAT',&
1070  cfnam_cf_nitro,cftyp_cf_nitro,xunif_cf_nitro,dti%XPAR_CF_NITRO,dti%LDATA_CF_NITRO)
1071  IF (.NOT. dti%LDATA_CF_NITRO) DEALLOCATE(dti%XPAR_CF_NITRO)
1072  !
1073  ALLOCATE(dti%XPAR_CNA_NITRO (ig%NDIM,nvegtype))
1074  CALL ini_var_from_data(dtco, dgu, ug, u, uss, dti, &
1075  hprogram,'ARI','CNA_NITRO: nitrogen ccion of active biomass','NAT',&
1076  cfnam_cna_nitro,cftyp_cna_nitro,xunif_cna_nitro,dti%XPAR_CNA_NITRO,dti%LDATA_CNA_NITRO)
1077  IF (.NOT. dti%LDATA_CNA_NITRO) DEALLOCATE(dti%XPAR_CNA_NITRO)
1078  !
1079  IF (.NOT.i%LECOCLIMAP .AND. .NOT.(dti%LDATA_CE_NITRO.AND.dti%LDATA_CF_NITRO.AND.dti%LDATA_CNA_NITRO)) THEN
1080  !
1081  WRITE(iluout,*) ' '
1082  WRITE(iluout,*) '***********************************************************'
1083  WRITE(iluout,*) '* Error in PGD field preparation of AGS Nitrogen fields *'
1084  WRITE(iluout,*) '* There is no prescribed value and no input file : *'
1085  IF (.NOT.dti%LDATA_CE_NITRO ) WRITE(iluout,*) '* for CE_NITRO *'
1086  IF (.NOT.dti%LDATA_CF_NITRO ) WRITE(iluout,*) '* for CF_NITRO *'
1087  IF (.NOT.dti%LDATA_CNA_NITRO ) WRITE(iluout,*) '* for CNA_NITRO *'
1088  WRITE(iluout,*) '* Without ECOCLIMAP, these fields must be prescribed *'
1089  WRITE(iluout,*) '***********************************************************'
1090  WRITE(iluout,*) ' '
1091  CALL abor1_sfx('PGD_ISBA_PAR: NO PRESCRIBED VALUE NOR INPUT FILE FOR AGS NITROGEN PARAMETERS')
1092  !
1093  ENDIF
1094  !
1095  ENDIF
1096  !
1097  ENDIF
1098  !
1099 ENDIF
1100 !
1101 !--------------------------------------irrigation parameters----------------------------
1102 !
1103 dti%LDATA_IRRIG=.false.
1104 dti%LDATA_WATSUP=.false.
1105 !
1106 !----------------------------------------------------------------------------------------
1107 !
1108 IF (i%LECOCLIMAP .AND. dti%LDATA_VEGTYPE) THEN
1109  !
1110  ALLOCATE(dti%XPAR_IRRIG (ig%NDIM,ntime,nvegtype))
1111  ALLOCATE(dti%XPAR_WATSUP (ig%NDIM,ntime,nvegtype))
1112  ALLOCATE(dti%XPAR_ROOT_DEPTHGV(ig%NDIM,nvegtype))
1113  !
1114  CALL extrapol_fields(dtco, dti, ig, i, ug, u, &
1115  hprogram,iluout)
1116  !
1117  IF (.NOT. dti%LDATA_LAI) DEALLOCATE(dti%XPAR_LAI)
1118  IF (.NOT. dti%LDATA_H_TREE .AND. i%CPHOTO/='NON') DEALLOCATE(dti%XPAR_H_TREE)
1119  IF (.NOT. dti%LDATA_DG) DEALLOCATE(dti%XPAR_DG)
1120  IF (.NOT. dti%LDATA_ROOT_DEPTH) DEALLOCATE(dti%XPAR_ROOT_DEPTH)
1121  IF (.NOT. dti%LDATA_ROOT_DEPTHGV) DEALLOCATE(dti%XPAR_ROOT_DEPTHGV)
1122  IF (.NOT. dti%LDATA_GROUND_DEPTH) DEALLOCATE(dti%XPAR_GROUND_DEPTH)
1123  !
1124 ENDIF
1125 !
1126 !----------------------------------------------------------------------------------------
1127 !
1128 IF (lhook) CALL dr_hook('PGD_ISBA_PAR',1,zhook_handle)
1129 !
1130 END SUBROUTINE pgd_isba_par
modd_surf_atm_sso_n::surf_atm_sso_t
Definition: modd_surf_atm_sson.F90:40
modd_surf_atm_n::surf_atm_t
Definition: modd_surf_atmn.F90:42
modd_isba_n
Definition: modd_isban.F90:6
mode_pos_surf
Definition: mode_pos_surf.F90:6
modd_surf_atm_grid_n
Definition: modd_surf_atm_gridn.F90:6
modd_data_cover_n
Definition: modd_data_covern.F90:6
modd_data_cover_par
Definition: modd_data_cover_par.F90:6
modd_diag_surf_atm_n
Definition: modd_diag_surf_atmn.F90:6
modd_surf_atm_grid_n::surf_atm_grid_t
Definition: modd_surf_atm_gridn.F90:39
abor1_sfx
subroutine abor1_sfx(YTEXT)
Definition: abor1_sfx.F90:6
modi_ini_var_from_data::ini_var_from_data
Definition: ini_var_from_data.F90:7
modd_data_isba_n
Definition: modd_data_isban.F90:6
close_namelist
subroutine close_namelist(HPROGRAM, KLUNAM)
Definition: close_namelist.F90:6
modd_data_isba_n::data_isba_t
Definition: modd_data_isban.F90:42
mode_pos_surf::pos::posnam
subroutine posnam(KULNAM, HDNAML, OFOUND, KLUOUT)
Definition: mode_pos_surf.F90:25
get_luout
subroutine get_luout(HPROGRAM, KLUOUT)
Definition: get_luout.F90:6
extrapol_fields
subroutine extrapol_fields(DTCO, DTI, IG, I, UG, U, HPROGRAM, KLUOUT)
Definition: extrapol_fields.F90:5
modd_surf_atm_sso_n
Definition: modd_surf_atm_sson.F90:6
pgd_isba_par
subroutine pgd_isba_par(DTCO, DGU, UG, U, USS, DTI, I, IG, HPROGRAM)
Definition: pgd_isba_par.F90:6
modd_data_cover_n::data_cover_t
Definition: modd_data_covern.F90:43
modd_surf_par
Definition: modd_surf_par.F90:6
open_namelist
subroutine open_namelist(HPROGRAM, KLUNAM, HFILE)
Definition: open_namelist.F90:6
modd_isba_grid_n
Definition: modd_isba_gridn.F90:6
modd_diag_surf_atm_n::diag_surf_atm_t
Definition: modd_diag_surf_atmn.F90:44
modi_ini_var_from_data
Definition: ini_var_from_data.F90:5
modd_surf_atm_n
Definition: modd_surf_atmn.F90:6
Generated on Fri May 13 2016 09:31:05 for SURFEX by   doxygen 1.8.5