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.
ice.F90 in trunk/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: trunk/NEMOGCM/NEMO/LIM_SRC_3/ice.F90 @ 4863

Last change on this file since 4863 was 4863, checked in by clem, 9 years ago

LIM3: change elastic timescale to ratio of elastic timescale over ice time step

  • Property svn:keywords set to Id
File size: 39.7 KB
Line 
1MODULE ice
2   !!======================================================================
3   !!                        ***  MODULE ice  ***
4   !! LIM-3 Sea Ice physics:  diagnostics variables of ice defined in memory
5   !!=====================================================================
6   !! History :  3.0  ! 2008-03  (M. Vancoppenolle) original code LIM-3
7   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation
8   !!----------------------------------------------------------------------
9#if defined key_lim3
10   !!----------------------------------------------------------------------
11   !!   'key_lim3'                                      LIM-3 sea-ice model
12   !!----------------------------------------------------------------------
13   USE par_ice        ! LIM sea-ice parameters
14   USE in_out_manager ! I/O manager
15   USE lib_mpp        ! MPP library
16
17   IMPLICIT NONE
18   PRIVATE
19
20   PUBLIC    ice_alloc  !  Called in iceini.F90
21
22   !!======================================================================
23   !! LIM3 by the use of sweat, agile fingers and sometimes brain juice,
24   !!  was developed in Louvain-la-Neuve by :
25   !!    * Martin Vancoppenolle (UCL-ASTR, Belgium)
26   !!    * Sylvain Bouillon (UCL-ASTR, Belgium)
27   !!    * Miguel Angel Morales Maqueda (NOC-L, UK)
28   !!
29   !! Based on extremely valuable earlier work by
30   !!    * Thierry Fichefet
31   !!    * Hugues Goosse
32   !!
33   !! The following persons also contributed to the code in various ways
34   !!    * Gurvan Madec, Claude Talandier, Christian Ethe (LOCEAN, France)
35   !!    * Xavier Fettweis (UCL-ASTR), Ralph Timmermann (AWI, Germany)
36   !!    * Bill Lipscomb (LANL), Cecilia Bitz (UWa)
37   !!      and Elisabeth Hunke (LANL), USA.
38   !!
39   !! For more info, the interested user is kindly invited to consult the following references
40   !!    For model description and validation :
41   !!    * Vancoppenolle et al., Ocean Modelling, 2008a.
42   !!    * Vancoppenolle et al., Ocean Modelling, 2008b.
43   !!    For a specific description of EVP :
44   !!    * Bouillon et al., Ocean Modelling 2009.
45   !!
46   !!    Or the reference manual, that should be available by 2011
47   !!======================================================================
48   !!                                                                     |
49   !!              I C E   S T A T E   V A R I A B L E S                  |
50   !!                                                                     |
51   !! Introduction :                                                      |
52   !! --------------                                                      |
53   !! Every ice-covered grid cell is characterized by a series of state   |
54   !! variables. To account for unresolved spatial variability in ice     |
55   !! thickness, the ice cover in divided in ice thickness categories.    |
56   !!                                                                     |
57   !! Sea ice state variables depend on the ice thickness category        |
58   !!                                                                     |
59   !! Those variables are divided into two groups                         |
60   !! * Extensive (or global) variables.                                  |
61   !!   These are the variables that are transported by all means         |
62   !! * Intensive (or equivalent) variables.                              |
63   !!   These are the variables that are either physically more           |
64   !!   meaningful and/or used in ice thermodynamics                      |
65   !!                                                                     |
66   !! Routines in limvar.F90 perform conversions                          |
67   !!  - lim_var_glo2eqv  : from global to equivalent variables           |
68   !!  - lim_var_eqv2glo  : from equivalent to global variables           |
69   !!                                                                     |
70   !! For various purposes, the sea ice state variables have sometimes    |
71   !! to be aggregated over all ice thickness categories. This operation  |
72   !! is done in :                                                        |
73   !!  - lim_var_agg                                                      |
74   !!                                                                     |
75   !! in icestp.F90, the routines that compute the changes in the ice     |
76   !! state variables are called                                          |
77   !! - lim_dyn : ice dynamics                                            |
78   !! - lim_trp : ice transport                                           |
79   !! - lim_itd_me : mechanical redistribution (ridging and rafting)      |
80   !! - lim_thd : ice halo-thermodynamics                                 |
81   !! - lim_itd_th : thermodynamic changes in ice thickness distribution  |
82   !!                and creation of new ice                              |
83   !!                                                                     |
84   !! See the associated routines for more information                    |
85   !!                                                                     |
86   !! List of ice state variables :                                       |
87   !! -----------------------------                                       |
88   !!                                                                     |
89   !!-------------|-------------|---------------------------------|-------|
90   !!   name in   |   name in   |              meaning            | units |
91   !! 2D routines | 1D routines |                                 |       |
92   !!-------------|-------------|---------------------------------|-------|
93   !!                                                                     |
94   !! ******************************************************************* |
95   !! ***         Dynamical variables (prognostic)                    *** |
96   !! ******************************************************************* |
97   !!                                                                     |
98   !! u_ice       |      -      |    Comp. U of the ice velocity  | m/s   |
99   !! v_ice       |      -      |    Comp. V of the ice velocity  | m/s   |
100   !!                                                                     |
101   !! ******************************************************************* |
102   !! ***         Category dependent state variables (prognostic)     *** |
103   !! ******************************************************************* |
104   !!                                                                     |
105   !! ** Global variables                                                 |
106   !!-------------|-------------|---------------------------------|-------|
107   !! a_i         | a_i_b       |    Ice concentration            |       |
108   !! v_i         |      -      |    Ice volume per unit area     | m     |
109   !! v_s         |      -      |    Snow volume per unit area    | m     |
110   !! smv_i       |      -      |    Sea ice salt content         | ppt.m |
111   !! oa_i        !      -      !    Sea ice areal age content    | day   |
112   !! e_i         !      -      !    Ice enthalpy                 | 10^9 J|
113   !!      -      ! q_i_b       !    Ice enthalpy per unit vol.   | J/m3  |
114   !! e_s         !      -      !    Snow enthalpy                | 10^9 J|
115   !!      -      ! q_s_b       !    Snow enthalpy per unit vol.  | J/m3  |
116   !!                                                                     |
117   !!-------------|-------------|---------------------------------|-------|
118   !!                                                                     |
119   !! ** Equivalent variables                                             |
120   !!-------------|-------------|---------------------------------|-------|
121   !!                                                                     |
122   !! ht_i        | ht_i_b      |    Ice thickness                | m     |
123   !! ht_s        ! ht_s_b      |    Snow depth                   | m     |
124   !! sm_i        ! sm_i_b      |    Sea ice bulk salinity        ! ppt   |
125   !! s_i         ! s_i_b       |    Sea ice salinity profile     ! ppt   |
126   !! o_i         !      -      |    Sea ice Age                  ! days  |
127   !! t_i         ! t_i_b       |    Sea ice temperature          ! K     |
128   !! t_s         ! t_s_b       |    Snow temperature             ! K     |
129   !! t_su        ! t_su_b      |    Sea ice surface temperature  ! K     |
130   !!                                                                     |
131   !! notes: the ice model only sees a bulk (i.e., vertically averaged)   |
132   !!        salinity, except in thermodynamic computations, for which    |
133   !!        the salinity profile is computed as a function of bulk       |
134   !!        salinity                                                     |
135   !!                                                                     |
136   !!        the sea ice surface temperature is not associated to any     |
137   !!        heat content. Therefore, it is not a state variable and      |
138   !!        does not have to be advected. Nevertheless, it has to be     |
139   !!        computed to determine whether the ice is melting or not      |
140   !!                                                                     |
141   !! ******************************************************************* |
142   !! ***         Category-summed state variables (diagnostic)        *** |
143   !! ******************************************************************* |
144   !! at_i        | at_i_b      |    Total ice concentration      |       |
145   !! vt_i        |      -      |    Total ice vol. per unit area | m     |
146   !! vt_s        |      -      |    Total snow vol. per unit ar. | m     |
147   !! smt_i       |      -      |    Mean sea ice salinity        | ppt   |
148   !! tm_i        |      -      |    Mean sea ice temperature     | K     |
149   !! ot_i        !      -      !    Sea ice areal age content    | day   |
150   !! et_i        !      -      !    Total ice enthalpy           | 10^9 J|
151   !! et_s        !      -      !    Total snow enthalpy          | 10^9 J|
152   !! bv_i        !      -      !    Mean relative brine volume   | ???   |
153   !!=====================================================================
154
155   LOGICAL, PUBLIC ::   con_i = .false.   ! switch for conservation test
156
157   !!--------------------------------------------------------------------------
158   !! * Share Module variables
159   !!--------------------------------------------------------------------------
160   INTEGER , PUBLIC ::   nstart           !: iteration number of the begining of the run
161   INTEGER , PUBLIC ::   nlast            !: iteration number of the end of the run
162   INTEGER , PUBLIC ::   nitrun           !: number of iteration
163   INTEGER , PUBLIC ::   numit            !: iteration number
164   REAL(wp), PUBLIC ::   rdt_ice          !: ice time step
165   REAL(wp), PUBLIC ::   r1_rdtice        !: = 1. / rdt_ice
166
167   !                                     !!** ice-dynamic namelist (namicedyn) **
168   INTEGER , PUBLIC ::   nevp             !: number of iterations for subcycling
169   REAL(wp), PUBLIC ::   epsd             !: tolerance parameter for dynamic
170   REAL(wp), PUBLIC ::   om               !: relaxation constant
171   REAL(wp), PUBLIC ::   cw               !: drag coefficient for oceanic stress
172   REAL(wp), PUBLIC ::   angvg            !: turning angle for oceanic stress
173   REAL(wp), PUBLIC ::   pstar            !: determines ice strength (N/M), Hibler JPO79
174   REAL(wp), PUBLIC ::   c_rhg            !: determines changes in ice strength
175   REAL(wp), PUBLIC ::   creepl           !: creep limit : has to be under 1.0e-9
176   REAL(wp), PUBLIC ::   ecc              !: eccentricity of the elliptical yield curve
177   REAL(wp), PUBLIC ::   ahi0             !: sea-ice hor. eddy diffusivity coeff. (m2/s)
178   REAL(wp), PUBLIC ::   telast           !: timescale for elastic waves (s)
179   REAL(wp), PUBLIC ::   relast           !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp)
180   REAL(wp), PUBLIC ::   alphaevp         !: coeficient of the internal stresses
181   REAL(wp), PUBLIC ::   unit_fac = 1.e+09_wp  !: conversion factor for ice / snow enthalpy
182   REAL(wp), PUBLIC ::   hminrhg          !: ice volume (a*h, in m) below which ice velocity is set to ocean velocity
183
184   !                                     !!** ice-salinity namelist (namicesal) **
185   REAL(wp), PUBLIC ::   s_i_max          !: maximum ice salinity [PSU]
186   REAL(wp), PUBLIC ::   s_i_min          !: minimum ice salinity [PSU]
187   REAL(wp), PUBLIC ::   s_i_0            !: 1st sal. value for the computation of sal .prof. [PSU]
188   REAL(wp), PUBLIC ::   s_i_1            !: 2nd sal. value for the computation of sal .prof. [PSU]
189   REAL(wp), PUBLIC ::   sal_G            !: restoring salinity for gravity drainage [PSU]
190   REAL(wp), PUBLIC ::   sal_F            !: restoring salinity for flushing [PSU]
191   REAL(wp), PUBLIC ::   time_G           !: restoring time constant for gravity drainage (= 20 days) [s]
192   REAL(wp), PUBLIC ::   time_F           !: restoring time constant for gravity drainage (= 10 days) [s]
193   REAL(wp), PUBLIC ::   bulk_sal         !: bulk salinity (ppt) in case of constant salinity
194
195   !                                     !!** ice-salinity namelist (namicesal) **
196   INTEGER , PUBLIC ::   num_sal             !: salinity configuration used in the model
197   !                                         ! 1 - constant salinity in both space and time
198   !                                         ! 2 - prognostic salinity (s(z,t))
199   !                                         ! 3 - salinity profile, constant in time
200   INTEGER , PUBLIC ::   thcon_i_swi         !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007)
201
202   !                                     !!** ice-mechanical redistribution namelist (namiceitdme)
203   REAL(wp), PUBLIC ::   Cs               !: fraction of shearing energy contributing to ridging           
204   REAL(wp), PUBLIC ::   Cf               !: ratio of ridging work to PE loss
205   REAL(wp), PUBLIC ::   fsnowrdg         !: fractional snow loss to the ocean during ridging
206   REAL(wp), PUBLIC ::   fsnowrft         !: fractional snow loss to the ocean during ridging
207   REAL(wp), PUBLIC ::   Gstar            !: fractional area of young ice contributing to ridging
208   REAL(wp), PUBLIC ::   astar            !: equivalent of G* for an exponential participation function
209   REAL(wp), PUBLIC ::   Hstar            !: thickness that determines the maximal thickness of ridged ice
210   REAL(wp), PUBLIC ::   hparmeter        !: threshold thickness (m) for rafting / ridging
211   REAL(wp), PUBLIC ::   Craft            !: coefficient for smoothness of the hyperbolic tangent in rafting
212   REAL(wp), PUBLIC ::   ridge_por        !: initial porosity of ridges (0.3 regular value)
213   REAL(wp), PUBLIC ::   betas            !: coef. for partitioning of snowfall between leads and sea ice
214   REAL(wp), PUBLIC ::   kappa_i          !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m]
215   REAL(wp), PUBLIC ::   nconv_i_thd      !: maximal number of iterations for heat diffusion
216   REAL(wp), PUBLIC ::   maxer_i_thd      !: maximal tolerated error (C) for heat diffusion
217
218   !                                     !!** ice-mechanical redistribution namelist (namiceitdme)
219   INTEGER , PUBLIC ::   ridge_scheme_swi !: scheme used for ice ridging
220   INTEGER , PUBLIC ::   raft_swi         !: rafting of ice or not                       
221   INTEGER , PUBLIC ::   partfun_swi      !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007)
222   INTEGER , PUBLIC ::   brinstren_swi    !: use brine volume to diminish ice strength
223
224   REAL(wp), PUBLIC ::   usecc2           !:  = 1.0 / ( ecc * ecc )
225   REAL(wp), PUBLIC ::   rhoco            !: = rau0 * cw
226   REAL(wp), PUBLIC ::   sangvg, cangvg   !: sin and cos of the turning angle for ocean stress
227   REAL(wp), PUBLIC ::   pstarh           !: pstar / 2.0
228
229   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce, v_oce   !: surface ocean velocity used in ice dynamics
230   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahiu , ahiv    !: hor. diffusivity coeff. at U- and V-points [m2/s]
231   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pahu , pahv    !: ice hor. eddy diffusivity coef. at U- and V-points
232   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ust2s, hicol   !: friction velocity, ice collection thickness accreted in leads
233   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   strp1, strp2   !: strength at previous time steps
234   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   strength       !: ice strength
235   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stress1_i, stress2_i, stress12_i   !: 1st, 2nd & diagonal stress tensor element
236   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   delta_i        !: ice rheology elta factor (Flato & Hibler 95) [s-1]
237   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   divu_i         !: Divergence of the velocity field [s-1]
238   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   shear_i        !: Shear of the velocity field [s-1]
239   !
240   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sist        !: Average Sea-Ice Surface Temperature [Kelvin]
241   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   icethi      !: total ice thickness (for all categories) (diag only)
242   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_bo        !: Sea-Ice bottom temperature [Kelvin]     
243   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frld        !: Leads fraction = 1 - ice fraction
244   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pfrld       !: Leads fraction at previous time 
245   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   phicif      !: Old ice thickness
246   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qlead       !: heat balance of the lead (or of the open ocean)
247   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhtur       !: net downward heat flux from the ice to the ocean
248   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhld        !: heat flux from the lead used for bottom melting
249
250   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_snw    !: snow-ocean mass exchange over 1 time step [kg/m2]
251   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_spr    !: snow precipitation on ice over 1 time step [kg/m2]
252   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sub    !: snow sublimation over 1 time step [kg/m2]
253
254   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_ice    !: ice-ocean mass exchange over 1 time step [kg/m2]
255   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sni    !: snow ice growth component of wfx_ice [kg/m2]
256   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_opw    !: lateral ice growth component of wfx_ice [kg/m2]
257   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bog    !: bottom ice growth component of wfx_ice [kg/m2]
258   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_dyn    !: dynamical ice growth component of wfx_ice [kg/m2]
259   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_bom    !: bottom melt component of wfx_ice [kg/m2]
260   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_sum    !: surface melt component of wfx_ice [kg/m2]
261   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_res    !: residual component of wfx_ice [kg/m2]
262
263   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice growth/melt                      [PSU/m2/s]
264   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bom     !: salt flux due to ice growth/melt                      [PSU/m2/s]
265   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sum     !: salt flux due to ice growth/melt                      [PSU/m2/s]
266   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_sni     !: salt flux due to ice growth/melt                      [PSU/m2/s]
267   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_opw     !: salt flux due to ice growth/melt                      [PSU/m2/s]
268   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bri     !: salt flux due to brine rejection                      [PSU/m2/s]
269   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_dyn     !: salt flux due to porous ridged ice formation          [PSU/m2/s]
270   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_res     !: residual salt flux due to correction of ice thickness [PSU/m2/s]
271
272   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bog     !: total heat flux causing bottom ice growth
273   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_bom     !: total heat flux causing bottom ice melt
274   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sum     !: total heat flux causing surface ice melt
275   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_opw     !: total heat flux causing open water ice formation
276   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dif     !: total heat flux causing Temp change in the ice
277   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_snw     !: heat flux for snow melt
278   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err     !: heat flux error after heat diffusion
279   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_err_rem !: heat flux error after heat remapping
280   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_in      !: heat flux available for thermo transformations
281   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_out     !: heat flux remaining at the end of thermo transformations
282
283   ! heat flux associated with ice-atmosphere mass exchange
284   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_sub     !: heat flux for sublimation
285   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_spr     !: heat flux of the snow precipitation
286
287   ! heat flux associated with ice-ocean mass exchange
288   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_thd     !: ice-ocean heat flux from thermo processes (limthd_dh)
289   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_dyn     !: ice-ocean heat flux from mecanical processes (limitd_me)
290   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hfx_res     !: residual heat flux due to correction of ice thickness
291
292   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ftr_ice   !: transmitted solar radiation under ice
293
294   ! temporary arrays for dummy version of the code
295   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dh_i_surf2D, dh_i_bott2D, q_s
296
297   !!--------------------------------------------------------------------------
298   !! * Ice global state variables
299   !!--------------------------------------------------------------------------
300   !! Variables defined for each ice category
301   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_i    !: Ice thickness (m)
302   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i     !: Ice fractional areas (concentration)
303   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_i     !: Ice volume per unit area (m)
304   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_s     !: Snow volume per unit area(m)
305   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ht_s    !: Snow thickness (m)
306   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   t_su    !: Sea-Ice Surface Temperature (K)
307   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sm_i    !: Sea-Ice Bulk salinity (ppt)
308   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   smv_i   !: Sea-Ice Bulk salinity times volume per area (ppt.m)
309   !                                                                  !  this is an extensive variable that has to be transported
310   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   o_i     !: Sea-Ice Age (days)
311   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ov_i    !: Sea-Ice Age times volume per area (days.m)
312   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   oa_i    !: Sea-Ice Age times ice area (days)
313
314   !! Variables summed over all categories, or associated to all the ice in a single grid cell
315   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_ice, v_ice   !: components of the ice velocity (m/s)
316   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tio_u, tio_v   !: components of the ice-ocean stress (N/m2)
317   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vt_i , vt_s    !: ice and snow total volume per unit area (m)
318   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   at_i           !: ice total fractional area (ice concentration)
319   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ato_i          !: =1-at_i ; total open water fractional area
320   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   et_i , et_s    !: ice and snow total heat content
321   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ot_i           !: mean age over all categories
322   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_i           !: mean ice temperature over all categories
323   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bv_i           !: brine volume averaged over all categories
324   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   smt_i          !: mean sea ice salinity averaged over all categories [PSU]
325
326   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   at_i_typ     !: total area   contained in each ice type [m^2]
327   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   vt_i_typ     !: total volume contained in each ice type [m^3]
328
329   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_s        !: Snow temperatures [K]
330   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_s        !: Snow ...     
331
332   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   e_i_cat    !: ! go to trash
333     
334   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i        !: ice temperatures          [K]
335   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i        !: ice thermal contents [Giga J]
336   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   s_i        !: ice salinities          [PSU]
337
338   !!--------------------------------------------------------------------------
339   !! * Moments for advection
340   !!--------------------------------------------------------------------------
341   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   sxopw, syopw, sxxopw, syyopw, sxyopw   !: open water in sea ice
342   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxice, syice, sxxice, syyice, sxyice   !: ice thickness
343   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxsn , sysn , sxxsn , syysn , sxysn    !: snow thickness
344   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxa  , sya  , sxxa  , syya  , sxya     !: lead fraction
345   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxc0 , syc0 , sxxc0 , syyc0 , sxyc0    !: snow thermal content
346   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxsal, sysal, sxxsal, syysal, sxysal   !: ice salinity
347   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sxage, syage, sxxage, syyage, sxyage   !: ice age
348   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   sxe  , sye  , sxxe  , syye  , sxye     !: ice layers heat content
349
350   !!--------------------------------------------------------------------------
351   !! * Old values of global variables
352   !!--------------------------------------------------------------------------
353   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   old_v_s, old_v_i               !: snow and ice volumes
354   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   old_a_i, old_smv_i, old_oa_i   !: ???
355   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   old_e_s                        !: snow heat content
356   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   old_e_i                        !: ice temperatures
357   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   old_u_ice, old_v_ice           !: ice velocity (gv6 and gv7)
358     
359
360   !!--------------------------------------------------------------------------
361   !! * Increment of global variables
362   !!--------------------------------------------------------------------------
363   ! thd refers to changes induced by thermodynamics
364   ! trp   ''         ''     ''       advection (transport of ice)
365   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_a_i_thd  , d_a_i_trp                 !: icefractions                 
366   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_v_s_thd  , d_v_s_trp                 !: snow volume
367   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_v_i_thd  , d_v_i_trp                 !: ice  volume
368   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_smv_i_thd, d_smv_i_trp               !:     
369   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_sm_i_fl  , d_sm_i_gd                 !:
370   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_sm_i_se  , d_sm_i_si  , d_sm_i_la    !:
371   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_oa_i_thd , d_oa_i_trp , s_i_newice   !:
372
373   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   d_e_s_thd  , d_e_s_trp     !:
374   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   d_e_i_thd  , d_e_i_trp     !:
375   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   d_u_ice_dyn, d_v_ice_dyn   !: ice velocity
376     
377   !!--------------------------------------------------------------------------
378   !! * Ice thickness distribution variables
379   !!--------------------------------------------------------------------------
380   ! REMOVE
381   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   ice_types      !: Vector connecting types and categories
382   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ice_cat_bounds !: Matrix containing the integer upper and
383   !                                                                       !  lower boundaries of ice thickness categories
384   ! REMOVE
385   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   ice_ncat_types !: nb of thickness categories in each ice type
386   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_max         !: Boundary of ice thickness categories in thickness space
387   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   hi_mean        !: Mean ice thickness in catgories
388   ! REMOVE
389   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hi_max_typ     !: Boundary of ice thickness categories in thickness space
390
391   !!--------------------------------------------------------------------------
392   !! * Ice Run
393   !!--------------------------------------------------------------------------
394   !                                                  !!: ** Namelist namicerun read in iceini **
395   CHARACTER(len=32)     , PUBLIC ::   cn_icerst_in    !: suffix of ice restart name (input)
396   CHARACTER(len=32)     , PUBLIC ::   cn_icerst_out   !: suffix of ice restart name (output)
397   LOGICAL               , PUBLIC ::   ln_limdyn       !: flag for ice dynamics (T) or not (F)
398   LOGICAL               , PUBLIC ::   ln_nicep        !: flag for sea-ice points output (T) or not (F)
399   REAL(wp)              , PUBLIC ::   cai             !: atmospheric drag over sea ice
400   REAL(wp)              , PUBLIC ::   cao             !: atmospheric drag over ocean
401   REAL(wp)              , PUBLIC ::   amax            !: maximum ice concentration
402   !
403   !!--------------------------------------------------------------------------
404   !! * Ice diagnostics
405   !!--------------------------------------------------------------------------
406   !! Check if everything down here is necessary
407   LOGICAL , PUBLIC                                      ::   ln_limdiahsb  !: flag for ice diag (T) or not (F)
408   LOGICAL , PUBLIC                                      ::   ln_limdiaout  !: flag for ice diag (T) or not (F)
409   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dv_dt_thd     !: thermodynamic growth rates
410   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   izero
411   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vi   !: transport of ice volume
412   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_vs   !: transport of snw volume
413   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_ei   !: transport of ice enthalpy (W/m2)
414   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_trp_es   !: transport of snw enthalpy (W/m2)
415   !
416   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_heat_dhc !: snw/ice heat content variation   [W/m2]
417   !
418   INTEGER , PUBLIC ::   jiindx, jjindx        !: indexes of the debugging point
419
420   !!----------------------------------------------------------------------
421   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010)
422   !! $Id$
423   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
424   !!----------------------------------------------------------------------
425CONTAINS
426
427   FUNCTION ice_alloc()
428      !!-----------------------------------------------------------------
429      !!               *** Routine ice_alloc_2 ***
430      !!-----------------------------------------------------------------
431      INTEGER :: ice_alloc
432      !
433      INTEGER :: ierr(20), ii
434      !!-----------------------------------------------------------------
435
436      ierr(:) = 0
437
438      ! What could be one huge allocate statement is broken-up to try to
439      ! stay within Fortran's max-line length limit.
440      ii = 1
441      ALLOCATE( u_oce    (jpi,jpj) , v_oce    (jpi,jpj) ,                           &
442         &      ahiu     (jpi,jpj) , ahiv     (jpi,jpj) ,                           &
443         &      pahu     (jpi,jpj) , pahv     (jpi,jpj) ,                           &
444         &      ust2s    (jpi,jpj) , hicol    (jpi,jpj) ,                           &
445         &      strp1    (jpi,jpj) , strp2    (jpi,jpj) , strength  (jpi,jpj) ,     &
446         &      stress1_i(jpi,jpj) , stress2_i(jpi,jpj) , stress12_i(jpi,jpj) ,     &
447         &      delta_i  (jpi,jpj) , divu_i   (jpi,jpj) , shear_i   (jpi,jpj) , STAT=ierr(ii) )
448
449      ii = ii + 1
450      ALLOCATE( sist   (jpi,jpj) , icethi (jpi,jpj) , t_bo   (jpi,jpj) ,      &
451         &      frld   (jpi,jpj) , pfrld  (jpi,jpj) , phicif (jpi,jpj) ,      &
452         &      wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) ,    &
453         &      wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,     &
454         &      wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,  qlead  (jpi,jpj) ,     &
455         &      fhtur  (jpi,jpj) , ftr_ice(jpi,jpj,jpl) ,      &
456         &      sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) ,      &
457         &      sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) ,   &
458         &      hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) , hfx_err_rem(jpi,jpj), &
459         &      hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) ,  &
460         &      hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) , &
461         &      hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) ,  STAT=ierr(ii) )
462
463      ii = ii + 1
464      ALLOCATE( dh_i_surf2D(jpi,jpj) , dh_i_bott2D(jpi,jpj) , q_s(jpi,jpj) , STAT=ierr(ii) )
465
466      ! * Ice global state variables
467      ii = ii + 1
468      ALLOCATE( ht_i (jpi,jpj,jpl) , a_i  (jpi,jpj,jpl) , v_i  (jpi,jpj,jpl) ,     &
469         &      v_s  (jpi,jpj,jpl) , ht_s (jpi,jpj,jpl) , t_su (jpi,jpj,jpl) ,     &
470         &      sm_i (jpi,jpj,jpl) , smv_i(jpi,jpj,jpl) , o_i  (jpi,jpj,jpl) ,     &
471         &      ov_i (jpi,jpj,jpl) , oa_i (jpi,jpj,jpl)                      , STAT=ierr(ii) )
472      ii = ii + 1
473      ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) , tio_u(jpi,jpj) , tio_v(jpi,jpj) ,     &
474         &      vt_i (jpi,jpj) , vt_s (jpi,jpj) , at_i (jpi,jpj) , ato_i(jpi,jpj) ,     &
475         &      et_i (jpi,jpj) , et_s (jpi,jpj) , ot_i (jpi,jpj) , tm_i (jpi,jpj) ,     &
476         &      bv_i (jpi,jpj) , smt_i(jpi,jpj)                                   , STAT=ierr(ii) )
477      ii = ii + 1
478      ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , at_i_typ(jpi,jpj,jpm) ,                            &
479         &      e_s(jpi,jpj,nlay_s,jpl) , vt_i_typ(jpi,jpj,jpm) , e_i_cat(jpi,jpj,jpl) , STAT=ierr(ii) )
480      ii = ii + 1
481      ALLOCATE( t_i(jpi,jpj,jkmax,jpl) , e_i(jpi,jpj,jkmax,jpl) , s_i(jpi,jpj,jkmax,jpl) , STAT=ierr(ii) )
482
483      ! * Moments for advection
484      ii = ii + 1
485      ALLOCATE( sxopw(jpi,jpj) , syopw(jpi,jpj) , sxxopw(jpi,jpj) , syyopw(jpi,jpj) , sxyopw(jpi,jpj) , STAT=ierr(ii) )
486      ii = ii + 1
487      ALLOCATE( sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) ,   &
488         &      sxsn (jpi,jpj,jpl) , sysn (jpi,jpj,jpl) , sxxsn (jpi,jpj,jpl) , syysn (jpi,jpj,jpl) , sxysn (jpi,jpj,jpl) ,   &
489         &      STAT=ierr(ii) )
490      ii = ii + 1
491      ALLOCATE( sxa  (jpi,jpj,jpl) , sya  (jpi,jpj,jpl) , sxxa  (jpi,jpj,jpl) , syya  (jpi,jpj,jpl) , sxya  (jpi,jpj,jpl) ,   &
492         &      sxc0 (jpi,jpj,jpl) , syc0 (jpi,jpj,jpl) , sxxc0 (jpi,jpj,jpl) , syyc0 (jpi,jpj,jpl) , sxyc0 (jpi,jpj,jpl) ,   &
493         &      sxsal(jpi,jpj,jpl) , sysal(jpi,jpj,jpl) , sxxsal(jpi,jpj,jpl) , syysal(jpi,jpj,jpl) , sxysal(jpi,jpj,jpl) ,   &
494         &      sxage(jpi,jpj,jpl) , syage(jpi,jpj,jpl) , sxxage(jpi,jpj,jpl) , syyage(jpi,jpj,jpl) , sxyage(jpi,jpj,jpl) ,   &
495         &      STAT=ierr(ii) )
496      ii = ii + 1
497      ALLOCATE( sxe (jpi,jpj,jkmax,jpl) , sye (jpi,jpj,jkmax,jpl) , sxxe(jpi,jpj,jkmax,jpl) ,     &
498         &      syye(jpi,jpj,jkmax,jpl) , sxye(jpi,jpj,jkmax,jpl)                           , STAT=ierr(ii) )
499
500      ! * Old values of global variables
501      ii = ii + 1
502      ALLOCATE( old_v_s  (jpi,jpj,jpl) , old_v_i  (jpi,jpj,jpl) , old_e_s(jpi,jpj,nlay_s,jpl) ,     &
503         &      old_a_i  (jpi,jpj,jpl) , old_smv_i(jpi,jpj,jpl) , old_e_i(jpi,jpj,jkmax ,jpl) ,     &
504         &      old_oa_i (jpi,jpj,jpl)                                                        ,     &
505         &      old_u_ice(jpi,jpj)     , old_v_ice(jpi,jpj)                                   , STAT=ierr(ii) )
506
507      ! * Increment of global variables
508      ii = ii + 1
509      ALLOCATE( d_a_i_thd(jpi,jpj,jpl) , d_a_i_trp (jpi,jpj,jpl) , d_v_s_thd  (jpi,jpj,jpl) , d_v_s_trp  (jpi,jpj,jpl) ,   &
510         &      d_v_i_thd(jpi,jpj,jpl) , d_v_i_trp (jpi,jpj,jpl) , d_smv_i_thd(jpi,jpj,jpl) , d_smv_i_trp(jpi,jpj,jpl) ,   &     
511         &      d_sm_i_fl(jpi,jpj,jpl) , d_sm_i_gd (jpi,jpj,jpl) , d_sm_i_se  (jpi,jpj,jpl) , d_sm_i_si  (jpi,jpj,jpl) ,   &
512         &      d_sm_i_la(jpi,jpj,jpl) , d_oa_i_thd(jpi,jpj,jpl) , d_oa_i_trp (jpi,jpj,jpl) , s_i_newice (jpi,jpj,jpl) ,   &
513         &     STAT=ierr(ii) )
514      ii = ii + 1
515      ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj,jkmax,jpl) , d_u_ice_dyn(jpi,jpj) ,     &
516         &      d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj,jkmax,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) )
517     
518      ! * Ice thickness distribution variables
519      ii = ii + 1
520      ALLOCATE( ice_types(jpl) , ice_cat_bounds(jpm,2) , ice_ncat_types  (jpm) ,     &
521         &      hi_max (0:jpl) , hi_mean(jpl)          , hi_max_typ(0:jpl,jpm) , STAT=ierr(ii) )
522
523      ! * Ice diagnostics
524      ii = ii + 1
525      ALLOCATE( dv_dt_thd(jpi,jpj,jpl), izero (jpi,jpj,jpl),    &
526         &      diag_trp_vi(jpi,jpj), diag_trp_vs  (jpi,jpj), diag_trp_ei(jpi,jpj),   & 
527         &      diag_trp_es(jpi,jpj), diag_heat_dhc(jpi,jpj),  STAT=ierr(ii) )
528
529      ice_alloc = MAXVAL( ierr(:) )
530      IF( ice_alloc /= 0 )   CALL ctl_warn('ice_alloc_2: failed to allocate arrays.')
531      !
532   END FUNCTION ice_alloc
533
534#else
535   !!----------------------------------------------------------------------
536   !!   Default option         Empty module            NO LIM sea-ice model
537   !!----------------------------------------------------------------------
538#endif
539
540   !!======================================================================
541END MODULE ice
Note: See TracBrowser for help on using the repository browser.