SURFEX v8.1
General documentation of Surfex
diag_isba_initn.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 diag_isba_init_n (CHI, DE, DEC, NDE, NDEC, DGO, D, DC, ND, NDC, DM, NDM, &
7  OREAD_BUDGETC, NGB, GB, IO, NP, HSNOW_SCHEME, KSNOW_NLAYER, &
8  KABC, HPROGRAM,KLU,KSW)
9 ! #####################
10 !
11 !!**** *DIAG_ISBA_INIT_n* - routine to initialize ISBA-AGS diagnostic variables
12 !!
13 !! PURPOSE
14 !! -------
15 !!
16 !!** METHOD
17 !! ------
18 !!
19 !! EXTERNAL
20 !! --------
21 !!
22 !!
23 !! IMPLICIT ARGUMENTS
24 !! ------------------
25 !!
26 !! REFERENCE
27 !! ---------
28 !!
29 !!
30 !! AUTHOR
31 !! ------
32 !! V. Masson *Meteo France*
33 !!
34 !! MODIFICATIONS
35 !! -------------
36 !! Original 02/2003
37 !! modified 11/2003 by P. LeMoigne: surface cumulated energy budget
38 !! modified 10/2004 by P. LeMoigne: surface miscellaneous fields
39 !! B. Decharme 2008 New diag for water budget and allow to reset
40 ! cumulatives variables at the beginning of a run
41 !! B. Decharme 06/2009 add patch budget switch
42 !! B. Decharme 08/2009 add cummulative diag
43 !! A.L. Gibelin 04/2009 : Add respiration diagnostics
44 !! A.L. Gibelin 05/2009 : Add carbon spinup
45 !! A.L. Gibelin 07/2009 : Suppress RDK and transform GPP as a diagnostic
46 !! B. Decharme 05/12 : Carbon fluxes in diag_evap
47 !! B. Decharme 10/12 Isba water budget diag
48 !! B. Decharme 10/12 New diag for DIF:
49 !! F2 stress
50 !! Root zone swi, wg and wgi
51 !! swi, wg and wgi comparable to ISBA-FR-DG2 and DG3 layers
52 !! active layer thickness over permafrost
53 !! frozen layer thickness over non-permafrost
54 !! B. Vincendon 02/2014 : condition added for RAD_BUDGET variables (needed for
55 !! restart mode)
56 ! B. decharme 04/2013 : Add new diag for coupling
57 ! Delete XTSRAD (because same than XTSRAD_NAT)
58 !! P. Samuelsson 10/2014: MEB
59 !-------------------------------------------------------------------------------
60 !
61 !* 0.0 DECLARATIONS
62 ! ------------
63 !
64 USE mode_diag
65 !
66 USE modd_ch_isba_n, ONLY : ch_isba_t
72 USE modd_isba_n, ONLY : isba_np_t, isba_p_t
73 !
74 #ifdef SFX_OL
75 USE modn_io_offline, ONLY : lrestart
76 #endif
77 USE modd_surf_par, ONLY : xundef
79 USE modd_agri, ONLY : lagrip
80 !
82 USE modi_make_choice_array
84 !
85 USE yomhook ,ONLY : lhook, dr_hook
86 USE parkind1 ,ONLY : jprb
87 !
88 IMPLICIT NONE
89 !
90 !* 0.01 Declarations of arguments
91 ! -------------------------
92 !
93 TYPE(ch_isba_t), INTENT(INOUT) :: CHI
94 TYPE(diag_evap_isba_t), INTENT(INOUT) :: DE
95 TYPE(diag_evap_isba_t), INTENT(INOUT) :: DEC
96 TYPE(diag_evap_isba_np_t), INTENT(INOUT) :: NDE
97 TYPE(diag_evap_isba_np_t), INTENT(INOUT) :: NDEC
98 TYPE(diag_options_t), INTENT(IN) :: DGO
99 TYPE(diag_t), INTENT(INOUT) :: D
100 TYPE(diag_t), INTENT(INOUT) :: DC
101 TYPE(diag_np_t), INTENT(INOUT) :: ND
102 TYPE(diag_np_t), INTENT(INOUT) :: NDC
103 TYPE(diag_misc_isba_t), INTENT(INOUT) :: DM
104 TYPE(diag_misc_isba_np_t), INTENT(INOUT) :: NDM
105 LOGICAL, INTENT(IN) :: OREAD_BUDGETC
106 TYPE(gr_biog_np_t), INTENT(INOUT) :: NGB
107 TYPE(gr_biog_t), INTENT(INOUT) :: GB
108 TYPE(isba_options_t), INTENT(INOUT) :: IO
109 TYPE(isba_np_t), INTENT(INOUT) :: NP
110  CHARACTER(LEN=*), INTENT(IN) :: HSNOW_SCHEME
111 INTEGER, INTENT(IN) :: KSNOW_NLAYER
112 !
113 INTEGER, INTENT(IN) :: KABC
114 !
115 INTEGER, INTENT(IN) :: KLU ! size of arrays
116 INTEGER, INTENT(IN) :: KSW ! spectral bands
117  CHARACTER(LEN=6), INTENT(IN):: HPROGRAM ! program calling
118 !
119 !* 0.02 Declarations of local variables
120 ! -------------------------------
121 !
122 TYPE(diag_options_t) :: YDO
123 TYPE(diag_evap_isba_t) :: YDE
124 TYPE(diag_misc_isba_t) :: YDM
125 TYPE(isba_p_t), POINTER :: PK
126 REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK
127 LOGICAL :: GCUMUL, GDIM
128 INTEGER :: JP
129 INTEGER :: IVERSION, IBUG
130 INTEGER :: IRESP ! IRESP : return-code if a problem appears
131 INTEGER :: ISIZE_LMEB_PATCH ! Number of patches where multi-energy balance should be applied
132  CHARACTER(LEN=12) :: YREC ! Name of the article to be read
133  CHARACTER(LEN=6) :: YREC2
134 REAL(KIND=JPRB) :: ZHOOK_HANDLE
135 !
136 !-------------------------------------------------------------------------------
137 !
138 !////////////////NOT CUMULATED DIAGNOSTICS//////////////////////////////
139 !
140 !* surface energy budget
141 !
142 IF (lhook) CALL dr_hook('DIAG_ISBA_INIT_N',0,zhook_handle)
143 !
144 isize_lmeb_patch=count(io%LMEB_PATCH(:))
145 !
146 ydo%LSURF_BUDGET = .true.
147 ydo%N2M = 1
148 ydo%LCOEF = .true.
149 ydo%LSURF_VARS = .true.
150 !
151 yde%LSURF_EVAP_BUDGET = .true.
152 !
153 ydm%LSURF_MISC_BUDGET = .true.
154 !
155  CALL alloc_bud(ydo,d,klu,ksw)
156 !
157 DO jp = 1,io%NPATCH
158  CALL alloc_bud(ydo,nd%AL(jp),np%AL(jp)%NSIZE_P,ksw)
159  !
160  ALLOCATE(nd%AL(jp)%XCDN(np%AL(jp)%NSIZE_P))
161  ALLOCATE(nd%AL(jp)%XHUG(np%AL(jp)%NSIZE_P))
162  ALLOCATE(nd%AL(jp)%XHU (np%AL(jp)%NSIZE_P))
163  !
164  nd%AL(jp)%XCDN = xundef
165  nd%AL(jp)%XHUG = xundef
166  nd%AL(jp)%XHU = xundef
167  !
168 ENDDO
169 !
170 IF (ydo%LSURF_BUDGET) THEN
171  !
172  ALLOCATE(d%XEVAP(klu))
173  ALLOCATE(d%XSUBL(klu))
174  d%XEVAP = xundef
175  d%XSUBL = xundef
176  !
177  DO jp = 1,io%NPATCH
178  ALLOCATE(nd%AL(jp)%XEVAP(np%AL(jp)%NSIZE_P))
179  ALLOCATE(nd%AL(jp)%XSUBL(np%AL(jp)%NSIZE_P))
180  nd%AL(jp)%XEVAP = xundef
181  nd%AL(jp)%XSUBL = xundef
182  ENDDO
183  !
184 ELSE
185  !
186  ALLOCATE(d%XEVAP(0))
187  ALLOCATE(d%XSUBL(0))
188  !
189  DO jp = 1,io%NPATCH
190  ALLOCATE(nd%AL(jp)%XEVAP(0))
191  ALLOCATE(nd%AL(jp)%XSUBL(0))
192  ENDDO
193  !
194 END IF
195 !
196 IF (ydo%N2M>=1) THEN
197  !
198  ALLOCATE(d%XSFCO2(klu))
199  d%XSFCO2 = xundef
200  DO jp = 1,io%NPATCH
201  ALLOCATE(nd%AL(jp)%XSFCO2(np%AL(jp)%NSIZE_P))
202  nd%AL(jp)%XSFCO2 = xundef
203  ENDDO
204  !
205 ELSE
206  !
207  ALLOCATE(d%XSFCO2(0))
208  DO jp=1,io%NPATCH
209  ALLOCATE(nd%AL(jp)%XSFCO2(0))
210  ENDDO
211  !
212 END IF
213 !
214 !* transfer coefficients
215 !
216 DO jp=1,io%NPATCH
217  ALLOCATE(nd%AL(jp)%XZ0EFF(np%AL(jp)%NSIZE_P))
218  nd%AL(jp)%XZ0EFF = xundef
219 ENDDO
220 !
221 IF (ydo%LCOEF) THEN
222  !
223  ALLOCATE(d%XZ0EFF(klu))
224  d%XZ0EFF = xundef
225  !
226 ELSE
227  !
228  ALLOCATE(d%XZ0EFF(0))
229  !
230 END IF
231 !
232 !
233 !* surface temperature and parameters at 2m
234 !
235 ALLOCATE(d%XALBT(klu))
236 d%XALBT = xundef
237 DO jp=1,io%NPATCH
238  ALLOCATE(nd%AL(jp)%XTS (np%AL(jp)%NSIZE_P))
239  ALLOCATE(nd%AL(jp)%XALBT (np%AL(jp)%NSIZE_P))
240  ALLOCATE(nd%AL(jp)%XTSRAD (np%AL(jp)%NSIZE_P))
241  nd%AL(jp)%XTS = xundef
242  nd%AL(jp)%XTSRAD = xundef
243  nd%AL(jp)%XALBT = xundef
244 ENDDO
245 !
246 !* detailed surface energy budget
247 !
248 IF (yde%LSURF_EVAP_BUDGET) THEN
249  !
250  CALL alloc_evap_bud(de,klu,0)
251  DO jp = 1,io%NPATCH
252  CALL alloc_evap_bud(nde%AL(jp),np%AL(jp)%NSIZE_P,np%AL(jp)%NSIZE_P)
253  ENDDO
254  !
255  IF (isize_lmeb_patch>0) THEN
256  !
257  CALL alloc_meb_bud(de,klu)
258  DO jp = 1,io%NPATCH
259  CALL alloc_meb_bud(nde%AL(jp),np%AL(jp)%NSIZE_P)
260  ENDDO
261  !
262  ENDIF
263  !
264  IF(io%LGLACIER)THEN
265  ALLOCATE(de%XICEFLUX(klu))
266  de%XICEFLUX(:) = xundef
267  DO jp=1,io%NPATCH
268  ALLOCATE(nde%AL(jp)%XICEFLUX(np%AL(jp)%NSIZE_P))
269  nde%AL(jp)%XICEFLUX(:) = xundef
270  ENDDO
271  ENDIF
272  !
273  IF(de%LWATER_BUDGET)THEN
274  !
275  ALLOCATE(de%XRAINFALL (klu))
276  ALLOCATE(de%XSNOWFALL (klu))
277  de%XRAINFALL = xundef
278  de%XSNOWFALL = xundef
279  !
280  CALL alloc_water_bud(de,klu)
281  DO jp=1,io%NPATCH
282  CALL alloc_water_bud(nde%AL(jp),np%AL(jp)%NSIZE_P)
283  ENDDO
284  !
285  ENDIF
286  !
287 ELSE
288  !
289  CALL alloc_evap_bud(de,0,0)
290  DO jp=1,io%NPATCH
291  CALL alloc_evap_bud(nde%AL(jp),0,0)
292  ENDDO
293  !
294 ENDIF
295 !
296 IF (.NOT. yde%LSURF_EVAP_BUDGET .OR. .NOT.de%LWATER_BUDGET) THEN
297  !
298  ALLOCATE(de%XRAINFALL (0))
299  ALLOCATE(de%XSNOWFALL (0))
300  !
301  CALL alloc_water_bud(de,0)
302  DO jp=1,io%NPATCH
303  CALL alloc_water_bud(nde%AL(jp),0)
304  ENDDO
305  !
306 ENDIF
307 !
308 IF (.NOT.yde%LSURF_EVAP_BUDGET .OR. isize_lmeb_patch<=0) THEN
309  !
310  CALL alloc_meb_bud(de,0)
311  DO jp=1,io%NPATCH
312  CALL alloc_meb_bud(nde%AL(jp),0)
313  ENDDO
314  !
315 END IF
316 !
317 IF(.NOT.yde%LSURF_EVAP_BUDGET .OR. .NOT.io%LGLACIER)THEN
318  ALLOCATE(de%XICEFLUX(0))
319  DO jp=1,io%NPATCH
320  ALLOCATE(nde%AL(jp)%XICEFLUX(0))
321  ENDDO
322 ENDIF
323 !
324 !////////////////CUMULATED DIAGNOSTICS//////////////////////////////
325 !
326 !* surface cumulated energy budget
327 !
328 #ifdef SFX_OL
329 gcumul = (dgo%LSURF_BUDGETC .OR. (lrestart .AND. .NOT.dgo%LRESET_BUDGETC))
330 #else
331 gcumul = (dgo%LSURF_BUDGETC .OR. .NOT.dgo%LRESET_BUDGETC)
332 #endif
333 !
334 IF ( gcumul ) THEN
335  !
336  !///////////////////////ALLOCATIONS//////////////////////
337  !
338  CALL alloc_evap_bud(dec,klu,0)
339  DO jp=1,io%NPATCH
340  CALL alloc_evap_bud(ndec%AL(jp),np%AL(jp)%NSIZE_P,0)
341  ENDDO
342  !
343  IF (isize_lmeb_patch>0) THEN
344  !
345  CALL alloc_meb_bud(dec,klu)
346  DO jp=1,io%NPATCH
347  CALL alloc_meb_bud(ndec%AL(jp),np%AL(jp)%NSIZE_P)
348  ENDDO
349  !
350  ENDIF
351  !
352  CALL alloc_surf_bud(dc,0,klu,0)
353  ALLOCATE(dc%XEVAP(klu))
354  ALLOCATE(dc%XSUBL(klu))
355  dc%XEVAP = xundef
356  dc%XSUBL = xundef
357  DO jp=1,io%NPATCH
358  CALL alloc_surf_bud(ndc%AL(jp),0,np%AL(jp)%NSIZE_P,0)
359  ALLOCATE(ndc%AL(jp)%XEVAP(np%AL(jp)%NSIZE_P))
360  ALLOCATE(ndc%AL(jp)%XSUBL(np%AL(jp)%NSIZE_P))
361  ndc%AL(jp)%XEVAP = xundef
362  ndc%AL(jp)%XSUBL = xundef
363  ENDDO
364  !
365  IF(io%LGLACIER)THEN
366  ALLOCATE(dec%XICEFLUX(klu))
367  DO jp=1,io%NPATCH
368  ALLOCATE(ndec%AL(jp)%XICEFLUX(np%AL(jp)%NSIZE_P))
369  ENDDO
370  ENDIF
371  !
372 #ifdef SFX_OL
373  IF(de%LWATER_BUDGET .OR. (lrestart .AND. .NOT.dgo%LRESET_BUDGETC))THEN
374 #else
375  IF(de%LWATER_BUDGET .OR. .NOT.dgo%LRESET_BUDGETC)THEN
376 #endif
377  !
378  ALLOCATE(dec%XRAINFALL (klu))
379  ALLOCATE(dec%XSNOWFALL (klu))
380  !
381  CALL alloc_water_bud(dec,klu)
382  DO jp=1,io%NPATCH
383  CALL alloc_water_bud(ndec%AL(jp),np%AL(jp)%NSIZE_P)
384  ENDDO
385  !
386  ENDIF
387  !
388  !/////////////////INITIALISATIONS//////////////////////////
389  !
390  CALL init_evap_bud(dec)
391  !
392  IF (isize_lmeb_patch>0) THEN
393  !
394  CALL init_meb_bud(dec)
395  !
396  ENDIF
397  !
398  CALL init_surf_bud(dc,0.)
399  dc%XEVAP = 0.
400  dc%XSUBL = 0.
401  !
402  IF(io%LGLACIER) dec%XICEFLUX = 0.0
403  !
404  IF (.NOT.oread_budgetc .OR. (oread_budgetc.AND.dgo%LRESET_BUDGETC)) THEN
405  !
406  DO jp=1,io%NPATCH
407  CALL init_evap_bud(ndec%AL(jp))
408  ENDDO
409  !
410  IF (isize_lmeb_patch>0) THEN
411  !
412  DO jp=1,io%NPATCH
413  CALL init_meb_bud(ndec%AL(jp))
414  ENDDO
415  !
416  ENDIF
417  !
418  DO jp=1,io%NPATCH
419  CALL init_surf_bud(ndc%AL(jp),0.)
420  ndc%AL(jp)%XEVAP = 0.
421  ndc%AL(jp)%XSUBL = 0.
422  ENDDO
423  !
424  IF(io%LGLACIER)THEN
425  DO jp=1,io%NPATCH
426  ndec%AL(jp)%XICEFLUX = 0.0
427  ENDDO
428  ENDIF
429  !
430 #ifdef SFX_OL
431  IF(de%LWATER_BUDGET .OR. (lrestart .AND. .NOT.dgo%LRESET_BUDGETC))THEN
432 #else
433  IF(de%LWATER_BUDGET .OR. .NOT.dgo%LRESET_BUDGETC)THEN
434 #endif
435  !
436  CALL init_water_bud(dec)
437  DO jp=1,io%NPATCH
438  CALL init_water_bud(ndec%AL(jp))
439  ENDDO
440  !
441  dec%XRAINFALL = 0.0
442  dec%XSNOWFALL = 0.0
443  !
444  ENDIF
445  !
446  ELSE
447  !
448  CALL read_surf(hprogram,'VERSION',iversion,iresp)
449  CALL read_surf(hprogram,'BUG ',ibug,iresp)
450  !
451  gdim = (iversion>8 .OR. iversion==8 .AND. ibug>0)
452  !
453 #ifdef SFX_OL
454  IF(de%LWATER_BUDGET .OR. (lrestart .AND. .NOT.dgo%LRESET_BUDGETC))THEN
455 #else
456  IF(de%LWATER_BUDGET .OR. .NOT.dgo%LRESET_BUDGETC)THEN
457 #endif
458  IF(iversion>7 .OR. iversion==7 .AND. ibug>=3)THEN
459  yrec='RAINFC_ISBA'
460  CALL read_surf(hprogram,yrec,dec%XRAINFALL,iresp)
461  yrec='SNOWFC_ISBA'
462  CALL read_surf(hprogram,yrec,dec%XSNOWFALL,iresp)
463  ELSE
464  dec%XRAINFALL = 0.0
465  dec%XSNOWFALL = 0.0
466  ENDIF
467  ENDIF
468  !
469  IF(dgo%LPATCH_BUDGET .AND. io%NPATCH>1)THEN
470  !
471  !
472  IF (gdim) THEN
473  yrec2=''
474  ELSEIF (iversion<7 .OR. iversion==7 .AND. ibug<3) THEN
475  yrec2='PATCH'
476  ELSE
477  yrec2='P'
478  ENDIF
479  !
480  ALLOCATE(zwork(klu,io%NPATCH))
481  !
482  !/////////////EVAP PATCH/////////////////////////////
483  !
484  yrec='LEGC_'//yrec2
485  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
486  DO jp = 1,io%NPATCH
487  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLEG(:))
488  ENDDO
489  !
490  yrec='LEGIC_'//yrec2
491  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
492  DO jp = 1,io%NPATCH
493  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLEGI(:))
494  ENDDO
495  !
496  yrec='LEVC_'//yrec2
497  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
498  DO jp = 1,io%NPATCH
499  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLEV(:))
500  ENDDO
501 
502  !
503  yrec='LESC_'//yrec2
504  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
505  DO jp = 1,io%NPATCH
506  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLES(:))
507  ENDDO
508  !
509  IF(hsnow_scheme=='3-L' .OR. hsnow_scheme=='CRO')THEN
510  IF(iversion>7 .OR. iversion==7 .AND. ibug>=3)THEN
511  !
512  yrec='LESLC_'//yrec2
513  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
514  DO jp = 1,io%NPATCH
515  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLESL(:))
516  ENDDO
517  !
518  ELSE
519  !
520  DO jp=1,io%NPATCH
521  ndec%AL(jp)%XLESL(:) = 0.0
522  ENDDO
523  !
524  ENDIF
525  !
526  IF(iversion>=8)THEN
527  !
528  yrec='SNDRIFC_'//yrec2
529  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
530  DO jp = 1,io%NPATCH
531  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XSNDRIFT(:))
532  ENDDO
533  !
534  ELSE
535  !
536  DO jp=1,io%NPATCH
537  ndec%AL(jp)%XSNDRIFT(:) = 0.0
538  ENDDO
539  !
540  ENDIF
541  !
542  ELSE
543  !
544  DO jp=1,io%NPATCH
545  ndec%AL(jp)%XLESL(:) = 0.0
546  ndec%AL(jp)%XSNDRIFT(:) = 0.0
547  ENDDO
548  !
549  ENDIF
550  !
551  yrec='LERC_'//yrec2
552  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
553  DO jp = 1,io%NPATCH
554  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLER(:))
555  ENDDO
556  !
557  yrec='LETRC_'//yrec2
558  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
559  DO jp = 1,io%NPATCH
560  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLETR(:))
561  ENDDO
562  !
563  yrec='EVAPC_'//yrec2
564  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
565  DO jp = 1,io%NPATCH
566  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndc%AL(jp)%XEVAP(:))
567  ENDDO
568  !
569  IF (iversion<8)THEN
570  DO jp=1,io%NPATCH
571  ndc%AL(jp)%XSUBL(:) = 0.0
572  ENDDO
573  ELSE
574  yrec='SUBLC_'//yrec2
575  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
576  DO jp = 1,io%NPATCH
577  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndc%AL(jp)%XSUBL(:))
578  ENDDO
579  ENDIF
580  !
581  yrec='DRAINC_'//yrec2
582  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
583  DO jp = 1,io%NPATCH
584  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XDRAIN(:))
585  ENDDO
586  !
587  yrec='RUNOFFC_'//yrec2
588  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
589  DO jp = 1,io%NPATCH
590  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XRUNOFF(:))
591  ENDDO
592  !
593  yrec='DRIVEGC_'//yrec2
594  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
595  DO jp = 1,io%NPATCH
596  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XDRIP(:))
597  ENDDO
598  !
599  yrec='RRVEGC_'//yrec2
600  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
601  DO jp = 1,io%NPATCH
602  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XRRVEG(:))
603  ENDDO
604  !
605  yrec='SNOMLTC_'//yrec2
606  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
607  DO jp = 1,io%NPATCH
608  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XMELT(:))
609  ENDDO
610  !
611  IF (lagrip) THEN
612  yrec='IRRIGC_'//yrec2
613  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
614  DO jp = 1,io%NPATCH
615  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XIRRIG_FLUX(:))
616  ENDDO
617  ELSE
618  DO jp=1,io%NPATCH
619  ndec%AL(jp)%XIRRIG_FLUX(:) = 0.0
620  ENDDO
621  ENDIF
622  !
623  IF(io%CPHOTO/='NON' .AND. (iversion>7 .OR. iversion==7 .AND. ibug>=3))THEN
624  yrec='GPPC_'//yrec2
625  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
626  DO jp = 1,io%NPATCH
627  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XGPP(:))
628  ENDDO
629  !
630  yrec='RC_AUTO_'//yrec2
631  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
632  DO jp = 1,io%NPATCH
633  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XRESP_AUTO(:))
634  ENDDO
635  !
636  yrec='RC_ECO_'//yrec2
637  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
638  DO jp = 1,io%NPATCH
639  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XRESP_ECO(:))
640  ENDDO
641  ELSE
642  DO jp=1,io%NPATCH
643  ndec%AL(jp)%XGPP(:) = 0.0
644  ndec%AL(jp)%XRESP_AUTO(:) = 0.0
645  ndec%AL(jp)%XRESP_ECO(:) = 0.0
646  ENDDO
647  ENDIF
648  !
649  IF((io%CRUNOFF=='SGH'.AND.io%CISBA=='DIF').AND.iversion>=8)THEN
650  yrec='QSBC_'//yrec2
651  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
652  DO jp = 1,io%NPATCH
653  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XQSB(:))
654  ENDDO
655  ELSE
656  de%XQSB = 0.0
657  ENDIF
658  !
659  IF(io%CHORT=='SGH'.OR.io%CISBA=='DIF')THEN
660  yrec='HORTONC_'//yrec2
661  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
662  DO jp = 1,io%NPATCH
663  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XHORT(:))
664  ENDDO
665  ELSE
666  DO jp=1,io%NPATCH
667  ndec%AL(jp)%XHORT(:) = 0.0
668  ENDDO
669  ENDIF
670  !
671  IF(io%LFLOOD)THEN
672  yrec='IFLOODC_'//yrec2
673  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
674  DO jp = 1,io%NPATCH
675  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XIFLOOD(:))
676  ENDDO
677  !
678  yrec='PFLOODC_'//yrec2
679  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
680  DO jp = 1,io%NPATCH
681  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XPFLOOD(:))
682  ENDDO
683  !
684  yrec='LEFC_'//yrec2
685  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
686  DO jp = 1,io%NPATCH
687  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLE_FLOOD(:))
688  ENDDO
689  !
690  yrec='LEIFC_'//yrec2
691  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
692  DO jp = 1,io%NPATCH
693  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLEI_FLOOD(:))
694  ENDDO
695  ELSE
696  DO jp=1,io%NPATCH
697  ndec%AL(jp)%XIFLOOD(:) = 0.0
698  ndec%AL(jp)%XPFLOOD(:) = 0.0
699  ndec%AL(jp)%XLE_FLOOD(:) = 0.0
700  ndec%AL(jp)%XLEI_FLOOD(:) = 0.0
701  ENDDO
702  ENDIF
703  !
704  !
705  IF (isize_lmeb_patch>0) THEN
706  !
707  yrec='LEV_CVC_'//yrec2
708  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
709  DO jp = 1,io%NPATCH
710  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLEV_CV(:))
711  ENDDO
712  !
713  yrec='LES_CVC_'//yrec2
714  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
715  DO jp = 1,io%NPATCH
716  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLES_CV(:))
717  ENDDO
718  !
719  yrec='LETR_CVC_'//yrec2
720  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
721  DO jp = 1,io%NPATCH
722  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLETR_CV(:))
723  ENDDO
724  !
725  yrec='LER_CVC_'//yrec2
726  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
727  DO jp = 1,io%NPATCH
728  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLER_CV(:))
729  ENDDO
730  !
731  yrec='LE_CVC_'//yrec2
732  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
733  DO jp = 1,io%NPATCH
734  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLE_CV(:))
735  ENDDO
736  !
737  yrec='H_CVC_'//yrec2
738  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
739  DO jp = 1,io%NPATCH
740  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XH_CV(:))
741  ENDDO
742  !
743  yrec='MELT_CVC_'//yrec2
744  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
745  DO jp = 1,io%NPATCH
746  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XMELT_CV(:))
747  ENDDO
748  !
749  yrec='FRZ_CVC_'//yrec2
750  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
751  DO jp = 1,io%NPATCH
752  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XFRZ_CV(:))
753  ENDDO
754  !
755  yrec='LE_GVC_'//yrec2
756  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
757  DO jp = 1,io%NPATCH
758  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLE_GV(:))
759  ENDDO
760  !
761  yrec='H_GVC_'//yrec2
762  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
763  DO jp = 1,io%NPATCH
764  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XH_GV(:))
765  ENDDO
766  !
767  yrec='LE_GNC_'//yrec2
768  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
769  DO jp = 1,io%NPATCH
770  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLE_GN(:))
771  ENDDO
772  !
773  yrec='H_GNC_'//yrec2
774  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
775  DO jp = 1,io%NPATCH
776  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XH_GN(:))
777  ENDDO
778  !
779  yrec='SR_GNC_'//yrec2
780  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
781  DO jp = 1,io%NPATCH
782  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XSR_GN(:))
783  ENDDO
784  !
785  yrec='SWDN_GNC_'//yrec2
786  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
787  DO jp = 1,io%NPATCH
788  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XSWDOWN_GN(:))
789  ENDDO
790  !
791  yrec='LWDN_GNC_'//yrec2
792  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
793  DO jp = 1,io%NPATCH
794  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLWDOWN_GN(:))
795  ENDDO
796  !
797  yrec='LE_CAC_'//yrec2
798  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
799  DO jp = 1,io%NPATCH
800  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLE_CA(:))
801  ENDDO
802  !
803  yrec='H_CAC_'//yrec2
804  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
805  DO jp = 1,io%NPATCH
806  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XH_CA(:))
807  ENDDO
808  !
809  yrec='SWNT_VC_'//yrec2
810  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
811  DO jp = 1,io%NPATCH
812  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XSWNET_V(:))
813  ENDDO
814  !
815  yrec='SWNT_GC_'//yrec2
816  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
817  DO jp = 1,io%NPATCH
818  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XSWNET_G(:))
819  ENDDO
820  !
821  yrec='SWNT_NC_'//yrec2
822  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
823  DO jp = 1,io%NPATCH
824  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XSWNET_N(:))
825  ENDDO
826  !
827  yrec='SWNT_NSC_'//yrec2
828  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
829  DO jp = 1,io%NPATCH
830  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XSWNET_NS(:))
831  ENDDO
832  !
833  yrec='LWNT_VC_'//yrec2
834  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
835  DO jp = 1,io%NPATCH
836  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLWNET_V(:))
837  ENDDO
838  !
839  yrec='LWNT_GC_'//yrec2
840  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
841  DO jp = 1,io%NPATCH
842  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLWNET_G(:))
843  ENDDO
844  !
845  yrec='LWNT_NC_'//yrec2
846  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
847  DO jp = 1,io%NPATCH
848  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XLWNET_N(:))
849  ENDDO
850  !
851  ENDIF
852  !
853  yrec='RNC_'//yrec2
854  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
855  DO jp = 1,io%NPATCH
856  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndc%AL(jp)%XRN(:))
857  ENDDO
858  !
859  yrec='HC_'//yrec2
860  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
861  DO jp = 1,io%NPATCH
862  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndc%AL(jp)%XH(:))
863  ENDDO
864  !
865  yrec='LEC_'//yrec2
866  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
867  DO jp = 1,io%NPATCH
868  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndc%AL(jp)%XLE(:))
869  ENDDO
870  !
871  yrec='LEIC_'//yrec2
872  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
873  DO jp = 1,io%NPATCH
874  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndc%AL(jp)%XLEI(:))
875  ENDDO
876  !
877  yrec='GFLUXC_'//yrec2
878  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
879  DO jp = 1,io%NPATCH
880  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndc%AL(jp)%XGFLUX(:))
881  ENDDO
882  !
883  IF (dgo%LRAD_BUDGET) THEN
884  !
885  yrec='SWDC_'//yrec2
886  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
887  DO jp = 1,io%NPATCH
888  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndc%AL(jp)%XSWD(:))
889  ENDDO
890  !
891  yrec='SWUC_'//yrec2
892  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
893  DO jp = 1,io%NPATCH
894  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndc%AL(jp)%XSWU(:))
895  ENDDO
896  !
897  yrec='LWDC_'//yrec2
898  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
899  DO jp = 1,io%NPATCH
900  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndc%AL(jp)%XLWD(:))
901  ENDDO
902  !
903  yrec='LWUC_'//yrec2
904  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
905  DO jp = 1,io%NPATCH
906  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndc%AL(jp)%XLWU(:))
907  ENDDO
908  !
909  ENDIF
910  !
911  yrec='FMUC_'//yrec2
912  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
913  DO jp = 1,io%NPATCH
914  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndc%AL(jp)%XFMU(:))
915  ENDDO
916  !
917  yrec='FMVC_'//yrec2
918  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
919  DO jp = 1,io%NPATCH
920  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndc%AL(jp)%XFMV(:))
921  ENDDO
922  !
923  IF(io%LGLACIER)THEN
924  yrec='ICE_FC_'//yrec2
925  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
926  DO jp = 1,io%NPATCH
927  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XICEFLUX(:))
928  ENDDO
929  ENDIF
930  !
931  !
932 #ifdef SFX_OL
933  IF(de%LWATER_BUDGET .OR. (lrestart .AND. .NOT.dgo%LRESET_BUDGETC))THEN
934 #else
935  IF(de%LWATER_BUDGET .OR. .NOT.dgo%LRESET_BUDGETC)THEN
936 #endif
937  IF(iversion>7 .OR. iversion==7 .AND. ibug>=3)THEN
938  !
939  yrec='DWGC_'//yrec2
940  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
941  DO jp = 1,io%NPATCH
942  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XDWG(:))
943  ENDDO
944  !
945  yrec='DWGIC_'//yrec2
946  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
947  DO jp = 1,io%NPATCH
948  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XDWGI(:))
949  ENDDO
950  !
951  yrec='DWRC_'//yrec2
952  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
953  DO jp = 1,io%NPATCH
954  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XDWR(:))
955  ENDDO
956  !
957  yrec='DSWEC_'//yrec2
958  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
959  DO jp = 1,io%NPATCH
960  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XDSWE(:))
961  ENDDO
962  !
963  yrec='WATBUDC_'//yrec2
964  CALL make_choice_array(hprogram, io%NPATCH, gdim, yrec, zwork)
965  DO jp = 1,io%NPATCH
966  CALL pack_same_rank(np%AL(jp)%NR_P,zwork(:,jp),ndec%AL(jp)%XWATBUD(:))
967  ENDDO
968  !
969  ELSE
970  !
971  DO jp=1,io%NPATCH
972  CALL init_water_bud(ndec%AL(jp))
973  ENDDO
974  !
975  ENDIF
976  !
977  DEALLOCATE(zwork)
978  !
979  ELSE
980  !
981  DO jp=1,io%NPATCH
982  !
983  CALL init_evap_bud(ndec%AL(jp))
984  !
985  IF (isize_lmeb_patch>0) THEN
986  CALL init_meb_bud(ndec%AL(jp))
987  ENDIF
988  !
989  CALL init_surf_bud(dc,0.)
990  dc%XEVAP = 0.
991  dc%XSUBL = 0.
992  !
993  ENDDO
994  !
995  IF(io%LGLACIER)THEN
996  DO jp=1,io%NPATCH
997  ndec%AL(jp)%XICEFLUX=0.0
998  ENDDO
999  ENDIF
1000  !
1001 #ifdef SFX_OL
1002  IF(de%LWATER_BUDGET .OR. (lrestart .AND. .NOT.dgo%LRESET_BUDGETC))THEN
1003 #else
1004  IF(de%LWATER_BUDGET .OR. .NOT.dgo%LRESET_BUDGETC)THEN
1005 #endif
1006  !
1007  DO jp=1,io%NPATCH
1008  CALL init_water_bud(ndec%AL(jp))
1009  ENDDO
1010  !
1011  ENDIF
1012  !
1013  ENDIF
1014  !
1015  ENDIF
1016  !
1017  ENDIF
1018  !
1019 ELSE
1020  !
1021  CALL alloc_surf_bud(dc,0,0,0)
1022  ALLOCATE(dc%XEVAP(0))
1023  ALLOCATE(dc%XSUBL(0))
1024  !
1025  CALL alloc_evap_bud(dec,0,0)
1026  !
1027  DO jp=1,io%NPATCH
1028  !
1029  CALL alloc_surf_bud(ndc%AL(jp),0,0,0)
1030  ALLOCATE(ndc%AL(jp)%XEVAP(0))
1031  ALLOCATE(ndc%AL(jp)%XSUBL(0))
1032  !
1033  CALL alloc_evap_bud(ndec%AL(jp),0,0)
1034  !
1035  ENDDO
1036  !
1037 ENDIF
1038 !
1039 #ifdef SFX_OL
1040 IF(.NOT.gcumul .AND. (.NOT.de%LWATER_BUDGET .OR. .NOT.lrestart .OR. dgo%LRESET_BUDGETC))THEN
1041 #else
1042 IF(.NOT.gcumul .AND. (.NOT.de%LWATER_BUDGET .OR. dgo%LRESET_BUDGETC))THEN
1043 #endif
1044  !
1045  ALLOCATE(dec%XRAINFALL (0))
1046  ALLOCATE(dec%XSNOWFALL (0))
1047  !
1048  CALL alloc_water_bud(dec,0)
1049  DO jp=1,io%NPATCH
1050  CALL alloc_water_bud(ndec%AL(jp),0)
1051  ENDDO
1052  !
1053 ENDIF
1054 !
1055 IF (.NOT.gcumul .OR. isize_lmeb_patch<=0) THEN
1056  !
1057  CALL alloc_meb_bud(dec,0)
1058  DO jp=1,io%NPATCH
1059  CALL alloc_meb_bud(ndec%AL(jp),0)
1060  ENDDO
1061  !
1062 ENDIF
1063 !
1064 IF(.NOT.io%LGLACIER)THEN
1065  ALLOCATE(dec%XICEFLUX(0))
1066  DO jp=1,io%NPATCH
1067  ALLOCATE(ndec%AL(jp)%XICEFLUX(0))
1068  ENDDO
1069 ENDIF
1070 !
1071 !* miscellaneous surface fields
1072 !
1073 IF (ydm%LSURF_MISC_BUDGET) THEN
1074  !
1075  CALL alloc_misc_bud(dm,klu,0,io%NGROUND_LAYER,0,dm%LPROSNOW)
1076  DO jp=1,io%NPATCH
1077  CALL alloc_misc_bud(ndm%AL(jp),np%AL(jp)%NSIZE_P,np%AL(jp)%NSIZE_P,&
1078  io%NGROUND_LAYER,ksnow_nlayer,dm%LPROSNOW)
1079  ENDDO
1080  !
1081 ELSE
1082  !
1083  CALL alloc_misc_bud(dm,0,0,0,0,dm%LPROSNOW)
1084  DO jp=1,io%NPATCH
1085  CALL alloc_misc_bud(ndm%AL(jp),0,0,0,0,dm%LPROSNOW)
1086  ENDDO
1087  !
1088 END IF
1089 !
1090 !* Chemical fluxes
1091 IF (chi%SVI%NBEQ>0 .AND. chi%LCH_BIO_FLUX) THEN
1092  ALLOCATE(gb%XFISO(klu))
1093  ALLOCATE(gb%XFMONO(klu))
1094  !
1095  gb%XFISO = xundef
1096  gb%XFMONO = xundef
1097 ELSE
1098  ALLOCATE(gb%XFISO(0))
1099  ALLOCATE(gb%XFMONO(0))
1100 ENDIF
1101 !
1102 IF (io%CPHOTO/='NON') THEN
1103  DO jp = 1,io%NPATCH
1104  ALLOCATE(ngb%AL(jp)%XIACAN(np%AL(jp)%NSIZE_P,kabc))
1105  !
1106  ngb%AL(jp)%XIACAN = xundef
1107  ENDDO
1108  !
1109 ELSE
1110  DO jp = 1,io%NPATCH
1111  ALLOCATE(ngb%AL(jp)%XIACAN(0,0))
1112  ENDDO
1113 ENDIF
1114 !
1115 IF (lhook) CALL dr_hook('DIAG_ISBA_INIT_N',1,zhook_handle)
1116 !
1117 CONTAINS
1118 !
1119 !
1120 SUBROUTINE alloc_misc_bud(DMA,KLUA,KLUAP,KNLAYER,KSNLAYER,OPROSNOW)
1122 TYPE(diag_misc_isba_t), INTENT(INOUT) :: DMA
1123 INTEGER, INTENT(IN) :: KLUA
1124 INTEGER, INTENT(IN) :: KLUAP
1125 INTEGER, INTENT(IN) :: KNLAYER
1126 INTEGER, INTENT(IN) :: KSNLAYER
1127 LOGICAL, INTENT(IN) :: OPROSNOW
1128 REAL(KIND=JPRB) :: ZHOOK_HANDLE
1129 !
1130 IF (lhook) CALL dr_hook('DIAG_ISBA_INIT_N:ALLOC_MISC_BUD',0,zhook_handle)
1131 !
1132 !////////////DIAG DEFINED BY PATCH AND AVERAGED//////////
1133 !
1134 ALLOCATE(dma%XHV (klua))
1135 !
1136 ALLOCATE(dma%XSWI (klua,knlayer))
1137 ALLOCATE(dma%XTSWI (klua,knlayer))
1138 !
1139 ALLOCATE(dma%XTWSNOW (klua))
1140 ALLOCATE(dma%XTDSNOW (klua))
1141 ALLOCATE(dma%XTTSNOW (klua))
1142 !
1143 IF ( oprosnow .AND. hsnow_scheme=="CRO" ) THEN
1144  !
1145  ALLOCATE(dma%XSNOWDEND (kluap,ksnlayer))
1146  ALLOCATE(dma%XSNOWSPHER (kluap,ksnlayer))
1147  ALLOCATE(dma%XSNOWSIZE (kluap,ksnlayer))
1148  ALLOCATE(dma%XSNOWSSA (kluap,ksnlayer))
1149  ALLOCATE(dma%XSNOWTYPEMEPRA(kluap,ksnlayer))
1150  ALLOCATE(dma%XSNOWRAM (kluap,ksnlayer))
1151  ALLOCATE(dma%XSNOWSHEAR (kluap,ksnlayer))
1152  !
1153  ALLOCATE(dma%XSNDPT_1DY(klua))
1154  ALLOCATE(dma%XSNDPT_3DY(klua))
1155  ALLOCATE(dma%XSNDPT_5DY(klua))
1156  ALLOCATE(dma%XSNDPT_7DY(klua))
1157  ALLOCATE(dma%XSNSWE_1DY(klua))
1158  ALLOCATE(dma%XSNSWE_3DY(klua))
1159  ALLOCATE(dma%XSNSWE_5DY(klua))
1160  ALLOCATE(dma%XSNSWE_7DY(klua))
1161  ALLOCATE(dma%XSNRAM_SONDE(klua))
1162  ALLOCATE(dma%XSN_WETTHCKN(klua))
1163  ALLOCATE(dma%XSN_REFRZNTHCKN(klua))
1164  !
1165 ELSE
1166  !
1167  ALLOCATE(dma%XSNOWDEND (0,0))
1168  ALLOCATE(dma%XSNOWSPHER (0,0))
1169  ALLOCATE(dma%XSNOWSIZE (0,0))
1170  ALLOCATE(dma%XSNOWSSA (0,0))
1171  ALLOCATE(dma%XSNOWTYPEMEPRA(0,0))
1172  ALLOCATE(dma%XSNOWRAM (0,0))
1173  ALLOCATE(dma%XSNOWSHEAR (0,0))
1174  !
1175  ALLOCATE(dma%XSNDPT_1DY(0))
1176  ALLOCATE(dma%XSNDPT_3DY(0))
1177  ALLOCATE(dma%XSNDPT_5DY(0))
1178  ALLOCATE(dma%XSNDPT_7DY(0))
1179  ALLOCATE(dma%XSNSWE_1DY(0))
1180  ALLOCATE(dma%XSNSWE_3DY(0))
1181  ALLOCATE(dma%XSNSWE_5DY(0))
1182  ALLOCATE(dma%XSNSWE_7DY(0))
1183  ALLOCATE(dma%XSNRAM_SONDE(0))
1184  ALLOCATE(dma%XSN_WETTHCKN(0))
1185  ALLOCATE(dma%XSN_REFRZNTHCKN(0))
1186  !
1187 ENDIF
1188 !
1189 ALLOCATE(dma%XPSNG (klua))
1190 ALLOCATE(dma%XPSNV (klua))
1191 ALLOCATE(dma%XPSN (klua))
1192 !
1193 ALLOCATE(dma%XFSAT (klua))
1194 !
1195 ALLOCATE(dma%XFFG (klua))
1196 ALLOCATE(dma%XFFV (klua))
1197 ALLOCATE(dma%XFF (klua))
1198 !
1199 IF (klua>0) THEN
1200  dma%XHV = xundef
1201  dma%XSWI = xundef
1202  dma%XTSWI = xundef
1203  dma%XTWSNOW = xundef
1204  dma%XTDSNOW = xundef
1205  dma%XTTSNOW = xundef
1206  dma%XPSNG = xundef
1207  dma%XPSNV = xundef
1208  dma%XPSN = xundef
1209  dma%XFSAT = xundef
1210  dma%XFFG = xundef
1211  dma%XFFV = xundef
1212  dma%XFF = xundef
1213 ENDIF
1214 !
1215 IF ( oprosnow .AND. hsnow_scheme=="CRO" ) THEN
1216  !
1217  IF (kluap>0) THEN
1218  dma%XSNOWDEND = xundef
1219  dma%XSNOWSPHER = xundef
1220  dma%XSNOWSIZE = xundef
1221  dma%XSNOWSSA = xundef
1222  dma%XSNOWTYPEMEPRA = xundef
1223  dma%XSNOWRAM = xundef
1224  dma%XSNOWSHEAR = xundef
1225  ENDIF
1226  !
1227  IF (klua>0) THEN
1228  dma%XSNDPT_1DY = xundef
1229  dma%XSNDPT_3DY = xundef
1230  dma%XSNDPT_5DY = xundef
1231  dma%XSNDPT_7DY = xundef
1232  dma%XSNSWE_1DY = xundef
1233  dma%XSNSWE_3DY = xundef
1234  dma%XSNSWE_5DY = xundef
1235  dma%XSNSWE_7DY = xundef
1236  dma%XSNRAM_SONDE = xundef
1237  dma%XSN_WETTHCKN = xundef
1238  dma%XSN_REFRZNTHCKN = xundef
1239  ENDIF
1240  !
1241 ENDIF
1242 !
1243 IF(io%CISBA=='DIF')THEN
1244  ALLOCATE(dma%XALT(klua))
1245  ALLOCATE(dma%XFLT(klua))
1246  IF (klua>0) THEN
1247  dma%XALT = xundef
1248  dma%XFLT = xundef
1249  ENDIF
1250 ELSE
1251  ALLOCATE(dma%XALT(0))
1252  ALLOCATE(dma%XFLT(0))
1253 ENDIF
1254 !
1255 !//////////////DIAG DEFINED ONLY BY PATCH//////////////
1256 !
1257 ALLOCATE(dma%XSNOWLIQ (kluap,ksnlayer))
1258 ALLOCATE(dma%XSNOWTEMP (kluap,ksnlayer))
1259 ALLOCATE(dma%XSNOWDZ (kluap,ksnlayer))
1260 !
1261 IF (kluap>0) THEN
1262  dma%XSNOWLIQ = xundef
1263  dma%XSNOWTEMP= xundef
1264  dma%XSNOWDZ = xundef
1265 ENDIF
1266 !
1267 IF (lagrip) THEN
1268  ALLOCATE(dma%XSEUIL (kluap))
1269  !
1270  IF (kluap>0) THEN
1271  dma%XSEUIL = xundef
1272  ENDIF
1273 ELSE
1274  ALLOCATE(dma%XSEUIL(0))
1275 ENDIF
1276 !
1277 IF (io%LTR_ML) THEN
1278  ALLOCATE (dma%XFAPAR (kluap))
1279  ALLOCATE (dma%XFAPIR (kluap))
1280  ALLOCATE (dma%XFAPAR_BS (kluap))
1281  ALLOCATE (dma%XFAPIR_BS (kluap))
1282  ALLOCATE (dma%XDFAPARC (kluap))
1283  ALLOCATE (dma%XDFAPIRC (kluap))
1284  ALLOCATE (dma%XDLAI_EFFC (kluap))
1285  !
1286  IF (kluap>0) THEN
1287  dma%XFAPAR = xundef
1288  dma%XFAPIR = xundef
1289  dma%XFAPAR_BS = xundef
1290  dma%XFAPIR_BS = xundef
1291  dma%XDFAPARC = 0.
1292  dma%XDFAPIRC = 0.
1293  dma%XDLAI_EFFC = 0.
1294  ENDIF
1295 ELSE
1296  ALLOCATE (dma%XFAPAR (0))
1297  ALLOCATE (dma%XFAPIR (0))
1298  ALLOCATE (dma%XFAPAR_BS (0))
1299  ALLOCATE (dma%XFAPIR_BS (0))
1300  ALLOCATE (dma%XDFAPARC (0))
1301  ALLOCATE (dma%XDFAPIRC (0))
1302  ALLOCATE (dma%XDLAI_EFFC (0))
1303 ENDIF
1304 !
1305 !
1306 ALLOCATE(dma%XC1 (kluap))
1307 ALLOCATE(dma%XC2 (kluap))
1308 ALLOCATE(dma%XWGEQ (kluap))
1309 ALLOCATE(dma%XCG (kluap))
1310 ALLOCATE(dma%XCT (kluap))
1311 ALLOCATE(dma%XRS (kluap))
1312 ALLOCATE(dma%XGRNDFLUX (kluap))
1313 ALLOCATE(dma%XSNOWHMASS(kluap))
1314 ALLOCATE(dma%XSRSFC (kluap))
1315 ALLOCATE(dma%XRRSFC (kluap))
1316 ALLOCATE(dma%XRNSNOW (kluap))
1317 ALLOCATE(dma%XHSNOW (kluap))
1318 ALLOCATE(dma%XGFLUXSNOW(kluap))
1319 ALLOCATE(dma%XHPSNOW (kluap))
1320 ALLOCATE(dma%XUSTARSNOW(kluap))
1321 ALLOCATE(dma%XCDSNOW (kluap))
1322 ALLOCATE(dma%XCHSNOW (kluap))
1323 !
1324 IF (kluap>0) THEN
1325  dma%XC1 = xundef
1326  dma%XC2 = xundef
1327  dma%XWGEQ = xundef
1328  dma%XCG = xundef
1329  dma%XCT = xundef
1330  dma%XRS = xundef
1331  dma%XGRNDFLUX = xundef
1332  dma%XSNOWHMASS = xundef
1333  dma%XSRSFC = xundef
1334  dma%XRRSFC = xundef
1335  dma%XRNSNOW = xundef
1336  dma%XHSNOW = xundef
1337  dma%XGFLUXSNOW = xundef
1338  dma%XHPSNOW = xundef
1339  dma%XUSTARSNOW = xundef
1340  dma%XCDSNOW = xundef
1341  dma%XCHSNOW = xundef
1342 ENDIF
1343 !
1344 !////////////DIAG DEFINED ONLY AVERAGED//////////////
1345 !
1346 ALLOCATE(dma%XLAI (klua))
1347 !
1348 ALLOCATE(dma%XSOIL_SWI (klua))
1349 ALLOCATE(dma%XSOIL_TSWI (klua))
1350 ALLOCATE(dma%XSOIL_TWG (klua))
1351 ALLOCATE(dma%XSOIL_TWGI (klua))
1352 ALLOCATE(dma%XSOIL_WG (klua))
1353 ALLOCATE(dma%XSOIL_WGI (klua))
1354 !
1355 IF (klua>0) THEN
1356  dma%XLAI = xundef
1357  dma%XSOIL_TSWI = xundef
1358  dma%XSOIL_SWI = xundef
1359  dma%XSOIL_TWG = xundef
1360  dma%XSOIL_TWGI = xundef
1361  dma%XSOIL_WG = xundef
1362  dma%XSOIL_WGI = xundef
1363 ENDIF
1364 !
1365 IF(io%CISBA=='DIF'.AND.dm%LSURF_MISC_DIF)THEN
1366  ALLOCATE(dma%XFRD2_TSWI(klua))
1367  ALLOCATE(dma%XFRD2_TWG (klua))
1368  ALLOCATE(dma%XFRD2_TWGI(klua))
1369  ALLOCATE(dma%XFRD3_TSWI(klua))
1370  ALLOCATE(dma%XFRD3_TWG (klua))
1371  ALLOCATE(dma%XFRD3_TWGI(klua))
1372  !
1373  IF (klua>0) THEN
1374  dma%XFRD2_TSWI = xundef
1375  dma%XFRD2_TWG = xundef
1376  dma%XFRD2_TWGI = xundef
1377  dma%XFRD3_TSWI = xundef
1378  dma%XFRD3_TWG = xundef
1379  dma%XFRD3_TWGI = xundef
1380  ENDIF
1381  !
1382 ELSE
1383  ALLOCATE(dma%XFRD2_TSWI(0))
1384  ALLOCATE(dma%XFRD2_TWG (0))
1385  ALLOCATE(dma%XFRD2_TWGI(0))
1386  ALLOCATE(dma%XFRD3_TSWI(0))
1387  ALLOCATE(dma%XFRD3_TWG (0))
1388  ALLOCATE(dma%XFRD3_TWGI(0))
1389 ENDIF
1390 !
1391 IF (lhook) CALL dr_hook('DIAG_ISBA_INIT_N:ALLOC_MISC_BUD',1,zhook_handle)
1392 !
1393 END SUBROUTINE alloc_misc_bud
1394 !
1395 SUBROUTINE alloc_evap_bud(DEA,KLUA,KLUAP)
1397 TYPE(diag_evap_isba_t), INTENT(INOUT) :: DEA
1398 INTEGER, INTENT(IN) :: KLUA
1399 INTEGER, INTENT(IN) :: KLUAP
1400 REAL(KIND=JPRB) :: ZHOOK_HANDLE
1401 !
1402 IF (lhook) CALL dr_hook('DIAG_ISBA_INIT_N:ALLOC_EVAP_BUD',0,zhook_handle)
1403 !
1404 ALLOCATE(dea%XLEG (klua))
1405 ALLOCATE(dea%XLEGI (klua))
1406 ALLOCATE(dea%XLEV (klua))
1407 ALLOCATE(dea%XLES (klua))
1408 !
1409 ALLOCATE(dea%XLESL (klua))
1410 ALLOCATE(dea%XSNDRIFT (klua))
1411 !
1412 ALLOCATE(dea%XLER (klua))
1413 ALLOCATE(dea%XLETR (klua))
1414 !
1415 ALLOCATE(dea%XDRAIN (klua))
1416 ALLOCATE(dea%XRUNOFF (klua))
1417 ALLOCATE(dea%XDRIP (klua))
1418 ALLOCATE(dea%XRRVEG (klua))
1419 ALLOCATE(dea%XMELT (klua))
1420 !
1421 ALLOCATE(dea%XIRRIG_FLUX(klua))
1422 !
1423 ALLOCATE(dea%XGPP (klua))
1424 ALLOCATE(dea%XRESP_AUTO (klua))
1425 ALLOCATE(dea%XRESP_ECO (klua))
1426 !
1427 ALLOCATE(dea%XQSB (klua))
1428 ALLOCATE(dea%XHORT (klua))
1429 !
1430 ALLOCATE(dea%XIFLOOD (klua))
1431 ALLOCATE(dea%XPFLOOD (klua))
1432 ALLOCATE(dea%XLE_FLOOD (klua))
1433 ALLOCATE(dea%XLEI_FLOOD(klua))
1434 !
1435 ALLOCATE(dea%XRN_SN_FR (kluap))
1436 ALLOCATE(dea%XH_SN_FR (kluap))
1437 ALLOCATE(dea%XLEI_SN_FR (kluap))
1438 ALLOCATE(dea%XLE_SN_FR (kluap))
1439 ALLOCATE(dea%XGFLUX_SN_FR(kluap))
1440 ALLOCATE(dea%XLEG_SN_FR (kluap))
1441 ALLOCATE(dea%XLEGI_SN_FR (kluap))
1442 ALLOCATE(dea%XLEV_SN_FR (kluap))
1443 ALLOCATE(dea%XLETR_SN_FR (kluap))
1444 ALLOCATE(dea%XUSTAR_SN_FR(kluap))
1445 ALLOCATE(dea%XLER_SN_FR (kluap))
1446 !
1447 ALLOCATE(dea%XMELTADV (kluap))
1448 ALLOCATE(dea%XRESTORE (kluap))
1449 !
1450 IF (klua>0) THEN
1451  dea%XLEG = xundef
1452  dea%XLEGI = xundef
1453  dea%XLEV = xundef
1454  dea%XLES = xundef
1455  !
1456  dea%XLESL = xundef
1457  dea%XSNDRIFT = xundef
1458  !
1459  dea%XLER = xundef
1460  dea%XLETR = xundef
1461  !
1462  dea%XDRAIN = xundef
1463  dea%XRUNOFF = xundef
1464  dea%XDRIP = xundef
1465  dea%XRRVEG = xundef
1466  dea%XMELT = xundef
1467  !
1468  dea%XIRRIG_FLUX = xundef
1469  !
1470  dea%XGPP = xundef
1471  dea%XRESP_AUTO = xundef
1472  dea%XRESP_ECO = xundef
1473  !
1474  dea%XQSB = xundef
1475  dea%XHORT = xundef
1476  !
1477  dea%XIFLOOD = xundef
1478  dea%XPFLOOD = xundef
1479  dea%XLE_FLOOD = xundef
1480  dea%XLEI_FLOOD = xundef
1481  !
1482 ENDIF
1483 !
1484 IF (kluap>0) THEN
1485  dea%XRN_SN_FR = xundef
1486  dea%XH_SN_FR = xundef
1487  dea%XLEI_SN_FR = xundef
1488  dea%XLE_SN_FR = xundef
1489  dea%XGFLUX_SN_FR = xundef
1490  dea%XLEG_SN_FR = xundef
1491  dea%XLEGI_SN_FR = xundef
1492  dea%XLEV_SN_FR = xundef
1493  dea%XLETR_SN_FR = xundef
1494  dea%XUSTAR_SN_FR = xundef
1495  dea%XLER_SN_FR = xundef
1496  !
1497  dea%XMELTADV = xundef
1498  dea%XRESTORE = xundef
1499 ENDIF
1500 !
1501 IF (lhook) CALL dr_hook('DIAG_ISBA_INIT_N:ALLOC_EVAP_BUD',1,zhook_handle)
1502 !
1503 END SUBROUTINE alloc_evap_bud
1504 !
1505 SUBROUTINE alloc_meb_bud(DEA,KLUA)
1507 TYPE(diag_evap_isba_t), INTENT(INOUT) :: DEA
1508 INTEGER, INTENT(IN) :: KLUA
1509 REAL(KIND=JPRB) :: ZHOOK_HANDLE
1510 !
1511 IF (lhook) CALL dr_hook('DIAG_ISBA_INIT_N:ALLOC_MEB_BUD',0,zhook_handle)
1512 !
1513 ALLOCATE(dea%XLELITTER (klua))
1514 ALLOCATE(dea%XLELITTERI(klua))
1515 ALLOCATE(dea%XDRIPLIT (klua))
1516 ALLOCATE(dea%XRRLIT (klua))
1517 !
1518 ALLOCATE(dea%XLEV_CV (klua))
1519 ALLOCATE(dea%XLES_CV (klua))
1520 ALLOCATE(dea%XLETR_CV(klua))
1521 ALLOCATE(dea%XLER_CV (klua))
1522 ALLOCATE(dea%XLE_CV (klua))
1523 ALLOCATE(dea%XH_CV (klua))
1524 ALLOCATE(dea%XMELT_CV(klua))
1525 ALLOCATE(dea%XFRZ_CV (klua))
1526 
1527 ALLOCATE(dea%XLETR_GV(klua))
1528 ALLOCATE(dea%XLER_GV (klua))
1529 ALLOCATE(dea%XLE_GV (klua))
1530 ALLOCATE(dea%XH_GV (klua))
1531 
1532 ALLOCATE(dea%XLE_GN (klua))
1533 ALLOCATE(dea%XEVAP_GN(klua))
1534 ALLOCATE(dea%XH_GN (klua))
1535 ALLOCATE(dea%XSR_GN (klua))
1536 ALLOCATE(dea%XSWDOWN_GN(klua))
1537 ALLOCATE(dea%XLWDOWN_GN(klua))
1538 
1539 ALLOCATE(dea%XEVAP_G (klua))
1540 ALLOCATE(dea%XLE_CA (klua))
1541 ALLOCATE(dea%XH_CA (klua))
1542 !
1543 ALLOCATE(dea%XSWUP(klua))
1544 ALLOCATE(dea%XLWUP(klua))
1545 !
1546 ALLOCATE(dea%XSWNET_V (klua))
1547 ALLOCATE(dea%XSWNET_G (klua))
1548 ALLOCATE(dea%XSWNET_N (klua))
1549 ALLOCATE(dea%XSWNET_NS (klua))
1550 ALLOCATE(dea%XLWNET_V (klua))
1551 ALLOCATE(dea%XLWNET_G (klua))
1552 ALLOCATE(dea%XLWNET_N (klua))
1553 !
1554 IF (klua>0) THEN
1555  dea%XLELITTER = xundef
1556  dea%XLELITTERI = xundef
1557  dea%XDRIPLIT = xundef
1558  dea%XRRLIT = xundef
1559 
1560  dea%XLEV_CV = xundef
1561  dea%XLES_CV = xundef
1562  dea%XLETR_CV = xundef
1563  dea%XLER_CV = xundef
1564  dea%XLE_CV = xundef
1565  dea%XH_CV = xundef
1566  dea%XMELT_CV = xundef
1567  dea%XFRZ_CV = xundef
1568 
1569  dea%XLETR_GV = xundef
1570  dea%XLER_GV = xundef
1571  dea%XLE_GV = xundef
1572  dea%XH_GV = xundef
1573 
1574  dea%XLE_GN = xundef
1575  dea%XEVAP_GN = xundef
1576  dea%XH_GN = xundef
1577  dea%XSR_GN = xundef
1578  dea%XSWDOWN_GN = xundef
1579  dea%XLWDOWN_GN = xundef
1580 
1581  dea%XEVAP_G = xundef
1582  dea%XLE_CA = xundef
1583  dea%XH_CA = xundef
1584  !
1585  dea%XSWUP = xundef
1586  dea%XLWUP = xundef
1587  !
1588  dea%XSWNET_V = xundef
1589  dea%XSWNET_G = xundef
1590  dea%XSWNET_N = xundef
1591  dea%XSWNET_NS = xundef
1592  dea%XLWNET_V = xundef
1593  dea%XLWNET_G = xundef
1594  dea%XLWNET_N = xundef
1595 ENDIF
1596 !
1597 IF (lhook) CALL dr_hook('DIAG_ISBA_INIT_N:ALLOC_MEB_BUD',1,zhook_handle)
1598 !
1599 END SUBROUTINE alloc_meb_bud
1600 !
1601 SUBROUTINE alloc_water_bud(DEA,KLUA)
1603 TYPE(diag_evap_isba_t), INTENT(INOUT) :: DEA
1604 INTEGER, INTENT(IN) :: KLUA
1605 REAL(KIND=JPRB) :: ZHOOK_HANDLE
1606 !
1607 IF (lhook) CALL dr_hook('DIAG_ISBA_INIT_N:ALLOC_WATER_BUD',0,zhook_handle)
1608 !
1609 ALLOCATE(dea%XDWG (klua))
1610 ALLOCATE(dea%XDWGI (klua))
1611 ALLOCATE(dea%XDWR (klua))
1612 ALLOCATE(dea%XDSWE (klua))
1613 ALLOCATE(dea%XWATBUD(klua))
1614 !
1615 IF (klua>0) THEN
1616  dea%XDWG = xundef
1617  dea%XDWGI = xundef
1618  dea%XDWR = xundef
1619  dea%XDSWE = xundef
1620  dea%XWATBUD = xundef
1621 ENDIF
1622 !
1623 IF (lhook) CALL dr_hook('DIAG_ISBA_INIT_N:ALLOC_WATER_BUD',1,zhook_handle)
1624 !
1625 END SUBROUTINE alloc_water_bud
1626 !
1627 !-------------------------------------------------------------------------------
1628 !
1629 END SUBROUTINE diag_isba_init_n
subroutine init_surf_bud(DA, PVAL)
Definition: mode_diag.F90:213
subroutine make_choice_array(HPROGRAM, KNPATCH, ODIM, HRECFM, PWORK, HDIR, KPATCH)
subroutine alloc_meb_bud(DEA, KLUA)
subroutine diag_isba_init_n(CHI, DE, DEC, NDE, NDEC, DGO, D, DC,
subroutine alloc_water_bud(DEA, KLUA)
subroutine alloc_evap_bud(DEA, KLUA, KLUAP)
subroutine init_meb_bud(DEA)
Definition: mode_diag.F90:495
real, parameter xundef
subroutine alloc_bud(DGO, DA, KLU, KSW)
Definition: mode_diag.F90:137
subroutine init_water_bud(DEA)
Definition: mode_diag.F90:546
integer, parameter jprb
Definition: parkind1.F90:32
subroutine init_evap_bud(DEA)
Definition: mode_diag.F90:441
logical lhook
Definition: yomhook.F90:15
subroutine alloc_misc_bud(DMA, KLUA, KLUAP, KNLAYER, KSNLAYER, OPROSNOW)
subroutine alloc_surf_bud(DA, KLUA, KLUAC, KSWA)
Definition: mode_diag.F90:21
static int count
Definition: memory_hook.c:21