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 branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/ice.F90 @ 5055

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

LIM3: removing par_ice and put jpl, nlay_i and nlay_s as namelist parameters

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