Juan 8/12/2016: add management of LEN_HREC in MNH & SURFEX
[MNH-git_open_source-lfs.git] / src / SURFEX / write_diag_seb_surf_atmn.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_SURF_ATM_n(HPROGRAM)
7 !     #################################
8 !
9 !!****  *WRITE_DIAG_SEB_SURF_ATM_n* - writes surface diagnostics
10 !!
11 !!    PURPOSE
12 !!    -------
13 !!
14 !!
15 !!**  METHOD
16 !!    ------
17 !!
18 !!
19 !!    REFERENCE
20 !!    ---------
21 !!
22 !!
23 !!    AUTHOR
24 !!    ------
25 !!      V. Masson   *Meteo France*      
26 !!
27 !!    MODIFICATIONS
28 !!    -------------
29 !!      Original    01/2004
30 !!      Modified    01/2006 : sea flux parameterization.
31 !!      Modified    08/2009 : cumulated diag
32 !!      Juan        6/12/2011: parallel bug , remove local ANY(XAVG_ZON10M) test
33 !-------------------------------------------------------------------------------
34 !
35 !*       0.    DECLARATIONS
36 !              ------------
37 !
38 USE MODD_DIAG_SURF_ATM_n,  ONLY : N2M, L2M_MIN_ZS, LSURF_BUDGET, LCOEF,          &
39                                   LRAD_BUDGET, LRESET_BUDGETC, LSURF_BUDGETC,    &
40                                   XAVG_RN, XAVG_H, XAVG_LE, XAVG_LEI, XAVG_GFLUX,&
41                                   XAVG_RI, XAVG_CD, XAVG_CH, XAVG_CE,            &
42                                   XAVG_T2M, XAVG_TS, XAVG_Q2M, XAVG_HU2M,        &
43                                   XAVG_ZON10M, XAVG_MER10M, XAVG_Z0, XAVG_Z0H,   &
44                                   XAVG_T2M_MIN_ZS, XAVG_Q2M_MIN_ZS,              &
45                                   XAVG_HU2M_MIN_ZS, XDIAG_UREF, XDIAG_ZREF,      &
46                                   XAVG_SWD, XAVG_SWU, XAVG_SWBD, XAVG_SWBU,      &
47                                   XAVG_LWD, XAVG_LWU, XAVG_FMU, XAVG_FMV,        &
48                                   XSSO_FMU, XSSO_FMV,                            &
49                                   XAVG_RNC, XAVG_HC, XAVG_LEC, XAVG_GFLUXC,      &
50                                   XAVG_SWDC, XAVG_SWUC, XAVG_LWDC, XAVG_LWUC,    &
51                                   XAVG_FMUC, XAVG_FMVC, XAVG_T2M_MIN,            &
52                                   XAVG_T2M_MAX, XAVG_LEIC, XDIAG_TRAD,           &
53                                   XDIAG_EMIS, XAVG_HU2M_MIN, XAVG_HU2M_MAX,      &
54                                   XAVG_WIND10M, XAVG_WIND10M_MAX, XAVG_SFCO2
55 !
56 USE MODD_SURF_ATM_GRID_n, ONLY : CGRID
57 USE MODD_SURF_PAR, ONLY : XUNDEF
58 !
59 USE MODI_INIT_IO_SURF_n
60 USE MODI_WRITE_SURF
61 USE MODI_END_IO_SURF_n
62 USE MODI_SUM_ON_ALL_PROCS
63 !
64 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
65 USE PARKIND1  ,ONLY : JPRB
66 !
67 IMPLICIT NONE
68 !
69 !*       0.1   Declarations of arguments
70 !              -------------------------
71 !
72  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
73 !
74 !*       0.2   Declarations of local variables
75 !              -------------------------------
76 !
77
78 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
79  CHARACTER(LEN=LEN_HREC) :: YRECFM         ! Name of the article to be read
80  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
81  CHARACTER(LEN=2)  :: YNUM
82 !
83 INTEGER           :: JSW
84 REAL(KIND=JPRB) :: ZHOOK_HANDLE
85 !
86 !-------------------------------------------------------------------------------
87 !
88 !         Initialisation for IO
89 !
90 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_SURF_ATM_N',0,ZHOOK_HANDLE)
91  CALL INIT_IO_SURF_n(HPROGRAM,'FULL  ','SURF  ','WRITE')
92 !
93 !
94 !*       1.     Richardson number :
95 !               -----------------
96 !
97 IF (N2M>=1) THEN
98   !        
99   YRECFM='RI'
100   YCOMMENT='X_Y_'//YRECFM
101   !
102   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RI(:),IRESP,HCOMMENT=YCOMMENT)
103   !
104 ENDIF
105 !
106 !*       2.     parameters at surface, 2 and 10 meters :
107 !               ----------------------------------------
108 !
109 IF (N2M>=1.OR.LSURF_BUDGET.OR.LSURF_BUDGETC) THEN
110   !
111   YRECFM='TS'
112   YCOMMENT='X_Y_'//YRECFM//' (K)'
113   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TS(:),IRESP,HCOMMENT=YCOMMENT)
114   !
115   YRECFM='TSRAD'
116   YCOMMENT='X_Y_'//YRECFM//' (K)'
117   CALL WRITE_SURF(HPROGRAM,YRECFM,XDIAG_TRAD(:),IRESP,HCOMMENT=YCOMMENT)
118   !
119   YRECFM='EMIS'
120   YCOMMENT='X_Y_'//YRECFM//' (-)'
121   CALL WRITE_SURF(HPROGRAM,YRECFM,XDIAG_EMIS(:),IRESP,HCOMMENT=YCOMMENT)
122   !
123   YRECFM='SFCO2'
124   YCOMMENT='X_Y_'//YRECFM//' (KG/M2/S)'
125   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SFCO2(:),IRESP,HCOMMENT=YCOMMENT)
126   !
127 ENDIF
128 !
129 IF (N2M>=1) THEN
130   !
131   YRECFM='T2M'
132   YCOMMENT='X_Y_'//YRECFM//' (K)'
133   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_T2M(:),IRESP,HCOMMENT=YCOMMENT)
134   !
135   YRECFM='T2MMIN'
136   YCOMMENT='X_Y_'//YRECFM//' (K)'
137   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_T2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
138   !
139   YRECFM='T2MMAX'
140   YCOMMENT='X_Y_'//YRECFM//' (K)'
141   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_T2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
142   !
143   YRECFM='Q2M'
144   YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
145   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_Q2M(:),IRESP,HCOMMENT=YCOMMENT)
146   !
147   YRECFM='HU2M'
148   YCOMMENT='X_Y_'//YRECFM//' (-)'
149   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HU2M(:),IRESP,HCOMMENT=YCOMMENT)
150   !
151   YRECFM='HU2MMIN'
152   YCOMMENT='X_Y_'//YRECFM//' (-)'
153   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
154   !
155   YRECFM='HU2MMAX'
156   YCOMMENT='X_Y_'//YRECFM//' (-)'
157   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
158   !
159   IF ( SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XAVG_ZON10M(:)/= XUNDEF) > 0. ) THEN
160     !
161     YRECFM='ZON10M'
162     YCOMMENT='X_Y_'//YRECFM//' (M/S)'
163     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_ZON10M(:),IRESP,HCOMMENT=YCOMMENT)
164     !
165     YRECFM='MER10M'
166     YCOMMENT='X_Y_'//YRECFM//' (M/S)'
167     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_MER10M(:),IRESP,HCOMMENT=YCOMMENT)
168     !
169     YRECFM='W10M'
170     YCOMMENT='X_Y_'//YRECFM//' (M/S)'
171     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_WIND10M(:),IRESP,HCOMMENT=YCOMMENT)
172     !
173     YRECFM='W10MMAX'
174     YCOMMENT='X_Y_'//YRECFM//' (M/S)'
175     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_WIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
176     !
177   ENDIF
178   !
179   IF (L2M_MIN_ZS) THEN
180     !
181     YRECFM='T2M_MIN_ZS'
182     YCOMMENT='X_Y_'//YRECFM//' (K)'
183     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_T2M_MIN_ZS(:),IRESP,HCOMMENT=YCOMMENT)
184     !
185     YRECFM='Q2M_MIN_ZS'
186     YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
187     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_Q2M_MIN_ZS(:),IRESP,HCOMMENT=YCOMMENT)
188     !
189     YRECFM='HU2M_MIN_ZS'
190     YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
191     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HU2M_MIN_ZS(:),IRESP,HCOMMENT=YCOMMENT)
192     !
193   END IF
194   !
195 END IF
196 !
197 !*       3.     Energy fluxes :
198 !               -------------
199 !
200 IF (LSURF_BUDGET) THEN
201   !
202   YRECFM='RN'
203   YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
204   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RN(:),IRESP,HCOMMENT=YCOMMENT)
205   !
206   YRECFM='H'
207   YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
208   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_H(:),IRESP,HCOMMENT=YCOMMENT)
209   !
210   YRECFM='LE'
211   YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
212   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LE(:),IRESP,HCOMMENT=YCOMMENT)
213   !
214   YRECFM='LEI'
215   YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
216   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEI(:),IRESP,HCOMMENT=YCOMMENT)
217   !
218   YRECFM='GFLUX'
219   YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
220   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_GFLUX(:),IRESP,HCOMMENT=YCOMMENT)
221   !
222   IF (LRAD_BUDGET) THEN
223     !         
224     YRECFM='SWD'
225     YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
226     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWD(:),IRESP,HCOMMENT=YCOMMENT)
227     !
228     YRECFM='SWU'
229     YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
230     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWU(:),IRESP,HCOMMENT=YCOMMENT)
231     !
232     YRECFM='LWD'
233     YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
234     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWD(:),IRESP,HCOMMENT=YCOMMENT)
235     !
236     YRECFM='LWU'
237     YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
238     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWU(:),IRESP,HCOMMENT=YCOMMENT)
239     !
240     DO JSW=1, SIZE(XAVG_SWBD,2)
241       YNUM=ACHAR(48+JSW)
242       !
243       YRECFM='SWD_'//YNUM
244       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
245       CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
246       !
247       YRECFM='SWU_'//YNUM
248       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
249       CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
250       !
251     ENDDO
252     !
253   ENDIF
254   !
255   YRECFM='FMUNOSSO'
256   YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
257   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMU(:),IRESP,HCOMMENT=YCOMMENT)
258   !
259   YRECFM='FMVNOSSO'
260   YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
261   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMV(:),IRESP,HCOMMENT=YCOMMENT)
262   !
263   YRECFM='FMU'
264   YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
265   CALL WRITE_SURF(HPROGRAM,YRECFM,XSSO_FMU(:),IRESP,HCOMMENT=YCOMMENT)
266   !
267   YRECFM='FMV'
268   YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
269   CALL WRITE_SURF(HPROGRAM,YRECFM,XSSO_FMV(:),IRESP,HCOMMENT=YCOMMENT)
270   !
271 END IF
272 !
273 ! * Cumulated diag
274 !
275 IF (LSURF_BUDGETC) THEN
276   !
277   YRECFM='RNC'
278   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
279   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RNC(:),IRESP,HCOMMENT=YCOMMENT)
280   !
281   YRECFM='HC'
282   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
283   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HC(:),IRESP,HCOMMENT=YCOMMENT)
284   !
285   YRECFM='LEC'
286   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
287   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEC(:),IRESP,HCOMMENT=YCOMMENT)
288   !
289   YRECFM='LEIC'
290   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
291   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEIC(:),IRESP,HCOMMENT=YCOMMENT)
292   !
293   YRECFM='GFLUXC'
294   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
295   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_GFLUXC(:),IRESP,HCOMMENT=YCOMMENT)
296   !
297   IF (LRAD_BUDGET .OR. (LSURF_BUDGETC .AND. .NOT.LRESET_BUDGETC)) THEN
298     !        
299     YRECFM='SWDC'
300     YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
301     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWDC(:),IRESP,HCOMMENT=YCOMMENT)
302     !
303     YRECFM='SWUC'
304     YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
305     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWUC(:),IRESP,HCOMMENT=YCOMMENT)
306     !
307     YRECFM='LWDC'
308     YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
309     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWDC(:),IRESP,HCOMMENT=YCOMMENT)
310     !
311     YRECFM='LWUC'
312     YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
313     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWUC(:),IRESP,HCOMMENT=YCOMMENT)
314     !
315   ENDIF
316   !
317   YRECFM='FMUC'
318   YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
319   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMUC(:),IRESP,HCOMMENT=YCOMMENT)
320   !
321   YRECFM='FMVC'
322   YCOMMENT='X_Y_'//YRECFM//' (kg/ms)'
323   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMVC(:),IRESP,HCOMMENT=YCOMMENT)
324   !
325 END IF
326 !
327 !
328 !*       4.     Transfer coefficients
329 !               ---------------------
330 !
331 IF (LCOEF) THEN
332   !
333   YRECFM='CD'
334   YCOMMENT='X_Y_'//YRECFM
335   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_CD(:),IRESP,HCOMMENT=YCOMMENT)
336   !
337   YRECFM='CH'
338   YCOMMENT='X_Y_'//YRECFM
339   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_CH(:),IRESP,HCOMMENT=YCOMMENT)
340   !
341   YRECFM='CE'
342   YCOMMENT='X_Y_'//YRECFM
343   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_CE(:),IRESP,HCOMMENT=YCOMMENT)
344   !
345   YRECFM='Z0'
346   YCOMMENT='X_Y_'//YRECFM
347   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_Z0(:),IRESP,HCOMMENT=YCOMMENT)
348   !
349   YRECFM='Z0H'
350   YCOMMENT='X_Y_'//YRECFM
351   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_Z0H(:),IRESP,HCOMMENT=YCOMMENT)
352   !
353   YRECFM='UREF'
354   YCOMMENT='X_Y_'//YRECFM
355   CALL WRITE_SURF(HPROGRAM,YRECFM,XDIAG_UREF(:),IRESP,HCOMMENT=YCOMMENT)
356   !
357   YRECFM='ZREF'
358   YCOMMENT='X_Y_'//YRECFM
359   CALL WRITE_SURF(HPROGRAM,YRECFM,XDIAG_ZREF(:),IRESP,HCOMMENT=YCOMMENT)
360   !
361 END IF
362 !
363 !-------------------------------------------------------------------------------
364 !
365 !         End of IO
366 !
367  CALL END_IO_SURF_n(HPROGRAM)
368 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_SURF_ATM_N',1,ZHOOK_HANDLE)
369 !
370 !
371 END SUBROUTINE WRITE_DIAG_SEB_SURF_ATM_n