c65f24828583416b5b2bfb7133a5c9574e2493e5
[MNH-git_open_source-lfs.git] / src / SURFEX / write_diag_seb_tebn.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_TEB_n(HPROGRAM)
7 !     #################################
8 !
9 !!****  *WRITE_DIAG_SEB_TEB_n* - writes TEB 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 : TEB flux parameterization.
31 !-------------------------------------------------------------------------------
32 !
33 !*       0.    DECLARATIONS
34 !              ------------
35 !
36 USE MODD_DIAG_TEB_n,ONLY : N2M, LSURF_BUDGET, LRAD_BUDGET,          &
37                              LCOEF, LSURF_VARS,                       &
38                              XRN, XH, XLE, XGFLUX,                    &
39                              XRI, XCD, XCH, XCE, XZ0, XZ0H,           &
40                              XT2M, XQ2M, XHU2M,                       &
41                              XZON10M, XMER10M, XSFCO2, XQS,           &
42                              XSWD, XSWU, XSWBD, XSWBU,                &
43                              XLWD, XLWU, XFMU, XFMV  
44 USE MODD_DIAG_UTCI_TEB_n, ONLY : LUTCI, XUTCI_IN, XUTCI_OUTSUN,       &
45                                  XUTCI_OUTSHADE, XTRAD_SUN, XTRAD_SHADE
46                            
47 USE MODD_CH_TEB_n,  ONLY : XDEP, CCH_DRY_DEP, CCH_NAMES, NBEQ 
48 !
49 USE MODI_INIT_IO_SURF_n
50 USE MODI_WRITE_SURF
51 USE MODI_END_IO_SURF_n
52 !
53 !
54 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
55 USE PARKIND1  ,ONLY : JPRB
56 !
57 IMPLICIT NONE
58 !
59 !*       0.1   Declarations of arguments
60 !              -------------------------
61 !
62  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
63 !
64 !*       0.2   Declarations of local variables
65 !              -------------------------------
66 !
67 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
68  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
69  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
70  CHARACTER(LEN=2)  :: YNUM
71 !
72 INTEGER           :: JSV, JSW
73 REAL(KIND=JPRB) :: ZHOOK_HANDLE
74 !-------------------------------------------------------------------------------
75 !
76 !         Initialisation for IO
77 !
78 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_TEB_N',0,ZHOOK_HANDLE)
79  CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','WRITE')
80 !
81 !
82 !
83 !*       2.     Richardson number :
84 !               -----------------
85 !
86 IF (N2M>=1) THEN
87
88 YRECFM='RI_TEB'
89 YCOMMENT='X_Y_'//YRECFM
90 !
91  CALL WRITE_SURF(HPROGRAM,YRECFM,XRI(:),IRESP,HCOMMENT=YCOMMENT)
92 !
93 END IF
94 !
95 !*       3.     Energy fluxes :
96 !               -------------
97 !
98 IF (LSURF_BUDGET) THEN
99
100 YRECFM='RN_TEB'
101 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
102 !
103  CALL WRITE_SURF(HPROGRAM,YRECFM,XRN(:),IRESP,HCOMMENT=YCOMMENT)
104 !
105 YRECFM='H_TEB'
106 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
107 !
108  CALL WRITE_SURF(HPROGRAM,YRECFM,XH(:),IRESP,HCOMMENT=YCOMMENT)
109 !
110 YRECFM='LE_TEB'
111 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
112 !
113  CALL WRITE_SURF(HPROGRAM,YRECFM,XLE(:),IRESP,HCOMMENT=YCOMMENT)
114 !
115 YRECFM='GFLUX_TEB'
116 YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
117 !
118  CALL WRITE_SURF(HPROGRAM,YRECFM,XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
119 !
120 IF (LRAD_BUDGET) THEN
121 !        
122    YRECFM='SWD_TEB'
123    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
124    !
125    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWD(:),IRESP,HCOMMENT=YCOMMENT)
126    !
127    YRECFM='SWU_TEB'
128    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
129    !
130    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWU(:),IRESP,HCOMMENT=YCOMMENT)
131    !
132    YRECFM='LWD_TEB'
133    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
134    !
135    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWD(:),IRESP,HCOMMENT=YCOMMENT)
136    !
137    YRECFM='LWU_TEB'
138    YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
139    !
140    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWU(:),IRESP,HCOMMENT=YCOMMENT)
141    !
142    DO JSW=1, SIZE(XSWBD,2)
143       YNUM=ACHAR(48+JSW)
144       !
145       YRECFM='SWD_TEB_'//YNUM
146       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
147       !
148       CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
149       !
150       YRECFM='SWU_TEB_'//YNUM
151       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
152       !
153       CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
154       !
155    ENDDO
156 !
157 ENDIF
158 !
159 YRECFM='FMU_TEB'
160 YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
161 !
162  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMU(:),IRESP,HCOMMENT=YCOMMENT)
163 !
164 YRECFM='FMV_TEB'
165 YCOMMENT='X_Y_'//YRECFM//' (kg/ms2)'
166 !
167  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMV(:),IRESP,HCOMMENT=YCOMMENT)
168 !
169 END IF
170 !
171 !
172 !
173 !*       4.     Transfer coefficients
174 !               ---------------------
175 !
176 IF (LCOEF) THEN
177
178 YRECFM='CD_TEB'
179 YCOMMENT='X_Y_'//YRECFM
180 !
181  CALL WRITE_SURF(HPROGRAM,YRECFM,XCD(:),IRESP,HCOMMENT=YCOMMENT)
182 !
183 YRECFM='CH_TEB'
184 YCOMMENT='X_Y_'//YRECFM
185 !
186  CALL WRITE_SURF(HPROGRAM,YRECFM,XCH(:),IRESP,HCOMMENT=YCOMMENT)
187 !
188 YRECFM='CE_TEB'
189 YCOMMENT='X_Y_'//YRECFM
190 !
191  CALL WRITE_SURF(HPROGRAM,YRECFM,XCE(:),IRESP,HCOMMENT=YCOMMENT)
192 !
193 YRECFM='Z0_TEB'
194 YCOMMENT='X_Y_'//YRECFM//' (M)'
195 !
196  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0(:),IRESP,HCOMMENT=YCOMMENT)
197 !
198 YRECFM='Z0H_TEB'
199 YCOMMENT='X_Y_'//YRECFM//' (M)'
200 !
201  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
202 !
203 ENDIF
204 !
205 !
206 !*       5.     Surface humidity
207 !               ----------------
208 !
209 IF (LSURF_VARS) THEN
210
211 YRECFM='QS_TEB'
212 YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
213 !
214  CALL WRITE_SURF(HPROGRAM,YRECFM,XQS(:),IRESP,HCOMMENT=YCOMMENT)
215 !
216 ENDIF
217
218 !
219 !*       5.     parameters at 2 and 10 meters :
220 !               -----------------------------
221 !
222 IF (N2M>=1) THEN
223
224 YRECFM='T2M_TEB'
225 YCOMMENT='X_Y_'//YRECFM//' (K)'
226 !
227  CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M(:),IRESP,HCOMMENT=YCOMMENT)
228 !
229 YRECFM='Q2M_TEB'
230 YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
231 !
232  CALL WRITE_SURF(HPROGRAM,YRECFM,XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
233 !
234 YRECFM='HU2M_TEB'
235 YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
236 !
237  CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
238 !
239 YRECFM='ZON10M_TEB'
240 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
241 !
242  CALL WRITE_SURF(HPROGRAM,YRECFM,XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
243 !
244 YRECFM='MER10M_TEB'
245 YCOMMENT='X_Y_'//YRECFM//' (M/S)'
246 !
247  CALL WRITE_SURF(HPROGRAM,YRECFM,XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
248 !
249 YRECFM='SFCO2_TEB'
250 YCOMMENT='X_Y_'//YRECFM//' (KG/M2/S)'
251 !
252  CALL WRITE_SURF(HPROGRAM,YRECFM,XSFCO2(:),IRESP,HCOMMENT=YCOMMENT)
253 !
254 END IF
255 !
256 IF (LUTCI .AND. N2M >0) THEN
257   YRECFM='UTCI_IN'
258   YCOMMENT='UTCI for person indoor'//' (°C)'
259   CALL WRITE_SURF(HPROGRAM,YRECFM,XUTCI_IN(:),IRESP,HCOMMENT=YCOMMENT)
260   !
261   YRECFM='UTCI_OUTSUN'
262   YCOMMENT='UTCI for person at sun'//' (°C)'
263   CALL WRITE_SURF(HPROGRAM,YRECFM,XUTCI_OUTSUN(:),IRESP,HCOMMENT=YCOMMENT)
264   !
265   YRECFM='UTCI_OUTSHAD'
266   YCOMMENT='UTCI for person in shade'//' (°C)'
267   CALL WRITE_SURF(HPROGRAM,YRECFM,XUTCI_OUTSHADE(:),IRESP,HCOMMENT=YCOMMENT)
268   !
269   YRECFM='TRAD_SUN'
270   YCOMMENT='Mean radiant temperature seen by person at sun'//' (K)'
271   CALL WRITE_SURF(HPROGRAM,YRECFM,XTRAD_SUN(:),IRESP,HCOMMENT=YCOMMENT)
272   !
273   YRECFM='TRAD_SHADE'
274   YCOMMENT='Mean radiant temperature seen by person in shade'//' (K)'
275   CALL WRITE_SURF(HPROGRAM,YRECFM,XTRAD_SHADE(:),IRESP,HCOMMENT=YCOMMENT)
276 END IF
277 !
278 !
279 !*       6.     chemical diagnostics:
280 !               --------------------
281 !
282 IF (NBEQ>0 .AND. CCH_DRY_DEP=="WES89 ") THEN
283   DO JSV = 1,SIZE(CCH_NAMES,1)
284     YRECFM='DV_TWN_'//TRIM(CCH_NAMES(JSV))
285     WRITE(YCOMMENT,'(A13,I3.3)')'(m/s) DV_TWN_',JSV
286     CALL WRITE_SURF(HPROGRAM,YRECFM,XDEP(:,JSV),IRESP,HCOMMENT=YCOMMENT)
287   END DO
288 ENDIF
289 !-------------------------------------------------------------------------------
290 !
291 !         End of IO
292 !
293  CALL END_IO_SURF_n(HPROGRAM)
294 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_TEB_N',1,ZHOOK_HANDLE)
295 !
296 !
297 END SUBROUTINE WRITE_DIAG_SEB_TEB_n