86c20828e614c4dbbb2fe503c44560fb778b51e4
[MNH-git_open_source-lfs.git] / src / SURFEX / write_diag_seb_watfluxn.F90
1 !SURFEX_LIC Copyright 1994-2014 Meteo-France 
2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SURFEX_LIC for details. version 1.
5 !     #########
6       SUBROUTINE WRITE_DIAG_SEB_WATFLUX_n(HPROGRAM)
7 !     #################################
8 !
9 !!****  *WRITE_DIAG_SEB_WATFLUX_n* - writes WATFLUX diagnostics
10 !!
11 !!    PURPOSE
12 !!    -------
13 !!
14 !!
15 !!**  METHOD
16 !!    ------
17 !!          
18 !!    REFERENCE
19 !!    ---------
20 !!
21 !!
22 !!    AUTHOR
23 !!    ------
24 !!      V. Masson   *Meteo France*      
25 !!
26 !!    MODIFICATIONS
27 !!    -------------
28 !!      Original    01/2004
29 !!      Modified    01/2006 : sea flux parameterization.
30 !!      S.Bielli    11/2012 : write HU2M_WAT mis placed
31 !-------------------------------------------------------------------------------
32 !
33 !*       0.    DECLARATIONS
34 !              ------------
35 !
36 USE MODD_SURF_PAR,      ONLY : XUNDEF
37 !
38 USE MODD_DIAG_SURF_ATM_n,ONLY : LPROVAR_TO_DIAG, LRESET_BUDGETC
39 !
40 USE MODD_DIAG_WATFLUX_n,ONLY : N2M, LRAD_BUDGET, LSURF_BUDGET, LCOEF,    &
41                                  LSURF_VARS,                               &
42                                  XRN, XH, XLE, XLEI, XGFLUX,               &
43                                  XRI, XCD, XCH, XCE, XZ0, XZ0H,            &
44                                  XT2M, XQ2M, XHU2M, XT2M_MIN, XT2M_MAX,    &
45                                  XZON10M, XMER10M, XQS, XDIAG_TS,          &
46                                  XSWD, XSWU, XLWD, XLWU, XSWBD, XSWBU,     &
47                                  XFMU, XFMV, LSURF_BUDGETC,                &
48                                  XRNC, XHC, XLEC, XGFLUXC, XSWDC, XSWUC,   &
49                                  XLWDC, XLWUC, XFMUC, XFMVC, XLEIC,        &
50                                  XHU2M_MIN, XHU2M_MAX, XWIND10M, XWIND10M_MAX  
51 !
52 USE MODD_WATFLUX_n,ONLY : LINTERPOL_TS
53 !
54 USE MODD_CH_WATFLUX_n,  ONLY : XDEP, CCH_DRY_DEP, CCH_NAMES, NBEQ
55 !
56 USE MODI_INIT_IO_SURF_n
57 USE MODI_WRITE_SURF
58 USE MODI_END_IO_SURF_n
59 !
60 !
61 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
62 USE PARKIND1  ,ONLY : JPRB
63 !
64 IMPLICIT NONE
65 !
66 !*       0.1   Declarations of arguments
67 !              -------------------------
68 !
69  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
70 !
71 !*       0.2   Declarations of local variables
72 !              -------------------------------
73 !
74 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
75  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
76  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
77  CHARACTER(LEN=2)  :: YNUM
78 !
79 INTEGER           :: JSV, JSW
80 REAL(KIND=JPRB) :: ZHOOK_HANDLE
81 !-------------------------------------------------------------------------------
82 !
83 !         Initialisation for IO
84 !
85 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_WATFLUX_N',0,ZHOOK_HANDLE)
86  CALL INIT_IO_SURF_n(HPROGRAM,'WATER ','WATFLX','WRITE')
87 !
88 !
89 !*       2.     Richardson number :
90 !               -----------------
91 !
92 IF (N2M>=1) THEN
93
94 YRECFM='RI_WAT'
95 YCOMMENT='X_Y_'//YRECFM
96 !
97  CALL WRITE_SURF(HPROGRAM,YRECFM,XRI(:),IRESP,HCOMMENT=YCOMMENT)
98 !
99 END IF
100 !
101 !*       3.     Energy fluxes :
102 !               -------------
103 !
104 IF (LSURF_BUDGET) THEN
105
106 YRECFM='RN_WAT'
107 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
108 !
109  CALL WRITE_SURF(HPROGRAM,YRECFM,XRN(:),IRESP,HCOMMENT=YCOMMENT)
110 !
111 YRECFM='H_WAT'
112 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
113 !
114  CALL WRITE_SURF(HPROGRAM,YRECFM,XH(:),IRESP,HCOMMENT=YCOMMENT)
115 !
116 YRECFM='LE_WAT'
117 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
118 !
119  CALL WRITE_SURF(HPROGRAM,YRECFM,XLE(:),IRESP,HCOMMENT=YCOMMENT)
120 !
121 YRECFM='LEI_WAT'
122 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
123 !
124  CALL WRITE_SURF(HPROGRAM,YRECFM,XLEI(:),IRESP,HCOMMENT=YCOMMENT)
125 !
126 YRECFM='GFLUX_WAT'
127 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
128 !
129  CALL WRITE_SURF(HPROGRAM,YRECFM,XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
130 !
131 IF (LRAD_BUDGET) THEN
132 !       
133    YRECFM='SWD_WAT'
134    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
135    !
136    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWD(:),IRESP,HCOMMENT=YCOMMENT)
137    !
138    YRECFM='SWU_WAT'
139    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
140    !
141    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWU(:),IRESP,HCOMMENT=YCOMMENT)
142    !
143    YRECFM='LWD_WAT'
144    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
145    !
146    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWD(:),IRESP,HCOMMENT=YCOMMENT)
147    !
148    YRECFM='LWU_WAT'
149    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
150    !
151    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWU(:),IRESP,HCOMMENT=YCOMMENT)
152    !
153    DO JSW=1, SIZE(XSWBD,2)
154       YNUM=ACHAR(48+JSW)
155       !
156       YRECFM='SWD_WAT_'//YNUM
157       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
158       !
159       CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
160       !
161       YRECFM='SWU_WAT_'//YNUM
162       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
163       !
164       CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
165       !
166    ENDDO
167 !
168 ENDIF
169 !
170 YRECFM='FMU_WAT'
171 YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
172 !
173  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMU(:),IRESP,HCOMMENT=YCOMMENT)
174 YRECFM='FMV_WAT'
175 YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
176 !
177  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMV(:),IRESP,HCOMMENT=YCOMMENT)
178 !
179 END IF
180 !
181 IF (LSURF_BUDGETC) THEN
182
183 YRECFM='RNC_WAT'
184 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
185 !
186  CALL WRITE_SURF(HPROGRAM,YRECFM,XRNC(:),IRESP,HCOMMENT=YCOMMENT)
187 !
188 YRECFM='HC_WAT'
189 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
190 !
191  CALL WRITE_SURF(HPROGRAM,YRECFM,XHC(:),IRESP,HCOMMENT=YCOMMENT)
192 !
193 YRECFM='LEC_WAT'
194 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
195 !
196  CALL WRITE_SURF(HPROGRAM,YRECFM,XLEC(:),IRESP,HCOMMENT=YCOMMENT)
197 !
198 YRECFM='LEIC_WAT'
199 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
200 !
201  CALL WRITE_SURF(HPROGRAM,YRECFM,XLEIC(:),IRESP,HCOMMENT=YCOMMENT)
202 !
203 YRECFM='GFLUXC_WAT'
204 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
205 !
206  CALL WRITE_SURF(HPROGRAM,YRECFM,XGFLUXC(:),IRESP,HCOMMENT=YCOMMENT)
207 !
208 IF (LRAD_BUDGET .OR. (LSURF_BUDGETC .AND. .NOT.LRESET_BUDGETC)) THEN
209 !
210    YRECFM='SWDC_WAT'
211    YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
212    !
213    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWDC(:),IRESP,HCOMMENT=YCOMMENT)
214    !
215    YRECFM='SWUC_WAT'
216    YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
217    !
218    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWUC(:),IRESP,HCOMMENT=YCOMMENT)
219    !
220    YRECFM='LWDC_WAT'
221    YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
222    !
223    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWDC(:),IRESP,HCOMMENT=YCOMMENT)
224    !
225    YRECFM='LWUC_WAT'
226    YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
227    !
228    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWUC(:),IRESP,HCOMMENT=YCOMMENT)
229 !
230 ENDIF
231 !
232 YRECFM='FMUC_WAT'
233 YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
234 !
235  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMUC(:),IRESP,HCOMMENT=YCOMMENT)
236 !
237 YRECFM='FMVC_WAT'
238 YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
239 !
240  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMVC(:),IRESP,HCOMMENT=YCOMMENT)
241 !
242 END IF
243 !
244 !
245 !*       4.     Transfer coefficients
246 !               ---------------------
247 !
248 IF (LCOEF) THEN
249
250 YRECFM='CD_WAT'
251 YCOMMENT='X_Y_'//YRECFM
252 !
253  CALL WRITE_SURF(HPROGRAM,YRECFM,XCD(:),IRESP,HCOMMENT=YCOMMENT)
254 !
255 YRECFM='CH_WAT'
256 YCOMMENT='X_Y_'//YRECFM
257 !
258  CALL WRITE_SURF(HPROGRAM,YRECFM,XCH(:),IRESP,HCOMMENT=YCOMMENT)
259 !
260 YRECFM='CE_WAT'
261 YCOMMENT='X_Y_'//YRECFM
262 !
263  CALL WRITE_SURF(HPROGRAM,YRECFM,XCE(:),IRESP,HCOMMENT=YCOMMENT)
264 !
265 YRECFM='Z0_WAT'
266 YCOMMENT='X_Y_'//YRECFM
267 !
268  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0(:),IRESP,HCOMMENT=YCOMMENT)
269 !
270 YRECFM='Z0H_WAT'
271 YCOMMENT='X_Y_'//YRECFM
272 !
273  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
274 !
275 END IF
276 !
277 !
278 !*       5.     Surface humidity
279 !               ----------------
280 !
281 IF (LSURF_VARS) THEN
282
283 YRECFM='QS_WAT'
284 YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
285 !
286  CALL WRITE_SURF(HPROGRAM,YRECFM,XQS(:),IRESP,HCOMMENT=YCOMMENT)
287 !
288 ENDIF
289 !
290
291 !
292 !*       6.     parameters at 2 and 10 meters :
293 !               -----------------------------
294 !
295 IF (N2M>=1) THEN
296 !
297 YRECFM='T2M_WAT'
298 YCOMMENT='X_Y_'//YRECFM//' (K)'
299 !
300  CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M(:),IRESP,HCOMMENT=YCOMMENT)
301 !
302 YRECFM='T2MMIN_WAT'
303 YCOMMENT='X_Y_'//YRECFM//' (K)'
304 !
305  CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
306 XT2M_MIN(:)=XUNDEF
307 !
308 YRECFM='T2MMAX_WAT'
309 YCOMMENT='X_Y_'//YRECFM//' (K)'
310 !
311  CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
312 XT2M_MAX(:)=0.0
313 !
314 YRECFM='Q2M_WAT'
315 YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
316 !
317  CALL WRITE_SURF(HPROGRAM,YRECFM,XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
318 !
319 YRECFM='HU2M_WAT'
320 YCOMMENT='X_Y_'//YRECFM//' (-)'
321 !
322  CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
323 !
324 YRECFM='HU2MMIN_WAT'
325 YCOMMENT='X_Y_'//YRECFM//' (-)'
326 !
327  CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
328 XHU2M_MIN(:)=XUNDEF
329 !
330 YRECFM='HU2MMAX_WAT'
331 YCOMMENT='X_Y_'//YRECFM//' (-)'
332 !
333  CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
334 XHU2M_MAX(:)=-XUNDEF
335 !
336 YRECFM='ZON10M_WAT'
337 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
338 !
339  CALL WRITE_SURF(HPROGRAM,YRECFM,XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
340 !
341 YRECFM='MER10M_WAT'
342 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
343 !
344  CALL WRITE_SURF(HPROGRAM,YRECFM,XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
345 !
346 YRECFM='W10M_WAT'
347 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
348 !
349  CALL WRITE_SURF(HPROGRAM,YRECFM,XWIND10M(:),IRESP,HCOMMENT=YCOMMENT)
350 !
351 YRECFM='W10MMAX_WAT'
352 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
353 !
354  CALL WRITE_SURF(HPROGRAM,YRECFM,XWIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
355 XWIND10M_MAX(:)=0.0
356 !
357 END IF
358 !
359 !
360 !*       7.     chemical diagnostics:
361 !               --------------------
362 !
363 IF (NBEQ>0 .AND. CCH_DRY_DEP=="WES89 ") THEN
364   DO JSV = 1,SIZE(CCH_NAMES,1)
365     YRECFM='DV_WAT_'//TRIM(CCH_NAMES(JSV))
366     WRITE(YCOMMENT,'(A13,I3.3)')'(m/s) DV_WAT_',JSV
367     CALL WRITE_SURF(HPROGRAM,YRECFM,XDEP(:,JSV),IRESP,HCOMMENT=YCOMMENT)
368   END DO
369 ENDIF
370 !
371 !
372 !*       8.     prognostic variable diagnostics:
373 !               --------------------------------
374 !
375 IF(LPROVAR_TO_DIAG.OR.LINTERPOL_TS)THEN
376 !
377   YRECFM='TS_WATER'
378   YCOMMENT='TS_WATER (K)'
379   CALL WRITE_SURF(HPROGRAM,YRECFM,XDIAG_TS(:),IRESP,HCOMMENT=YCOMMENT)
380 !
381 ENDIF
382 !
383 !-------------------------------------------------------------------------------
384 !
385 !         End of IO
386 !
387  CALL END_IO_SURF_n(HPROGRAM)
388 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_WATFLUX_N',1,ZHOOK_HANDLE)
389 !
390 !
391 END SUBROUTINE WRITE_DIAG_SEB_WATFLUX_n