SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
mode_glt_dia_glt.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 !GLT_LIC The GELATO model is a seaice model used in stand-alone or embedded mode.
6 !GLT_LIC It has been developed by Meteo-France. The holder of GELATO is Meteo-France.
7 !GLT_LIC
8 !GLT_LIC This software is governed by the CeCILL-C license under French law and biding
9 !GLT_LIC by the rules of distribution of free software. See the CeCILL-C_V1-en.txt
10 !GLT_LIC (English) and CeCILL-C_V1-fr.txt (French) for details. The CeCILL is a free
11 !GLT_LIC software license, explicitly compatible with the GNU GPL
12 !GLT_LIC (see http://www.gnu.org/licenses/license-list.en.html#CeCILL)
13 !GLT_LIC
14 !GLT_LIC The CeCILL-C licence agreement grants users the right to modify and re-use the
15 !GLT_LIC software governed by this free software license. The exercising of this right
16 !GLT_LIC is conditional upon the obligation to make available to the community the
17 !GLT_LIC modifications made to the source code of the software so as to contribute to
18 !GLT_LIC its evolution.
19 !GLT_LIC
20 !GLT_LIC In consideration of access to the source code and the rights to copy, modify
21 !GLT_LIC and redistribute granted by the license, users are provided only with a limited
22 !GLT_LIC warranty and the software's author, the holder of the economic rights, and the
23 !GLT_LIC successive licensors only have limited liability. In this respect, the risks
24 !GLT_LIC associated with loading, using, modifying and/or developing or reproducing the
25 !GLT_LIC software by the user are brought to the user's attention, given its Free
26 !GLT_LIC Software status, which may make it complicated to use, with the result that its
27 !GLT_LIC use is reserved for developers and experienced professionals having in-depth
28 !GLT_LIC computer knowledge. Users are therefore encouraged to load and test the
29 !GLT_LIC suitability of the software as regards their requirements in conditions enabling
30 !GLT_LIC the security of their systems and/or data to be ensured and, more generally, to
31 !GLT_LIC use and operate it in the same conditions of security.
32 !GLT_LIC
33 !GLT_LIC The GELATO sofware is cureently distibuted with the SURFEX software, available at
34 !GLT_LIC http://www.cnrm.meteo.fr/surfex. The fact that you download the software deemed that
35 !GLT_LIC you had knowledge of the CeCILL-C license and that you accept its terms.
36 !GLT_LIC Attempts to use this software in a way not complying with CeCILL-C license
37 !GLT_LIC may lead to prosecution.
38 !GLT_LIC
39 ! =======================================================================
40 ! ========================= MODULE modi_glt_dia_glt =========================
41 ! =======================================================================
42 !
43 !
44 ! * Contains a subroutine that writes model glt_output in Gelato format
45 !
46 ! --------------------- BEGIN MODULE modi_glt_dia_glt -----------------------
47 
48 MODULE mode_glt_dia_glt
49 !INTERFACE
50 !
51 ! SUBROUTINE wridiag_glt &
52 ! ( tpind,tpdom,tpml,tptfl,tpblkw,tpblki,tpsit,tpbud,tpdia,pcumdia )
53 ! USE modd_types_glt
54 ! USE modd_glt_param
55 ! TYPE(t_ind), INTENT(inout) :: &
56 ! tpind
57 ! TYPE(t_dom), DIMENSION(nxglo,nyglo), INTENT(in) :: &
58 ! tpdom
59 ! TYPE(t_mxl), DIMENSION(nxglo,nyglo), INTENT(in) :: &
60 ! tpml
61 ! TYPE(t_tfl), DIMENSION(nxglo,nyglo), INTENT(in) :: &
62 ! tptfl
63 ! TYPE(t_blk), DIMENSION(nxglo,nyglo), INTENT(in) :: &
64 ! tpblkw
65 ! TYPE(t_blk), DIMENSION(nt,nxglo,nyglo), INTENT(in) :: &
66 ! tpblki
67 ! TYPE(t_sit), DIMENSION(nt,nxglo,nyglo), INTENT(in) :: &
68 ! tpsit
69 ! TYPE(t_bud), DIMENSION(nxglo,nyglo), INTENT(in) :: &
70 ! tpbud
71 ! TYPE(t_dia), DIMENSION(nxglo,nyglo), INTENT(inout) :: &
72 ! tpdia
73 ! REAL, DIMENSION(ndiamax,nxglo,nyglo), INTENT(inout) :: &
74 ! pcumdia
75 ! END SUBROUTINE wridiag_glt
76 ! !
77 ! END INTERFACE
78 
79  CONTAINS
80 !
81 ! ---------------------- END MODULE modi_glt_dia_glt ------------------------
82 !
83 !
84 !
85 ! -----------------------------------------------------------------------
86 ! ------------------------ SUBROUTINE WRIDIAG_GLT -----------------------
87 
88 ! * A subroutine that computes interesting quantities from certain
89 ! icestate variables (statistics) and records them in data files at
90 ! every time step.
91 
92 SUBROUTINE wridiag_glt &
93  ( tpind,tpdom,tpml,tptfl,tpblkw,tpblki,tpsit,tpbud,tpdia,pcumdia )
94 !
95  USE modd_types_glt
96  USE modd_glt_param
97  USE modd_glt_const_thm
98  USE modi_gltools_avevai
99  USE mode_gltools_wrivais
100  USE modi_gltools_outdia
101  USE mode_glt_stats
102  USE modi_gltools_glterr
103  IMPLICIT none
104 !
105  TYPE(t_ind), INTENT(inout) :: &
106  tpind
107  TYPE(t_dom), DIMENSION(nxglo,nyglo), INTENT(in) :: &
108  tpdom
109  TYPE(t_mxl), DIMENSION(nxglo,nyglo), INTENT(in) :: &
110  tpml
111  TYPE(t_tfl), DIMENSION(nxglo,nyglo), INTENT(in) :: &
112  tptfl
113  TYPE(t_blk), DIMENSION(nxglo,nyglo), INTENT(in) :: &
114  tpblkw
115  TYPE(t_blk), DIMENSION(nt,nxglo,nyglo), INTENT(in) :: &
116  tpblki
117  TYPE(t_sit), DIMENSION(nt,nxglo,nyglo), INTENT(in) :: &
118  tpsit
119  TYPE(t_bud), DIMENSION(nxglo,nyglo), INTENT(in) :: &
120  tpbud
121  TYPE(t_dia), DIMENSION(nxglo,nyglo), INTENT(inout) :: &
122  tpdia
123  REAL, DIMENSION(ndiamax,nxglo,nyglo), INTENT(inout) :: &
124  pcumdia
125 !
126  CHARACTER(8) :: &
127  yword
128  CHARACTER(80) :: &
129  yfname,ymess
130  INTEGER :: &
131  ji,jt,ii,ij,ii0,ij0
132  LOGICAL, DIMENSION(nxglo,nyglo) :: &
133  ynhemis,yshemis
134  REAL :: &
135  zai,zaj,zcslat,zdilat,zdilon,zdjlat,zdjlon
136  REAL(KIND=4) :: &
137  zehn,zehs,zshn,zshs,zvhn,zvhs,zwhn,zwhs, &
138  zfram,zbering,zncwest,znceast,znorthb
139  REAL, DIMENSION(nxglo,nyglo) :: &
140  zfsit,zhsit,zhsnt,zmsnt
141  REAL, DIMENSION(nxglo,nyglo) :: &
142  zwork2
143  REAL, DIMENSION(nt,nxglo,nyglo) :: &
144  zwork3
145  TYPE(t_def) :: &
146  tznam
147 !
148 !
149 #if ! defined in_surfex
150 !
151 ! 1. Initializations
152 ! ===================
153 !
154 ! .. Arrays
155 !
156  zwork2(:,:) = 0.
157  zwork3(:,:,:) = 0.
158 !
159 ! .. Welcome message
160 !
161  IF (lwg) THEN
162  WRITE(noutlu,*) ' '
163  WRITE(noutlu,*) ' *** LEVEL 3 - SUBROUTINE WRIDIAG_GLT'
164  WRITE(noutlu,*) ' '
165  WRITE(noutlu,*) ' --> Write diagnostic files'
166  ENDIF
167 !
168 ! .. Compute total sea ice concentration with threshold, net total sea
169 ! ice concentration, sea ice average thickness
170 !
171  zfsit(:,:) = glt_iceconcm( tpdom,tpsit )
172  zhsit(:,:) = glt_avhicem( tpdom,tpsit )
173  zhsnt(:,:) = glt_avhsnwm( tpdom,tpsit )
174  zmsnt(:,:) = glt_avmsnwm( tpdom,tpsit )
175 !
176 ! .. Time counter
177 !
178  tpind%nts = tpind%nts + 1
179 !
180 ! .. Set field counters to zero (field index in cumulated diagnostics array)
181 ! Has to be done before writing first 0d and 2d arrays
182 !
183  tpind%i0d = 0
184  tpind%i2d = 0
185 !
186 ! .. For 'specialised averaging' (e.g. ice age or salinity), count time steps
187 ! when there is sea ice
188 !
189  tpdia(:,:)%sic = tpdia(:,:)%sic + zfsit(:,:)
190  tpdia(:,:)%sit = tpdia(:,:)%sit + zhsit(:,:)
191 !
192 !
193 !
194 ! 2. Write first set of diagnostics
195 ! ==================================
196 !
197  IF ( ndiap1==1 ) THEN
198 !
199 ! >>> Write sea ice u-velocity field [m.s-1]
200 !
201  zwork2(:,:) = tpdia(:,:)%uvl
202  yword = 'SIUVLSIT'
203  tznam = t_def( " ", " ", yword, " ", "U", "VECTOR" )
204  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
205 !
206 ! >>> Write sea ice v-velocity field [m.s-1]
207 !
208  zwork2(:,:) = tpdia(:,:)%vvl
209  yword = 'SIVVLSIT'
210  tznam = t_def( " ", " ", yword, " ", "V", "VECTOR" )
211  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
212 !
213 ! >>> Write sea ice average thickness field [m]
214 !
215  zwork2(:,:) = zhsit(:,:)*float( tpdom(:,:)%tmk )
216  yword = 'SIHHHSIW'
217  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
218  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
219 !
220 ! >>> Write snow average thickness field [m]
221 !
222  zwork2(:,:) = zhsnt(:,:)*float( tpdom(:,:)%tmk )
223  yword = 'SIHHHSNW'
224  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
225  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
226 !
227 ! >>> Write snow average density field [kg.m-3]
228 !
229  zwork2(:,:) = zmsnt(:,:)*float( tpdom(:,:)%tmk )
230  yword = 'SIMMMSNW'
231  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
232  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
233 !
234 ! >>> Write total ice concentration field [0-1]
235 !
236  zwork2(:,:) = zfsit(:,:)*float( tpdom(:,:)%tmk )
237  yword = 'SIFRCSIS'
238  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
239  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
240 !
241 ! >> Write fraction of time during which sea ice is present [0-1]
242 !
243  WHERE( zfsit(:,:)>xfsic )
244  zwork2(:,:) = 1.
245  ENDWHERE
246  yword = 'SICETIME'
247  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
248  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
249 !
250 ! >> Write average fraction of the marine surface that melts [0-1]
251 !
252  WHERE( abs( tpsit(:,:,:)%tsf-tice_m ) < epsil1 )
253  zwork3(:,:,:) = tpsit(:,:,:)%fsi
254  ENDWHERE
255  zwork2(:,:) = &
256  sum( zwork3(:,:,:),dim=1 )*float( tpdom(:,:)%tmk )
257  yword = 'SIMELTFR'
258  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
259  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
260 !
261 ! >>> Write average surface temperature field [deg C]
262 !
263  zwork2(:,:) = &
264  ( sum( tpsit(:,:,:)%fsi*tpsit(:,:,:)%tsf,dim=1 ) + &
265  ( 1.-zfsit(:,:) )*tpml(:,:)%tml )*float( tpdom(:,:)%tmk )
266  yword = 'SITEMSMW'
267  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
268  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
269 !
270 ! >>> Write average surface albedo field (all marine surface) [0-1]
271 !
272  zwork2(:,:) = &
273  ( sum( tpsit(:,:,:)%fsi*tpsit(:,:,:)%asn,dim=1 ) + &
274  ( 1.-zfsit(:,:) )*albw )*float( tpdom(:,:)%tmk )
275  yword = 'SIALBSMW'
276  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
277  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
278 !
279 ! >>> Write average surface albedo field (ice only) [0-1]
280 !
281  WHERE( tpdom(:,:)%tmk==1 .AND. zfsit(:,:)>=xiok )
282  zwork2(:,:) = &
283  sum( tpsit(:,:,:)%fsi*tpsit(:,:,:)%asn, dim=1 ) / zfsit(:,:)
284  ELSEWHERE
285  zwork2(:,:) = 0.
286  ENDWHERE
287  yword = 'SIALBSIW'
288  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
289  CALL gltools_outdia &
290  ( tpind,tznam,tpdom,zwork2,pcumdia,pwgt=tpdia%sic )
291 !
292 ! >>> Write average ice salinity [psu]
293 !
294  IF ( nicesal==1 ) THEN
295  WHERE( tpdom(:,:)%tmk==1 .AND. zfsit(:,:)>=xiok )
296  zwork2(:,:) = &
297  sum( tpsit(:,:,:)%fsi*tpsit(:,:,:)%hsi*tpsit(:,:,:)%ssi, dim=1 )
298  ELSEWHERE
299  zwork2(:,:) = 0.
300  ENDWHERE
301  yword = 'SISALSIW'
302  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
303  CALL gltools_outdia &
304  ( tpind,tznam,tpdom,zwork2,pcumdia,pwgt=tpdia%sit )
305  ENDIF
306 !
307 ! >>> Write average surface ice age [years]
308 !
309  IF ( niceage==1 ) THEN
310  WHERE( tpdom(:,:)%tmk==1 .AND. zfsit(:,:)>=xiok )
311  zwork2(:,:) = &
312  sum( tpsit(:,:,:)%fsi*tpsit(:,:,:)%age, dim=1 ) / &
313  ( xyear2day*xday2sec )
314  ELSEWHERE
315  zwork2(:,:) = 0.
316  ENDWHERE
317  yword = 'SIAGESIW'
318  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
319  CALL gltools_outdia &
320  ( tpind,tznam,tpdom,zwork2,pcumdia,pwgt=tpdia%sic )
321  ENDIF
322 !
323 ! >>> Write average surface ice age [years]
324 !
325  IF ( nmponds==1 ) THEN
326  WHERE( tpdom(:,:)%tmk==1 .AND. zfsit(:,:)>=xiok )
327  zwork2(:,:) = &
328  sum( tpsit(:,:,:)%fsi*tpsit(:,:,:)%vmp, dim=1 )
329  ELSEWHERE
330  zwork2(:,:) = 0.
331  ENDWHERE
332  yword = 'SIVMPSIW'
333  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
334  CALL gltools_outdia &
335  ( tpind,tznam,tpdom,zwork2,pcumdia,pwgt=tpdia%sic )
336  ENDIF
337 !
338  ENDIF
339 !
340 !
341 !
342 ! 3. Write second set of diagnostics
343 ! ===================================
344 !
345 ! .. Note that the outgoing heat flux affecting ice free areas are
346 ! exactly equal to the incoming heat flux in the same zones.
347 !
348 ! NOTES
349 ! ------
350 ! * If you want to compute a complete energy balance on sea ice,
351 ! you must compare, on the one hand:
352 ! . SITDENIW (gltools_enthalpy change)
353 ! And, on the other hand:
354 ! . OIHFLUIW + AIHFLUIW + AISNWFIW + AWHFLUWW + AWSNWFWW -
355 ! ( IOLFLUIW + IOTFLUIW + LOLFLUIW + LOTFLUIW )
356 ! i.e.
357 ! ( ocean heat flux +
358 ! atmospheric heat flux on ice + energy flux due to snowfalls on ice +
359 ! atmospheric heat flux on water + energy flux due to snowfalls on water )
360 ! minus
361 ! ( outgoing short wave + non-solar through leads +
362 ! outgoing short wave + non-solar through ice )
363 !
364 ! - outgoing energy (solar+non-solar) at the bottom of sea ice)
365 !
366 ! * If you want to compute a complete fresh water balance on sea ice,
367 ! you must compare, on the one hand:
368 ! ALLFWTOT (all precip-evapo) - LOWFLUIW - IOWFLUIW (outgoing water
369 ! through leads and under sea ice)
370 ! And, on the other hand:
371 ! SITDSIIW + SIDDSIIW (sea ice mass change due to glt_thermo + dynamics)
372 ! + (SITDSNIW + SIDDSNIW) (snow mass changes due to glt_thermo + dynamics)
373 ! - (SITDSAIW + SIDDSAIW) (salt mass changes due to glt_thermo + dynamics)
374 !
375 ! * The energetic balance due to the (non perfectly conservative) sea
376 ! ice advection is also available, see SIDDENIW and SIDDLAIW fields.
377 !
378 ! * The change in water budget due to dynamics is not implemented yet.
379 !
380  IF ( ndiap2==1 ) THEN
381 !
382 ! >>> Write ocean heat flux - weighed [W.m-2]
383 !
384  zwork2(:,:) = tpdia(:,:)%qoi*float( tpdom(:,:)%tmk )
385  yword = 'OIHFLUIW'
386  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
387  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
388 !
389 ! >>> Write equivalent heat flux due to snow melting in the ocean [W.m-2]
390 !
391  zwork2(:,:) = tpbud(:,:)%nli*float(tpdom(:,:)%tmk)
392  yword = 'AWSNWFWW'
393  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
394  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
395 !
396 ! >>> Write equivalent heat flux due to snowfalls on sea ice [W.m-2]
397 !
398  zwork2(:,:) = tpbud(:,:)%nii
399  yword = 'AISNWFIW'
400  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
401  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
402 !
403 ! >>> Write net heat flux on the ice surface only - weighed [W.m-2]
404 ! (without the effect of snow)
405 !
406  zwork2(:,:) = tpbud(:,:)%hii-tpbud(:,:)%nii
407  yword = 'AIHFLUIW'
408  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
409  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
410 !
411 ! >>> Write net heat flux on the water surface only - weighed [W.m-2]
412 ! (without the effect of snow)
413 !
414  zwork2(:,:) = (tpbud(:,:)%hli-tpbud(:,:)%nli)*float(tpdom(:,:)%tmk)
415  yword = 'AWHFLUWW'
416  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
417  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
418 !
419 ! >>> Write solar energy absorbed by the water surface [W.m-2]
420 !
421  zwork2(:,:) = tpblkw(:,:)%swa*float( tpdom(:,:)%tmk )
422  yword = 'AWSFLUWW'
423  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
424  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
425 !
426 ! >>> Write weighed sea ice gltools_enthalpy variation due to thermodynamics [W.m-2]
427 !
428  zwork2(:,:) = tpdia(:,:)%the
429  yword = 'SITDENIW'
430  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
431  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
432 !
433 ! >>> Write weighed sea ice gltools_enthalpy variation due to advection [W.m-2]
434 !
435  zwork2(:,:) = &
436  ( tpbud(:,:)%enn-tpbud(:,:)%eni ) / dtt - tpdia(:,:)%the
437  yword = 'SIDDENIW'
438  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
439  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
440 !
441 ! >>> Write weighted net FW flux sent by sea ice to the ocean [W.m-2]
442 !
443  zwork2(:,:) = tptfl(:,:)%wio
444  yword = 'IOWFLUIW'
445  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
446  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
447 !
448 ! >>> Write weighted net FW flux sent by leads to the ocean [kg.m-2.s-1]
449 !
450  zwork2(:,:) = tptfl(:,:)%wlo*float( tpdom(:,:)%tmk )
451  yword = 'LOWFLUIW'
452  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
453  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
454 !
455 ! >>> Write weighted virtual FW flux sent by sea ice to the ocean [kg.m-2.s-1]
456 !
457  zwork2(:,:) = tptfl(:,:)%cio
458  yword = 'IOVFLUIW'
459  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
460  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
461 !
462 ! >>> Write weighted salt flux sent by sea ice to the ocean
463 !
464  zwork2(:,:) = tptfl(:,:)%sio
465  yword = 'IOSFLUIW'
466  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
467  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
468 !
469 ! >>> Write weighted solar heat flux sent by sea ice to the ocean
470 !
471  zwork2(:,:) = tptfl(:,:)%lio
472  yword = 'IOLFLUIW'
473  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
474  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
475 !
476 ! >>> Write weighted non-solar heat flux sent by sea ice to the ocean
477 !
478  zwork2(:,:) = tptfl(:,:)%tio
479  yword = 'IOTFLUIW'
480  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
481  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
482 !
483 ! >>> Write weighted solar heat flux sent by leads to the ocean
484 !
485  zwork2(:,:) = tptfl(:,:)%llo*float( tpdom(:,:)%tmk )
486  yword = 'LOLFLUIW'
487  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
488  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
489 !
490 ! >>> Write weighted non-solar heat flux sent by leads to the ocean
491 !
492  zwork2(:,:) = tptfl(:,:)%tlo*float( tpdom(:,:)%tmk )
493  yword = 'LOTFLUIW'
494  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
495  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
496 !
497 ! >>> Write weighted salt mass change field - glt_thermo only [ kg.m-2.s-1 ]
498 !
499  zwork2(:,:) = tpdia(:,:)%dsa*float( tpdom(:,:)%tmk )
500  yword = 'SITDSAIW'
501  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
502  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
503 !
504 ! >>> Write weighted snow mass change field - glt_thermo only [ kg.m-2.s-1 ]
505 !
506  zwork2(:,:) = tpdia(:,:)%dsn*float( tpdom(:,:)%tmk )
507  yword = 'SITDSNIW'
508  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
509  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
510 !
511 ! >>> Write weighted sea ice mass change field - glt_thermo only [ kg.m-2.s-1 ]
512 !
513  zwork2(:,:) = tpdia(:,:)%dsi*float( tpdom(:,:)%tmk )
514  yword = 'SITDSIIW'
515  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
516  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
517 !
518 ! >>> Write weighted salt mass change field - dynamics only [ kg.m-2.s-1 ]
519 !
520  zwork2(:,:) = tpdia(:,:)%dds*float( tpdom(:,:)%tmk )
521  yword = 'SIDDSAIW'
522  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
523  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
524 !
525 ! >>> Write weighted snow mass change field - dynamics only [ kg.m-2.s-1 ]
526 !
527  zwork2(:,:) = tpdia(:,:)%ddn*float( tpdom(:,:)%tmk )
528  yword = 'SIDDSNIW'
529  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
530  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
531 !
532 ! >>> Write weighted sea ice mass change field - dynamics only [ kg.m-2.s-1 ]
533 !
534  zwork2(:,:) = tpdia(:,:)%ddi*float( tpdom(:,:)%tmk )
535  yword = 'SIDDSIIW'
536  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
537  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
538 !
539 ! >>> Write weighted ice FW content change field - glt_thermo only [ kg.m-2.s-1 ]
540 !
541  zwork2(:,:) = tpdia(:,:)%dwi*float( tpdom(:,:)%tmk )
542  yword = 'SIDMWIIW'
543  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
544  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
545 !
546 ! >>> Write total input water to the snow-ice leads system [kg.m-2.s-1]
547 !
548  zwork2(:,:) = tpdia(:,:)%ifw*float( tpdom(:,:)%tmk )
549  yword = 'ALLFWTOT'
550  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
551  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
552 !
553 ! >>> Write ice production in leads [ kg.m-2.s-1 ]
554 !
555  zwork2(:,:) = tpdia(:,:)%lsi*float( tpdom(:,:)%tmk )
556  yword = 'SILDSIIW'
557  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
558  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
559 !
560 ! >>> Write weighted ice top mass balance - positive if melting [ kg.m-2.s-1 ]
561 !
562  zwork2(:,:) = tpdia(:,:)%mrt*float( tpdom(:,:)%tmk )
563  yword = 'SIMRTIIW'
564  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
565  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
566 !
567 ! >>> Write weighted ice lateral ablation [ kg.m-2.s-1 ]
568 !
569  zwork2(:,:) = tpdia(:,:)%mrl*float( tpdom(:,:)%tmk )
570  yword = 'SIMRLIIW'
571  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
572  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
573 !
574 ! >>> Write weighted ice bottom mass balance [ kg.m-2.s-1 ]
575 !
576  zwork2(:,:) = &
577  ( tpdia(:,:)%dsi-tpdia(:,:)%lsi-tpdia(:,:)%mrt-tpdia(:,:)%mrl )* &
578  float( tpdom(:,:)%tmk )
579  yword = 'SIMRBIIW'
580  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
581  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
582 !
583 ! >>> Write spare fields
584 !
585  IF ( any( abs( tpdia(:,:)%sp1 ) > epsil2 ) ) THEN
586  zwork2(:,:) = &
587  tpdia(:,:)%sp1*float( tpdom(:,:)%tmk )
588  yword = 'FIELDSP1'
589  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
590  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
591  ENDIF
592 !
593  IF ( any( abs( tpdia(:,:)%sp2 ) > epsil2 ) ) THEN
594  zwork2(:,:) = &
595  tpdia(:,:)%sp2*float( tpdom(:,:)%tmk )
596  yword = 'FIELDSP2'
597  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
598  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
599  ENDIF
600 !
601  DO jt=1,nt
602 !
603 ! >>> Write sea ice categories concentration fields
604 !
605  zwork2(:,:) = tpsit(jt,:,:)%fsi*float( tpdom(:,:)%tmk )
606  WRITE( yword,fmt='("SIFRCSI",I1.1)' ) jt
607  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
608  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
609 !
610 ! >>> Write sea ice categories thickness fields
611 !
612  zwork2(:,:) = tpsit(jt,:,:)%hsi*float( tpdom(:,:)%tmk )
613  WRITE( yword,fmt='("SIHHHSI",I1.1)' ) jt
614  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
615  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
616 !
617 ! >>> Write sea ice categories surface temperature
618 !
619  zwork2(:,:) = tpsit(jt,:,:)%tsf*float( tpdom(:,:)%tmk )
620  WRITE( yword,fmt='("SITEMSI",I1.1)' ) jt
621  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
622  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
623 !
624 ! >>> Write melt pond volume over each ice category
625 !
626  zwork2(:,:) = tpsit(jt,:,:)%vmp*float( tpdom(:,:)%tmk )
627  WRITE( yword,fmt='("SIVMPSI",I1.1)' ) jt
628  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
629  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
630 !
631 ! >>> Write sea ice category albedo
632 !
633  zwork2(:,:) = tpsit(jt,:,:)%asn*float( tpdom(:,:)%tmk )
634  WRITE( yword,fmt='("SIALBSI",I1.1)' ) jt
635  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
636  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
637 !
638 ! >>> Write solar energy absorbed by sea ice categories
639 !
640  zwork2(:,:) = tpblki(jt,:,:)%swa*float( tpdom(:,:)%tmk )
641  WRITE( yword,fmt='("AISWASI",I1.1)' ) jt
642  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
643  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
644 !
645 ! >>> Write non-solar energy absorbed by sea ice categories
646 !
647  zwork2(:,:) = tpblki(jt,:,:)%nsf*float( tpdom(:,:)%tmk )
648  WRITE( yword,fmt='("SINSFSI",I1.1)' ) jt
649  tznam = t_def( " ", " ", yword, " ", "T", "SCALAR" )
650  CALL gltools_outdia( tpind,tznam,tpdom,zwork2,pcumdia )
651 !
652  END DO
653 !
654  ENDIF
655 !
656 ! .. Just a final check, if ndiamax (in gltpar) is too small to hold all the
657 ! data
658 !
659  IF ( tpind%cur==tpind%beg ) THEN
660  IF ( tpind%i2d>ndiamax ) THEN
661  WRITE( ymess, &
662  fmt='("Number of 2d diagnostic fields=", &
663  & I3,"> ndiamax=",I3,"\n")' ) tpind%i2d,ndiamax
664  CALL gltools_glterr( 'imod_results','Check ndiamax in gltpar', 'STOP' )
665  ENDIF
666  IF ( tpind%i0d>ndiamax ) THEN
667  WRITE( ymess, &
668  fmt='("Number of 0d diagnostic fields=", &
669  & I3,"> ndiamax=",I3,"\n")' ) tpind%i0d,ndiamax
670  CALL gltools_glterr( 'imod_results','Check ndiamax in gltpar', 'STOP' )
671  ENDIF
672  ENDIF
673 !
674 !
675 !
676 ! 3. Sea ice totals for Northern and Southern hemispheres
677 ! ========================================================
678 !
679 ! 3.1. Compute sea ice totals
680 ! ----------------------------
681 !
682 ! The following quantities are computed :
683 ! - sea ice extent (sum of all grid cells with more than X % ice
684 ! concentration)
685 ! - sea ice area
686 ! - sea ice volume
687 !
688 ! .. Sea ice extent, north and south
689 !
690  ynhemis(:,:) = ( tpdom(:,:)%lat>0..AND.tpdom(:,:)%tmk==1 )
691  yshemis(:,:) = ( tpdom(:,:)%lat<0..AND.tpdom(:,:)%tmk==1 )
692  IF ( ndiap3==1 ) THEN
693  zehn = sum(tpdom(:,:)%srf, mask=(ynhemis.AND.zfsit(:,:)>xfsic)) / 1.e+12
694  zehs = sum(tpdom(:,:)%srf, mask=(yshemis.AND.zfsit(:,:)>xfsic)) / 1.e+12
695  ENDIF
696 !
697 ! .. Sea ice area, north and south
698 !
699  zshn = sum(tpdom(:,:)%srf*zfsit(:,:), mask=ynhemis) / 1.e+12
700  zshs = sum(tpdom(:,:)%srf*zfsit(:,:), mask=yshemis) / 1.e+12
701 !
702 ! .. Sea ice volume, north and south
703 !
704  zvhn = sum(tpdom(:,:)%srf*zhsit(:,:), mask=ynhemis) / 1.e+12
705  zvhs = sum(tpdom(:,:)%srf*zhsit(:,:), mask=yshemis) / 1.e+12
706 !
707 ! .. Snow volume, north and south
708 !
709  zwhn = sum(tpdom(:,:)%srf*zhsnt(:,:), mask=ynhemis) / 1.e+12
710  zwhs = sum(tpdom(:,:)%srf*zhsnt(:,:), mask=yshemis) / 1.e+12
711 !
712 ! .. Ice glt_transport through straits (depends on mesh geometry)
713 !
714  zfram = 0.
715  zbering = 0.
716  zncwest = 0.
717  znceast = 0.
718  znorthb = 0.
719 !
720  IF ( cgrdname=='NEMO1' ) THEN
721 !
722 ! Fram Strait
723  ii0 = 268
724  ij0 = 271
725 !
726  DO ji=1,10
727  ii = ii0+ji-1
728  ij = ij0
729  zfram = zfram + &
730  iceflx( tpdom,zhsit,tpdia,ii,ij,ii,ij+1 )
731  END DO
732  zfram = -zfram
733 !
734 ! Bering Strait
735  ii0 = 114
736  ij0 = 245
737 !
738  DO ji=1,2
739  ii = ii0+ji-1
740  ij = ij0
741  zbering = zbering + &
742  iceflx( tpdom,zhsit,tpdia,ii,ij,ii,ij+1 )
743  END DO
744  zbering = -zbering
745 !
746 ! North Canadian Archipelago (West)
747  ii0 = 231
748  ij0 = 288
749 !
750  DO ji=1,2
751  ii = ii0
752  ij = ij0+ji-1
753  zncwest = zncwest + &
754  iceflx( tpdom,zhsit,tpdia,ii,ij,ii+1,ij )
755  END DO
756  zncwest = -zncwest
757 !
758 ! Nares Strait (between Ellesmere Land and North Western Greenland)
759 ! - we compute the ice flux at the northern boundary of this strait (at its
760 ! Arctic Ocean boundary)
761  ii0 = 252
762  ij0 = 276
763 !
764  DO ji=1,2
765  ii = ii0
766  ij = ij0+ji-1
767  znceast = znceast + &
768  iceflx( tpdom,zhsit,tpdia,ii,ij,ii+1,ij )
769  END DO
770  znceast = -znceast
771 !
772 ! Barrow Strait (between Prince of Wales I. - south and Bathurst I. - north)
773 ! - we compute the ice flux
774  ii0 = 282
775  ij0 = 273
776 !
777  DO ji=1,14
778  ii = ii0+ji-1
779  ij = ij0+ji-1
780  znorthb = znorthb - &
781  iceflx( tpdom,zhsit,tpdia,ii,ij,ii,ij+1 ) + &
782  iceflx( tpdom,zhsit,tpdia,ii-1,ij,ii,ij )
783  END DO
784  znorthb = -znorthb
785 !
786  ENDIF
787 !
788 !
789 ! 3.2. Write totals to diagnostic file
790 ! -------------------------------------
791 !
792  IF ( ndiap3==1 ) THEN
793 !
794 ! >>> Write north ice extent
795 !
796  WRITE(n0vilu) 'SIEHNSIG'
797  WRITE(n0vilu) zehn
798 !
799 ! >>> Write south ice extent
800 !
801  WRITE(n0vilu) 'SIEHSSIG'
802  WRITE(n0vilu) zehs
803 !
804 ! >>> Write north ice area
805 !
806  WRITE(n0vilu) 'SISHNSIG'
807  WRITE(n0vilu) zshn
808 !
809 ! >>> Write south ice area
810 !
811  WRITE(n0vilu) 'SISHSSIG'
812  WRITE(n0vilu) zshs
813 !
814 ! >>> Write north ice volume
815 !
816  WRITE(n0vilu) 'SIVHNSIG'
817  WRITE(n0vilu) zvhn
818 !
819 ! >>> Write south ice area
820 !
821  WRITE(n0vilu) 'SIVHSSIG'
822  WRITE(n0vilu) zvhs
823 !
824 ! >>> Write north snow volume
825 !
826  WRITE(n0vilu) 'SIWHNSIG'
827  WRITE(n0vilu) zwhn
828 !
829 ! >>> Write south snow volume
830 !
831  WRITE(n0vilu) 'SIWHSSIG'
832  WRITE(n0vilu) zwhs
833 !
834 ! >>> Fram Strait sea ice outflow
835 !
836  WRITE(n0vilu) 'SIFRAMST'
837  WRITE(n0vilu) zfram
838 !
839 ! >>> Bering Strait sea ice outflow
840 !
841  WRITE(n0vilu) 'SIBERING'
842  WRITE(n0vilu) zbering
843 !
844 ! >>> North Canadian Archipelago (West) sea ice outflow
845 !
846  WRITE(n0vilu) 'SINCWEST'
847  WRITE(n0vilu) zncwest
848 !
849 ! >>> North Canadian Archipelago (East) sea ice outflow
850 !
851  WRITE(n0vilu) 'SINCEAST'
852  WRITE(n0vilu) znceast
853 !
854 ! >>> North Barents Sea sea ice outflow
855 !
856  WRITE(n0vilu) 'SINORTHB'
857  WRITE(n0vilu) znorthb
858 !
859  ENDIF
860 !
861 !
862 ! 3.3. Print out some important statistics to glt_output file
863 ! --------------------------------------------------------
864 !
865  IF (lwg) THEN
866  WRITE(noutlu,*) ' North South'
867  WRITE(noutlu,1000) zshn,zshs
868  IF ( ndiap3==1 ) THEN
869  WRITE(noutlu,1100) zehn,zehs
870  ENDIF
871  WRITE(noutlu,1200) zwhn,zwhs
872  WRITE(noutlu,1300) zvhn,zvhs
873  WRITE(noutlu,*) ' Ice flux at Fram : ',zfram
874  WRITE(noutlu,*) ' '
875  ENDIF
876 !
877 !
878 !
879 ! 4. End of time step operations
880 ! ===============================
881 !
882 ! .. Formats
883 !
884 1000 FORMAT(5x,"Ice surface (SISH.SIG)",2(4x,f9.5))
885 1100 FORMAT(5x,"Ice extent (SIEH.SIG)",2(4x,f9.5))
886 1200 FORMAT(5x,"Snow volume (SIWH.SIG)",2(4x,f9.5))
887 1300 FORMAT(5x,"Ice volume (SIVH.SIG)",2(4x,f9.5))
888 !
889  IF (lwg) THEN
890  WRITE(noutlu,*) &
891  ' ************************************'
892  WRITE(noutlu,*) &
893  ' END OF glt_gelato TIME STEP Nr =',tpind%cur
894  WRITE(noutlu,*) &
895  ' ************************************'
896 !
897 ! .. Farewell message
898 !
899  WRITE(noutlu,*) ' '
900  WRITE(noutlu,*) ' *** LEVEL 3 - END SUBROUTINE WRIDIAG_GLT'
901  WRITE(noutlu,*) ' '
902  ENDIF
903 #else
904  WRITE(noutlu,*) ' wri_dia_glt doesn t work in Surfex'
905 #endif
906 !
907 END SUBROUTINE wridiag_glt
908 !
909 ! ---------------------- END SUBROUTINE WRIDIAG_GLT -----------------------
910 ! -----------------------------------------------------------------------
911 END MODULE mode_glt_dia_glt
modd_types_glt::t_bud
Definition: modd_types_glt.F90:402
mode_glt_stats::glt_iceconcm
Definition: mode_glt_stats.F90:72
modd_types_glt
Definition: modd_types_glt.F90:65
gltools_glterr
subroutine gltools_glterr(hroutine, hmess, hflag)
Definition: modi_gltools_glterr.F90:85
modd_types_glt::t_sit
Definition: modd_types_glt.F90:227
mode_glt_dia_glt
Definition: mode_glt_dia_glt.F90:48
modd_types_glt::t_tfl
Definition: modd_types_glt.F90:321
mode_gltools_wrivais
Definition: mode_gltools_wrivais.F90:55
modd_types_glt::t_dia
Definition: modd_types_glt.F90:461
gltools_outdia
subroutine gltools_outdia(tpind, tpnam, tpdom, pfield, pcumdia, pwgt)
Definition: modi_gltools_outdia.F90:84
modd_glt_param
Definition: modd_glt_param.F90:53
mode_glt_stats::glt_avmsnwm
Definition: mode_glt_stats.F90:162
modd_types_glt::t_dom
Definition: modd_types_glt.F90:73
mode_glt_stats::glt_avhicem
Definition: mode_glt_stats.F90:140
modd_types_glt::t_def
Definition: modd_types_glt.F90:655
mode_glt_stats
Definition: mode_glt_stats.F90:51
modd_types_glt::t_blk
Definition: modd_types_glt.F90:181
modd_glt_const_thm
Definition: modd_glt_const_thm.F90:44
modd_types_glt::t_ind
Definition: modd_types_glt.F90:632
mode_glt_dia_glt::wridiag_glt
subroutine wridiag_glt(tpind, tpdom, tpml, tptfl, tpblkw, tpblki, tpsit, tpbud, tpdia, pcumdia)
Definition: mode_glt_dia_glt.F90:92
modd_types_glt::t_mxl
Definition: modd_types_glt.F90:117
mode_glt_stats::glt_avhsnwm
Definition: mode_glt_stats.F90:151
Generated on Fri May 13 2016 09:31:00 for SURFEX by   doxygen 1.8.5