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 NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE – NEMO

source: NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/ICE/icewri.F90 @ 9939

Last change on this file since 9939 was 9939, checked in by gm, 6 years ago

#1911 (ENHANCE-04): RK3 branche phased with MLF@9937 branche

File size: 19.8 KB
Line 
1MODULE icewri
2   !!======================================================================
3   !!                     ***  MODULE  icewri  ***
4   !!   sea-ice : output ice variables
5   !!======================================================================
6   !! History :  4.0  !  2018     (many people)      SI3 [aka Sea Ice cube]
7   !!----------------------------------------------------------------------
8#if defined key_si3
9   !!----------------------------------------------------------------------
10   !!   'key_si3'                                       SI3 sea-ice model
11   !!----------------------------------------------------------------------
12   !!   ice_wri       : write of the diagnostics variables in ouput file
13   !!   ice_wri_state : write for initial state or/and abandon
14   !!----------------------------------------------------------------------
15   USE dianam         ! build name of file (routine)
16   USE phycst         ! physical constant
17   USE dom_oce        ! domain: ocean
18   USE sbc_oce        ! surf. boundary cond.: ocean
19   USE sbc_ice        ! Surface boundary condition: ice fields
20   USE ice            ! sea-ice: variables
21   USE icevar         ! sea-ice: operations
22   !
23   USE ioipsl         !
24   USE in_out_manager ! I/O manager
25   USE iom            ! I/O manager library
26   USE lib_mpp        ! MPP library
27   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
28   USE lbclnk         ! lateral boundary conditions (or mpp links)
29   USE timing         ! Timing
30
31   IMPLICIT NONE
32   PRIVATE
33
34   PUBLIC ice_wri        ! called by ice_stp
35   PUBLIC ice_wri_state  ! called by dia_wri_state
36
37   !!----------------------------------------------------------------------
38   !! NEMO/ICE 4.0 , NEMO Consortium (2018)
39   !! $Id: icewri.F90 8409 2017-08-07 15:29:21Z clem $
40   !! Software governed by the CeCILL licence     (./LICENSE)
41   !!----------------------------------------------------------------------
42CONTAINS
43
44   SUBROUTINE ice_wri( kt )
45      !!-------------------------------------------------------------------
46      !!  This routine ouputs some (most?) of the sea ice fields
47      !!-------------------------------------------------------------------
48      INTEGER, INTENT(in) ::   kt   ! time-step
49      !
50      INTEGER  ::   ji, jj, jk, jl  ! dummy loop indices
51      REAL(wp) ::   z2da, z2db, zrho1, zrho2
52      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d !  2D workspace
53      REAL(wp), DIMENSION(jpi,jpj)     ::   zmsk00, zmsk05, zmsk15, zmsksn ! O%, 5% and 15% concentration mask and snow mask
54      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zmsk00l, zmsksnl               ! cat masks
55      !
56      ! Global ice diagnostics (SIMIP)
57      REAL(wp) ::   zdiag_area_nh, zdiag_extt_nh, zdiag_volu_nh   ! area, extent, volume
58      REAL(wp) ::   zdiag_area_sh, zdiag_extt_sh, zdiag_volu_sh 
59      !!-------------------------------------------------------------------
60
61      IF( ln_timing )   CALL timing_start('icewri')
62
63      ! brine volume
64      CALL ice_var_bv
65
66      ! tresholds for outputs
67      DO jj = 1, jpj
68         DO ji = 1, jpi
69            zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice
70            zmsk05(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.05_wp ) ) ! 1 if 5% ice , 0 if less
71            zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less
72            zmsksn(ji,jj) = MAX( 0._wp , SIGN( 1._wp , vt_s(ji,jj) - epsi06  ) ) ! 1 if snow   , 0 if no snow
73         END DO
74      END DO
75      DO jl = 1, jpl
76         DO jj = 1, jpj
77            DO ji = 1, jpi
78               zmsk00l(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
79               zmsksnl(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi06 ) )
80            END DO
81         END DO
82      END DO
83
84      !-----------------
85      ! Standard outputs
86      !-----------------
87      zrho1 = ( rho0 - rhoi ) * r1_rho0   ;   zrho2 = rhos * r1_rho0
88      ! masks
89      IF( iom_use('icemask'  ) )   CALL iom_put( "icemask"  , zmsk00              )   ! ice mask 0%
90      IF( iom_use('icemask05') )   CALL iom_put( "icemask05", zmsk05              )   ! ice mask 5%
91      IF( iom_use('icemask15') )   CALL iom_put( "icemask15", zmsk15              )   ! ice mask 15%
92      !
93      ! general fields
94      IF( iom_use('icemass'  ) )   CALL iom_put( "icemass", rhoi * vt_i * zmsk00  )   ! Ice mass per cell area
95      IF( iom_use('snwmass'  ) )   CALL iom_put( "snwmass", rhos * vt_s * zmsksn  )   ! Snow mass per cell area
96      IF( iom_use('icepres'  ) )   CALL iom_put( "icepres", zmsk00                )   ! Ice presence (1 or 0)
97      IF( iom_use('iceconc'  ) )   CALL iom_put( "iceconc", at_i  * zmsk00        )   ! ice concentration
98      IF( iom_use('icevolu'  ) )   CALL iom_put( "icevolu", vt_i  * zmsk00        )   ! ice volume = mean ice thickness over the cell
99      IF( iom_use('icethic'  ) )   CALL iom_put( "icethic", hm_i  * zmsk00        )   ! ice thickness
100      IF( iom_use('snwthic'  ) )   CALL iom_put( "snwthic", hm_s  * zmsk00        )   ! snw thickness
101      IF( iom_use('icebrv'   ) )   CALL iom_put( "icebrv" , bvm_i * zmsk00 * 100. )   ! brine volume
102      IF( iom_use('iceage'   ) )   CALL iom_put( "iceage" , om_i  * zmsk00 / rday )   ! ice age
103      IF( iom_use('icehnew'  ) )   CALL iom_put( "icehnew", ht_i_new              )   ! new ice thickness formed in the leads
104      IF( iom_use('snwvolu'  ) )   CALL iom_put( "snwvolu", vt_s  * zmsksn        )   ! snow volume
105      IF( iom_use('icefrb') ) THEN
106!!gm remove the WHERE by using :
107!!         z2d(:,:) = MAX( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) , 0._wp )                                         
108!!gm end
109         z2d(:,:) = ( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) )                                         
110         WHERE( z2d < 0._wp )   z2d = 0._wp
111                                   CALL iom_put( "icefrb" , z2d * zmsk00          )   ! Ice freeboard
112      ENDIF
113      !
114      ! melt ponds
115      IF( iom_use('iceapnd'  ) )   CALL iom_put( "iceapnd", at_ip  * zmsk00       )   ! melt pond total fraction
116      IF( iom_use('icevpnd'  ) )   CALL iom_put( "icevpnd", vt_ip  * zmsk00       )   ! melt pond total volume per unit area
117      !
118      ! salt
119      IF( iom_use('icesalt'  ) )   CALL iom_put( "icesalt", sm_i  * zmsk00        )   ! mean ice salinity
120      IF( iom_use('icesalm'  ) )   CALL iom_put( "icesalm", SUM( sv_i, DIM = 3 ) * rhoi * 1.0e-3 * zmsk00 )   ! Mass of salt in sea ice per cell area
121
122      ! heat
123      IF( iom_use('icetemp'  ) )   CALL iom_put( "icetemp", ( tm_i  - rt0 ) * zmsk00 )   ! ice mean temperature
124      IF( iom_use('snwtemp'  ) )   CALL iom_put( "snwtemp", ( tm_s  - rt0 ) * zmsksn )   ! snw mean temperature
125      IF( iom_use('icettop'  ) )   CALL iom_put( "icettop", ( tm_su - rt0 ) * zmsk00 )   ! temperature at the ice surface
126      IF( iom_use('icetbot'  ) )   CALL iom_put( "icetbot", ( t_bo  - rt0 ) * zmsk00 )   ! temperature at the ice bottom
127      IF( iom_use('icetsni'  ) )   CALL iom_put( "icetsni", ( tm_si - rt0 ) * zmsk00 )   ! temperature at the snow-ice interface
128      IF( iom_use('icehc'    ) )   CALL iom_put( "icehc"  ,  -et_i          * zmsk00 )   ! ice heat content
129      IF( iom_use('snwhc'    ) )   CALL iom_put( "snwhc"  ,  -et_s          * zmsksn )   ! snow heat content
130
131      ! momentum
132      IF( iom_use('uice'     ) )   CALL iom_put( "uice"   , u_ice                 )   ! ice velocity u component
133      IF( iom_use('vice'     ) )   CALL iom_put( "vice"   , v_ice                 )   ! ice velocity v component
134      IF( iom_use('utau_ai'  ) )   CALL iom_put( "utau_ai", utau_ice * zmsk00     )   ! Wind stress term in force balance (x)
135      IF( iom_use('vtau_ai'  ) )   CALL iom_put( "vtau_ai", vtau_ice * zmsk00     )   ! Wind stress term in force balance (y)
136
137      IF( iom_use('icevel') ) THEN
138         DO jj = 2 , jpjm1
139            DO ji = 2 , jpim1
140               z2da  = ( u_ice(ji,jj) + u_ice(ji-1,jj) )
141               z2db  = ( v_ice(ji,jj) + v_ice(ji,jj-1) )
142               z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db )
143           END DO
144         END DO
145         CALL lbc_lnk( z2d, 'T', 1. )
146         IF( iom_use('icevel') )   CALL iom_put( "icevel" , z2d                   )   ! ice velocity module
147      ENDIF
148
149      ! --- category-dependent fields --- !
150      IF( iom_use('icemask_cat' ) )   CALL iom_put( "icemask_cat" , zmsk00l                                                    )   ! ice mask 0%
151      IF( iom_use('iceconc_cat' ) )   CALL iom_put( "iceconc_cat" , a_i * zmsk00l                                              )   ! area for categories
152      IF( iom_use('icethic_cat' ) )   CALL iom_put( "icethic_cat" , h_i * zmsk00l                                              )   ! thickness for categories
153      IF( iom_use('snwthic_cat' ) )   CALL iom_put( "snwthic_cat" , h_s * zmsksnl                                              )   ! snow depth for categories
154      IF( iom_use('icesalt_cat' ) )   CALL iom_put( "icesalt_cat" , s_i * zmsk00l                                              )   ! salinity for categories
155      IF( iom_use('iceage_cat'  ) )   CALL iom_put( "iceage_cat"  , o_i * zmsk00l / rday                                       )   ! ice age
156      IF( iom_use('icetemp_cat' ) )   CALL iom_put( "icetemp_cat" , ( SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i - rt0 ) * zmsk00l )   ! ice temperature
157      IF( iom_use('snwtemp_cat' ) )   CALL iom_put( "snwtemp_cat" , ( SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s - rt0 ) * zmsksnl )   ! snow temperature
158      IF( iom_use('icettop_cat' ) )   CALL iom_put( "icettop_cat" , ( t_su - rt0 ) * zmsk00l                                   )   ! surface temperature
159      IF( iom_use('icebrv_cat'  ) )   CALL iom_put( "icebrv_cat"  ,   bv_i * 100.  * zmsk00l                                   )   ! brine volume
160      IF( iom_use('iceapnd_cat' ) )   CALL iom_put( "iceapnd_cat" ,   a_ip         * zmsk00l                                   )   ! melt pond frac for categories
161      IF( iom_use('icehpnd_cat' ) )   CALL iom_put( "icehpnd_cat" ,   h_ip         * zmsk00l                                   )   ! melt pond frac for categories
162      IF( iom_use('iceafpnd_cat') )   CALL iom_put( "iceafpnd_cat",   a_ip_frac    * zmsk00l                                   )   ! melt pond frac for categories
163
164      !------------------
165      ! Add-ons for SIMIP
166      !------------------
167      ! trends
168      IF( iom_use('dmithd') )   CALL iom_put( "dmithd", - wfx_bog - wfx_bom - wfx_sum - wfx_sni - wfx_opw - wfx_lam - wfx_res ) ! Sea-ice mass change from thermodynamics
169      IF( iom_use('dmidyn') )   CALL iom_put( "dmidyn", - wfx_dyn + rhoi * diag_trp_vi      )   ! Sea-ice mass change from dynamics(kg/m2/s)
170      IF( iom_use('dmiopw') )   CALL iom_put( "dmiopw", - wfx_opw                           )   ! Sea-ice mass change through growth in open water
171      IF( iom_use('dmibog') )   CALL iom_put( "dmibog", - wfx_bog                           )   ! Sea-ice mass change through basal growth
172      IF( iom_use('dmisni') )   CALL iom_put( "dmisni", - wfx_sni                           )   ! Sea-ice mass change through snow-to-ice conversion
173      IF( iom_use('dmisum') )   CALL iom_put( "dmisum", - wfx_sum                           )   ! Sea-ice mass change through surface melting
174      IF( iom_use('dmibom') )   CALL iom_put( "dmibom", - wfx_bom                           )   ! Sea-ice mass change through bottom melting
175      IF( iom_use('dmtsub') )   CALL iom_put( "dmtsub", - wfx_sub                           )   ! Sea-ice mass change through evaporation and sublimation
176      IF( iom_use('dmssub') )   CALL iom_put( "dmssub", - wfx_snw_sub                       )   ! Snow mass change through sublimation
177      IF( iom_use('dmisub') )   CALL iom_put( "dmisub", - wfx_ice_sub                       )   ! Sea-ice mass change through sublimation
178      IF( iom_use('dmsspr') )   CALL iom_put( "dmsspr", - wfx_spr                           )   ! Snow mass change through snow fall
179      IF( iom_use('dmsssi') )   CALL iom_put( "dmsssi",   wfx_sni*rhos*r1_rhoi              )   ! Snow mass change through snow-to-ice conversion
180      IF( iom_use('dmsmel') )   CALL iom_put( "dmsmel", - wfx_snw_sum                       )   ! Snow mass change through melt
181      IF( iom_use('dmsdyn') )   CALL iom_put( "dmsdyn", - wfx_snw_dyn + rhos * diag_trp_vs  )   ! Snow mass change through dynamics(kg/m2/s)
182
183      ! Global ice diagnostics
184      IF( iom_use('NH_icearea') .OR. iom_use('NH_icevolu') .OR. iom_use('NH_iceextt') )   THEN   ! NH diagnostics
185         !
186         WHERE( ff_t > 0._wp )   ;   zmsk00(:,:) = 1.0e-12
187         ELSEWHERE               ;   zmsk00(:,:) = 0.
188         END WHERE
189         zdiag_area_nh = glob_sum( at_i(:,:) * zmsk00(:,:) * e1e2t(:,:) )
190         zdiag_volu_nh = glob_sum( vt_i(:,:) * zmsk00(:,:) * e1e2t(:,:) )
191         !
192         WHERE( ff_t > 0._wp .AND. at_i > 0.15 )   ; zmsk00(:,:) = 1.0e-12
193         ELSEWHERE                                 ; zmsk00(:,:) = 0.
194         END WHERE
195         zdiag_extt_nh = glob_sum( zmsk00(:,:) * e1e2t(:,:) )
196         !
197         IF( iom_use('NH_icearea') )   CALL iom_put( "NH_icearea" ,  zdiag_area_nh )
198         IF( iom_use('NH_icevolu') )   CALL iom_put( "NH_icevolu" ,  zdiag_volu_nh )
199         IF( iom_use('NH_iceextt') )   CALL iom_put( "NH_iceextt" ,  zdiag_extt_nh )
200         !
201      ENDIF
202      !
203      IF( iom_use('SH_icearea') .OR. iom_use('SH_icevolu') .OR. iom_use('SH_iceextt') )   THEN   ! SH diagnostics
204         !
205         WHERE( ff_t < 0._wp ); zmsk00(:,:) = 1.0e-12; 
206         ELSEWHERE            ; zmsk00(:,:) = 0.
207         END WHERE
208         zdiag_area_sh = glob_sum( at_i(:,:) * zmsk00(:,:) * e1e2t(:,:) ) 
209         zdiag_volu_sh = glob_sum( vt_i(:,:) * zmsk00(:,:) * e1e2t(:,:) )
210         !
211         WHERE( ff_t < 0._wp .AND. at_i > 0.15 ); zmsk00(:,:) = 1.0e-12
212         ELSEWHERE                              ; zmsk00(:,:) = 0.
213         END WHERE
214         zdiag_extt_sh = glob_sum( zmsk00(:,:) * e1e2t(:,:) )
215         !
216         IF( iom_use('SH_icearea') ) CALL iom_put( "SH_icearea", zdiag_area_sh )
217         IF( iom_use('SH_icevolu') ) CALL iom_put( "SH_icevolu", zdiag_volu_sh )
218         IF( iom_use('SH_iceextt') ) CALL iom_put( "SH_iceextt", zdiag_extt_sh )
219         !
220      ENDIF 
221      !
222!!CR      !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s
223!!CR      !     IF( kindic < 0 )   CALL ice_wri_state( 'output.abort' )
224!!CR      !     not yet implemented
225!!gm  idem for the ocean...  Ask Seb how to get read of ioipsl....
226      !
227      IF( ln_timing )  CALL timing_stop('icewri')
228      !
229   END SUBROUTINE ice_wri
230
231 
232   SUBROUTINE ice_wri_state( kt, kid, kh_i )
233      !!---------------------------------------------------------------------
234      !!                 ***  ROUTINE ice_wri_state  ***
235      !!       
236      !! ** Purpose :   create a NetCDF file named cdfile_name which contains
237      !!      the instantaneous ice state and forcing fields for ice model
238      !!        Used to find errors in the initial state or save the last
239      !!      ocean state in case of abnormal end of a simulation
240      !!
241      !! History :   4.0  !  2013-06  (C. Rousset)
242      !!----------------------------------------------------------------------
243      INTEGER, INTENT( in ) ::   kt               ! ocean time-step index
244      INTEGER, INTENT( in ) ::   kid , kh_i
245      INTEGER               ::   nz_i, jl
246      REAL(wp), DIMENSION(jpl) ::   jcat
247      !!----------------------------------------------------------------------
248      !
249      DO jl = 1, jpl
250         jcat(jl) = REAL(jl)
251      END DO
252     
253      CALL histvert( kid, "ncatice", "Ice Categories","", jpl, jcat, nz_i, "up")
254
255      CALL histdef( kid, "sithic", "Ice thickness"          , "m"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt )
256      CALL histdef( kid, "siconc", "Ice concentration"      , "%"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt )
257      CALL histdef( kid, "sitemp", "Ice temperature"        , "C"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt )
258      CALL histdef( kid, "sivelu", "i-Ice speed "           , "m/s"    , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt )
259      CALL histdef( kid, "sivelv", "j-Ice speed "           , "m/s"    , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt ) 
260      CALL histdef( kid, "sistru", "i-Wind stress over ice" , "Pa"     , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt )
261      CALL histdef( kid, "sistrv", "j-Wind stress over ice" , "Pa"     , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt ) 
262      CALL histdef( kid, "sisflx", "Solar flx over ocean"   , "W/m2"   , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt ) 
263      CALL histdef( kid, "sinflx", "NonSolar flx over ocean", "W/m2"   , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt )
264      CALL histdef( kid, "snwpre", "Snow precipitation"     , "kg/m2/s", jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt ) 
265      CALL histdef( kid, "sisali", "Ice salinity"           , "PSU"    , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt ) 
266      CALL histdef( kid, "sivolu", "Ice volume"             , "m"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt ) 
267      CALL histdef( kid, "sidive", "Ice divergence"         , "10-8s-1", jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt ) 
268      CALL histdef( kid, "si_amp", "Melt pond fraction"     , "%"      , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt )
269      CALL histdef( kid, "si_vmp", "Melt pond volume"       ,  "m"     , jpi,jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rn_Dt, rn_Dt )
270      !
271      CALL histdef( kid, "sithicat", "Ice thickness"        , "m" , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rn_Dt, rn_Dt )
272      CALL histdef( kid, "siconcat", "Ice concentration"    , "%" , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rn_Dt, rn_Dt )
273      CALL histdef( kid, "sisalcat", "Ice salinity"         , ""  , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rn_Dt, rn_Dt )
274      CALL histdef( kid, "snthicat", "Snw thickness"        , "m" , jpi,jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rn_Dt, rn_Dt )
275
276      CALL histend( kid, snc4set )   ! end of the file definition
277
278      CALL histwrite( kid, "sithic", kt, hm_i          , jpi*jpj, (/1/) )   
279      CALL histwrite( kid, "siconc", kt, at_i          , jpi*jpj, (/1/) )
280      CALL histwrite( kid, "sitemp", kt, tm_i - rt0    , jpi*jpj, (/1/) )
281      CALL histwrite( kid, "sivelu", kt, u_ice         , jpi*jpj, (/1/) )
282      CALL histwrite( kid, "sivelv", kt, v_ice         , jpi*jpj, (/1/) )
283      CALL histwrite( kid, "sistru", kt, utau_ice      , jpi*jpj, (/1/) )
284      CALL histwrite( kid, "sistrv", kt, vtau_ice      , jpi*jpj, (/1/) )
285      CALL histwrite( kid, "sisflx", kt, qsr           , jpi*jpj, (/1/) )
286      CALL histwrite( kid, "sinflx", kt, qns           , jpi*jpj, (/1/) )
287      CALL histwrite( kid, "snwpre", kt, sprecip       , jpi*jpj, (/1/) )
288      CALL histwrite( kid, "sisali", kt, sm_i          , jpi*jpj, (/1/) )
289      CALL histwrite( kid, "sivolu", kt, vt_i          , jpi*jpj, (/1/) )
290      CALL histwrite( kid, "sidive", kt, divu_i*1.0e8  , jpi*jpj, (/1/) )
291      CALL histwrite( kid, "si_amp", kt, at_ip         , jpi*jpj, (/1/) )
292      CALL histwrite( kid, "si_vmp", kt, vt_ip         , jpi*jpj, (/1/) )
293      !
294      CALL histwrite( kid, "sithicat", kt, h_i         , jpi*jpj*jpl, (/1/) )   
295      CALL histwrite( kid, "siconcat", kt, a_i         , jpi*jpj*jpl, (/1/) )   
296      CALL histwrite( kid, "sisalcat", kt, s_i         , jpi*jpj*jpl, (/1/) )   
297      CALL histwrite( kid, "snthicat", kt, h_s         , jpi*jpj*jpl, (/1/) )   
298
299      !! The file is closed in dia_wri_state (ocean routine)
300      !! CALL histclo( kid )
301      !
302    END SUBROUTINE ice_wri_state
303
304#else
305   !!----------------------------------------------------------------------
306   !!   Default option :         Empty module         NO SI3 sea-ice model
307   !!----------------------------------------------------------------------
308#endif
309
310   !!======================================================================
311END MODULE icewri
Note: See TracBrowser for help on using the repository browser.