SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
diag_ideal_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_ideal_init_n (DGL, HPROGRAM, OREAD_BUDGETC, &
7  klu,ksw)
8 ! #####################
9 !
10 !!**** *DIAG_IDEAL_INIT_n* - routine to initialize IDEAL 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 !! P. Le Moigne *Meteo France*
32 !!
33 !! MODIFICATIONS
34 !! -------------
35 !! Original 04/2009
36 !! P. Le Moigne 03/2015: add diagnostics IDEAL case
37 !-------------------------------------------------------------------------------
38 !
39 !* 0. DECLARATIONS
40 ! ------------
41 !
42 !
44 !
45 USE modd_surf_par, ONLY : xundef
46 !
48 !
49 USE yomhook ,ONLY : lhook, dr_hook
50 USE parkind1 ,ONLY : jprb
51 !
52 IMPLICIT NONE
53 !
54 !* 0.1 Declarations of arguments
55 ! -------------------------
56 !
57 !
58 TYPE(diag_ideal_t), INTENT(INOUT) :: dgl
59 !
60  CHARACTER(LEN=6), INTENT(IN):: hprogram ! program calling
61 LOGICAL, INTENT(IN) :: oread_budgetc
62 !
63 INTEGER, INTENT(IN) :: klu ! size of arrays
64 INTEGER, INTENT(IN) :: ksw ! spectral bands
65 !
66 !* 0.2 Declarations of local variables
67 ! -------------------------------
68 !
69 INTEGER :: iversion
70 INTEGER :: iresp ! IRESP : return-code if a problem appears
71  CHARACTER(LEN=12) :: yrec ! Name of the article to be read
72 REAL(KIND=JPRB) :: zhook_handle
73 !
74 !-------------------------------------------------------------------------------
75 !
76 !* surface energy budget
77 !
78 IF (lhook) CALL dr_hook('DIAG_IDEAL_INIT_N',0,zhook_handle)
79 !
80 ALLOCATE(dgl%XDIAG_TS(klu))
81 dgl%XDIAG_TS = xundef
82 !
83 IF (dgl%LSURF_BUDGET .OR. dgl%LSURF_BUDGETC) THEN
84  ALLOCATE(dgl%XRN (klu))
85  ALLOCATE(dgl%XH (klu))
86  ALLOCATE(dgl%XLE (klu))
87  ALLOCATE(dgl%XLEI (klu))
88  ALLOCATE(dgl%XGFLUX (klu))
89  ALLOCATE(dgl%XEVAP (klu))
90  ALLOCATE(dgl%XSUBL (klu))
91  ALLOCATE(dgl%XSWD (klu))
92  ALLOCATE(dgl%XSWU (klu))
93  ALLOCATE(dgl%XLWD (klu))
94  ALLOCATE(dgl%XLWU (klu))
95  ALLOCATE(dgl%XSWBD (klu,ksw))
96  ALLOCATE(dgl%XSWBU (klu,ksw))
97  ALLOCATE(dgl%XFMU (klu))
98  ALLOCATE(dgl%XFMV (klu))
99  ALLOCATE(dgl%XALBT (klu))
100  ALLOCATE(dgl%XSWE (klu))
101  !
102  dgl%XRN = xundef
103  dgl%XH = xundef
104  dgl%XLE = xundef
105  dgl%XLEI = xundef
106  dgl%XGFLUX = xundef
107  dgl%XEVAP = xundef
108  dgl%XSUBL = xundef
109  dgl%XSWD = xundef
110  dgl%XSWU = xundef
111  dgl%XLWD = xundef
112  dgl%XLWU = xundef
113  dgl%XSWBD = xundef
114  dgl%XSWBU = xundef
115  dgl%XFMU = xundef
116  dgl%XFMV = xundef
117  dgl%XALBT = xundef
118  dgl%XSWE = xundef
119 ELSE
120  ALLOCATE(dgl%XRN (0))
121  ALLOCATE(dgl%XH (0))
122  ALLOCATE(dgl%XLE (0))
123  ALLOCATE(dgl%XLEI (0))
124  ALLOCATE(dgl%XGFLUX (0))
125  ALLOCATE(dgl%XEVAP (0))
126  ALLOCATE(dgl%XSUBL (0))
127  ALLOCATE(dgl%XSWD (0))
128  ALLOCATE(dgl%XSWU (0))
129  ALLOCATE(dgl%XLWD (0))
130  ALLOCATE(dgl%XLWU (0))
131  ALLOCATE(dgl%XSWBD (0,0))
132  ALLOCATE(dgl%XSWBU (0,0))
133  ALLOCATE(dgl%XFMU (0))
134  ALLOCATE(dgl%XFMV (0))
135  ALLOCATE(dgl%XALBT (0))
136  ALLOCATE(dgl%XSWE (0))
137 END IF
138 !
139 !* cumulative surface energy budget
140 !
141 IF (dgl%LSURF_BUDGETC) THEN
142 !
143  ALLOCATE(dgl%XRNC (klu))
144  ALLOCATE(dgl%XHC (klu))
145  ALLOCATE(dgl%XLEC (klu))
146  ALLOCATE(dgl%XLEIC (klu))
147  ALLOCATE(dgl%XGFLUXC (klu))
148  ALLOCATE(dgl%XEVAPC (klu))
149  ALLOCATE(dgl%XSUBLC (klu))
150  ALLOCATE(dgl%XSWDC (klu))
151  ALLOCATE(dgl%XSWUC (klu))
152  ALLOCATE(dgl%XLWDC (klu))
153  ALLOCATE(dgl%XLWUC (klu))
154  ALLOCATE(dgl%XFMUC (klu))
155  ALLOCATE(dgl%XFMVC (klu))
156 !
157  IF (.NOT. oread_budgetc) THEN
158  dgl%XRNC = 0.0
159  dgl%XHC = 0.0
160  dgl%XLEC = 0.0
161  dgl%XLEIC = 0.0
162  dgl%XGFLUXC = 0.0
163  dgl%XEVAPC = 0.0
164  dgl%XSUBLC = 0.0
165  dgl%XSWDC = 0.0
166  dgl%XSWUC = 0.0
167  dgl%XLWDC = 0.0
168  dgl%XLWUC = 0.0
169  dgl%XFMUC = 0.0
170  dgl%XFMVC = 0.0
171  ELSEIF (oread_budgetc.AND.dgl%LRESET_BUDGETC) THEN
172  dgl%XRNC = 0.0
173  dgl%XHC = 0.0
174  dgl%XLEC = 0.0
175  dgl%XLEIC = 0.0
176  dgl%XGFLUXC = 0.0
177  dgl%XEVAPC = 0.0
178  dgl%XSUBLC = 0.0
179  dgl%XSWDC = 0.0
180  dgl%XSWUC = 0.0
181  dgl%XLWDC = 0.0
182  dgl%XLWUC = 0.0
183  dgl%XFMUC = 0.0
184  dgl%XFMVC = 0.0
185  ELSE
186  CALL read_surf(hprogram,'VERSION',iversion,iresp)
187  IF (iversion<8)THEN
188  dgl%XRNC = 0.0
189  dgl%XHC = 0.0
190  dgl%XLEC = 0.0
191  dgl%XLEIC = 0.0
192  dgl%XGFLUXC = 0.0
193  dgl%XEVAPC = 0.0
194  dgl%XSUBLC = 0.0
195  dgl%XSWDC = 0.0
196  dgl%XSWUC = 0.0
197  dgl%XLWDC = 0.0
198  dgl%XLWUC = 0.0
199  dgl%XFMUC = 0.0
200  dgl%XFMVC = 0.0
201  ELSE
202  yrec='RNC_WAT'
203  CALL read_surf(hprogram,yrec,dgl%XRNC,iresp)
204  yrec='HC_WAT'
205  CALL read_surf(hprogram,yrec,dgl%XHC ,iresp)
206  yrec='LEC_WAT'
207  CALL read_surf(hprogram,yrec,dgl%XLEC,iresp)
208  yrec='LEIC_WAT'
209  CALL read_surf(hprogram,yrec,dgl%XLEIC,iresp)
210  yrec='GFLUXC_WAT'
211  CALL read_surf(hprogram,yrec,dgl%XGFLUXC,iresp)
212  yrec='SWDC_WAT'
213  CALL read_surf(hprogram,yrec,dgl%XSWDC,iresp)
214  yrec='SWUC_WAT'
215  CALL read_surf(hprogram,yrec,dgl%XSWUC,iresp)
216  yrec='LWDC_WAT'
217  CALL read_surf(hprogram,yrec,dgl%XLWDC,iresp)
218  yrec='LWUC_WAT'
219  CALL read_surf(hprogram,yrec,dgl%XLWUC,iresp)
220  yrec='FMUC_WAT'
221  CALL read_surf(hprogram,yrec,dgl%XFMUC,iresp)
222  yrec='FMVC_WAT'
223  CALL read_surf(hprogram,yrec,dgl%XFMVC,iresp)
224  yrec='EVAPC_WAT'
225  CALL read_surf(hprogram,yrec,dgl%XEVAPC,iresp)
226  yrec='SUBLC_WAT'
227  CALL read_surf(hprogram,yrec,dgl%XSUBLC,iresp)
228  ENDIF
229 !
230  ENDIF
231 ELSE
232  ALLOCATE(dgl%XRNC (0))
233  ALLOCATE(dgl%XHC (0))
234  ALLOCATE(dgl%XLEC (0))
235  ALLOCATE(dgl%XLEIC (0))
236  ALLOCATE(dgl%XGFLUXC (0))
237  ALLOCATE(dgl%XEVAPC (0))
238  ALLOCATE(dgl%XSUBLC (0))
239  ALLOCATE(dgl%XSWDC (0))
240  ALLOCATE(dgl%XSWUC (0))
241  ALLOCATE(dgl%XLWDC (0))
242  ALLOCATE(dgl%XLWUC (0))
243  ALLOCATE(dgl%XFMUC (0))
244  ALLOCATE(dgl%XFMVC (0))
245 ENDIF
246 !
247 !* parameters at 2m
248 !
249 IF (dgl%N2M>=1) THEN
250  ALLOCATE(dgl%XRI (klu))
251  ALLOCATE(dgl%XT2M (klu))
252  ALLOCATE(dgl%XT2M_MIN(klu))
253  ALLOCATE(dgl%XT2M_MAX(klu))
254  ALLOCATE(dgl%XQ2M (klu))
255  ALLOCATE(dgl%XHU2M (klu))
256  ALLOCATE(dgl%XHU2M_MIN(klu))
257  ALLOCATE(dgl%XHU2M_MAX(klu))
258  ALLOCATE(dgl%XZON10M (klu))
259  ALLOCATE(dgl%XMER10M (klu))
260  ALLOCATE(dgl%XWIND10M (klu))
261  ALLOCATE(dgl%XWIND10M_MAX(klu))
262  !
263  dgl%XRI = xundef
264  dgl%XT2M = xundef
265  dgl%XT2M_MIN = xundef
266  dgl%XT2M_MAX = 0.0
267  dgl%XQ2M = xundef
268  dgl%XHU2M = xundef
269  dgl%XHU2M_MIN= xundef
270  dgl%XHU2M_MAX=-xundef
271  dgl%XZON10M = xundef
272  dgl%XMER10M = xundef
273  dgl%XWIND10M = xundef
274  dgl%XWIND10M_MAX = 0.0
275 ELSE
276  ALLOCATE(dgl%XRI (0))
277  ALLOCATE(dgl%XT2M (0))
278  ALLOCATE(dgl%XT2M_MIN (0))
279  ALLOCATE(dgl%XT2M_MAX (0))
280  ALLOCATE(dgl%XQ2M (0))
281  ALLOCATE(dgl%XHU2M (0))
282  ALLOCATE(dgl%XHU2M_MIN(0))
283  ALLOCATE(dgl%XHU2M_MAX(0))
284  ALLOCATE(dgl%XZON10M (0))
285  ALLOCATE(dgl%XMER10M (0))
286  ALLOCATE(dgl%XWIND10M (0))
287  ALLOCATE(dgl%XWIND10M_MAX(0))
288 END IF
289 !
290 !* transfer coefficients
291 !
292 IF (dgl%LCOEF) THEN
293  ALLOCATE(dgl%XCD (klu))
294  ALLOCATE(dgl%XCH (klu))
295  ALLOCATE(dgl%XCE (klu))
296  ALLOCATE(dgl%XZ0 (klu))
297  ALLOCATE(dgl%XZ0H (klu))
298  !
299  dgl%XCD = xundef
300  dgl%XCH = xundef
301  dgl%XCE = xundef
302  dgl%XZ0 = xundef
303  dgl%XZ0H = xundef
304 ELSE
305  ALLOCATE(dgl%XCD (0))
306  ALLOCATE(dgl%XCH (0))
307  ALLOCATE(dgl%XCE (0))
308  ALLOCATE(dgl%XZ0 (0))
309  ALLOCATE(dgl%XZ0H (0))
310 END IF
311 !
312 !
313 !* surface humidity
314 !
315 IF (dgl%LSURF_VARS) THEN
316  ALLOCATE(dgl%XQS (klu))
317  !
318  dgl%XQS = xundef
319 ELSE
320  ALLOCATE(dgl%XQS (0))
321 END IF
322 IF (lhook) CALL dr_hook('DIAG_IDEAL_INIT_N',1,zhook_handle)
323 !
324 !-------------------------------------------------------------------------------
325 !
326 END SUBROUTINE diag_ideal_init_n
subroutine diag_ideal_init_n(DGL, HPROGRAM, OREAD_BUDGETC, KLU, KSW)