SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
write_diag_seb_surf_atmn.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 write_diag_seb_surf_atm_n (DTCO, DGU, U, UG, &
7  hprogram)
8 ! #################################
9 !
10 !!**** *WRITE_DIAG_SEB_SURF_ATM_n* - writes surface diagnostics
11 !!
12 !! PURPOSE
13 !! -------
14 !!
15 !!
16 !!** METHOD
17 !! ------
18 !!
19 !!
20 !! REFERENCE
21 !! ---------
22 !!
23 !!
24 !! AUTHOR
25 !! ------
26 !! V. Masson *Meteo France*
27 !!
28 !! MODIFICATIONS
29 !! -------------
30 !! Original 01/2004
31 !! Modified 01/2006 : sea flux parameterization.
32 !! Modified 08/2009 : cumulated diag
33 !! Juan 6/12/2011: parallel bug , remove local ANY(XAVG_ZON10M) test
34 !! B. Decharme 06/13 Add QS, evap and sublimation diags
35 !-------------------------------------------------------------------------------
36 !
37 !* 0. DECLARATIONS
38 ! ------------
39 !
40 !
41 USE modd_data_cover_n, ONLY : data_cover_t
42 USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
43 USE modd_surf_atm_n, ONLY : surf_atm_t
44 USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
45 !
46 USE modd_surf_par, ONLY : xundef
47 !
48 USE modi_init_io_surf_n
49 USE modi_write_surf
50 USE modi_end_io_surf_n
51 USE modi_sum_on_all_procs
52 !
53 USE yomhook ,ONLY : lhook, dr_hook
54 USE parkind1 ,ONLY : jprb
55 !
56 IMPLICIT NONE
57 !
58 !* 0.1 Declarations of arguments
59 ! -------------------------
60 !
61 !
62 TYPE(data_cover_t), INTENT(INOUT) :: dtco
63 TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
64 TYPE(surf_atm_t), INTENT(INOUT) :: u
65 TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
66 !
67  CHARACTER(LEN=6), INTENT(IN) :: hprogram ! program calling
68 !
69 !* 0.2 Declarations of local variables
70 ! -------------------------------
71 !
72 
73 INTEGER :: iresp ! IRESP : return-code if a problem appears
74  CHARACTER(LEN=12) :: yrecfm ! Name of the article to be read
75  CHARACTER(LEN=100):: ycomment ! Comment string
76  CHARACTER(LEN=2) :: ynum
77 !
78 INTEGER :: jsw
79 REAL(KIND=JPRB) :: zhook_handle
80 !
81 !-------------------------------------------------------------------------------
82 !
83 ! Initialisation for IO
84 !
85 IF (lhook) CALL dr_hook('WRITE_DIAG_SEB_SURF_ATM_N',0,zhook_handle)
86  CALL init_io_surf_n(dtco, dgu, u, &
87  hprogram,'FULL ','SURF ','WRITE')
88 !
89 !
90 !* 1. Richardson number :
91 ! -----------------
92 !
93 IF (dgu%N2M>=1) THEN
94  !
95  yrecfm='RI'
96  ycomment='X_Y_'//yrecfm
97  !
98  CALL write_surf(dgu, u, &
99  hprogram,yrecfm,dgu%XAVG_RI(:),iresp,hcomment=ycomment)
100  !
101 ENDIF
102 !
103 !* 2. parameters at surface, 2 and 10 meters :
104 ! ----------------------------------------
105 !
106 IF (dgu%N2M>=1.OR.dgu%LSURF_BUDGET.OR.dgu%LSURF_BUDGETC) THEN
107  !
108  yrecfm='TS'
109  ycomment='X_Y_'//yrecfm//' (K)'
110  CALL write_surf(dgu, u, &
111  hprogram,yrecfm,dgu%XAVG_TS(:),iresp,hcomment=ycomment)
112  !
113  yrecfm='TSRAD'
114  ycomment='X_Y_'//yrecfm//' (K)'
115  CALL write_surf(dgu, u, &
116  hprogram,yrecfm,dgu%XDIAG_TRAD(:),iresp,hcomment=ycomment)
117  !
118  yrecfm='EMIS'
119  ycomment='X_Y_'//yrecfm//' (-)'
120  CALL write_surf(dgu, u, &
121  hprogram,yrecfm,dgu%XDIAG_EMIS(:),iresp,hcomment=ycomment)
122  !
123  yrecfm='SFCO2'
124  ycomment='X_Y_'//yrecfm//' (M.kgCO2.S-1.kgAIR-1)'
125  CALL write_surf(dgu, u, &
126  hprogram,yrecfm,dgu%XAVG_SFCO2(:),iresp,hcomment=ycomment)
127  !
128 ENDIF
129 !
130 IF (dgu%N2M>=1) THEN
131  !
132  yrecfm='T2M'
133  ycomment='X_Y_'//yrecfm//' (K)'
134  CALL write_surf(dgu, u, &
135  hprogram,yrecfm,dgu%XAVG_T2M(:),iresp,hcomment=ycomment)
136  !
137  yrecfm='T2MMIN'
138  ycomment='X_Y_'//yrecfm//' (K)'
139  CALL write_surf(dgu, u, &
140  hprogram,yrecfm,dgu%XAVG_T2M_MIN(:),iresp,hcomment=ycomment)
141  !
142  yrecfm='T2MMAX'
143  ycomment='X_Y_'//yrecfm//' (K)'
144  CALL write_surf(dgu, u, &
145  hprogram,yrecfm,dgu%XAVG_T2M_MAX(:),iresp,hcomment=ycomment)
146  !
147  yrecfm='Q2M'
148  ycomment='X_Y_'//yrecfm//' (KG/KG)'
149  CALL write_surf(dgu, u, &
150  hprogram,yrecfm,dgu%XAVG_Q2M(:),iresp,hcomment=ycomment)
151  !
152  yrecfm='HU2M'
153  ycomment='X_Y_'//yrecfm//' (-)'
154  CALL write_surf(dgu, u, &
155  hprogram,yrecfm,dgu%XAVG_HU2M(:),iresp,hcomment=ycomment)
156  !
157  yrecfm='HU2MMIN'
158  ycomment='X_Y_'//yrecfm//' (-)'
159  CALL write_surf(dgu, u, &
160  hprogram,yrecfm,dgu%XAVG_HU2M_MIN(:),iresp,hcomment=ycomment)
161  !
162  yrecfm='HU2MMAX'
163  ycomment='X_Y_'//yrecfm//' (-)'
164  CALL write_surf(dgu, u, &
165  hprogram,yrecfm,dgu%XAVG_HU2M_MAX(:),iresp,hcomment=ycomment)
166  !
167  IF ( sum_on_all_procs(hprogram,ug%CGRID,dgu%XAVG_ZON10M(:)/= xundef) > 0. ) THEN
168  !
169  yrecfm='ZON10M'
170  ycomment='X_Y_'//yrecfm//' (M/S)'
171  CALL write_surf(dgu, u, &
172  hprogram,yrecfm,dgu%XAVG_ZON10M(:),iresp,hcomment=ycomment)
173  !
174  yrecfm='MER10M'
175  ycomment='X_Y_'//yrecfm//' (M/S)'
176  CALL write_surf(dgu, u, &
177  hprogram,yrecfm,dgu%XAVG_MER10M(:),iresp,hcomment=ycomment)
178  !
179  yrecfm='W10M'
180  ycomment='X_Y_'//yrecfm//' (M/S)'
181  CALL write_surf(dgu, u, &
182  hprogram,yrecfm,dgu%XAVG_WIND10M(:),iresp,hcomment=ycomment)
183  !
184  yrecfm='W10MMAX'
185  ycomment='X_Y_'//yrecfm//' (M/S)'
186  CALL write_surf(dgu, u, &
187  hprogram,yrecfm,dgu%XAVG_WIND10M_MAX(:),iresp,hcomment=ycomment)
188  !
189  ENDIF
190  !
191  IF (dgu%L2M_MIN_ZS) THEN
192  !
193  yrecfm='T2M_MIN_ZS'
194  ycomment='X_Y_'//yrecfm//' (K)'
195  CALL write_surf(dgu, u, &
196  hprogram,yrecfm,dgu%XAVG_T2M_MIN_ZS(:),iresp,hcomment=ycomment)
197  !
198  yrecfm='Q2M_MIN_ZS'
199  ycomment='X_Y_'//yrecfm//' (KG/KG)'
200  CALL write_surf(dgu, u, &
201  hprogram,yrecfm,dgu%XAVG_Q2M_MIN_ZS(:),iresp,hcomment=ycomment)
202  !
203  yrecfm='HU2M_MIN_ZS'
204  ycomment='X_Y_'//yrecfm//' (KG/KG)'
205  CALL write_surf(dgu, u, &
206  hprogram,yrecfm,dgu%XAVG_HU2M_MIN_ZS(:),iresp,hcomment=ycomment)
207  !
208  END IF
209  !
210 END IF
211 !
212 !* 3. Energy fluxes :
213 ! -------------
214 !
215 IF (dgu%LSURF_BUDGET) THEN
216  !
217  yrecfm='RN'
218  ycomment='X_Y_'//yrecfm//' (W/m2)'
219  CALL write_surf(dgu, u, &
220  hprogram,yrecfm,dgu%XAVG_RN(:),iresp,hcomment=ycomment)
221  !
222  yrecfm='H'
223  ycomment='X_Y_'//yrecfm//' (W/m2)'
224  CALL write_surf(dgu, u, &
225  hprogram,yrecfm,dgu%XAVG_H(:),iresp,hcomment=ycomment)
226  !
227  yrecfm='LE'
228  ycomment='X_Y_'//yrecfm//' (W/m2)'
229  CALL write_surf(dgu, u, &
230  hprogram,yrecfm,dgu%XAVG_LE(:),iresp,hcomment=ycomment)
231  !
232  yrecfm='LEI'
233  ycomment='X_Y_'//yrecfm//' (W/m2)'
234  CALL write_surf(dgu, u, &
235  hprogram,yrecfm,dgu%XAVG_LEI(:),iresp,hcomment=ycomment)
236  !
237  yrecfm='GFLUX'
238  ycomment='X_Y_'//yrecfm//' (W/m2)'
239  CALL write_surf(dgu, u, &
240  hprogram,yrecfm,dgu%XAVG_GFLUX(:),iresp,hcomment=ycomment)
241  !
242  yrecfm='EVAP'
243  ycomment='X_Y_'//yrecfm//' (kg/m2/s)'
244  !
245  CALL write_surf(dgu, u, &
246  hprogram,yrecfm,dgu%XAVG_EVAP(:),iresp,hcomment=ycomment)
247  !
248  yrecfm='SUBL'
249  ycomment='X_Y_'//yrecfm//' (kg/m2/s)'
250  !
251  CALL write_surf(dgu, u, &
252  hprogram,yrecfm,dgu%XAVG_SUBL(:),iresp,hcomment=ycomment)
253  !
254  IF (dgu%LRAD_BUDGET) THEN
255  !
256  yrecfm='SWD'
257  ycomment='X_Y_'//yrecfm//' (W/m2)'
258  CALL write_surf(dgu, u, &
259  hprogram,yrecfm,dgu%XAVG_SWD(:),iresp,hcomment=ycomment)
260  !
261  yrecfm='SWU'
262  ycomment='X_Y_'//yrecfm//' (W/m2)'
263  CALL write_surf(dgu, u, &
264  hprogram,yrecfm,dgu%XAVG_SWU(:),iresp,hcomment=ycomment)
265  !
266  yrecfm='LWD'
267  ycomment='X_Y_'//yrecfm//' (W/m2)'
268  CALL write_surf(dgu, u, &
269  hprogram,yrecfm,dgu%XAVG_LWD(:),iresp,hcomment=ycomment)
270  !
271  yrecfm='LWU'
272  ycomment='X_Y_'//yrecfm//' (W/m2)'
273  CALL write_surf(dgu, u, &
274  hprogram,yrecfm,dgu%XAVG_LWU(:),iresp,hcomment=ycomment)
275  !
276  DO jsw=1, SIZE(dgu%XAVG_SWBD,2)
277  ynum=achar(48+jsw)
278  !
279  yrecfm='SWD_'//ynum
280  ycomment='X_Y_'//yrecfm//' (W/m2)'
281  CALL write_surf(dgu, u, &
282  hprogram,yrecfm,dgu%XAVG_SWBD(:,jsw),iresp,hcomment=ycomment)
283  !
284  yrecfm='SWU_'//ynum
285  ycomment='X_Y_'//yrecfm//' (W/m2)'
286  CALL write_surf(dgu, u, &
287  hprogram,yrecfm,dgu%XAVG_SWBU(:,jsw),iresp,hcomment=ycomment)
288  !
289  ENDDO
290  !
291  ENDIF
292  !
293  yrecfm='FMUNOSSO'
294  ycomment='X_Y_'//yrecfm//' (kg/ms2)'
295  CALL write_surf(dgu, u, &
296  hprogram,yrecfm,dgu%XAVG_FMU(:),iresp,hcomment=ycomment)
297  !
298  yrecfm='FMVNOSSO'
299  ycomment='X_Y_'//yrecfm//' (kg/ms2)'
300  CALL write_surf(dgu, u, &
301  hprogram,yrecfm,dgu%XAVG_FMV(:),iresp,hcomment=ycomment)
302  !
303  yrecfm='FMU'
304  ycomment='X_Y_'//yrecfm//' (kg/ms2)'
305  CALL write_surf(dgu, u, &
306  hprogram,yrecfm,dgu%XSSO_FMU(:),iresp,hcomment=ycomment)
307  !
308  yrecfm='FMV'
309  ycomment='X_Y_'//yrecfm//' (kg/ms2)'
310  CALL write_surf(dgu, u, &
311  hprogram,yrecfm,dgu%XSSO_FMV(:),iresp,hcomment=ycomment)
312  !
313 END IF
314 !
315 ! * Cumulated diag
316 !
317 IF (dgu%LSURF_BUDGETC) THEN
318  !
319  yrecfm='RNC'
320  ycomment='X_Y_'//yrecfm//' (J/m2)'
321  CALL write_surf(dgu, u, &
322  hprogram,yrecfm,dgu%XAVG_RNC(:),iresp,hcomment=ycomment)
323  !
324  yrecfm='HC'
325  ycomment='X_Y_'//yrecfm//' (J/m2)'
326  CALL write_surf(dgu, u, &
327  hprogram,yrecfm,dgu%XAVG_HC(:),iresp,hcomment=ycomment)
328  !
329  yrecfm='LEC'
330  ycomment='X_Y_'//yrecfm//' (J/m2)'
331  CALL write_surf(dgu, u, &
332  hprogram,yrecfm,dgu%XAVG_LEC(:),iresp,hcomment=ycomment)
333  !
334  yrecfm='LEIC'
335  ycomment='X_Y_'//yrecfm//' (J/m2)'
336  CALL write_surf(dgu, u, &
337  hprogram,yrecfm,dgu%XAVG_LEIC(:),iresp,hcomment=ycomment)
338  !
339  yrecfm='GFLUXC'
340  ycomment='X_Y_'//yrecfm//' (J/m2)'
341  CALL write_surf(dgu, u, &
342  hprogram,yrecfm,dgu%XAVG_GFLUXC(:),iresp,hcomment=ycomment)
343  !
344  yrecfm='EVAPC'
345  ycomment='X_Y_'//yrecfm//' (kg/m2)'
346  !
347  CALL write_surf(dgu, u, &
348  hprogram,yrecfm,dgu%XAVG_EVAPC(:),iresp,hcomment=ycomment)
349  !
350  yrecfm='SUBLC'
351  ycomment='X_Y_'//yrecfm//' (kg/m2)'
352  !
353  CALL write_surf(dgu, u, &
354  hprogram,yrecfm,dgu%XAVG_SUBLC(:),iresp,hcomment=ycomment)
355  !
356  IF (dgu%LRAD_BUDGET .OR. (dgu%LSURF_BUDGETC .AND. .NOT.dgu%LRESET_BUDGETC)) THEN
357  !
358  yrecfm='SWDC'
359  ycomment='X_Y_'//yrecfm//' (J/m2)'
360  CALL write_surf(dgu, u, &
361  hprogram,yrecfm,dgu%XAVG_SWDC(:),iresp,hcomment=ycomment)
362  !
363  yrecfm='SWUC'
364  ycomment='X_Y_'//yrecfm//' (J/m2)'
365  CALL write_surf(dgu, u, &
366  hprogram,yrecfm,dgu%XAVG_SWUC(:),iresp,hcomment=ycomment)
367  !
368  yrecfm='LWDC'
369  ycomment='X_Y_'//yrecfm//' (J/m2)'
370  CALL write_surf(dgu, u, &
371  hprogram,yrecfm,dgu%XAVG_LWDC(:),iresp,hcomment=ycomment)
372  !
373  yrecfm='LWUC'
374  ycomment='X_Y_'//yrecfm//' (J/m2)'
375  CALL write_surf(dgu, u, &
376  hprogram,yrecfm,dgu%XAVG_LWUC(:),iresp,hcomment=ycomment)
377  !
378  ENDIF
379  !
380  yrecfm='FMUC'
381  ycomment='X_Y_'//yrecfm//' (kg/ms)'
382  CALL write_surf(dgu, u, &
383  hprogram,yrecfm,dgu%XAVG_FMUC(:),iresp,hcomment=ycomment)
384  !
385  yrecfm='FMVC'
386  ycomment='X_Y_'//yrecfm//' (kg/ms)'
387  CALL write_surf(dgu, u, &
388  hprogram,yrecfm,dgu%XAVG_FMVC(:),iresp,hcomment=ycomment)
389  !
390 END IF
391 !
392 !
393 !* 4. Transfer coefficients
394 ! ---------------------
395 !
396 IF (dgu%LCOEF) THEN
397  !
398  yrecfm='CD'
399  ycomment='X_Y_'//yrecfm
400  CALL write_surf(dgu, u, &
401  hprogram,yrecfm,dgu%XAVG_CD(:),iresp,hcomment=ycomment)
402  !
403  yrecfm='CH'
404  ycomment='X_Y_'//yrecfm
405  CALL write_surf(dgu, u, &
406  hprogram,yrecfm,dgu%XAVG_CH(:),iresp,hcomment=ycomment)
407  !
408  yrecfm='CE'
409  ycomment='X_Y_'//yrecfm
410  CALL write_surf(dgu, u, &
411  hprogram,yrecfm,dgu%XAVG_CE(:),iresp,hcomment=ycomment)
412  !
413  yrecfm='Z0'
414  ycomment='X_Y_'//yrecfm
415  CALL write_surf(dgu, u, &
416  hprogram,yrecfm,dgu%XAVG_Z0(:),iresp,hcomment=ycomment)
417  !
418  yrecfm='Z0H'
419  ycomment='X_Y_'//yrecfm
420  CALL write_surf(dgu, u, &
421  hprogram,yrecfm,dgu%XAVG_Z0H(:),iresp,hcomment=ycomment)
422  !
423  yrecfm='UREF'
424  ycomment='X_Y_'//yrecfm
425  CALL write_surf(dgu, u, &
426  hprogram,yrecfm,dgu%XDIAG_UREF(:),iresp,hcomment=ycomment)
427  !
428  yrecfm='ZREF'
429  ycomment='X_Y_'//yrecfm
430  CALL write_surf(dgu, u, &
431  hprogram,yrecfm,dgu%XDIAG_ZREF(:),iresp,hcomment=ycomment)
432  !
433 END IF
434 !
435 !
436 !* 5. Surface humidity
437 ! ----------------
438 !
439 IF (dgu%LSURF_VARS) THEN
440 !
441 yrecfm='QS'
442 ycomment='X_Y_'//yrecfm//' (kg/kg)'
443 !
444  CALL write_surf(dgu, u, &
445  hprogram,yrecfm,dgu%XAVG_QS(:),iresp,hcomment=ycomment)
446 !
447 ENDIF
448 !
449 !-------------------------------------------------------------------------------
450 !
451 ! End of IO
452 !
453  CALL end_io_surf_n(hprogram)
454 IF (lhook) CALL dr_hook('WRITE_DIAG_SEB_SURF_ATM_N',1,zhook_handle)
455 !
456 !
457 END SUBROUTINE write_diag_seb_surf_atm_n
init_io_surf_n
subroutine init_io_surf_n(DTCO, DGU, U, HPROGRAM, HMASK, HSCHEME, HACTION)
Definition: init_io_surfn.F90:6
modd_surf_atm_n::surf_atm_t
Definition: modd_surf_atmn.F90:42
modd_surf_atm_grid_n
Definition: modd_surf_atm_gridn.F90:6
modd_data_cover_n
Definition: modd_data_covern.F90:6
sum_on_all_procs
integer function sum_on_all_procs(HPROGRAM, HGRID, OIN, HNAME)
Definition: sum_on_all_procs.F90:6
modd_diag_surf_atm_n
Definition: modd_diag_surf_atmn.F90:6
modd_surf_atm_grid_n::surf_atm_grid_t
Definition: modd_surf_atm_gridn.F90:39
write_diag_seb_surf_atm_n
subroutine write_diag_seb_surf_atm_n(DTCO, DGU, U, UG, HPROGRAM)
Definition: write_diag_seb_surf_atmn.F90:6
end_io_surf_n
subroutine end_io_surf_n(HPROGRAM)
Definition: end_io_surfn.F90:6
modi_write_surf::write_surf
Definition: write_surf.F90:16
modd_data_cover_n::data_cover_t
Definition: modd_data_covern.F90:43
modd_surf_par
Definition: modd_surf_par.F90:6
modd_diag_surf_atm_n::diag_surf_atm_t
Definition: modd_diag_surf_atmn.F90:44
modi_write_surf
Definition: write_surf.F90:6
modd_surf_atm_n
Definition: modd_surf_atmn.F90:6
Generated on Fri May 13 2016 09:31:06 for SURFEX by   doxygen 1.8.5