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/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90 @ 5235

Last change on this file since 5235 was 5235, checked in by davestorkey, 9 years ago

Clear svn keyword information in branch
2014/dev_r4650_UKMO11_restart_functionality

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