Beginning of open source history
[MNH-git_open_source-lfs.git] / src / SURFEX / write_diag_seb_flaken.F90
1 !     #########
2       SUBROUTINE WRITE_DIAG_SEB_FLAKE_n(HPROGRAM)
3 !     #################################
4 !
5 !!****  *WRITE_DIAG_SEB_FLAKE_n* - writes FLAKE diagnostics
6 !!
7 !!    PURPOSE
8 !!    -------
9 !!
10 !!
11 !!**  METHOD
12 !!    ------
13 !!          
14 !!    REFERENCE
15 !!    ---------
16 !!
17 !!
18 !!    AUTHOR
19 !!    ------
20 !!      V. Masson   *Meteo France*      
21 !!
22 !!    MODIFICATIONS
23 !!    -------------
24 !!      Original    01/2004
25 !!      Modified    01/2006 : sea flux parameterization.
26 !-------------------------------------------------------------------------------
27 !
28 !*       0.    DECLARATIONS
29 !              ------------
30 !
31 USE MODD_DIAG_FLAKE_n,  ONLY : N2M, LSURF_BUDGET, LRAD_BUDGET,  LCOEF,   &
32                                  LSURF_VARS, XRN, XH, XLE, XLEI, XGFLUX,   &
33                                  XRI, XCD, XCH, XCE, XZ0, XZ0H,            &
34                                  XT2M, XQ2M, XHU2M,                        &
35                                  XZON10M, XMER10M, XQS,                    &
36                                  XSWD, XSWU, XLWD, XLWU, XSWBD, XSWBU,     &
37                                  XFMU, XFMV  
38
39 USE MODD_CH_WATFLUX_n,  ONLY : XDEP, CCH_DRY_DEP, CCH_NAMES, NBEQ
40 !
41 USE MODI_INIT_IO_SURF_n
42 USE MODI_WRITE_SURF
43 USE MODI_END_IO_SURF_n
44 !
45 !
46 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
47 USE PARKIND1  ,ONLY : JPRB
48 !
49 IMPLICIT NONE
50 !
51 !*       0.1   Declarations of arguments
52 !              -------------------------
53 !
54  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
55 !
56 !*       0.2   Declarations of local variables
57 !              -------------------------------
58 !
59 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
60  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
61  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
62  CHARACTER(LEN=2)  :: YNUM
63 !
64 INTEGER           :: JSV, JSW
65 REAL(KIND=JPRB) :: ZHOOK_HANDLE
66 !-------------------------------------------------------------------------------
67 !
68 !         Initialisation for IO
69 !
70 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_FLAKE_N',0,ZHOOK_HANDLE)
71  CALL INIT_IO_SURF_n(HPROGRAM,'WATER ','FLAKE ','WRITE')
72 !
73 !
74 !*       2.     Richardson number :
75 !               -----------------
76 !
77 IF (N2M>=1) THEN
78
79 YRECFM='RI_WAT'
80 YCOMMENT='Bulk-Richardson number for water'
81 !
82  CALL WRITE_SURF(HPROGRAM,YRECFM,XRI(:),IRESP,HCOMMENT=YCOMMENT)
83 !
84 END IF
85 !
86 !*       3.     Energy fluxes :
87 !               -------------
88 !
89 IF (LSURF_BUDGET) THEN
90
91 YRECFM='RN_WAT'
92 YCOMMENT='net radiation for water'//' (W/m2)'
93 !
94  CALL WRITE_SURF(HPROGRAM,YRECFM,XRN(:),IRESP,HCOMMENT=YCOMMENT)
95 !
96 YRECFM='H_WAT'
97 YCOMMENT='sensible heat flux for water'//' (W/m2)'
98 !
99  CALL WRITE_SURF(HPROGRAM,YRECFM,XH(:),IRESP,HCOMMENT=YCOMMENT)
100 !
101 YRECFM='LE_WAT'
102 YCOMMENT='total latent heat flux for water'//' (W/m2)'
103 !
104  CALL WRITE_SURF(HPROGRAM,YRECFM,XLE(:),IRESP,HCOMMENT=YCOMMENT)
105 !
106 YRECFM='LEI_WAT'
107 YCOMMENT='sublimation latent heat flux for water-ice'//' (W/m2)'
108 !
109  CALL WRITE_SURF(HPROGRAM,YRECFM,XLEI(:),IRESP,HCOMMENT=YCOMMENT)
110 !
111 YRECFM='GFLUX_WAT'
112 YCOMMENT='conduction flux for water'//' (W/m2)'
113 !
114  CALL WRITE_SURF(HPROGRAM,YRECFM,XGFLUX(:),IRESP,HCOMMENT=YCOMMENT)
115 !
116 IF (LRAD_BUDGET) THEN
117 !
118    YRECFM='SWD_WAT'
119    YCOMMENT='short wave downward radiation for water'//' (W/m2)'
120    !
121    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWD(:),IRESP,HCOMMENT=YCOMMENT)
122    !
123    YRECFM='SWU_WAT'
124    YCOMMENT='short wave upward radiation for water'//' (W/m2)'
125    !
126    CALL WRITE_SURF(HPROGRAM,YRECFM,XSWU(:),IRESP,HCOMMENT=YCOMMENT)
127    !
128    YRECFM='LWD_WAT'
129    YCOMMENT='downward long wave radiation'//' (W/m2)'
130    !
131    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWD(:),IRESP,HCOMMENT=YCOMMENT)
132    !
133    YRECFM='LWU_WAT'
134    YCOMMENT='upward long wave radiation'//' (W/m2)'
135    !
136    CALL WRITE_SURF(HPROGRAM,YRECFM,XLWU(:),IRESP,HCOMMENT=YCOMMENT)
137    !       
138    DO JSW=1, SIZE(XSWBD,2)
139       YNUM=ACHAR(48+JSW)
140       !
141       YRECFM='SWD_WAT_'//YNUM
142       YCOMMENT='downward short wave radiation by spectral band '//' (W/m2)'
143       !
144       CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
145       !
146       YRECFM='SWU_WAT_'//YNUM
147       YCOMMENT='upward short wave radiation by spectral band'//' (W/m2)'
148       !
149       CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
150       !
151    ENDDO
152 !
153 ENDIF
154 !
155 YRECFM='FMU_WAT'
156 YCOMMENT='u-component of momentum flux for water'//' (kg/ms2)'
157 !
158  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMU(:),IRESP,HCOMMENT=YCOMMENT)
159 YRECFM='FMV_WAT'
160 YCOMMENT='v-component of momentum flux for water'//' (kg/ms2)'
161 !
162  CALL WRITE_SURF(HPROGRAM,YRECFM,XFMV(:),IRESP,HCOMMENT=YCOMMENT)
163 !
164 END IF
165 !
166 !
167 !*       4.     Transfer coefficients
168 !               ---------------------
169 !
170 IF (LCOEF) THEN
171
172 YRECFM='CD_WAT'
173 YCOMMENT='drag coefficient for wind over water (W/s2)'
174 !
175  CALL WRITE_SURF(HPROGRAM,YRECFM,XCD(:),IRESP,HCOMMENT=YCOMMENT)
176 !
177 YRECFM='CH_WAT'
178 YCOMMENT='drag coefficient for heat (W/s)'
179 !
180  CALL WRITE_SURF(HPROGRAM,YRECFM,XCH(:),IRESP,HCOMMENT=YCOMMENT)
181 !
182 YRECFM='CE_WAT'
183 YCOMMENT='drag coefficient for vapor (W/s/K)'
184 !
185  CALL WRITE_SURF(HPROGRAM,YRECFM,XCE(:),IRESP,HCOMMENT=YCOMMENT)
186 !
187 YRECFM='Z0_WAT'
188 YCOMMENT='roughness length over water (m)'
189
190  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0(:),IRESP,HCOMMENT=YCOMMENT)
191 !
192 YRECFM='Z0H_WAT'
193 YCOMMENT='thermal roughness length over water (m)'
194 !
195  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0H(:),IRESP,HCOMMENT=YCOMMENT)
196 !
197 END IF
198 !
199 !
200 !*       5.     Surface humidity
201 !               ----------------
202 !
203 IF (LSURF_VARS) THEN
204
205 YRECFM='QS_WAT'
206 YCOMMENT='specific humidity over water'//' (KG/KG)'
207 !
208  CALL WRITE_SURF(HPROGRAM,YRECFM,XQS(:),IRESP,HCOMMENT=YCOMMENT)
209 !
210 ENDIF
211 !
212
213 !
214 !*       6.     parameters at 2 and 10 meters :
215 !               -----------------------------
216 !
217 IF (N2M>=1) THEN
218
219 YRECFM='T2M_WAT'
220 YCOMMENT='2 meters temperature'//' (K)'
221 !
222  CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M(:),IRESP,HCOMMENT=YCOMMENT)
223 !
224 YRECFM='Q2M_WAT'
225 YCOMMENT='2 meters specific humidity'//' (KG/KG)'
226 !
227  CALL WRITE_SURF(HPROGRAM,YRECFM,XQ2M(:),IRESP,HCOMMENT=YCOMMENT)
228 !
229 YRECFM='HU2M_WAT'
230 YCOMMENT='2 meters relative humidity'//' (KG/KG)'
231 !
232  CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M(:),IRESP,HCOMMENT=YCOMMENT)
233 !
234 YRECFM='ZON10M_WAT'
235 YCOMMENT='10 meters zonal wind'//' (M/S)'
236 !
237  CALL WRITE_SURF(HPROGRAM,YRECFM,XZON10M(:),IRESP,HCOMMENT=YCOMMENT)
238 !
239 YRECFM='MER10M_WAT'
240 YCOMMENT='10 meters meridian wind'//' (M/S)'
241 !
242  CALL WRITE_SURF(HPROGRAM,YRECFM,XMER10M(:),IRESP,HCOMMENT=YCOMMENT)
243 !
244 END IF
245 !
246 !
247 !*       7.     chemical diagnostics:
248 !               --------------------
249 !
250 IF (NBEQ>0 .AND. CCH_DRY_DEP=="WES89 ") THEN
251   DO JSV = 1,SIZE(CCH_NAMES,1)
252     YRECFM='DV_WAT_'//TRIM(CCH_NAMES(JSV))
253     WRITE(YCOMMENT,'(A26)')'final dry deposition (m/s)'
254     CALL WRITE_SURF(HPROGRAM,YRECFM,XDEP(:,JSV),IRESP,HCOMMENT=YCOMMENT)
255   END DO
256 ENDIF
257 !
258 !-------------------------------------------------------------------------------
259 !
260 !         End of IO
261 !
262  CALL END_IO_SURF_n(HPROGRAM)
263 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_FLAKE_N',1,ZHOOK_HANDLE)
264 !
265 !
266 END SUBROUTINE WRITE_DIAG_SEB_FLAKE_n