SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
diag_flake_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_flake_init_n (DGU, DGF, DGMF, F, &
7  hprogram,klu,ksw)
8 ! #####################
9 !
10 !!**** *DIAG_FLAKE_INIT_n* - routine to initialize FLAKE diagnostic variables
11 !!
12 !! PURPOSE
13 !! -------
14 !!
15 !!** METHOD
16 !! ------
17 !!
18 !! EXTERNAL
19 !! --------
20 !!
21 !!
22 !! IMPLICIT ARGUMENTS
23 !! ------------------
24 !!
25 !! REFERENCE
26 !! ---------
27 !!
28 !!
29 !! AUTHOR
30 !! ------
31 !! V. Masson *Meteo France*
32 !!
33 !! MODIFICATIONS
34 !! -------------
35 !! Original 01/2004
36 !! V.Masson 10/2013 Adds min and max 2m parameters
37 !! B. Decharme 04/2013 new diag
38 !-------------------------------------------------------------------------------
39 !
40 !* 0. DECLARATIONS
41 ! ------------
42 !
43 !
44 !
45 !
46 !
50 USE modd_flake_n, ONLY : flake_t
51 !
52 USE modd_surf_par, ONLY : xundef
53 USE modd_sfx_oasis, ONLY : lcpl_lake
54 !
55 !
56 !
57 !
59 !
60 USE yomhook ,ONLY : lhook, dr_hook
61 USE parkind1 ,ONLY : jprb
62 !
63 IMPLICIT NONE
64 !
65 !* 0.1 Declarations of arguments
66 ! -------------------------
67 !
68 !
69 !
70 !
71 TYPE(diag_flake_t), INTENT(INOUT) :: dgf
72 TYPE(diag_misc_flake_t), INTENT(INOUT) :: dgmf
73 TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
74 TYPE(flake_t), INTENT(INOUT) :: f
75 !
76 INTEGER, INTENT(IN) :: klu ! size of arrays
77 INTEGER, INTENT(IN) :: ksw ! number of SW spectral bands
78  CHARACTER(LEN=6), INTENT(IN):: hprogram ! program calling
79 !
80 !* 0.2 Declarations of local variables
81 ! -------------------------------
82 !
83 INTEGER :: iversion
84 INTEGER :: iresp ! IRESP : return-code if a problem appears
85  CHARACTER(LEN=12) :: yrec ! Name of the article to be read
86 REAL(KIND=JPRB) :: zhook_handle
87 !
88 !-------------------------------------------------------------------------------
89 !
90 !* surface energy budget
91 !
92 IF (lhook) CALL dr_hook('DIAG_FLAKE_INIT_N',0,zhook_handle)
93 !
94 ALLOCATE(dgf%XDIAG_TS(klu))
95 dgf%XDIAG_TS = xundef
96 !
97 IF (dgf%LSURF_BUDGET.OR.dgf%LSURF_BUDGETC) THEN
98  ALLOCATE(dgf%XRN (klu))
99  ALLOCATE(dgf%XH (klu))
100  ALLOCATE(dgf%XLE (klu))
101  ALLOCATE(dgf%XLEI (klu))
102  ALLOCATE(dgf%XGFLUX (klu))
103  ALLOCATE(dgf%XEVAP (klu))
104  ALLOCATE(dgf%XSUBL (klu))
105  ALLOCATE(dgf%XSWD (klu))
106  ALLOCATE(dgf%XSWU (klu))
107  ALLOCATE(dgf%XLWD (klu))
108  ALLOCATE(dgf%XLWU (klu))
109  ALLOCATE(dgf%XSWBD (klu,ksw))
110  ALLOCATE(dgf%XSWBU (klu,ksw))
111  ALLOCATE(dgf%XFMU (klu))
112  ALLOCATE(dgf%XFMV (klu))
113  ALLOCATE(dgf%XALBT (klu))
114  ALLOCATE(dgf%XSWE (klu))
115  !
116  dgf%XRN = xundef
117  dgf%XH = xundef
118  dgf%XLE = xundef
119  dgf%XLEI = xundef
120  dgf%XGFLUX = xundef
121  dgf%XEVAP = xundef
122  dgf%XSUBL = xundef
123  dgf%XSWD = xundef
124  dgf%XSWU = xundef
125  dgf%XLWD = xundef
126  dgf%XLWU = xundef
127  dgf%XSWBD = xundef
128  dgf%XSWBU = xundef
129  dgf%XFMU = xundef
130  dgf%XFMV = xundef
131  dgf%XALBT = xundef
132  dgf%XSWE = xundef
133 ELSE
134  ALLOCATE(dgf%XRN (0))
135  ALLOCATE(dgf%XH (0))
136  ALLOCATE(dgf%XLE (0))
137  ALLOCATE(dgf%XLEI (0))
138  ALLOCATE(dgf%XGFLUX (0))
139  ALLOCATE(dgf%XEVAP (0))
140  ALLOCATE(dgf%XSUBL (0))
141  ALLOCATE(dgf%XSWD (0))
142  ALLOCATE(dgf%XSWU (0))
143  ALLOCATE(dgf%XLWD (0))
144  ALLOCATE(dgf%XLWU (0))
145  ALLOCATE(dgf%XSWBD (0,0))
146  ALLOCATE(dgf%XSWBU (0,0))
147  ALLOCATE(dgf%XFMU (0))
148  ALLOCATE(dgf%XFMV (0))
149  ALLOCATE(dgf%XALBT (0))
150  ALLOCATE(dgf%XSWE (0))
151 END IF
152 !
153 !* cumulative surface energy budget
154 !
155 IF (dgf%LSURF_BUDGETC) THEN
156 !
157  ALLOCATE(dgf%XRNC (klu))
158  ALLOCATE(dgf%XHC (klu))
159  ALLOCATE(dgf%XLEC (klu))
160  ALLOCATE(dgf%XLEIC (klu))
161  ALLOCATE(dgf%XGFLUXC (klu))
162  ALLOCATE(dgf%XEVAPC (klu))
163  ALLOCATE(dgf%XSUBLC (klu))
164  ALLOCATE(dgf%XSWDC (klu))
165  ALLOCATE(dgf%XSWUC (klu))
166  ALLOCATE(dgf%XLWDC (klu))
167  ALLOCATE(dgf%XLWUC (klu))
168  ALLOCATE(dgf%XFMUC (klu))
169  ALLOCATE(dgf%XFMVC (klu))
170 !
171  IF (.NOT. dgu%LREAD_BUDGETC) THEN
172  dgf%XRNC = 0.0
173  dgf%XHC = 0.0
174  dgf%XLEC = 0.0
175  dgf%XLEIC = 0.0
176  dgf%XGFLUXC = 0.0
177  dgf%XEVAPC = 0.0
178  dgf%XSUBLC = 0.0
179  dgf%XSWDC = 0.0
180  dgf%XSWUC = 0.0
181  dgf%XLWDC = 0.0
182  dgf%XLWUC = 0.0
183  dgf%XFMUC = 0.0
184  dgf%XFMVC = 0.0
185  ELSEIF (dgu%LREAD_BUDGETC.AND.dgf%LRESET_BUDGETC) THEN
186  dgf%XRNC = 0.0
187  dgf%XHC = 0.0
188  dgf%XLEC = 0.0
189  dgf%XLEIC = 0.0
190  dgf%XGFLUXC = 0.0
191  dgf%XEVAPC = 0.0
192  dgf%XSUBLC = 0.0
193  dgf%XSWDC = 0.0
194  dgf%XSWUC = 0.0
195  dgf%XLWDC = 0.0
196  dgf%XLWUC = 0.0
197  dgf%XFMUC = 0.0
198  dgf%XFMVC = 0.0
199  ELSE
200  CALL read_surf(&
201  hprogram,'VERSION',iversion,iresp)
202  IF (iversion<8)THEN
203  dgf%XRNC = 0.0
204  dgf%XHC = 0.0
205  dgf%XLEC = 0.0
206  dgf%XLEIC = 0.0
207  dgf%XGFLUXC = 0.0
208  dgf%XEVAPC = 0.0
209  dgf%XSUBLC = 0.0
210  dgf%XSWDC = 0.0
211  dgf%XSWUC = 0.0
212  dgf%XLWDC = 0.0
213  dgf%XLWUC = 0.0
214  dgf%XFMUC = 0.0
215  dgf%XFMVC = 0.0
216  ELSE
217  yrec='RNC_WAT'
218  CALL read_surf(&
219  hprogram,yrec,dgf%XRNC,iresp)
220  yrec='HC_WAT'
221  CALL read_surf(&
222  hprogram,yrec,dgf%XHC ,iresp)
223  yrec='LEC_WAT'
224  CALL read_surf(&
225  hprogram,yrec,dgf%XLEC,iresp)
226  yrec='LEIC_WAT'
227  CALL read_surf(&
228  hprogram,yrec,dgf%XLEIC,iresp)
229  yrec='GFLUXC_WAT'
230  CALL read_surf(&
231  hprogram,yrec,dgf%XGFLUXC,iresp)
232  yrec='SWDC_WAT'
233  CALL read_surf(&
234  hprogram,yrec,dgf%XSWDC,iresp)
235  yrec='SWUC_WAT'
236  CALL read_surf(&
237  hprogram,yrec,dgf%XSWUC,iresp)
238  yrec='LWDC_WAT'
239  CALL read_surf(&
240  hprogram,yrec,dgf%XLWDC,iresp)
241  yrec='LWUC_WAT'
242  CALL read_surf(&
243  hprogram,yrec,dgf%XLWUC,iresp)
244  yrec='FMUC_WAT'
245  CALL read_surf(&
246  hprogram,yrec,dgf%XFMUC,iresp)
247  yrec='FMVC_WAT'
248  CALL read_surf(&
249  hprogram,yrec,dgf%XFMVC,iresp)
250  yrec='EVAPC_WAT'
251  CALL read_surf(&
252  hprogram,yrec,dgf%XEVAPC,iresp)
253  yrec='SUBLC_WAT'
254  CALL read_surf(&
255  hprogram,yrec,dgf%XSUBLC,iresp)
256  ENDIF
257 !
258  ENDIF
259 ELSE
260  ALLOCATE(dgf%XRNC (0))
261  ALLOCATE(dgf%XHC (0))
262  ALLOCATE(dgf%XLEC (0))
263  ALLOCATE(dgf%XLEIC (0))
264  ALLOCATE(dgf%XGFLUXC (0))
265  ALLOCATE(dgf%XEVAPC (0))
266  ALLOCATE(dgf%XSUBLC (0))
267  ALLOCATE(dgf%XSWDC (0))
268  ALLOCATE(dgf%XSWUC (0))
269  ALLOCATE(dgf%XLWDC (0))
270  ALLOCATE(dgf%XLWUC (0))
271  ALLOCATE(dgf%XFMUC (0))
272  ALLOCATE(dgf%XFMVC (0))
273 ENDIF
274 !
275 !* parameters at 2m
276 !
277 IF (dgf%N2M>=1) THEN
278  ALLOCATE(dgf%XRI (klu))
279  ALLOCATE(dgf%XT2M (klu))
280  ALLOCATE(dgf%XT2M_MIN(klu))
281  ALLOCATE(dgf%XT2M_MAX(klu))
282  ALLOCATE(dgf%XQ2M (klu))
283  ALLOCATE(dgf%XHU2M (klu))
284  ALLOCATE(dgf%XHU2M_MIN(klu))
285  ALLOCATE(dgf%XHU2M_MAX(klu))
286  ALLOCATE(dgf%XZON10M (klu))
287  ALLOCATE(dgf%XMER10M (klu))
288  ALLOCATE(dgf%XWIND10M (klu))
289  ALLOCATE(dgf%XWIND10M_MAX(klu))
290  !
291  dgf%XRI = xundef
292  dgf%XT2M = xundef
293  dgf%XT2M_MIN = xundef
294  dgf%XT2M_MAX = 0.0
295  dgf%XQ2M = xundef
296  dgf%XHU2M = xundef
297  dgf%XHU2M_MIN= xundef
298  dgf%XHU2M_MAX=-xundef
299  dgf%XZON10M = xundef
300  dgf%XMER10M = xundef
301  dgf%XWIND10M = xundef
302  dgf%XWIND10M_MAX = 0.0
303 ELSE
304  ALLOCATE(dgf%XRI (0))
305  ALLOCATE(dgf%XT2M (0))
306  ALLOCATE(dgf%XT2M_MIN (0))
307  ALLOCATE(dgf%XT2M_MAX (0))
308  ALLOCATE(dgf%XQ2M (0))
309  ALLOCATE(dgf%XHU2M (0))
310  ALLOCATE(dgf%XHU2M_MIN(0))
311  ALLOCATE(dgf%XHU2M_MAX(0))
312  ALLOCATE(dgf%XZON10M (0))
313  ALLOCATE(dgf%XMER10M (0))
314  ALLOCATE(dgf%XWIND10M (0))
315  ALLOCATE(dgf%XWIND10M_MAX(0))
316 END IF
317 !
318 !* transfer coefficients
319 !
320 IF (dgf%LCOEF) THEN
321  ALLOCATE(dgf%XCD (klu))
322  ALLOCATE(dgf%XCH (klu))
323  ALLOCATE(dgf%XCE (klu))
324  ALLOCATE(dgf%XZ0 (klu))
325  ALLOCATE(dgf%XZ0H (klu))
326  !
327  dgf%XCD = xundef
328  dgf%XCH = xundef
329  dgf%XCE = xundef
330  dgf%XZ0 = xundef
331  dgf%XZ0H = xundef
332 ELSE
333  ALLOCATE(dgf%XCD (0))
334  ALLOCATE(dgf%XCH (0))
335  ALLOCATE(dgf%XCE (0))
336  ALLOCATE(dgf%XZ0 (0))
337  ALLOCATE(dgf%XZ0H (0))
338 END IF
339 !
340 !* surface humidity
341 !
342 IF (dgf%LSURF_VARS) THEN
343  ALLOCATE(dgf%XQS (klu))
344  !
345  dgf%XQS = xundef
346 ELSE
347  ALLOCATE(dgf%XQS (0))
348 END IF
349 !
350 !* Flake temperature profile
351 !
352 IF (dgmf%LWATER_PROFILE) THEN
353  ALLOCATE (dgmf%XZW_PROFILE(count(dgmf%XZWAT_PROFILE/= xundef)))
354  ALLOCATE (dgmf%XTW_PROFILE(count(dgmf%XZWAT_PROFILE/= xundef),klu))
355  dgmf%XZW_PROFILE=dgmf%XZWAT_PROFILE(:count(dgmf%XZWAT_PROFILE /= xundef))
356  ELSE
357  ALLOCATE (dgmf%XZW_PROFILE(0))
358  ALLOCATE (dgmf%XTW_PROFILE(0,0))
359  END IF
360 !
361 !* Coupling field with earth systme model
362 !
363 !
364 IF(lcpl_lake)THEN
365 !
366  ALLOCATE(f%XCPL_FLAKE_EVAP(klu))
367  ALLOCATE(f%XCPL_FLAKE_RAIN(klu))
368  ALLOCATE(f%XCPL_FLAKE_SNOW(klu))
369  f%XCPL_FLAKE_EVAP(:) = 0.0
370  f%XCPL_FLAKE_RAIN(:) = 0.0
371  f%XCPL_FLAKE_SNOW(:) = 0.0
372 !
373 ELSE
374 !
375  ALLOCATE(f%XCPL_FLAKE_EVAP(0))
376  ALLOCATE(f%XCPL_FLAKE_RAIN(0))
377  ALLOCATE(f%XCPL_FLAKE_SNOW(0))
378 !
379 ENDIF
380 !
381 IF (lhook) CALL dr_hook('DIAG_FLAKE_INIT_N',1,zhook_handle)
382 !
383 !-------------------------------------------------------------------------------
384 !
385 END SUBROUTINE diag_flake_init_n
subroutine diag_flake_init_n(DGU, DGF, DGMF, F, HPROGRAM, KLU, KSW)