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.
thd_ice.F90 in branches/2013/dev_r3853_CNRS9_ConfSetting/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: branches/2013/dev_r3853_CNRS9_ConfSetting/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90 @ 3901

Last change on this file since 3901 was 3901, checked in by clevy, 11 years ago

Configuration Setting/Step2, see ticket:#1074

  • Property svn:keywords set to Id
File size: 14.4 KB
Line 
1MODULE thd_ice
2   !!======================================================================
3   !!                       ***  MODULE thd_ice  ***
4   !! LIM sea-ice :   Ice thermodynamics in 1D
5   !!=====================================================================
6   !! History :  3.0  !  2002-11  (C. Ethe)  F90: Free form and module
7   !!----------------------------------------------------------------------
8   USE par_ice        ! LIM-3 parameters
9   USE in_out_manager ! I/O manager
10   USE lib_mpp        ! MPP library
11
12   IMPLICIT NONE
13   PRIVATE
14
15   PUBLIC thd_ice_alloc ! Routine called by nemogcm.F90
16
17   !!---------------------------
18   !! * Share Module variables
19   !!---------------------------
20   !                               !!! ** ice-thermo namelist (namicethd) **
21   REAL(wp), PUBLIC ::   hmelt       !: maximum melting at the bottom; active only for one category
22   REAL(wp), PUBLIC ::   hicmin      !: (REMOVE)
23   REAL(wp), PUBLIC ::   hiclim      !: minimum ice thickness
24   REAL(wp), PUBLIC ::   amax        !: maximum lead fraction
25   REAL(wp), PUBLIC ::   sbeta       !: numerical scheme for diffusion in ice  (REMOVE)
26   REAL(wp), PUBLIC ::   parlat      !: (REMOVE)
27   REAL(wp), PUBLIC ::   hakspl      !: (REMOVE)
28   REAL(wp), PUBLIC ::   hibspl      !: (REMOVE)
29   REAL(wp), PUBLIC ::   exld        !: (REMOVE)
30   REAL(wp), PUBLIC ::   hakdif      !: (REMOVE)
31   REAL(wp), PUBLIC ::   thth        !: (REMOVE)
32   REAL(wp), PUBLIC ::   hnzst       !: thick. of the surf. layer in temp. comp.
33   REAL(wp), PUBLIC ::   parsub      !: switch for snow sublimation or not
34   REAL(wp), PUBLIC ::   alphs       !: coef. for snow density when snow-ice formation
35   REAL(wp), PUBLIC ::   fraz_swi    !: use of frazil ice collection in function of wind (1.0) or not (0.0)
36   REAL(wp), PUBLIC ::   maxfrazb    !: maximum portion of frazil ice collecting at the ice bottom
37   REAL(wp), PUBLIC ::   vfrazb      !: threshold drift speed for collection of bottom frazil ice
38   REAL(wp), PUBLIC ::   Cfrazb      !: squeezing coefficient for collection of bottom frazil ice
39
40   REAL(wp), PUBLIC, DIMENSION(2) ::   hiccrit   !: ice th. for lateral accretion in the NH (SH) (m)
41
42   !!-----------------------------
43   !! * Share 1D Module variables
44   !!-----------------------------
45   !: In ice thermodynamics, to spare memory, the vectors are folded
46   !: from 1D to 2D vectors. The following variables, with ending _1d (or _b)
47   !: are the variables corresponding to 2d vectors
48
49   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npb    !: number of points where computations has to be done
50   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npac   !: correspondance between points (lateral accretion)
51
52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qldif_1d      !: <==> the 2D  qldif
53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qcmif_1d      !: <==> the 2D  qcmif
54   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fstbif_1d     !: <==> the 2D  fstric
55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fltbif_1d     !: <==> the 2D  ffltbif
56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fscbq_1d      !: <==> the 2D  fscmcbq
57   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_1d    !: <==> the 2D  qsr_ice
58   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr1_i0_1d     !: <==> the 2D  fr1_i0
59   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr2_i0_1d     !: <==> the 2D  fr2_i0
60   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qnsr_ice_1d   !: <==> the 2D  qns_ice
61   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qfvbq_1d      !: <==> the 2D  qfvbq
62   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_bo_b        !: <==> the 2D  t_bo
63
64   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sprecip_1d    !: <==> the 2D  sprecip
65   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   frld_1d       !: <==> the 2D  frld
66   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   at_i_b        !: <==> the 2D  frld
67   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fbif_1d       !: <==> the 2D  fbif
68   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdm_ice_1d    !: <==> the 2D  rdm_ice
69   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdm_snw_1d    !: <==> the 2D  rdm_snw
70   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlbbq_1d      !: <==> the 2D  qlbsbq
71   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dmgwi_1d      !: <==> the 2D  dmgwi
72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvsbq_1d      !: <==> the 2D  rdvosif
73   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvbbq_1d      !: <==> the 2D  rdvobif
74   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvlbq_1d      !: <==> the 2D  rdvolif
75   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvnbq_1d      !: <==> the 2D  rdvolif
76   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqns_ice_1d   !: <==> the 2D  dqns_ice
77   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qla_ice_1d    !: <==> the 2D  qla_ice
78   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqla_ice_1d   !: <==> the 2D  dqla_ice
79   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tatm_ice_1d   !: <==> the 2D  tatm_ice
80   !                                                     ! to reintegrate longwave flux inside the ice thermodynamics
81   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fsup          !: Energy flux sent from bottom to lateral ablation if |dhb|> 0.15 m
82   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   focea         !: Remaining energy in case of total ablation
83   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice
84   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   old_ht_i_b    !: Ice thickness at the beginnning of the time step [m]
85   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   old_ht_s_b    !: Snow thickness at the beginning of the time step [m]
86   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_bri_1d    !: <==> the 2D sfx_bri
87   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhbri_1d      !: Heat flux due to brine drainage
88   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sfx_thd_1d    !: <==> the 2D sfx_thd
89   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_fl_1d   !: Ice salinity variations due to flushing
90   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_gd_1d   !: Ice salinity variations due to gravity drainage
91   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_se_1d   !: Ice salinity variations due to basal salt entrapment
92   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_si_1d   !: Ice salinity variations due to lateral accretion   
93   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hicol_b       !: Ice collection thickness accumulated in fleads
94
95   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_su_b      !: <==> the 2D  t_su
96   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_i_b       !: <==> the 2D  a_i
97   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_i_b      !: <==> the 2D  ht_s
98   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_s_b      !: <==> the 2D  ht_i
99   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_su       !: Surface Conduction flux
100   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fc_bo_i     !: Bottom  Conduction flux
101   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_s_tot    !: Snow accretion/ablation        [m]
102   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_surf   !: Ice surface accretion/ablation [m]
103   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_i_bott   !: Ice bottom accretion/ablation  [m]
104   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dh_snowice  !: Snow ice formation             [m of ice]
105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   sm_i_b      !: Ice bulk salinity [ppt]
106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_i_new     !: Salinity of new ice at the bottom
107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   s_snowice   !: Salinity of new snow ice on top of the ice
108   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   o_i_b       !: Ice age                        [days]
109
110   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_b   !: corresponding to the 2D var  t_s
111   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_i_b   !: corresponding to the 2D var  t_i
112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s_i_b   !: profiled ice salinity
113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_b   !:    Ice  enthalpy per unit volume
114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_s_b   !:    Snow enthalpy per unit volume
115
116   ! Clean the following ...
117   ! These variables are coded for conservation checks
118   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_i_in                  !: ice energy summed over categories (initial)
119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_i_fin                 !: ice energy summed over categories (final)
120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_s_in, qt_s_fin        !: snow energy summed over categories
121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dq_i, sum_fluxq          !: increment of energy, sum of fluxes
122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fatm, foce               !: atmospheric, oceanic, heat flux
123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   cons_error, surf_error   !: conservation, surface error
124
125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_layer_in        !: goes to trash
126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_layer_fin       !: goes to trash
127   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dq_i_layer, radab   !: goes to trash
128
129   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftotal_in    !: initial total heat flux
130   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftotal_fin   !: final total heat flux
131
132   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fc_s
133   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fc_i
134   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   de_s_lay
135   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   de_i_lay
136   
137   INTEGER , PUBLIC ::   jiindex_1d   ! 1D index of debugging point
138
139   !!----------------------------------------------------------------------
140   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011)
141   !! $Id$
142   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
143   !!----------------------------------------------------------------------
144CONTAINS
145
146   FUNCTION thd_ice_alloc()
147      !!---------------------------------------------------------------------!
148      !!                ***  ROUTINE thd_ice_alloc ***
149      !!---------------------------------------------------------------------!
150      INTEGER ::   thd_ice_alloc   ! return value
151      INTEGER ::   ierr(4)
152      !!---------------------------------------------------------------------!
153
154      ALLOCATE( npb      (jpij) , npac     (jpij),                          &
155         !                                                                  !
156         &      qldif_1d (jpij) , qcmif_1d (jpij) , fstbif_1d  (jpij) ,     &
157         &      fltbif_1d(jpij) , fscbq_1d (jpij) , qsr_ice_1d (jpij) ,     &
158         &      fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qnsr_ice_1d(jpij) ,     &
159         &      qfvbq_1d (jpij) , t_bo_b   (jpij)                     , STAT=ierr(1) )
160      !
161      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_b     (jpij) ,     &
162         &      fbif_1d    (jpij) , rdm_ice_1d (jpij) , rdm_snw_1d (jpij) ,     &
163         &      qlbbq_1d   (jpij) , dmgwi_1d   (jpij) , dvsbq_1d   (jpij) ,     &
164         &      dvbbq_1d   (jpij) , dvlbq_1d   (jpij) , dvnbq_1d   (jpij) ,     &
165         &      dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) ,     &
166         &      tatm_ice_1d(jpij) , fsup       (jpij) , focea      (jpij) ,     &   
167         &      i0         (jpij) , old_ht_i_b (jpij) , old_ht_s_b (jpij) ,     & 
168         &      sfx_bri_1d (jpij) , fhbri_1d   (jpij) , sfx_thd_1d (jpij) ,     &
169         &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,     &     
170         &      dsm_i_si_1d(jpij) , hicol_b    (jpij)                     , STAT=ierr(2) )
171      !
172      ALLOCATE( t_su_b    (jpij) , a_i_b    (jpij) , ht_i_b   (jpij) ,    &   
173         &      ht_s_b    (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &   
174         &      dh_s_tot  (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) ,    &   
175         &      dh_snowice(jpij) , sm_i_b   (jpij) , s_i_new  (jpij) ,    &   
176         &      s_snowice (jpij) , o_i_b    (jpij)                   ,    &
177         !                                                                !
178         &      t_s_b(jpij,nlay_s),                                       &
179         !                                                                !
180         &      t_i_b(jpij,jkmax), s_i_b(jpij,jkmax)                ,     &           
181         &      q_i_b(jpij,jkmax), q_s_b(jpij,jkmax)                , STAT=ierr(3))
182      !
183      ALLOCATE( qt_i_in   (jpij,jpl) , qt_i_fin(jpij,jpl) , qt_s_in   (jpij,jpl) ,     &
184         &      qt_s_fin  (jpij,jpl) , dq_i    (jpij,jpl) , sum_fluxq (jpij,jpl) ,     &
185         &      fatm      (jpij,jpl) , foce    (jpij,jpl) , cons_error(jpij,jpl) ,     &
186         &      surf_error(jpij,jpl)                                             ,     &
187         !                                                                             !
188         &      q_i_layer_in(jpij,jkmax) , q_i_layer_fin(jpij,jkmax)             ,     &
189         &      dq_i_layer  (jpij,jkmax) , radab        (jpij,jkmax)             ,     &
190         !                                                                             !
191         &      ftotal_in(jpij), ftotal_fin(jpij)                                ,     &
192         !                                                                             !
193         &      fc_s(jpij,0:nlay_s) , de_s_lay(jpij,nlay_s)                      ,     &
194         &      fc_i(jpij,0:jkmax)  , de_i_lay(jpij,jkmax)                       , STAT=ierr(4) )
195
196      thd_ice_alloc = MAXVAL( ierr )
197
198      IF( thd_ice_alloc /= 0 )   CALL ctl_warn( 'thd_ice_alloc: failed to allocate arrays.' )
199      !
200   END FUNCTION thd_ice_alloc
201   
202   !!======================================================================
203END MODULE thd_ice
Note: See TracBrowser for help on using the repository browser.