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.
icewri.F90 in branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icewri.F90 @ 8564

Last change on this file since 8564 was 8564, checked in by clem, 7 years ago

change variable names

File size: 25.2 KB
Line 
1MODULE icewri
2   !!======================================================================
3   !!                     ***  MODULE  icewri  ***
4   !!   sea-ice : output ice variables
5   !!======================================================================
6#if defined key_lim3
7   !!----------------------------------------------------------------------
8   !!   'key_lim3'                                       ESIM sea-ice model
9   !!----------------------------------------------------------------------
10   !!   ice_wri       : write of the diagnostics variables in ouput file
11   !!   ice_wri_state : write for initial state or/and abandon
12   !!----------------------------------------------------------------------
13   USE dianam         ! build name of file (routine)
14   USE phycst         ! physical constant
15   USE dom_oce        ! domain: ocean
16   USE sbc_oce        ! surf. boundary cond.: ocean
17   USE sbc_ice        ! Surface boundary condition: ice fields
18   USE ice            ! sea-ice: variables
19   USE icevar         ! sea-ice: operations
20   !
21   USE ioipsl         !
22   USE in_out_manager ! I/O manager
23   USE iom            ! I/O manager library
24   USE lib_mpp        ! MPP library
25   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
26   USE lbclnk         ! lateral boundary conditions (or mpp links)
27   USE timing         ! Timing
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC ice_wri        ! called by ice_stp
33   PUBLIC ice_wri_state  ! called by dia_wri_state
34
35   !!----------------------------------------------------------------------
36   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
37   !! $Id: icewri.F90 8409 2017-08-07 15:29:21Z clem $
38   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
39   !!----------------------------------------------------------------------
40CONTAINS
41
42   SUBROUTINE ice_wri( kt )
43      !!-------------------------------------------------------------------
44      !!  This routine computes the average of some variables and write it
45      !!  on the ouput files.
46      !!  ATTENTION cette routine n'est valable que si le pas de temps est
47      !!  egale a une fraction entiere de 1 jours.
48      !!  Diff 1-D 3-D : suppress common also included in etat
49      !!                 suppress cmoymo 11-18
50      !!  modif : 03/06/98
51      !!-------------------------------------------------------------------
52      INTEGER, INTENT(in) ::   kt   ! time-step
53      !
54      INTEGER  ::  ji, jj, jk, jl  ! dummy loop indices
55      REAL(wp) ::  z2da, z2db, zrho1, zrho2, zmiss_val
56      REAL(wp), DIMENSION(jpi,jpj)     ::  z2d, zswi, zmiss !  2D workspace
57      REAL(wp), DIMENSION(jpi,jpj)     ::  zfb              ! ice freeboard
58      REAL(wp), DIMENSION(jpi,jpj)     ::  zamask, zamask15 ! 15% concentration mask
59      REAL(wp), DIMENSION(jpi,jpj,jpl) ::  zswi2, zmiss2
60      !
61      ! Global ice diagnostics (SIMIP)
62      REAL(wp) ::  zdiag_area_nh, zdiag_extt_nh, zdiag_volu_nh   ! area, extent, volume
63      REAL(wp) ::  zdiag_area_sh, zdiag_extt_sh, zdiag_volu_sh 
64      !!-------------------------------------------------------------------
65
66      IF( nn_timing == 1 )   CALL timing_start('icewri')
67
68      !----------------------------------------
69      ! Brine volume, switches, missing values
70      !----------------------------------------
71
72      CALL ice_var_bv      ! brine volume
73
74      ! tresholds for outputs
75      DO jj = 1, jpj
76         DO ji = 1, jpi
77            zswi(ji,jj)      = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice
78            zamask(ji,jj)    = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.05   ) ) ! 1 if 5% ice, 0 if less - required to mask thickness and snow depth
79            zamask15(ji,jj)  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15   ) ) ! 1 if 15% ice, 0 if less
80         END DO
81      END DO
82      DO jl = 1, jpl
83         DO jj = 1, jpj
84            DO ji = 1, jpi
85               zswi2(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
86            END DO
87         END DO
88      END DO
89
90      zmiss_val     = 1.e20_wp
91      zmiss (:,:)   = zmiss_val * ( 1._wp - zswi (:,:) )
92      zmiss2(:,:,:) = zmiss_val * ( 1._wp - zswi2(:,:,:) )
93
94      !----------------------------------------
95      ! Standard outputs
96      !----------------------------------------
97      ! velocity
98      IF( iom_use('uice_ipa') )  CALL iom_put( "uice_ipa" , u_ice         )   ! ice velocity u component
99      IF( iom_use('vice_ipa') )  CALL iom_put( "vice_ipa" , v_ice         )   ! ice velocity v component
100
101      IF( iom_use('icevel') .OR. iom_use('icevel_mv') ) THEN
102         DO jj = 2 , jpjm1
103            DO ji = 2 , jpim1
104               z2da  = ( u_ice(ji,jj) + u_ice(ji-1,jj) )
105               z2db  = ( v_ice(ji,jj) + v_ice(ji,jj-1) )
106               z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db )
107           END DO
108         END DO
109         CALL lbc_lnk( z2d, 'T', 1. )
110         IF( iom_use('icevel'   ) )   CALL iom_put( "icevel"       , z2d        )                          ! ice velocity module
111         IF( iom_use('icevel_mv') )   CALL iom_put( "icevel_mv"    , z2d(:,:) * zswi(:,:) + zmiss(:,:) )   ! ice velocity module (missing value)
112      ENDIF
113      !
114      IF( iom_use('miceage')  )       CALL iom_put( "miceage"     , om_i * zswi * zamask15 )  ! mean ice age
115      IF( iom_use('micet')    )       CALL iom_put( "micet"       , ( tm_i  - rt0 ) * zswi )  ! ice mean    temperature
116      IF( iom_use('icest')    )       CALL iom_put( "icest"       , ( tm_su - rt0 ) * zswi )  ! ice surface temperature
117      IF( iom_use('icecolf')  )       CALL iom_put( "icecolf"     , ht_i_new               )  ! new ice thickness formed in the leads
118      !
119      CALL iom_put( "isst"        , sst_m               )        ! sea surface temperature
120      CALL iom_put( "isss"        , sss_m               )        ! sea surface salinity
121      CALL iom_put( "iceconc"     , at_i  * zswi        )        ! ice concentration
122      CALL iom_put( "icevolu"     , vt_i  * zswi        )        ! ice volume = mean ice thickness over the cell
123      CALL iom_put( "icethick"    , hm_i  * zswi        )        ! ice thickness
124      CALL iom_put( "icehc"       , et_i  * zswi        )        ! ice total heat content
125      CALL iom_put( "isnowhc"     , et_s  * zswi        )        ! snow total heat content
126      CALL iom_put( "ibrinv"      , bvm_i * zswi * 100. )        ! brine volume
127      CALL iom_put( "micesalt"    , sm_i  * zswi      )        ! mean ice salinity
128      CALL iom_put( "snowvol"     , vt_s  * zswi      )        ! snow volume
129     
130      IF ( ln_pnd ) THEN
131         CALL iom_put( "iceamp"  , at_ip  * zswi        )   ! melt pond total fraction
132         CALL iom_put( "icevmp"  , vt_ip  * zswi        )   ! melt pond total volume per unit area
133      ENDIF
134
135      !----------------------------------
136      ! Output category-dependent fields
137      !----------------------------------
138      IF ( iom_use('iceconc_cat' ) )  CALL iom_put( "iceconc_cat"      , a_i  * zswi2   )        ! area for categories
139      IF ( iom_use('icethic_cat' ) )  CALL iom_put( "icethic_cat"      , h_i  * zswi2   )        ! thickness for categories
140      IF ( iom_use('snowthic_cat') )  CALL iom_put( "snowthic_cat"     , h_s  * zswi2   )        ! snow depth for categories
141      IF ( iom_use('salinity_cat') )  CALL iom_put( "salinity_cat"     , s_i  * zswi2   )        ! salinity for categories
142      IF ( iom_use('icetemp_cat' ) )  CALL iom_put( "icetemp_cat", ( SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i - rt0 ) * zswi2 )    ! ice temperature
143      IF ( iom_use('snwtemp_cat' ) )  CALL iom_put( "snwtemp_cat", ( SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s - rt0 ) * zswi2 )    ! snow temperature
144      IF ( iom_use('iceage_cat'  ) )  CALL iom_put( "iceage_cat" , o_i * zswi2 )                   ! ice age
145      IF ( iom_use('brinevol_cat') )  CALL iom_put( "brinevol_cat", bv_i * 100. * zswi2 )          ! brine volume
146
147      IF ( ln_pnd ) THEN
148         IF ( iom_use('iceamp_cat') )  CALL iom_put( "iceamp_cat"     , a_ip       * zswi2   )       ! melt pond frac for categories
149         IF ( iom_use('icevmp_cat') )  CALL iom_put( "icevmp_cat"     , v_ip       * zswi2   )       ! melt pond frac for categories
150         IF ( iom_use('icehmp_cat') )  CALL iom_put( "icehmp_cat"     , h_ip       * zswi2   )       ! melt pond frac for categories
151         IF ( iom_use('iceafp_cat') )  CALL iom_put( "iceafp_cat"     , a_ip_frac  * zswi2   )       ! melt pond frac for categories
152      ENDIF
153
154      !--------------------------------
155      ! Add-ons for SIMIP
156      !--------------------------------
157      zrho1 = ( rau0 - rhoic ) * r1_rau0; zrho2 = rhosn * r1_rau0
158
159      IF ( iom_use( "icepres"  ) ) CALL iom_put( "icepres"     , zswi(:,:)                     )                                ! Ice presence (1 or 0)
160      IF ( iom_use( "icemass"  ) ) CALL iom_put( "icemass"     , rhoic * vt_i(:,:) * zswi(:,:) )                                ! Ice mass per cell area
161      IF ( iom_use( "icethic"  ) ) CALL iom_put( "icethic"     , hm_i(:,:) * zamask(:,:)  + ( 1. - zamask(:,:) ) * zmiss_val )     ! Ice thickness
162      IF ( iom_use( "snomass"  ) ) CALL iom_put( "snomass"     , rhosn * vt_s(:,:)         * zswi(:,:) + zmiss(:,:) )           ! Snow mass per cell area
163      IF ( iom_use( "snothic"  ) ) CALL iom_put( "snothic"     , hm_s(:,:) * zamask(:,:)  + ( 1. - zamask(:,:) ) * zmiss_val )     ! Snow thickness       
164
165      IF ( iom_use( "iceconc_cat_mv"  ) )  CALL iom_put( "iceconc_cat_mv" , a_i(:,:,:)  * zswi2(:,:,:) + zmiss2(:,:,:) )        ! Area for categories
166      IF ( iom_use( "icethic_cat_mv"  ) )  CALL iom_put( "icethic_cat_mv" , h_i(:,:,:) * zswi2(:,:,:) + zmiss2(:,:,:) )        ! Thickness for categories
167      IF ( iom_use( "snowthic_cat_mv" ) )  CALL iom_put( "snowthic_cat_mv", h_s(:,:,:) * zswi2(:,:,:) + zmiss2(:,:,:) )        ! Snow depth for categories
168
169      IF ( iom_use( "icestK"   ) ) CALL iom_put( "icestK"      , tm_su(:,:)                * zswi(:,:) + zmiss(:,:) )           ! Ice surface temperature
170      IF ( iom_use( "icesntK"  ) ) CALL iom_put( "icesntK"     , tm_si(:,:)                * zswi(:,:) + zmiss(:,:) )           ! Snow-ice interface temperature
171      IF ( iom_use( "icebotK"  ) ) CALL iom_put( "icebotK"     , t_bo(:,:)                 * zswi(:,:) + zmiss(:,:) )           ! Ice bottom temperature
172      IF ( iom_use( "iceage"   ) ) CALL iom_put( "iceage"      , om_i(:,:) * zamask15(:,:) + ( 1. - zamask15(:,:) ) * zmiss_val )   ! Ice age
173      IF ( iom_use( "icesmass" ) ) CALL iom_put( "icesmass"    , SUM( sv_i, DIM = 3 ) * rhoic * 1.0e-3 * zswi(:,:) )           ! Mass of salt in sea ice per cell area
174      IF ( iom_use( "icesal"   ) ) CALL iom_put( "icesal"      , sm_i(:,:)                * zswi(:,:) + zmiss(:,:) )           ! Ice salinity
175
176      IF ( iom_use( "icefb"    ) ) THEN
177         zfb(:,:) = ( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) )                                         
178         WHERE( zfb < 0._wp ) ;   zfb = 0._wp ;   END WHERE
179                                   CALL iom_put( "icefb"       , zfb(:,:)                  * zswi(:,:) + zmiss(:,:) )           ! Ice freeboard
180      ENDIF
181
182      IF ( iom_use( "isnhcneg" ) ) CALL iom_put( "isnhcneg"    , - et_s(:,:)               * zswi(:,:) + zmiss(:,:) )           ! Snow total heat content
183
184      IF ( iom_use( "dmithd"   ) ) CALL iom_put( "dmithd"      , - wfx_bog - wfx_bom - wfx_sum   &                       ! Sea-ice mass change from thermodynamics
185              &                                                   - wfx_sni - wfx_opw - wfx_res )
186      IF ( iom_use( "dmidyn"   ) ) CALL iom_put( "dmidyn"      , - wfx_dyn(:,:) + rhoic * diag_trp_vi(:,:) )             ! Sea-ice mass change from dynamics(kg/m2/s)
187      IF ( iom_use( "dmiopw"   ) ) CALL iom_put( "dmiopw"      , - wfx_opw                  )                            ! Sea-ice mass change through growth in open water
188      IF ( iom_use( "dmibog"   ) ) CALL iom_put( "dmibog"      , - wfx_bog                  )                            ! Sea-ice mass change through basal growth
189      IF ( iom_use( "dmisni"   ) ) CALL iom_put( "dmisni"      , - wfx_sni                  )                            ! Sea-ice mass change through snow-to-ice conversion
190      IF ( iom_use( "dmisum"   ) ) CALL iom_put( "dmisum"      , - wfx_sum                  )                            ! Sea-ice mass change through surface melting
191      IF ( iom_use( "dmibom"   ) ) CALL iom_put( "dmibom"      , - wfx_bom                  )                            ! Sea-ice mass change through bottom melting
192
193      IF ( iom_use( "dmtsub"   ) ) CALL iom_put( "dmtsub"      , - wfx_sub                  )                            ! Sea-ice mass change through evaporation and sublimation
194      IF ( iom_use( "dmssub"   ) ) CALL iom_put( "dmssub"      , - wfx_snw_sub              )                            ! Snow mass change through sublimation
195      IF ( iom_use( "dmisub"   ) ) CALL iom_put( "dmisub"      , - wfx_ice_sub              )                            ! Sea-ice mass change through sublimation
196
197      IF ( iom_use( "dmsspr"   ) ) CALL iom_put( "dmsspr"      , - wfx_spr                  )                            ! Snow mass change through snow fall
198      IF ( iom_use( "dmsssi"   ) ) CALL iom_put( "dmsssi"      ,   wfx_sni*rhosn*r1_rhoic   )                            ! Snow mass change through snow-to-ice conversion
199
200      IF ( iom_use( "dmsmel"   ) ) CALL iom_put( "dmsmel"      , - wfx_snw_sum              )                            ! Snow mass change through melt
201      IF ( iom_use( "dmsdyn"   ) ) CALL iom_put( "dmsdyn"      , - wfx_snw_dyn(:,:) + rhosn * diag_trp_vs(:,:) )         ! Snow mass change through dynamics(kg/m2/s)
202
203      IF ( iom_use( "hfxsenso" ) ) CALL iom_put( "hfxsenso"    ,   -fhtur(:,:)              * zswi(:,:) + zmiss(:,:) )   ! Sensible oceanic heat flux
204      IF ( iom_use( "hfxconbo" ) ) CALL iom_put( "hfxconbo"    ,   diag_fc_bo               * zswi(:,:) + zmiss(:,:) )   ! Bottom conduction flux
205      IF ( iom_use( "hfxconsu" ) ) CALL iom_put( "hfxconsu"    ,   diag_fc_su               * zswi(:,:) + zmiss(:,:) )   ! Surface conduction flux
206
207      IF ( iom_use( "wfxtot"   ) ) CALL iom_put( "wfxtot"      ,   wfx_ice(:,:)             * zswi(:,:) + zmiss(:,:) )   ! Total freshwater flux from sea ice
208      IF ( iom_use( "wfxsum"   ) ) CALL iom_put( "wfxsum"      ,   wfx_sum(:,:)             * zswi(:,:) + zmiss(:,:) )   ! Freshwater flux from sea-ice surface
209      IF ( iom_use( "sfx_mv"   ) ) CALL iom_put( "sfx_mv"      ,   sfx(:,:) * 0.001         * zswi(:,:) + zmiss(:,:) )   ! Total salt flux
210
211      IF ( iom_use( "uice_mv"  ) ) CALL iom_put( "uice_mv"     ,   u_ice(:,:)               * zswi(:,:) + zmiss(:,:) )   ! ice velocity u component
212      IF ( iom_use( "vice_mv"  ) ) CALL iom_put( "vice_mv"     ,   v_ice(:,:)               * zswi(:,:) + zmiss(:,:) )   ! ice velocity v component
213     
214      IF ( iom_use( "utau_ice" ) ) CALL iom_put( "utau_ice"     ,  utau_ice(:,:)            * zswi(:,:) + zmiss(:,:) )   ! Wind stress term in force balance (x)
215      IF ( iom_use( "vtau_ice" ) ) CALL iom_put( "vtau_ice"     ,  vtau_ice(:,:)            * zswi(:,:) + zmiss(:,:) )   ! Wind stress term in force balance (y)
216
217      !--------------------------------
218      ! Global ice diagnostics (SIMIP)
219      !--------------------------------
220      !
221      IF ( iom_use( "NH_icearea" ) .OR. iom_use( "NH_icevolu" ) .OR. iom_use( "NH_iceextt" ) )   THEN   ! NH diagnostics
222         !
223         WHERE( ff_t > 0._wp )   ;   zswi(:,:) = 1.0e-12
224         ELSEWHERE               ;   zswi(:,:) = 0.
225         END WHERE
226         zdiag_area_nh = glob_sum( at_i(:,:) * zswi(:,:) * e1e2t(:,:) )
227         zdiag_volu_nh = glob_sum( vt_i(:,:) * zswi(:,:) * e1e2t(:,:) )
228         !
229         WHERE( ff_t > 0._wp .AND. at_i > 0.15 )   ; zswi(:,:) = 1.0e-12
230         ELSEWHERE                                 ; zswi(:,:) = 0.
231         END WHERE
232         zdiag_extt_nh = glob_sum( zswi(:,:) * e1e2t(:,:) )
233         !
234         IF ( iom_use( "NH_icearea" ) )   CALL iom_put( "NH_icearea" ,  zdiag_area_nh  )
235         IF ( iom_use( "NH_icevolu" ) )   CALL iom_put( "NH_icevolu" ,  zdiag_volu_nh  )
236         IF ( iom_use( "NH_iceextt" ) )   CALL iom_put( "NH_iceextt" ,  zdiag_extt_nh  )
237         !
238      ENDIF
239      !
240      IF ( iom_use( "SH_icearea" ) .OR. iom_use( "SH_icevolu" ) .OR. iom_use( "SH_iceextt" ) )   THEN   ! SH diagnostics
241         !
242         WHERE( ff_t < 0._wp ); zswi(:,:) = 1.0e-12; 
243         ELSEWHERE            ; zswi(:,:) = 0.
244         END WHERE
245         zdiag_area_sh = glob_sum( at_i(:,:) * zswi(:,:) * e1e2t(:,:) ) 
246         zdiag_volu_sh = glob_sum( vt_i(:,:) * zswi(:,:) * e1e2t(:,:) )
247         !
248         WHERE( ff_t < 0._wp .AND. at_i > 0.15 ); zswi(:,:) = 1.0e-12
249         ELSEWHERE                              ; zswi(:,:) = 0.
250         END WHERE
251         zdiag_extt_sh = glob_sum( zswi(:,:) * e1e2t(:,:) )
252         !
253         IF ( iom_use( "SH_icearea" ) ) CALL iom_put( "SH_icearea", zdiag_area_sh )
254         IF ( iom_use( "SH_icevolu" ) ) CALL iom_put( "SH_icevolu", zdiag_volu_sh )
255         IF ( iom_use( "SH_iceextt" ) ) CALL iom_put( "SH_iceextt", zdiag_extt_sh )
256         !
257      ENDIF 
258      !
259!!CR      !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s
260!!CR      !     IF( kindic < 0 )   CALL ice_wri_state( 'output.abort' )
261!!CR      !     not yet implemented
262!!gm  idem for the ocean...  Ask Seb how to get read of ioipsl....
263      !
264      IF( nn_timing == 1 )  CALL timing_stop('icewri')
265      !
266   END SUBROUTINE ice_wri
267
268 
269   SUBROUTINE ice_wri_state( kt, kid, kh_i )
270      !!---------------------------------------------------------------------
271      !!                 ***  ROUTINE ice_wri_state  ***
272      !!       
273      !! ** Purpose :   create a NetCDF file named cdfile_name which contains
274      !!      the instantaneous ice state and forcing fields for ice model
275      !!        Used to find errors in the initial state or save the last
276      !!      ocean state in case of abnormal end of a simulation
277      !!
278      !! History :   4.0  !  2013-06  (C. Rousset)
279      !!----------------------------------------------------------------------
280      INTEGER, INTENT( in )   ::   kt               ! ocean time-step index
281      INTEGER, INTENT( in )   ::   kid , kh_i
282      INTEGER                 ::   nz_i, jl
283      REAL(wp), DIMENSION(jpl) :: jcat
284      !!----------------------------------------------------------------------
285      !
286      DO jl = 1, jpl
287         jcat(jl) = REAL(jl)
288      END DO
289     
290      CALL histvert( kid, "ncatice", "Ice Categories","", jpl, jcat, nz_i, "up")
291
292      CALL histdef( kid, "sithic", "Ice thickness"           , "m"      ,   &
293      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
294      CALL histdef( kid, "siconc", "Ice concentration"       , "%"      ,   &
295      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
296      CALL histdef( kid, "sitemp", "Ice temperature"         , "C"      ,   &
297      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
298      CALL histdef( kid, "sivelu", "i-Ice speed "            , "m/s"    ,   &
299      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
300      CALL histdef( kid, "sivelv", "j-Ice speed "            , "m/s"    ,   &
301      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
302      CALL histdef( kid, "sistru", "i-Wind stress over ice " , "Pa"     ,   &
303      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
304      CALL histdef( kid, "sistrv", "j-Wind stress over ice " , "Pa"     ,   &
305      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
306      CALL histdef( kid, "sisflx", "Solar flux over ocean"     , "w/m2" ,   &
307      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
308      CALL histdef( kid, "sinflx", "Non-solar flux over ocean" , "w/m2" ,   &
309      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
310      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s",   &
311      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
312      CALL histdef( kid, "sisali", "Ice salinity"            , "PSU"    ,   &
313      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
314      CALL histdef( kid, "sivolu", "Ice volume"              , "m"      ,   &
315      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
316      CALL histdef( kid, "sidive", "Ice divergence"          , "10-8s-1",   &
317      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
318
319      ! MV MP 2016
320      IF ( ln_pnd ) THEN
321         CALL histdef( kid, "si_amp", "Melt pond fraction"      , "%"      ,   &
322      &         jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
323         CALL histdef( kid, "si_vmp", "Melt pond volume"        ,  "m"     ,   &
324      &         jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
325      ENDIF
326      ! END MV MP 2016
327
328      CALL histdef( kid, "vfxbog", "Ice bottom production"   , "m/s"    ,   &
329      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
330      CALL histdef( kid, "vfxdyn", "Ice dynamic production"  , "m/s"    ,   &
331      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
332      CALL histdef( kid, "vfxopw", "Ice open water prod"     , "m/s"    ,   &
333      &       jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
334      CALL histdef( kid, "vfxsni", "Snow ice production "    , "m/s"    ,   &
335      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
336      CALL histdef( kid, "vfxres", "Ice prod from corrections" , "m/s"  ,   &
337      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
338      CALL histdef( kid, "vfxbom", "Ice bottom melt"         , "m/s"    ,   &
339      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
340      CALL histdef( kid, "vfxsum", "Ice surface melt"        , "m/s"    ,   &
341      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
342
343      CALL histdef( kid, "sithicat", "Ice thickness"         , "m"      ,   &
344      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
345      CALL histdef( kid, "siconcat", "Ice concentration"     , "%"      ,   &
346      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
347      CALL histdef( kid, "sisalcat", "Ice salinity"           , ""      ,   &
348      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
349      CALL histdef( kid, "sitemcat", "Ice temperature"       , "C"      ,   &
350      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
351      CALL histdef( kid, "snthicat", "Snw thickness"         , "m"      ,   &
352      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
353      CALL histdef( kid, "sntemcat", "Snw temperature"       , "C"      ,   &
354      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
355
356      CALL histend( kid, snc4set )   ! end of the file definition
357
358      CALL histwrite( kid, "sithic", kt, hm_i           , jpi*jpj, (/1/) )   
359      CALL histwrite( kid, "siconc", kt, at_i           , jpi*jpj, (/1/) )
360      CALL histwrite( kid, "sitemp", kt, tm_i - rt0     , jpi*jpj, (/1/) )
361      CALL histwrite( kid, "sivelu", kt, u_ice          , jpi*jpj, (/1/) )
362      CALL histwrite( kid, "sivelv", kt, v_ice          , jpi*jpj, (/1/) )
363      CALL histwrite( kid, "sistru", kt, utau_ice       , jpi*jpj, (/1/) )
364      CALL histwrite( kid, "sistrv", kt, vtau_ice       , jpi*jpj, (/1/) )
365      CALL histwrite( kid, "sisflx", kt, qsr , jpi*jpj, (/1/) )
366      CALL histwrite( kid, "sinflx", kt, qns , jpi*jpj, (/1/) )
367      CALL histwrite( kid, "isnowpre", kt, sprecip        , jpi*jpj, (/1/) )
368      CALL histwrite( kid, "sisali", kt, sm_i           , jpi*jpj, (/1/) )
369      CALL histwrite( kid, "sivolu", kt, vt_i           , jpi*jpj, (/1/) )
370      CALL histwrite( kid, "sidive", kt, divu_i*1.0e8   , jpi*jpj, (/1/) )
371
372      ! MV MP 2016
373      IF ( ln_pnd ) THEN
374         CALL histwrite( kid, "si_amp", kt, at_ip         , jpi*jpj, (/1/) )
375         CALL histwrite( kid, "si_vmp", kt, vt_ip         , jpi*jpj, (/1/) )
376      ENDIF
377      ! END MV MP 2016
378
379      CALL histwrite( kid, "vfxbog", kt, wfx_bog        , jpi*jpj, (/1/) )
380      CALL histwrite( kid, "vfxdyn", kt, wfx_dyn        , jpi*jpj, (/1/) )
381      CALL histwrite( kid, "vfxopw", kt, wfx_opw        , jpi*jpj, (/1/) )
382      CALL histwrite( kid, "vfxsni", kt, wfx_sni        , jpi*jpj, (/1/) )
383      CALL histwrite( kid, "vfxres", kt, wfx_res        , jpi*jpj, (/1/) )
384      CALL histwrite( kid, "vfxbom", kt, wfx_bom        , jpi*jpj, (/1/) )
385      CALL histwrite( kid, "vfxsum", kt, wfx_sum        , jpi*jpj, (/1/) )
386      IF ( ln_pnd ) &
387         CALL histwrite( kid, "vfxpnd", kt, wfx_pnd     , jpi*jpj, (/1/) )
388
389      CALL histwrite( kid, "sithicat", kt, h_i         , jpi*jpj*jpl, (/1/) )   
390      CALL histwrite( kid, "siconcat", kt, a_i         , jpi*jpj*jpl, (/1/) )   
391      CALL histwrite( kid, "sisalcat", kt, s_i         , jpi*jpj*jpl, (/1/) )   
392      CALL histwrite( kid, "sitemcat", kt, tm_i - rt0  , jpi*jpj*jpl, (/1/) )   
393      CALL histwrite( kid, "snthicat", kt, h_s         , jpi*jpj*jpl, (/1/) )   
394      CALL histwrite( kid, "sntemcat", kt, tm_su - rt0 , jpi*jpj*jpl, (/1/) )   
395
396      !! The file is closed in dia_wri_state (ocean routine)
397      !! CALL histclo( kid )
398      !
399    END SUBROUTINE ice_wri_state
400
401#else
402   !!----------------------------------------------------------------------
403   !!   Default option :         Empty module         NO ESIM sea-ice model
404   !!----------------------------------------------------------------------
405#endif
406
407   !!======================================================================
408END MODULE icewri
Note: See TracBrowser for help on using the repository browser.