New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
limwri.F90 in branches/2015/dev_r5056_CMCC4_simplification/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: branches/2015/dev_r5056_CMCC4_simplification/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90 @ 5443

Last change on this file since 5443 was 5282, checked in by diovino, 9 years ago

Dev. branch CMCC4_simplification ticket #1456

  • Property svn:keywords set to Id
File size: 19.1 KB
Line 
1MODULE limwri
2   !!======================================================================
3   !!                     ***  MODULE  limwri  ***
4   !!         Ice diagnostics :  write ice output files
5   !!======================================================================
6#if defined key_lim3
7   !!----------------------------------------------------------------------
8   !!   'key_lim3'                                      LIM3 sea-ice model
9   !!----------------------------------------------------------------------
10   !!   lim_wri      : write of the diagnostics variables in ouput file
11   !!   lim_wri_state : write for initial state or/and abandon
12   !!----------------------------------------------------------------------
13   USE ioipsl
14   USE dianam          ! build name of file (routine)
15   USE phycst
16   USE dom_oce
17   USE sbc_oce         ! Surface boundary condition: ocean fields
18   USE sbc_ice         ! Surface boundary condition: ice fields
19   USE dom_ice
20   USE ice
21   USE limvar
22   USE in_out_manager
23   USE lbclnk
24   USE lib_mpp         ! MPP library
25   USE wrk_nemo        ! work arrays
26   USE par_ice
27   USE iom
28   USE timing          ! Timing
29   USE lib_fortran     ! Fortran utilities
30
31   IMPLICIT NONE
32   PRIVATE
33
34   PUBLIC lim_wri        ! routine called by lim_step.F90
35   PUBLIC lim_wri_state  ! called by dia_wri_state
36
37   !!----------------------------------------------------------------------
38   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
39   !! $Id$
40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
41   !!----------------------------------------------------------------------
42CONTAINS
43
44
45   SUBROUTINE lim_wri( kindic )
46      !!-------------------------------------------------------------------
47      !!  This routine computes the average of some variables and write it
48      !!  on the ouput files.
49      !!  ATTENTION cette routine n'est valable que si le pas de temps est
50      !!  egale a une fraction entiere de 1 jours.
51      !!  Diff 1-D 3-D : suppress common also included in etat
52      !!                 suppress cmoymo 11-18
53      !!  modif : 03/06/98
54      !!-------------------------------------------------------------------
55      INTEGER, INTENT(in) ::   kindic   ! if kindic < 0 there has been an error somewhere
56      !
57      INTEGER  ::  ji, jj, jk, jl  ! dummy loop indices
58      REAL(wp) ::  z1_365
59      REAL(wp) ::  ztmp
60      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zoi, zei
61      REAL(wp), POINTER, DIMENSION(:,:)   ::  z2d, z2da, z2db, zswi    ! 2D workspace
62      !!-------------------------------------------------------------------
63
64      IF( nn_timing == 1 )  CALL timing_start('limwri')
65
66      CALL wrk_alloc( jpi, jpj, jpl, zoi, zei )
67      CALL wrk_alloc( jpi, jpj     , z2d, z2da, z2db, zswi )
68
69      !-----------------------------
70      ! Mean category values
71      !-----------------------------
72
73      CALL lim_var_icetm      ! mean sea ice temperature
74
75      CALL lim_var_bv         ! brine volume
76
77      DO jj = 1, jpj          ! presence indicator of ice
78         DO ji = 1, jpi
79            zswi(ji,jj)  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) )
80         END DO
81      END DO
82      !
83      !
84      !                                             
85      IF ( iom_use( "icethic_cea" ) ) THEN                       ! mean ice thickness
86         DO jj = 1, jpj 
87            DO ji = 1, jpi
88               z2d(ji,jj)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj)
89            END DO
90         END DO
91         CALL iom_put( "icethic_cea"  , z2d              )
92      ENDIF
93
94      IF ( iom_use( "snowthic_cea" ) ) THEN                      ! snow thickness = mean snow thickness over the cell
95         DO jj = 1, jpj                                           
96            DO ji = 1, jpi
97               z2d(ji,jj)  = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zswi(ji,jj)
98            END DO
99         END DO
100         CALL iom_put( "snowthic_cea" , z2d              )       
101      ENDIF
102      !
103      IF ( iom_use( "uice_ipa" ) .OR. iom_use( "vice_ipa" ) .OR. iom_use( "icevel" ) ) THEN
104         DO jj = 2 , jpjm1
105            DO ji = 2 , jpim1
106               z2da(ji,jj)  = (  u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp
107               z2db(ji,jj)  = (  v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp
108           END DO
109         END DO
110         CALL lbc_lnk( z2da, 'T', -1. )
111         CALL lbc_lnk( z2db, 'T', -1. )
112         CALL iom_put( "uice_ipa"     , z2da                )       ! ice velocity u component
113         CALL iom_put( "vice_ipa"     , z2db                )       ! ice velocity v component
114         DO jj = 1, jpj                                 
115            DO ji = 1, jpi
116               z2d(ji,jj)  = SQRT( z2da(ji,jj) * z2da(ji,jj) + z2db(ji,jj) * z2db(ji,jj) ) 
117            END DO
118         END DO
119         CALL iom_put( "icevel"       , z2d                 )       ! ice velocity module
120      ENDIF
121      !
122      IF ( iom_use( "miceage" ) ) THEN
123         z2d(:,:) = 0.e0
124         DO jl = 1, jpl
125            DO jj = 1, jpj
126               DO ji = 1, jpi
127                  z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * oa_i(ji,jj,jl)
128               END DO
129            END DO
130         END DO
131         z1_365 = 1._wp / 365._wp
132         CALL iom_put( "miceage"     , z2d * z1_365         )        ! mean ice age
133      ENDIF
134
135      IF ( iom_use( "micet" ) ) THEN
136         DO jj = 1, jpj
137            DO ji = 1, jpi
138               z2d(ji,jj) = ( tm_i(ji,jj) - rtt ) * zswi(ji,jj)
139            END DO
140         END DO
141         CALL iom_put( "micet"       , z2d                  )        ! mean ice temperature
142      ENDIF
143      !
144      IF ( iom_use( "icest" ) ) THEN
145         z2d(:,:) = 0.e0
146         DO jl = 1, jpl
147            DO jj = 1, jpj
148               DO ji = 1, jpi
149                  z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * ( t_su(ji,jj,jl) - rtt ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi06 )
150               END DO
151            END DO
152         END DO
153         CALL iom_put( "icest"       , z2d                 )        ! ice surface temperature
154      ENDIF
155
156      IF ( iom_use( "icecolf" ) ) THEN
157         DO jj = 1, jpj
158            DO ji = 1, jpi
159               rswitch  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) ) )
160               z2d(ji,jj) = hicol(ji,jj) * rswitch
161            END DO
162         END DO
163         CALL iom_put( "icecolf"     , z2d                 )        ! frazil ice collection thickness
164      ENDIF
165
166      CALL iom_put( "isst"        , sst_m               )        ! sea surface temperature
167      CALL iom_put( "isss"        , sss_m               )        ! sea surface salinity
168      CALL iom_put( "iceconc"     , at_i                )        ! ice concentration
169      CALL iom_put( "icevolu"     , vt_i                )        ! ice volume = mean ice thickness over the cell
170      CALL iom_put( "icehc"       , et_i                )        ! ice total heat content
171      CALL iom_put( "isnowhc"     , et_s                )        ! snow total heat content
172      CALL iom_put( "ibrinv"      , bv_i * 100._wp      )        ! brine volume
173      CALL iom_put( "utau_ice"    , utau_ice            )        ! wind stress over ice along i-axis at I-point
174      CALL iom_put( "vtau_ice"    , vtau_ice            )        ! wind stress over ice along j-axis at I-point
175      CALL iom_put( "snowpre"     , sprecip             )        ! snow precipitation
176      CALL iom_put( "micesalt"    , smt_i               )        ! mean ice salinity
177
178      CALL iom_put( "icestr"      , strength * 0.001    )        ! ice strength
179      CALL iom_put( "idive"       , divu_i * 1.0e8      )        ! divergence
180      CALL iom_put( "ishear"      , shear_i * 1.0e8     )        ! shear
181      CALL iom_put( "snowvol"     , vt_s                )        ! snow volume
182     
183      CALL iom_put( "icetrp"      , diag_trp_vi * rday  )        ! ice volume transport
184      CALL iom_put( "snwtrp"      , diag_trp_vs * rday  )        ! snw volume transport
185      CALL iom_put( "deitrp"      , diag_trp_ei         )        ! advected ice enthalpy (W/m2)
186      CALL iom_put( "destrp"      , diag_trp_es         )        ! advected snw enthalpy (W/m2)
187
188      CALL iom_put( "sfxbog"      , sfx_bog * rday      )        ! salt flux from brines
189      CALL iom_put( "sfxbom"      , sfx_bom * rday      )        ! salt flux from brines
190      CALL iom_put( "sfxsum"      , sfx_sum * rday      )        ! salt flux from brines
191      CALL iom_put( "sfxsni"      , sfx_sni * rday      )        ! salt flux from brines
192      CALL iom_put( "sfxopw"      , sfx_opw * rday      )        ! salt flux from brines
193      CALL iom_put( "sfxdyn"      , sfx_dyn * rday      )        ! salt flux from ridging rafting
194      CALL iom_put( "sfxres"      , sfx_res * rday      )        ! salt flux from limupdate (resultant)
195      CALL iom_put( "sfxbri"      , sfx_bri * rday      )        ! salt flux from brines
196      CALL iom_put( "sfx"         , sfx     * rday      )        ! total salt flux
197
198      ztmp = rday / rhoic
199      CALL iom_put( "vfxres"     , wfx_res * ztmp  )             ! daily prod./melting due to limupdate
200      CALL iom_put( "vfxopw"     , wfx_opw * ztmp  )             ! daily lateral thermodynamic ice production
201      CALL iom_put( "vfxsni"     , wfx_sni * ztmp  )             ! daily snowice ice production
202      CALL iom_put( "vfxbog"     , wfx_bog * ztmp  )             ! daily bottom thermodynamic ice production
203      CALL iom_put( "vfxdyn"     , wfx_dyn * ztmp  )             ! daily dynamic ice production (rid/raft)
204      CALL iom_put( "vfxsum"     , wfx_sum * ztmp  )             ! surface melt
205      CALL iom_put( "vfxbom"     , wfx_bom * ztmp  )             ! bottom melt
206      CALL iom_put( "vfxice"     , wfx_ice * ztmp  )             ! total ice growth/melt
207      CALL iom_put( "vfxsnw"     , wfx_snw * ztmp  )             ! total snw growth/melt
208      CALL iom_put( "vfxsub"     , wfx_sub * ztmp  )             ! sublimation (snow)
209      CALL iom_put( "vfxspr"     , wfx_spr * ztmp  )             ! precip (snow)
210
211      CALL iom_put ('hfxthd', hfx_thd(:,:) )   ! 
212      CALL iom_put ('hfxdyn', hfx_dyn(:,:) )   ! 
213      CALL iom_put ('hfxres', hfx_res(:,:) )   ! 
214      CALL iom_put ('hfxout', hfx_out(:,:) )   ! 
215      CALL iom_put ('hfxin' , hfx_in(:,:) )   ! 
216      CALL iom_put ('hfxsnw', hfx_snw(:,:) )   ! 
217      CALL iom_put ('hfxsub', hfx_sub(:,:) )   ! 
218      CALL iom_put ('hfxerr', hfx_err(:,:) )   ! 
219      CALL iom_put ('hfxerr_rem', hfx_err_rem(:,:) )   ! 
220     
221      CALL iom_put ('hfxsum', hfx_sum(:,:) )   ! 
222      CALL iom_put ('hfxbom', hfx_bom(:,:) )   ! 
223      CALL iom_put ('hfxbog', hfx_bog(:,:) )   ! 
224      CALL iom_put ('hfxdif', hfx_dif(:,:) )   ! 
225      CALL iom_put ('hfxopw', hfx_opw(:,:) )   ! 
226      CALL iom_put ('hfxtur', fhtur(:,:) * at_i(:,:) )   ! turbulent heat flux at ice base
227      CALL iom_put ('hfxdhc', diag_heat_dhc(:,:) )          ! Heat content variation in snow and ice
228      CALL iom_put ('hfxspr', hfx_spr(:,:) )          ! Heat content of snow precip
229     
230      !--------------------------------
231      ! Output values for each category
232      !--------------------------------
233      CALL iom_put( "iceconc_cat"      , a_i         )        ! area for categories
234      CALL iom_put( "icethic_cat"      , ht_i        )        ! thickness for categories
235      CALL iom_put( "snowthic_cat"     , ht_s        )        ! snow depth for categories
236      CALL iom_put( "salinity_cat"     , sm_i        )        ! salinity for categories
237
238      ! Compute ice age
239      IF ( iom_use( "iceage_cat" ) ) THEN
240         DO jl = 1, jpl 
241            DO jj = 1, jpj
242               DO ji = 1, jpi
243                  rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
244                  zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , epsi06 ) * rswitch
245               END DO
246            END DO
247         END DO
248         CALL iom_put( "iceage_cat"     , zoi         )        ! ice age for categories
249      ENDIF
250
251      ! Compute brine volume
252      IF ( iom_use( "brinevol_cat" ) ) THEN
253         zei(:,:,:) = 0._wp
254         DO jl = 1, jpl 
255            DO jk = 1, nlay_i
256               DO jj = 1, jpj
257                  DO ji = 1, jpi
258                     rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
259                     zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* &
260                        ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), - epsi06 ) ) * &
261                        rswitch / nlay_i
262                  END DO
263               END DO
264            END DO
265         END DO
266         CALL iom_put( "brinevol_cat"     , zei         )        ! brine volume for categories
267      ENDIF
268
269      !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s
270      !     IF( kindic < 0 )   CALL lim_wri_state( 'output.abort' )
271      !     not yet implemented
272     
273      CALL wrk_dealloc( jpi, jpj, jpl, zoi, zei )
274      CALL wrk_dealloc( jpi, jpj     , z2d, zswi, z2da, z2db )
275
276      IF( nn_timing == 1 )  CALL timing_stop('limwri')
277     
278   END SUBROUTINE lim_wri
279
280 
281   SUBROUTINE lim_wri_state( kt, kid, kh_i )
282      !!---------------------------------------------------------------------
283      !!                 ***  ROUTINE lim_wri_state  ***
284      !!       
285      !! ** Purpose :   create a NetCDF file named cdfile_name which contains
286      !!      the instantaneous ice state and forcing fields for ice model
287      !!        Used to find errors in the initial state or save the last
288      !!      ocean state in case of abnormal end of a simulation
289      !!
290      !! History :
291      !!   4.1  !  2013-06  (C. Rousset)
292      !!----------------------------------------------------------------------
293      INTEGER, INTENT( in ) ::   kt               ! ocean time-step index)
294      INTEGER, INTENT( in ) ::   kid , kh_i       
295      !!----------------------------------------------------------------------
296
297      CALL histdef( kid, "iicethic", "Ice thickness"           , "m"      ,   &
298      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
299      CALL histdef( kid, "iiceconc", "Ice concentration"       , "%"      ,   &
300      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
301      CALL histdef( kid, "iicetemp", "Ice temperature"         , "C"      ,   &
302      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
303      CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)"   , "m/s"    ,   &
304      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
305      CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)"   , "m/s"    ,   &
306      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
307      CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa",   &
308      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
309      CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa",   &
310      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
311      CALL histdef( kid, "iicesflx", "Solar flux over ocean"     , "w/m2" ,   &
312      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
313      CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2" ,   &
314      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
315      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s",   &
316      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
317      CALL histdef( kid, "iicesali", "Ice salinity"            , "PSU"    ,   &
318      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
319      CALL histdef( kid, "iicevolu", "Ice volume"              , "m"      ,   &
320      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
321      CALL histdef( kid, "iicedive", "Ice divergence"          , "10-8s-1",   &
322      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
323      CALL histdef( kid, "iicebopr", "Ice bottom production"   , "m/s"    ,   &
324      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
325      CALL histdef( kid, "iicedypr", "Ice dynamic production"  , "m/s"    ,   &
326      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
327      CALL histdef( kid, "iicelapr", "Ice open water prod"     , "m/s"    ,   &
328      &       jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
329      CALL histdef( kid, "iicesipr", "Snow ice production "    , "m/s"    ,   &
330      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
331      CALL histdef( kid, "iicerepr", "Ice prod from limupdate" , "m/s"    ,   &
332      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
333      CALL histdef( kid, "iicebome", "Ice bottom melt"         , "m/s"    ,   &
334      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
335      CALL histdef( kid, "iicesume", "Ice surface melt"        , "m/s"    ,   &
336      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
337      CALL histdef( kid, "iisfxdyn", "Salt flux from dynmics"  , ""       ,   &
338      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
339      CALL histdef( kid, "iisfxres", "Salt flux from limupdate", ""       ,   &
340      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
341
342      CALL histend( kid, snc4set )   ! end of the file definition
343
344      CALL histwrite( kid, "iicethic", kt, icethi        , jpi*jpj, (/1/) )   
345      CALL histwrite( kid, "iiceconc", kt, at_i          , jpi*jpj, (/1/) )
346      CALL histwrite( kid, "iicetemp", kt, tm_i - rtt    , jpi*jpj, (/1/) )
347      CALL histwrite( kid, "iicevelu", kt, u_ice          , jpi*jpj, (/1/) )
348      CALL histwrite( kid, "iicevelv", kt, v_ice          , jpi*jpj, (/1/) )
349      CALL histwrite( kid, "iicestru", kt, utau_ice       , jpi*jpj, (/1/) )
350      CALL histwrite( kid, "iicestrv", kt, vtau_ice       , jpi*jpj, (/1/) )
351      CALL histwrite( kid, "iicesflx", kt, qsr , jpi*jpj, (/1/) )
352      CALL histwrite( kid, "iicenflx", kt, qns , jpi*jpj, (/1/) )
353      CALL histwrite( kid, "isnowpre", kt, sprecip        , jpi*jpj, (/1/) )
354      CALL histwrite( kid, "iicesali", kt, smt_i          , jpi*jpj, (/1/) )
355      CALL histwrite( kid, "iicevolu", kt, vt_i           , jpi*jpj, (/1/) )
356      CALL histwrite( kid, "iicedive", kt, divu_i*1.0e8   , jpi*jpj, (/1/) )
357
358      CALL histwrite( kid, "iicebopr", kt, wfx_bog        , jpi*jpj, (/1/) )
359      CALL histwrite( kid, "iicedypr", kt, wfx_dyn        , jpi*jpj, (/1/) )
360      CALL histwrite( kid, "iicelapr", kt, wfx_opw        , jpi*jpj, (/1/) )
361      CALL histwrite( kid, "iicesipr", kt, wfx_sni        , jpi*jpj, (/1/) )
362      CALL histwrite( kid, "iicerepr", kt, wfx_res        , jpi*jpj, (/1/) )
363      CALL histwrite( kid, "iicebome", kt, wfx_bom        , jpi*jpj, (/1/) )
364      CALL histwrite( kid, "iicesume", kt, wfx_sum        , jpi*jpj, (/1/) )
365      CALL histwrite( kid, "iisfxdyn", kt, sfx_dyn        , jpi*jpj, (/1/) )
366      CALL histwrite( kid, "iisfxres", kt, sfx_res        , jpi*jpj, (/1/) )
367
368      ! Close the file
369      ! -----------------
370      !CALL histclo( kid )
371
372    END SUBROUTINE lim_wri_state
373
374#else
375   !!----------------------------------------------------------------------
376   !!   Default option :         Empty module          NO LIM sea-ice model
377   !!----------------------------------------------------------------------
378CONTAINS
379   SUBROUTINE lim_wri          ! Empty routine
380   END SUBROUTINE lim_wri
381#endif
382
383   !!======================================================================
384END MODULE limwri
Note: See TracBrowser for help on using the repository browser.