15a5e39cd2ea3b2a88433f54142194625c0b0e66
[MNH-git_open_source-lfs.git] / src / SURFEX / write_diag_seb_seafluxn.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_SEAFLUX_n(HPROGRAM)
7 !     #################################
8 !
9 !!****  *WRITE_DIAG_SEB_SEAFLUX_n* - write the SEAFLUX diagnostic fields
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 !!      Modified    08/2009 : cumulated diag
31 !-------------------------------------------------------------------------------
32 !
33 !*       0.    DECLARATIONS
34 !              ------------
35 !
36 USE MODD_DIAG_SURF_ATM_n,ONLY : LPROVAR_TO_DIAG, LRESET_BUDGETC
37 !
38 USE MODD_SEAFLUX_n,     ONLY : LINTERPOL_SST
39 USE MODD_SURF_PAR,      ONLY : XUNDEF
40 USE MODD_DIAG_SEAFLUX_n,ONLY : N2M, LRAD_BUDGET, LSURF_BUDGET,           &
41                                  LCOEF, LSURF_VARS, XDIAG_SST,             &
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,                    &
46                                  XSWD, XSWU, XLWD, XLWU, XSWBD, XSWBU,     &
47                                  XFMU, XFMV, LSURF_BUDGETC,                &
48                                  XRNC, XHC, XLEC, XLEIC, XGFLUXC, XSWDC,   &
49                                  XSWUC, XLWDC, XLWUC, XFMUC, XFMVC,        &
50                                  XHU2M_MIN, XHU2M_MAX, XWIND10M, XWIND10M_MAX  
51 !                               
52 USE MODD_CH_SEAFLUX_n,  ONLY : XDEP, CCH_DRY_DEP, CCH_NAMES, NBEQ
53 !
54 USE MODI_INIT_IO_SURF_n
55 USE MODI_WRITE_SURF
56 USE MODI_END_IO_SURF_n
57 !
58 !
59 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
60 USE PARKIND1  ,ONLY : JPRB
61 !
62 IMPLICIT NONE
63 !
64 !*       0.1   Declarations of arguments
65 !              -------------------------
66 !
67  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
68 !
69 !*       0.2   Declarations of local variables
70 !              -------------------------------
71 !
72 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
73  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
74  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
75  CHARACTER(LEN=2)  :: YNUM
76 !
77 INTEGER           :: JSV, JSW
78 REAL(KIND=JPRB) :: ZHOOK_HANDLE
79 !
80 !-------------------------------------------------------------------------------
81 !
82 !         Initialisation for IO
83 !
84 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_SEAFLUX_N',0,ZHOOK_HANDLE)
85  CALL INIT_IO_SURF_n(HPROGRAM,'SEA   ','SEAFLX','WRITE')
86 !
87 !
88 !*       2.     Richardson number :
89 !               -----------------
90 !
91 IF (N2M>=1) THEN
92
93 YRECFM='RI_SEA'
94 YCOMMENT='X_Y_'//YRECFM
95 !
96  CALL WRITE_SURF(HPROGRAM,YRECFM,XRI(:),IRESP,HCOMMENT=YCOMMENT)
97 !
98 END IF
99 !
100 !*       3.     Energy fluxes :
101 !               -------------
102 !
103 IF (LSURF_BUDGET) THEN
104
105 YRECFM='RN_SEA'
106 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
107 !
108  CALL WRITE_SURF(HPROGRAM,YRECFM,XRN(:),IRESP,HCOMMENT=YCOMMENT)
109 !
110 YRECFM='H_SEA'
111 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
112 !
113  CALL WRITE_SURF(HPROGRAM,YRECFM,XH(:),IRESP,HCOMMENT=YCOMMENT)
114 !
115 YRECFM='LE_SEA'
116 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
117 !
118  CALL WRITE_SURF(HPROGRAM,YRECFM,XLE(:),IRESP,HCOMMENT=YCOMMENT)
119 !
120 YRECFM='LEI_SEA'
121 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
122 !
123  CALL WRITE_SURF(HPROGRAM,YRECFM,XLEI(:),IRESP,HCOMMENT=YCOMMENT)
124 !
125 YRECFM='GFLUX_SEA'
126 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
127 !
128  CALL WRITE_SURF(HPROGRAM,YRECFM,XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
129 !
130 IF (LRAD_BUDGET) THEN
131 !
132    YRECFM='SWD_SEA'
133    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
134    !
135    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWD(:),IRESP,HCOMMENT=YCOMMENT)
136    !
137    YRECFM='SWU_SEA'
138    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
139    !
140    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWU(:),IRESP,HCOMMENT=YCOMMENT)
141    !
142    YRECFM='LWD_SEA'
143    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
144    !
145    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWD(:),IRESP,HCOMMENT=YCOMMENT)
146    !
147    YRECFM='LWU_SEA'
148    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
149    !
150    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWU(:),IRESP,HCOMMENT=YCOMMENT)
151    !
152    DO JSW=1, SIZE(XSWBD,2)
153       YNUM=ACHAR(48+JSW)
154       !
155       YRECFM='SWD_SEA_'//YNUM
156       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
157       !
158       CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
159       !
160       YRECFM='SWU_SEA_'//YNUM
161       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
162       !
163       CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
164       !
165    ENDDO
166 !
167 ENDIF
168 !
169 YRECFM='FMU_SEA'
170 YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
171 !
172  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMU(:),IRESP,HCOMMENT=YCOMMENT)
173 !
174 YRECFM='FMV_SEA'
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_SEA'
184 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
185 !
186  CALL WRITE_SURF(HPROGRAM,YRECFM,XRNC(:),IRESP,HCOMMENT=YCOMMENT)
187 !
188 YRECFM='HC_SEA'
189 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
190 !
191  CALL WRITE_SURF(HPROGRAM,YRECFM,XHC(:),IRESP,HCOMMENT=YCOMMENT)
192 !
193 YRECFM='LEC_SEA'
194 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
195 !
196  CALL WRITE_SURF(HPROGRAM,YRECFM,XLEC(:),IRESP,HCOMMENT=YCOMMENT)
197 !
198 YRECFM='LEIC_SEA'
199 YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
200 !
201  CALL WRITE_SURF(HPROGRAM,YRECFM,XLEIC(:),IRESP,HCOMMENT=YCOMMENT)
202 !
203 YRECFM='GFLUXC_SEA'
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_SEA'
211    YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
212    !
213    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWDC(:),IRESP,HCOMMENT=YCOMMENT)
214    !
215    YRECFM='SWUC_SEA'
216    YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
217    !
218    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWUC(:),IRESP,HCOMMENT=YCOMMENT)
219    !
220    YRECFM='LWDC_SEA'
221    YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
222    !
223    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWDC(:),IRESP,HCOMMENT=YCOMMENT)
224    !
225    YRECFM='LWUC_SEA'
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_SEA'
233 YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
234 !
235  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMUC(:),IRESP,HCOMMENT=YCOMMENT)
236 !
237 YRECFM='FMVC_SEA'
238 YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
239 !
240  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMVC(:),IRESP,HCOMMENT=YCOMMENT)
241 !
242 END IF
243 !
244 !*       4.     transfer coefficients
245 !               ---------------------
246 !
247 IF (LCOEF) THEN
248
249 YRECFM='CD_SEA'
250 YCOMMENT='X_Y_'//YRECFM//' (W/s2)'
251 !
252  CALL WRITE_SURF(HPROGRAM,YRECFM,XCD(:),IRESP,HCOMMENT=YCOMMENT)
253 !
254 YRECFM='CH_SEA'
255 YCOMMENT='X_Y_'//YRECFM//' (W/s)'
256 !
257  CALL WRITE_SURF(HPROGRAM,YRECFM,XCH(:),IRESP,HCOMMENT=YCOMMENT)
258 !
259 YRECFM='CE_SEA'
260 YCOMMENT='X_Y_'//YRECFM//' (W/s/K)'
261 !
262  CALL WRITE_SURF(HPROGRAM,YRECFM,XCE(:),IRESP,HCOMMENT=YCOMMENT)
263 !
264 YRECFM='Z0_SEA'
265 YCOMMENT='X_Y_'//YRECFM//' (M)'
266 !
267  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0(:),IRESP,HCOMMENT=YCOMMENT)
268 !
269 YRECFM='Z0H_SEA'
270 YCOMMENT='X_Y_'//YRECFM//' (M)'
271 !
272  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
273 !
274 END IF
275 !
276 !
277 !*       5.     Surface humidity
278 !               ----------------
279 !
280 IF (LSURF_VARS) THEN
281
282 YRECFM='QS_SEA'
283 YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
284 !
285  CALL WRITE_SURF(HPROGRAM,YRECFM,XQS(:),IRESP,HCOMMENT=YCOMMENT)
286 !
287 ENDIF
288 !
289
290 !
291 !*       6.     parameters at 2 and 10 meters :
292 !               -----------------------------
293 !
294 IF (N2M>=1) THEN
295 !
296 YRECFM='T2M_SEA'
297 YCOMMENT='X_Y_'//YRECFM//' (K)'
298 !
299  CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M(:),IRESP,HCOMMENT=YCOMMENT)
300 !
301 YRECFM='T2MMIN_SEA'
302 YCOMMENT='X_Y_'//YRECFM//' (K)'
303 !
304  CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
305 XT2M_MIN(:)=XUNDEF
306 !
307 YRECFM='T2MMAX_SEA'
308 YCOMMENT='X_Y_'//YRECFM//' (K)'
309 !
310  CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
311 XT2M_MAX(:)=0.0
312 !
313 YRECFM='Q2M_SEA'
314 YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
315 !
316  CALL WRITE_SURF(HPROGRAM,YRECFM,XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
317 !
318 YRECFM='HU2M_SEA'
319 YCOMMENT='X_Y_'//YRECFM//' (-)'
320 !
321  CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
322 !
323 YRECFM='HU2MMIN_SEA'
324 YCOMMENT='X_Y_'//YRECFM//' (-)'
325 !
326  CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
327 XHU2M_MIN(:)=XUNDEF
328 !
329 YRECFM='HU2MMAX_SEA'
330 YCOMMENT='X_Y_'//YRECFM//' (-)'
331 !
332  CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
333 XHU2M_MAX(:)=-XUNDEF
334 !
335 YRECFM='ZON10M_SEA'
336 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
337 !
338  CALL WRITE_SURF(HPROGRAM,YRECFM,XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
339 !
340 YRECFM='MER10M_SEA'
341 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
342 !
343  CALL WRITE_SURF(HPROGRAM,YRECFM,XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
344 !
345 YRECFM='W10M_SEA'
346 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
347 !
348  CALL WRITE_SURF(HPROGRAM,YRECFM,XWIND10M(:),IRESP,HCOMMENT=YCOMMENT)
349 !
350 YRECFM='W10MMAX_SEA'
351 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
352 !
353  CALL WRITE_SURF(HPROGRAM,YRECFM,XWIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
354 XWIND10M_MAX(:)=0.0
355 !
356 END IF
357 !
358 !
359 !*       7.     chemical diagnostics:
360 !               --------------------
361 !
362 IF (NBEQ>0 .AND. CCH_DRY_DEP=="WES89 ") THEN
363   DO JSV = 1,SIZE(CCH_NAMES,1)
364     YRECFM='DV_SEA_'//TRIM(CCH_NAMES(JSV))
365     WRITE(YCOMMENT,'(A13,I3.3)')'(m/s) DV_SEA_',JSV
366     CALL WRITE_SURF(HPROGRAM,YRECFM,XDEP(:,JSV),IRESP,HCOMMENT=YCOMMENT)
367   END DO
368 ENDIF
369 !
370 !
371 !*       8.     prognostic variable diagnostics:
372 !               --------------------------------
373 !
374 IF(LPROVAR_TO_DIAG.OR.LINTERPOL_SST)THEN
375 !
376   YRECFM='SST'
377   YCOMMENT='SST'
378   CALL WRITE_SURF(HPROGRAM,YRECFM,XDIAG_SST(:),IRESP,HCOMMENT=YCOMMENT)
379 !
380 ENDIF
381 !
382 !------------------------------------------------------------------------------
383 !
384 !         End of IO
385 !
386  CALL END_IO_SURF_n(HPROGRAM)
387 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_SEAFLUX_N',1,ZHOOK_HANDLE)
388 !
389 !
390 END SUBROUTINE WRITE_DIAG_SEB_SEAFLUX_n