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.
limthd_zdf_2.F90 in branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2 – NEMO

source: branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90 @ 2633

Last change on this file since 2633 was 2633, checked in by trackstand2, 13 years ago

Renamed wrk_use => wrk_in_use and wrk_release => wrk_not_released

  • Property svn:keywords set to Id
File size: 44.8 KB
Line 
1MODULE limthd_zdf_2
2   !!======================================================================
3   !!                       ***  MODULE limthd_zdf_2 ***
4   !!                thermodynamic growth and decay of the ice
5   !!======================================================================
6   !! History :  1.0  !  01-04 (LIM) Original code
7   !!            2.0  !  02-08 (C. Ethe, G. Madec) F90
8   !!----------------------------------------------------------------------
9#if defined key_lim2
10   !!----------------------------------------------------------------------
11   !!   'key_lim2'                                    LIM 2.0 sea-ice model
12   !!----------------------------------------------------------------------
13   !!----------------------------------------------------------------------
14   !!   lim_thd_zdf_2 : vertical accr./abl. and lateral ablation of sea ice
15   !!----------------------------------------------------------------------
16   !! * Modules used
17   USE par_oce          ! ocean parameters
18   USE phycst           ! ???
19   USE thd_ice_2
20   USE ice_2
21   USE limistate_2
22   USE in_out_manager
23   USE cpl_oasis3, ONLY : lk_cpl
24     
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   lim_thd_zdf_2        ! called by lim_thd_2
29
30   REAL(wp) ::   epsi20 = 1.e-20  ,  &  ! constant values
31      &          epsi13 = 1.e-13  ,  &
32      &          zzero  = 0.e0    ,  &
33      &          zone   = 1.e0
34   !!----------------------------------------------------------------------
35   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
36   !! $Id$
37   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
38   !!----------------------------------------------------------------------
39
40CONTAINS
41
42   SUBROUTINE lim_thd_zdf_2( kideb , kiut )
43      !!------------------------------------------------------------------
44      !!                ***  ROUTINE lim_thd_zdf_2  ***
45      !!             
46      !! ** Purpose : This routine determines the time evolution of snow
47      !!      and sea-ice thicknesses, concentration and heat content
48      !!      due to the vertical and lateral thermodynamic accretion-
49      !!      ablation processes. One only treats the case of lat. abl.
50      !!      For lateral accretion, see routine lim_lat_accr
51      !!
52      !! ** Method  : The representation of vertical growth and decay of
53      !!      the sea-ice model is based upon the diffusion of heat
54      !!      through the external and internal boundaries of a
55      !!      three-layer system (two layers of ice and one layer and
56      !!      one layer of snow, if present, on top of the ice).
57      !!
58      !! ** Action  : - Calculation of some intermediates variables
59      !!              - Calculation of surface temperature
60      !!              - Calculation of available heat for surface ablation
61      !!              - Calculation of the changes in internal temperature
62      !!                of the three-layer system, due to vertical diffusion
63      !!                processes
64      !!              - Performs surface ablation and bottom accretion-ablation
65      !!              - Performs snow-ice formation
66      !!              - Performs lateral ablation
67      !!
68      !! References : Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646   
69      !!              Fichefet T. and M. Maqueda 1999, Clim. Dyn, 15(4), 251-268 
70      !!------------------------------------------------------------------
71      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
72      USE wrk_nemo, ONLY: wrk_1d_1,  wrk_1d_2,  wrk_1d_3,  wrk_1d_4,  wrk_1d_5 
73      USE wrk_nemo, ONLY: wrk_1d_6,  wrk_1d_7,  wrk_1d_8,  wrk_1d_9,  wrk_1d_10
74      USE wrk_nemo, ONLY: wrk_1d_11, wrk_1d_12, wrk_1d_13, wrk_1d_14, wrk_1d_15
75      USE wrk_nemo, ONLY: wrk_1d_16, wrk_1d_17, wrk_1d_18, wrk_1d_19, wrk_1d_20
76      USE wrk_nemo, ONLY: wrk_1d_21, wrk_1d_22, wrk_1d_23, wrk_1d_24, wrk_1d_25
77      USE wrk_nemo, ONLY: wrk_1d_26, wrk_1d_27
78      !!
79      INTEGER, INTENT(in) ::   kideb    ! Start point on which the  the computation is applied
80      INTEGER, INTENT(in) ::   kiut     ! End point on which the  the computation is applied
81      !!
82      INTEGER ::   ji       ! dummy loop indices
83      REAL(wp), POINTER, DIMENSION(:) ::   zqcmlts        ! energy due to surface melting
84      REAL(wp), POINTER, DIMENSION(:) ::   zqcmltb        ! energy due to bottom melting
85      REAL(wp), POINTER, DIMENSION(:) ::  &
86         ztsmlt      &    ! snow/ice surface melting temperature
87         ,ztbif      &    ! int. temp. at the mid-point of the 1st layer of the snow/ice sys.
88         ,zksn       &    ! effective conductivity of snow
89         ,zkic       &    ! effective conductivity of ice
90         ,zksndh     &    ! thermal cond. at the mid-point of the 1st layer of the snow/ice sys.
91         , zfcsu     &    ! conductive heat flux at the surface of the snow/ice system
92         , zfcsudt   &    ! = zfcsu * dt
93         , zi0       &    ! frac. of the net SW rad. which is not absorbed at the surface
94         , z1mi0     &    ! fraction of the net SW radiation absorbed at the surface
95         , zqmax     &    ! maximum energy stored in brine pockets
96         , zrcpdt    &    ! h_su*rho_su*cp_su/dt(h_su being the thick. of surf. layer)
97         , zts_old   &    ! previous surface temperature
98         , zidsn , z1midsn , zidsnic ! tempory variables
99      REAL(wp), POINTER, DIMENSION(:) ::   &
100          zfnet       &  ! net heat flux at the top surface( incl. conductive heat flux)
101          , zsprecip  &    ! snow accumulation
102          , zhsnw_old &    ! previous snow thickness
103          , zdhictop  &    ! change in ice thickness due to top surf ablation/accretion
104          , zdhicbot  &    ! change in ice thickness due to bottom surf abl/acc
105          , zqsup     &    ! energy transmitted to ocean (coming from top surf abl/acc)
106          , zqocea    &    ! energy transmitted to ocean (coming from bottom sur abl/acc)
107          , zfrl_old  &    ! previous sea/ice fraction
108          , zfrld_1d    &    ! new sea/ice fraction
109          , zep            ! internal temperature of the 2nd layer of the snow/ice system
110       REAL(wp), DIMENSION(3) :: & 
111          zplediag  &    ! principle diagonal, subdiag. and supdiag. of the
112          , zsubdiag  &    ! tri-diagonal matrix coming from the computation
113          , zsupdiag  &    ! of the temperatures inside the snow-ice system
114          , zsmbr          ! second member
115       REAL(wp) :: & 
116          zhsu     &     ! thickness of surface layer
117          , zhe      &     ! effective thickness for compu. of equ. thermal conductivity
118          , zheshth  &     ! = zhe / thth
119          , zghe     &     ! correction factor of the thermal conductivity
120          , zumsb    &     ! parameter for numerical method to solve heat-diffusion eq.
121          , zkhsn    &     ! conductivity at the snow layer
122          , zkhic    &     ! conductivity at the ice layers
123          , zkint    &     ! equivalent conductivity at the snow-ice interface
124          , zkhsnint &     ! = zkint*dt / (hsn*rhosn*cpsn) 
125          , zkhicint &     ! = 2*zkint*dt / (hic*rhoic*cpic)
126          , zpiv1 , zpiv2  &       ! tempory scalars used to solve the tri-diagonal system
127          , zb2 , zd2 , zb3 , zd3 &
128          , ztint          ! equivalent temperature at the snow-ice interface
129       REAL(wp) :: & 
130          zexp      &     ! exponential function of the ice thickness
131          , zfsab     &     ! part of solar radiation stored in brine pockets
132          , zfts      &     ! value of energy balance function when the temp. equal surf. temp.
133          , zdfts     &     ! value of derivative of ztfs when the temp. equal surf. temp.
134          , zdts      &     ! surface temperature increment
135          , zqsnw_mlt &     ! energy needed to melt snow
136          , zdhsmlt   &     ! change in snow thickness due to melt
137          , zhsn      &     ! snow thickness (previous+accumulation-melt)
138          , zqsn_mlt_rem &  ! remaining heat coming from snow melting
139          , zqice_top_mlt & ! energy used to melt ice at top surface
140          , zdhssub      &  ! change in snow thick. due to sublimation or evaporation
141          , zdhisub      &  ! change in ice thick. due to sublimation or evaporation   
142          , zdhsn        &  ! snow ice thickness increment
143          , zdtsn        &  ! snow internal temp. increment
144          , zdtic        &  ! ice internal temp. increment
145          , zqnes          ! conductive energy due to ice melting in the first ice layer
146       REAL(wp) :: & 
147          ztbot     &      ! temperature at the bottom surface
148          , zfcbot    &      ! conductive heat flux at bottom surface
149          , zqice_bot &      ! energy used for bottom melting/growing
150          , zqice_bot_mlt &  ! energy used for bottom melting
151          , zqstbif_bot  &  ! part of energy stored in brine pockets used for bottom melting
152          , zqstbif_old  &  ! tempory var. for zqstbif_bot
153          , zdhicmlt      &  ! change in ice thickness due to bottom melting
154          , zdhicm        &  ! change in ice thickness var.
155          , zdhsnm        &  ! change in snow thickness var.
156          , zhsnfi        &  ! snow thickness var.
157          , zc1, zpc1, zc2, zpc2, zp1, zp2 & ! tempory variables
158          , ztb2, ztb3
159       REAL(wp) :: & 
160          zdrmh         &   ! change in snow/ice thick. after snow-ice formation
161          , zhicnew       &   ! new ice thickness
162          , zhsnnew       &   ! new snow thickness
163          , zquot , ztneq &   ! tempory temp. variables
164          , zqice, zqicetot & ! total heat inside the snow/ice system
165          , zdfrl         &   ! change in ice concentration
166          , zdvsnvol      &   ! change in snow volume
167          , zdrfrl1, zdrfrl2 &  ! tempory scalars
168          , zihsn, zidhb, zihic, zihe, zihq, ziexp, ziqf, zihnf, zibmlt, ziqr, zihgnew, zind
169       !!----------------------------------------------------------------------
170
171       IF(wrk_in_use(1, 1,  2, 3, 4, 5, 6, 7, 8, 9,10, &
172                        11,12,13,14,15,16,17,18,19,20, &
173                        21,22,23,24,25,26,27))THEN
174          CALL ctl_stop('lim_thd_zdf_2 : requested workspace arrays unavailable.')
175          RETURN
176       END IF
177
178       ztsmlt  => wrk_1d_1(1:jpij)
179       ztbif   => wrk_1d_2(1:jpij) 
180       zksn    => wrk_1d_3(1:jpij) 
181       zkic    => wrk_1d_4(1:jpij)   
182       zksndh  => wrk_1d_5(1:jpij)   
183       zfcsu   => wrk_1d_6(1:jpij)   
184       zfcsudt => wrk_1d_7(1:jpij) 
185       zi0     => wrk_1d_8(1:jpij)   
186       z1mi0   => wrk_1d_9(1:jpij)   
187       zqmax   => wrk_1d_10(1:jpij)   
188       zrcpdt  => wrk_1d_11(1:jpij) 
189       zts_old => wrk_1d_12(1:jpij) 
190       zidsn   => wrk_1d_13(1:jpij) 
191       z1midsn => wrk_1d_14(1:jpij) 
192       zidsnic => wrk_1d_15(1:jpij)
193
194       zfnet     => wrk_1d_16(1:jpij)
195       zsprecip  => wrk_1d_17(1:jpij) 
196       zhsnw_old => wrk_1d_18(1:jpij) 
197       zdhictop  => wrk_1d_19(1:jpij) 
198       zdhicbot  => wrk_1d_20(1:jpij)
199       zqsup     => wrk_1d_21(1:jpij) 
200       zqocea    => wrk_1d_22(1:jpij)
201       zfrl_old  => wrk_1d_23(1:jpij) 
202       zfrld_1d  => wrk_1d_24(1:jpij) 
203       zep       => wrk_1d_25(1:jpij) 
204
205       zqcmlts   => wrk_1d_26(1:jpij)
206       zqcmltb   => wrk_1d_27(1:jpij)
207
208       !-----------------------------------------------------------------------
209       !  1. Boundaries conditions for snow/ice system internal temperature
210       !       - If tbif_1d(ji,1) > rt0_snow, tbif_1d(ji,1) = rt0_snow
211       !       - If tbif_1d(ji,2/3) > rt0_ice, tbif_1d(ji,2/3) = rt0_ice
212       !     Computation of energies due to surface and bottom melting
213       !-----------------------------------------------------------------------
214       
215       DO ji = kideb , kiut
216          zihsn = MAX( zzero , SIGN( zone , hsndif - h_snow_1d(ji) ) )
217          zihic = MAX( zzero , SIGN( zone , hicdif - h_ice_1d(ji) ) )
218          !--computation of energy due to surface melting
219          zqcmlts(ji) = ( MAX ( zzero ,  &
220             &                   rcpsn * h_snow_1d(ji) * ( tbif_1d(ji,1) - rt0_snow ) ) ) * ( 1.0 - zihsn )
221          !--computation of energy due to bottom melting
222          zqcmltb(ji) = ( MAX( zzero , &
223             &                  rcpic * ( tbif_1d(ji,2) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) &
224             &           + MAX( zzero , &
225             &                  rcpic * ( tbif_1d(ji,3) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) &
226             &           ) * ( 1.0 - zihic  )
227          !--limitation of  snow/ice system internal temperature
228          tbif_1d(ji,1)   = MIN( rt0_snow, tbif_1d(ji,1) )
229          tbif_1d(ji,2)   = MIN( rt0_ice , tbif_1d(ji,2) )
230          tbif_1d(ji,3)   = MIN( rt0_ice , tbif_1d(ji,3) )
231       END DO
232
233       !-------------------------------------------
234       !  2. Calculate some intermediate variables. 
235       !-------------------------------------------
236       
237       ! initialisation of the thickness of surface layer
238       zhsu = hnzst 
239
240       DO ji = kideb , kiut
241          zind   = MAX( zzero , SIGN( zone , zhsu - h_snow_1d(ji) ) )
242          zihsn  = MAX( zzero , SIGN( zone , hsndif - h_snow_1d(ji) ) )
243          zihsn  = MAX( zihsn , zind )
244          zihic  = MAX( zzero , sign( zone , hicdif - h_ice_1d(ji) ) )
245          !     2.1. Computation of surface melting temperature
246          !----------------------------------------------------
247          zind  = MAX( zzero , SIGN( zone , -h_snow_1d(ji) ) )
248          ztsmlt(ji) = ( 1.0 - zind ) * rt0_snow + zind * rt0_ice
249          !
250          !     2.2. Effective conductivity of snow and ice
251          !-----------------------------------------------
252
253          !---computation of the correction factor on the thermal conductivity
254          !-- (Morales Maqueda, 1995 ; Fichefet and Morales Maqueda, 1997)
255          zhe      =  ( rcdsn / ( rcdsn + rcdic ) ) * h_ice_1d(ji)   &
256             &     + ( rcdic / ( rcdsn + rcdic ) ) * h_snow_1d(ji) 
257          zihe     = MAX( zzero , SIGN( zone , 2.0 * zhe - thth ) )
258          zheshth  = zhe / thth
259          zghe     = ( 1.0 - zihe ) * zheshth * ( 2.0 - zheshth )   &
260             &     +         zihe   * 0.5 * ( 1.5 + LOG( 2.0 * zheshth ) )
261
262          !---effective conductivities
263          zksn(ji)  = zghe * rcdsn 
264          zkic(ji)  = zghe * rcdic
265
266          !
267          !     2.3. Computation of the conductive heat flux from the snow/ice
268          !          system interior toward the top surface
269          !------------------------------------------------------------------
270
271          !---Thermal conductivity at the mid-point of the first snow/ice system layer
272          zksndh(ji) =   ( ( 1.0 - zihsn ) * 2.0 * zksn(ji) + zihsn * 4.0 * zkic(ji) )   &
273             &         / ( ( 1.0 - zihsn ) *  h_snow_1d(ji)                              &
274             &           +        zihsn   *  ( ( 1.0 + 3.0 * zihic ) * h_ice_1d(ji)      &
275             &           + 4.0 * zkic(ji)/zksn(ji) * h_snow_1d(ji) ) )
276
277          !---internal temperature at the mid-point of the first snow/ice system layer
278          ztbif(ji)  = ( 1.0 - zihsn ) * tbif_1d(ji,1)                       &
279             &       +         zihsn   * ( ( 1.0 - zihic ) * tbif_1d(ji,2)   &
280             &       +         zihic   * tfu_1d(ji)   )
281          !---conductive heat flux
282          zfcsu(ji) = zksndh(ji) * ( ztbif(ji) - sist_1d(ji) )
283
284       END DO
285
286       !--------------------------------------------------------------------
287       !  3. Calculate :
288       !     - fstbif_1d, part of solar radiation absorbing inside the ice
289       !       assuming an exponential absorption (Grenfell and Maykut, 1977)
290       !     - zqmax,  maximum energy stored in brine pockets
291       !     - qstbif_1d, total energy stored in brine pockets (updating)
292       !-------------------------------------------------------------------
293
294       DO ji = kideb , kiut
295          zihsn  = MAX( zzero , SIGN (zone , -h_snow_1d(ji) ) )
296          zihic  = MAX( zzero , 1.0 - ( h_ice_1d(ji) / zhsu ) )     
297          zind   = MAX( zzero , SIGN (zone , hicdif - h_ice_1d(ji) ) )
298          !--Computation of the fraction of the net shortwave radiation which
299          !--penetrates inside the ice cover ( See Forcat)
300          zi0(ji)  = zihsn * ( fr1_i0_1d(ji) + zihic * fr2_i0_1d(ji) )
301          zexp     = MIN( zone , EXP( -1.5 * ( h_ice_1d(ji) - zhsu ) ) )
302          fstbif_1d(ji) = zi0(ji) * qsr_ice_1d(ji) * zexp
303          !--Computation of maximum energy stored in brine pockets zqmax and update
304          !--the total energy stored in brine pockets, if less than zqmax
305          zqmax(ji) = MAX( zzero , 0.5 * xlic * ( h_ice_1d(ji) - hicmin ) )
306          zfsab   = zi0(ji) * qsr_ice_1d(ji) * ( 1.0 - zexp )
307          zihq    = ( 1.0 - zind ) * MAX(zzero, SIGN( zone , qstbif_1d(ji) - zqmax(ji) ) ) &
308             &    +         zind   * zone
309          qstbif_1d(ji) = ( qstbif_1d(ji) + ( 1.0 - zihq ) * zfsab * rdt_ice ) * swiqst
310          !--fraction of shortwave radiation absorbed at surface
311          ziexp = zihq * zexp + ( 1.0 - zihq ) * ( swiqst + ( 1.0 - swiqst ) * zexp )
312          z1mi0(ji) = 1.0 - zi0(ji) * ziexp
313       END DO
314
315       !--------------------------------------------------------------------------------
316       !  4. Computation of the surface temperature : determined by considering the
317       !     budget of a thin layer of thick. zhsu at the top surface (H. Grenier, 1995)
318       !     and based on a surface energy balance :
319       !     hsu * rcp * dT/dt = Fsr + Fnsr(T) + Fcs(T),
320       !     where - Fsr is the net absorbed solar radiation,
321       !           - Fnsr is the total non solar radiation (incoming and outgoing long-wave,
322       !             sensible and latent heat fluxes)
323       !           - Fcs the conductive heat flux at the top of surface
324       !------------------------------------------------------------------------------
325
326       !     4.1. Computation of intermediate values
327       !---------------------------------------------
328       DO ji = kideb, kiut
329          zrcpdt(ji) = ( rcpsn * MIN( h_snow_1d(ji) , zhsu )    &
330             &       + rcpic * MAX( zhsu - h_snow_1d(ji) , zzero ) ) / rdt_ice
331          zts_old(ji) =  sist_1d(ji)
332       END DO
333
334       !     4.2. Computation of surface temperature by expanding the eq. of energy balance
335       !          with Ts = Tp + DT. One obtain , F(Tp) + DT * DF(Tp) = 0
336       !          where  - F(Tp) = Fsr + Fnsr(Tp) + Fcs(Tp)
337       !                 - DF(Tp)= (dFnsr(Tp)/dT) + (dFcs(Tp)/dT) - hsu*rcp/dt
338       !---------------------------------------------------------------------------------
339
340       DO ji = kideb, kiut
341          !---computation of the derivative of energy balance function
342          zdfts    =  zksndh(ji)   & ! contribution of the conductive heat flux
343             &      + zrcpdt(ji)   & ! contribution of hsu * rcp / dt
344             &      - dqns_ice_1d (ji)     ! contribution of the total non solar radiation
345          !---computation of the energy balance function
346          zfts    = - z1mi0 (ji) * qsr_ice_1d(ji)   & ! net absorbed solar radiation
347             &      - qns_ice_1d(ji)                & ! total non solar radiation
348             &      - zfcsu (ji)                      ! conductive heat flux from the surface
349          !---computation of surface temperature increment 
350          zdts    = -zfts / zdfts
351          !---computation of the new surface temperature
352          sist_1d(ji) = sist_1d(ji) + zdts
353       END DO
354
355       !----------------------------------------------------------------------------
356       !  5. Boundary condition at the top surface
357       !--    IF Tsb < Tmelt, Fnet = Fcs (the net heat flux equal the conductive heat flux)
358       !      Otherwise Tsb = Tmelt and Qnet(Tmelt) > 0
359       !      Fnet(Tmelt) is therefore the net surface flux needed for melting
360       !----------------------------------------------------------------------------
361       
362       
363       !     5.1.  Limitation of surface temperature and update total non solar fluxes,
364       !          latent heat flux and conductive flux at the top surface
365       !---------------------------------------------------------------------- 
366                     
367       IF ( .NOT. lk_cpl ) THEN   ! duplicate the loop for performances issues
368          DO ji = kideb, kiut
369             sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) )
370             qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) )
371             qla_ice_1d(ji) = qla_ice_1d(ji) + dqla_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) )
372             zfcsu(ji)  = zksndh(ji) * ( ztbif(ji) - sist_1d(ji) )
373          END DO
374       ELSE
375          DO ji = kideb, kiut
376             sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) )
377             zfcsu(ji)  = zksndh(ji) * ( ztbif(ji) - sist_1d(ji) )
378          END DO
379       ENDIF
380
381       !     5.2. Calculate available heat for surface ablation.
382       !---------------------------------------------------------------------
383
384       DO ji = kideb, kiut
385          zfnet(ji) = qns_ice_1d(ji) + z1mi0(ji) * qsr_ice_1d(ji) + zfcsu(ji)         
386          zfnet(ji) = MAX( zzero , zfnet(ji) )
387          zfnet(ji) = zfnet(ji) * MAX( zzero , SIGN( zone , sist_1d(ji) - ztsmlt(ji) ) )
388       END DO
389
390       !-------------------------------------------------------------------------
391       !  6. Calculate changes in internal temperature due to vertical diffusion   
392       !     processes. The evolution of this temperature is governed by the one-
393       !     dimensionnal heat-diffusion equation.
394       !     Given the temperature tbif(1/2/3), at time m we solve a set
395       !     of finite difference equations to obtain new tempe. Each tempe is coupled
396       !     to the temp. immediatly above and below by heat conduction terms. Thus
397       !     we have a set of equations of the form A * T = B, where A is a tridiagonal
398       !     matrix, T a vector whose components are the unknown new temp.
399       !-------------------------------------------------------------------------
400       
401       !--parameter for the numerical methode use to solve the heat-diffusion equation
402       !- implicit, explicit or Crank-Nicholson
403       zumsb = 1.0 - sbeta 
404       DO ji = kideb, kiut
405          zidsn(ji)   = MAX ( zzero, SIGN( zone, hsndif - h_snow_1d(ji) ) ) 
406          z1midsn(ji) = 1.0 - zidsn(ji)
407          zihic       = MAX ( zzero, SIGN( zone, hicdif - h_ice_1d(ji) ) ) 
408          zidsnic(ji) = zidsn(ji) *  zihic 
409          zfcsudt(ji) = zfcsu(ji) * rdt_ice 
410       END DO
411   
412       DO ji = kideb, kiut
413
414          !     6.1 Calculate intermediate variables.
415          !----------------------------------------
416
417          !--conductivity at the snow surface
418          zkhsn = 2.0 * zksn(ji) * rdt_ice / rcpsn
419          !--conductivity at the ice surface
420          zkhic = 4.0 * zkic(ji) * rdt_ice / MAX( h_ice_1d(ji) * h_ice_1d(ji) * rcpic , epsi20 )
421          !--conductivity at the snow/ice interface
422          zkint = 4.0 * zksn(ji) * zkic(ji)  &
423             &        / ( zksn(ji) * h_ice_1d(ji) + 2.0 * zkic(ji) * h_snow_1d(ji) * z1midsn(ji)) 
424          zkhsnint = zkint * rdt_ice / rcpsn
425          zkhicint = zkint * 2.0 * rdt_ice / MAX( h_ice_1d(ji) * rcpic , epsi20 )
426         
427          !     6.2. Fulfill the linear system matrix.
428          !-----------------------------------------
429!$$$          zplediag(1) = 1 + sbeta * z1midsn(ji) * ( zkhsn + zkhsnint )       
430          zplediag(1) =   zidsn(ji) + z1midsn(ji) * h_snow_1d(ji)   &
431             &          + sbeta * z1midsn(ji) * zkhsnint 
432          zplediag(2) = 1 + sbeta * ( z1midsn(ji) * zkhicint + zkhic ) 
433          zplediag(3) = 1 + 3.0 * sbeta * zkhic   
434
435          zsubdiag(1) =  0.e0             
436          zsubdiag(2) = -1.e0 * z1midsn(ji) * sbeta * zkhicint
437          zsubdiag(3) = -1.e0 * sbeta * zkhic 
438
439          zsupdiag(1) = -1.e0 * z1midsn(ji) * sbeta * zkhsnint 
440          zsupdiag(2) = zsubdiag(3)
441          zsupdiag(3) =  0.e0
442         
443          !     6.3. Fulfill the idependent term vector.
444          !-------------------------------------------
445         
446!$$$          zsmbr(1) = zidsn(ji) * sist_1d(ji) + z1midsn(ji) *   &
447!$$$             &         ( tbif_1d(ji,1) + zkhsn * sist_1d(ji)
448!$$$             &         - zumsb * ( zkhsn * tbif_1d(ji,1)
449!$$$             &                   + zkhsnint * ( tbif_1d(ji,1) - tbif_1d(ji,2) ) ) )
450          zsmbr(1) = zidsn(ji) * sist_1d(ji) + z1midsn(ji) *    &
451             &       ( h_snow_1d(ji) * tbif_1d(ji,1) - ( zfcsudt(ji) / rcpsn )  &
452             &       - zumsb * zkhsnint * ( tbif_1d(ji,1) - tbif_1d(ji,2) ) )
453
454          zsmbr(2) =  tbif_1d(ji,2)  &
455             &      - zidsn(ji) * ( 1.0 - zidsnic(ji) ) &
456             &        * ( zfcsudt(ji) / MAX( h_ice_1d(ji) * rcpic , epsi20 ) ) &
457             &      + zumsb * ( zkhicint * ( tbif_1d(ji,1) - tbif_1d(ji,2) ) &
458             &                   - zkhic * ( tbif_1d(ji,2) - tbif_1d(ji,3) )  )
459
460          zsmbr(3) =  tbif_1d(ji,3)  &
461             &      + zkhic * ( 2.0 * tfu_1d(ji) &
462             &                + zumsb * ( tbif_1d(ji,2) - 3.0 * tbif_1d(ji,3) ) )
463         
464          !     6.4. Solve the system (Gauss elimination method).
465          !----------------------------------------------------
466         
467          zpiv1 = zsubdiag(2) / zplediag(1) 
468          zb2   = zplediag(2) - zpiv1 * zsupdiag(1)
469          zd2   = zsmbr(2) - zpiv1 * zsmbr(1)
470
471          zpiv2 = zsubdiag(3) / zb2
472          zb3   = zplediag(3) - zpiv2 * zsupdiag(2)
473          zd3   = zsmbr(3) - zpiv2 * zd2
474
475          tbif_1d(ji,3) = zd3 / zb3
476          tbif_1d(ji,2) = ( zd2 - zsupdiag(2) * tbif_1d(ji,3) ) / zb2
477          tbif_1d(ji,1) = ( zsmbr(1) - zsupdiag(1) * tbif_1d(ji,2) ) / zplediag(1)           
478
479          !--- taking into account the particular case of  zidsnic(ji) = 1
480          ztint =  (  zkic(ji) * h_snow_1d(ji) * tfu_1d (ji)    &
481             &      + zksn(ji) * h_ice_1d(ji) * sist_1d(ji) )   &
482             &   / ( zkic(ji) * h_snow_1d(ji) + zksn(ji) * h_ice_1d(ji) ) 
483
484          tbif_1d(ji,1) = ( 1.0 - zidsnic(ji) ) * tbif_1d(ji,1)   &
485             &                + zidsnic(ji)   * ( ztint + sist_1d(ji) ) / 2.0
486          tbif_1d(ji,2) = ( 1.0 - zidsnic(ji) ) * tbif_1d(ji,2)   &
487             &                + zidsnic(ji)   * ( 3.0 * ztint + tfu_1d(ji) ) / 4.0
488          tbif_1d(ji,3) = ( 1.0 - zidsnic(ji) ) * tbif_1d(ji,3)   &
489             &                + zidsnic(ji)   * ( ztint + 3.0 * tfu_1d(ji) ) / 4.0     
490       END DO
491 
492       !----------------------------------------------------------------------
493       !  9. Take into account surface ablation and bottom accretion-ablation.|
494       !----------------------------------------------------------------------
495       
496       !---Snow accumulation in one thermodynamic time step
497       zsprecip(kideb:kiut) = sprecip_1d(kideb:kiut) * rdt_ice / rhosn
498
499
500       DO ji = kideb, kiut
501         
502          !      9.1. Surface ablation and update of snow thickness and qstbif_1d
503          !--------------------------------------------------------------------
504         
505          !--------------------------------------------------------------------------
506          !--      Melting snow processes :
507          !--      Melt at the upper surface is computed from the difference between
508          !--      the net heat flux (including the conductive heat flux) at the upper
509          !--      surface and the pre-existing energy due to surface melting
510          !------------------------------------------------------------------------------
511         
512          !-- store the snow thickness
513          zhsnw_old(ji) =  h_snow_1d(ji)
514          !--computation of the energy needed to melt snow
515          zqsnw_mlt  = zfnet(ji) * rdt_ice - zqcmlts(ji)
516          !--change in snow thickness due to melt
517          zdhsmlt = - zqsnw_mlt / xlsn
518         
519          !-- compute new snow thickness, taking into account the part of snow accumulation
520          !   (as snow precipitation) and the part of snow lost due to melt
521          zhsn =  h_snow_1d(ji) + zsprecip(ji) + zdhsmlt
522          h_snow_1d(ji) = MAX( zzero , zhsn )
523          !-- compute the volume of snow lost after surface melting and the associated mass
524          dvsbq_1d(ji) =  ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsnw_old(ji) - zsprecip(ji) )
525          dvsbq_1d(ji) =  MIN( zzero , dvsbq_1d(ji) )
526          rdmsnif_1d(ji) =  rhosn * dvsbq_1d(ji)
527          !-- If the snow is completely melted the remaining heat is used to melt ice
528          zqsn_mlt_rem  = MAX( zzero , -zhsn ) * xlsn
529          zqice_top_mlt = zqsn_mlt_rem 
530          zqstbif_old   = qstbif_1d(ji)
531
532          !--------------------------------------------------------------------------
533          !--      Melting ice processes at the top surface :
534          !--      The energy used to melt ice, zqice_top_mlt, is taken from the energy
535          !--      stored in brine pockets qstbif_1d and the remaining energy coming
536          !--      from the melting snow process zqsn_mlt_rem.
537          !--      If qstbif_1d > zqsn_mlt_rem then, one uses only a zqsn_mlt_rem part
538          !--      of qstbif_1d to melt ice,
539          !--         zqice_top_mlt = zqice_top_mlt + zqsn_mlt_rem
540          !--         qstbif_1d = qstbif_1d - zqsn_mlt_rem
541          !--      Otherwise one uses all qstbif_1d to melt ice
542          !--         zqice_top_mlt = zqice_top_mlt + qstbif_1d
543          !--         qstbif_1d = 0
544          !------------------------------------------------------
545         
546          ziqf =  MAX ( zzero , SIGN( zone , qstbif_1d(ji) - zqsn_mlt_rem  ) )
547          zqice_top_mlt =         ziqf   * ( zqice_top_mlt + zqsn_mlt_rem )   &
548             &          + ( 1.0 - ziqf ) * ( zqice_top_mlt + qstbif_1d(ji)  )
549
550          qstbif_1d(ji) =         ziqf   * ( qstbif_1d(ji) - zqsn_mlt_rem )   &
551             &          + ( 1.0 - ziqf ) * ( qstbif_1d(ji) - qstbif_1d(ji)  )
552
553          !--    The contribution of the energy stored in brine pockets qstbif_1d to melt
554          !--    ice is taking into account only when qstbif_1d is less than zqmax.
555          !--    Otherwise, only the remaining energy coming from the melting snow
556          !--    process is used
557          zihq =  MAX ( zzero , SIGN( zone , qstbif_1d(ji) - zqmax(ji) ) )
558
559          zqice_top_mlt =         zihq   * zqice_top_mlt   &
560             &          + ( 1.0 - zihq ) * zqsn_mlt_rem
561
562          qstbif_1d(ji) =         zihq   * qstbif_1d(ji)   &
563             &          + ( 1.0 - zihq ) * zqstbif_old
564
565          !--change in ice thickness due to melt at the top surface
566          zdhictop(ji) = -zqice_top_mlt / xlic
567          !--compute the volume formed after surface melting
568          dvsbq_1d(ji) =  zdhictop(ji) * ( 1.0 - frld_1d(ji) )
569
570          !-------------------------------------------------------------------------
571          !--      A small variation at the surface also occurs because of sublimation
572          !--      associated with the latent flux. If qla_ice_1d is negative, snow condensates at
573          !        the surface. Otherwise, snow evaporates
574          !-----------------------------------------------------------------------
575          !----change in snow and ice thicknesses due to sublimation or evaporation
576          zdhssub  = parsub * ( qla_ice_1d(ji) / ( rhosn * xsn ) ) * rdt_ice 
577          zhsn     = h_snow_1d(ji) - zdhssub
578          zdhisub  = MAX( zzero , -zhsn ) * rhosn/rhoic
579          zdhictop(ji) =  zdhictop(ji) - zdhisub
580          h_snow_1d(ji)  =  MAX( zzero , zhsn )
581          !-------------------------------------------------
582          !--  Update Internal temperature and qstbif_1d.
583          !-------------------------------------------
584          zihsn  =  MAX( zzero , SIGN( zone, -h_snow_1d(ji) ) )
585          tbif_1d(ji,1) = ( 1.0 - zihsn ) * tbif_1d(ji,1) + zihsn   * tfu_1d(ji)
586          !--change in snow internal temperature if snow has increased
587          zihnf = MAX( zzero , SIGN( zone , h_snow_1d(ji) - zhsnw_old(ji) ) )
588          zdhsn = 1.0 - zhsnw_old(ji) / MAX( h_snow_1d(ji) , epsi20 )
589          zdtsn = zdhsn * ( sist_1d(ji) - tbif_1d(ji,1) )
590          tbif_1d(ji,1) = tbif_1d(ji,1) + z1midsn(ji) * zihnf * zdtsn
591          !--energy created due to ice melting in the first ice layer
592          zqnes  = ( rt0_ice - tbif_1d(ji,2) ) * rcpic * ( h_ice_1d(ji) / 2. )
593          !--change in first ice layer internal temperature
594          ziqr  = MAX( zzero , SIGN( zone , qstbif_1d(ji) - zqnes ) )
595          zdtic = qstbif_1d(ji) / ( rcpic * ( h_ice_1d(ji) / 2. ) )
596          tbif_1d(ji,2) =  ziqr * rt0_ice + ( 1 - ziqr ) * ( tbif_1d(ji,2) + zdtic )
597          !--update qstbif_1d
598          qstbif_1d(ji) = ziqr * ( qstbif_1d(ji) - zqnes ) * swiqst
599
600
601          !--      9.2. Calculate bottom accretion-ablation and update qstbif_1d.
602          !             Growth and melting at bottom ice surface are governed by 
603          !                 -xlic * Dh = (Fcb - Fbot ) * Dt
604          !             where Fbot is the net downward heat flux from ice to the ocean
605          !            and Fcb is the conductive heat flux at the bottom surface
606          !---------------------------------------------------------------------------
607          ztbot = ( 1.0 - zidsnic(ji) ) * tbif_1d(ji,3) + zidsnic(ji) * sist_1d(ji)
608          !---computes conductive heat flux at bottom surface
609          zfcbot =  4.0 * zkic(ji) * ( tfu_1d(ji) - ztbot )   &
610             &   / ( h_ice_1d(ji) + zidsnic(ji) * ( 3. * h_ice_1d(ji) &
611             &   + 4.0 * zkic(ji)/zksn(ji) * h_snow_1d(ji) ) )
612          !---computation of net energy needed for bottom melting/growing
613          zqice_bot = ( zfcbot - ( fbif_1d(ji) + qlbbq_1d(ji) ) ) * rdt_ice
614          zqstbif_bot = qstbif_1d(ji)
615          !---switch to know if bottom surface melts ( = 1 ) or grows ( = 0 )occurs
616          zibmlt = MAX( zzero , SIGN( zone , -zqice_bot ) )
617          !--particular case of melting (in the same way as the top surface)
618          zqice_bot_mlt = zqice_bot 
619          zqstbif_old = zqstbif_bot
620
621          ziqf =  MAX ( zzero , SIGN( zone , qstbif_1d(ji) + zqice_bot_mlt  ) )
622          zqice_bot_mlt =         ziqf   * ( zqice_bot_mlt + zqice_bot_mlt ) &
623             &          + ( 1.0 - ziqf ) * ( zqice_bot_mlt + qstbif_1d(ji)  )         
624          qstbif_1d(ji)   =         ziqf   * ( qstbif_1d(ji) + zqice_bot_mlt ) &
625             &          + ( 1.0 - ziqf ) * ( qstbif_1d(ji) - qstbif_1d(ji)  )
626          !--    The contribution of the energy stored in brine pockets qstbif_1d to melt
627          !--    ice is taking into account only when qstbif_1d is less than zqmax.
628          zihq =  MAX ( zzero , SIGN( zone , qstbif_1d(ji) - zqmax(ji) ) )
629          zqice_bot_mlt =         zihq   * zqice_bot_mlt   &
630             &          + ( 1.0 - zihq ) * zqice_bot
631          qstbif_1d(ji)   =         zihq   * qstbif_1d(ji)   &
632             &             + ( 1.0 - zihq ) * zqstbif_old
633
634          !---treatment of the case of melting/growing
635          zqice_bot   =         zibmlt   * ( zqice_bot_mlt - zqcmltb(ji) )   &
636             &        + ( 1.0 - zibmlt ) * ( zqice_bot - zqcmltb(ji)  )
637          qstbif_1d(ji) =         zibmlt   * qstbif_1d(ji)   &
638             &           + ( 1.0 - zibmlt ) * zqstbif_bot
639
640          !--computes change in ice thickness due to melt or growth
641          zdhicbot(ji) = zqice_bot / xlic
642          !--limitation of bottom melting if so : hmelt maximum melting at bottom
643          zdhicmlt  = MAX( hmelt , zdhicbot(ji) ) 
644          !-- output part due to bottom melting only
645          IF( zdhicmlt < 0.e0 ) rdvomif_1d(ji) = ( 1.0 - frld_1d(ji) ) * zdhicmlt
646          !--energy after bottom melting/growing
647          zqsup(ji) = ( 1.0 - frld_1d(ji) ) * xlic * ( zdhicmlt - zdhicbot(ji) )
648          !-- compute the new thickness and the newly formed volume after bottom melting/growing
649          zdhicbot(ji)  = zdhicmlt
650          dvbbq_1d(ji) = ( 1.0 - frld_1d(ji) ) * zdhicbot(ji)
651
652
653          !        9.3.  Updating ice thickness after top surface ablation
654          !              and bottom surface accretion/ablation
655          !---------------------------------------------------------------
656          zhicnew  = h_ice_1d(ji) + zdhictop(ji) + zdhicbot(ji)
657
658          !
659          !        9.4. Case of total ablation (ice is gone but snow may be left)
660          !-------------------------------------------------------------------
661          zhsn  = h_snow_1d(ji)
662          zihgnew = 1.0 - MAX( zzero , SIGN( zone , -zhicnew ) )
663          zihsn   = MAX( zzero , SIGN( zone , -zhsn ) )
664          !---convert
665          zdhicm  = ( 1.0 - zihgnew ) * ( zhicnew - qstbif_1d(ji) / xlic )
666          zdhsnm  = ( 1.0 - zihsn ) * zdhicm * rhoic / rhosn
667          !---updating new ice thickness and computing the newly formed ice mass
668          zhicnew   =  zihgnew * zhicnew
669          rdmicif_1d(ji) =  rdmicif_1d(ji) + ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d(ji) ) * rhoic
670          !---updating new snow thickness and computing the newly formed snow mass
671          zhsnfi   = zhsn + zdhsnm
672          h_snow_1d(ji) = MAX( zzero , zhsnfi )
673          rdmsnif_1d(ji) =  rdmsnif_1d(ji) + ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsn ) * rhosn
674          !--remaining energy in case of total ablation
675          zqocea(ji) = - ( zihsn * xlic * zdhicm + xlsn * ( zhsnfi - h_snow_1d(ji) ) ) * ( 1.0 - frld_1d(ji) )
676          qstbif_1d(ji) = zihgnew * qstbif_1d(ji)
677
678          !
679          !        9.5. Update internal temperature and ice thickness.
680          !-------------------------------------------------------
681          !
682          sist_1d(ji) = zihgnew * sist_1d(ji) + ( 1.0 - zihgnew ) * tfu_1d(ji)
683          zidhb  = MAX( zzero , SIGN( zone , - zdhicbot(ji) ) )
684          zc1    = - zhicnew * 0.5
685          zpc1   = MIN( 0.5 * zone , - h_ice_1d(ji) * 0.5 - zdhictop(ji) )
686          zc2    = - zhicnew
687          zpc2   =  zidhb * zc2 + ( 1.0 - zidhb ) * ( - h_ice_1d(ji) - zdhictop(ji) )
688          zp1    =  MAX( zpc1 , zc1 )
689          zp2    =  MAX( zpc2 , zc1 )
690          zep(ji) =  tbif_1d(ji,2)
691          ztb2  = 2.0 * (         - zp1   * tbif_1d(ji,2)  &
692             &  + ( zp1 - zp2 ) * tbif_1d(ji,3)  &
693             &  + ( zp2 - zc1 ) * tfu_1d(ji) ) / MAX( zhicnew , epsi20 ) 
694          tbif_1d(ji,2) = zihgnew * ztb2 + ( 1.0 - zihgnew ) * tfu_1d(ji)
695          !---
696          zp1  =  MIN( zpc1 , zc1 )
697          zp2  =  MIN( zpc2 , zc1 )
698          zp1  =  MAX( zc2  , zp1 )
699          ztb3 =  2.0 * (   ( 1.0 - zidhb ) * (  ( zc1 - zp2 ) * tbif_1d(ji,3)  &
700             &                                 + ( zp2 - zc2 ) * tfu_1d(ji) )   &
701             &               +      zidhb   * (  ( zc1 - zp1 ) * zep(ji)      &
702             &                                 + ( zp1 - zc2 ) * tbif_1d(ji,3))  ) / MAX( zhicnew , epsi20 )
703          tbif_1d(ji,3) =  zihgnew * ztb3 + ( 1.0 - zihgnew ) * tfu_1d(ji)
704          h_ice_1d(ji)  =  zhicnew
705       END DO
706
707
708       !----------------------------------------------------------------------------
709       !  10. Surface accretion.
710       !      The change of ice thickness after snow/ice formation is such that
711       !      the interface between snow and ice is located at the same height
712       !      as the ocean surface. It is given by (Fichefet and Morales Maqueda 1999)
713       !          D(h_ice) = (- D(hsn)/alph) =  [rhosn*hsn - (rau0 - rhoic)*hic]
714       !                                     / [alph*rhosn+rau0 - rhoic]
715       !----------------------------------------------------------------------------
716       !
717       DO ji = kideb , kiut
718
719          !--  Computation of the change of ice thickness after snow-ice formation
720          zdrmh =  ( rhosn * h_snow_1d(ji) + ( rhoic - rau0 ) * h_ice_1d(ji) )  &
721             &  / ( alphs * rhosn + rau0 - rhoic )
722          zdrmh = MAX( zzero , zdrmh )
723
724          !--New ice and snow thicknesses Fichefet and Morales Maqueda (1999)
725          zhicnew  = MAX( h_ice_1d(ji) , h_ice_1d(ji) + zdrmh )
726          zhsnnew  = MIN( h_snow_1d(ji) , h_snow_1d(ji) - alphs * zdrmh )
727          !---Compute new ice temperatures. snow temperature remains unchanged
728          !   Lepparanta (1983):
729          zihic = 1.0 - MAX( zzero , SIGN( zone , -zhicnew ) )
730          zquot  = ( 1.0 - zihic ) &
731             &   +         zihic * MIN( zone , h_ice_1d(ji) / MAX( zhicnew , epsi20 ) ) 
732          ztneq  =         alphs * cnscg * tbif_1d(ji,1)    &
733             &   + ( 1.0 - alphs * ( rhosn/rhoic ) ) * tfu_1d(ji)
734          zep(ji) = tbif_1d(ji,2)
735          tbif_1d(ji,2) = ztneq - zquot * zquot * ( ztneq - tbif_1d(ji,2) )
736          tbif_1d(ji,3) = 2.0 * ztneq &
737             &        + zquot * ( tbif_1d(ji,3) + zep(ji) - 2.0 * ztneq ) - tbif_1d(ji,2)
738
739          !---  Lepparanta (1983) (latent heat released during white ice formation
740          !     goes to the ocean -for lateral ablation-)
741          qldif_1d(ji)  = qldif_1d(ji) + zdrmh * ( 1.0 - alphs * ( rhosn/rhoic ) ) * xlic * ( 1.0 - frld_1d(ji) )
742          !--   Changes in ice volume and ice mass Lepparanta (1983):
743          dvnbq_1d(ji) = ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d(ji) )
744          dmgwi_1d(ji) = dmgwi_1d(ji) + ( 1.0 -frld_1d(ji) ) * ( h_snow_1d(ji) - zhsnnew ) * rhosn
745          !---  volume change of ice and snow (used for ocean-ice freshwater flux computation)
746          rdmicif_1d(ji) = rdmicif_1d(ji) + ( 1.0 - frld_1d(ji) )   * ( zhicnew - h_ice_1d (ji) ) * rhoic
747          rdmsnif_1d(ji) = rdmsnif_1d(ji) + ( 1.0 - frld_1d(ji) )   * ( zhsnnew - h_snow_1d(ji) ) * rhosn
748
749          !---  Actualize new snow and ice thickness.
750          h_snow_1d(ji)  = zhsnnew
751          h_ice_1d (ji)  = zhicnew
752
753       END DO
754
755       !----------------------------------------------------
756       !  11. Lateral ablation (Changes in sea/ice fraction)
757       !----------------------------------------------------
758       DO ji = kideb , kiut
759          zfrl_old(ji)  = frld_1d(ji)
760          zihic   = 1.0 - MAX( zzero , SIGN( zone , -h_ice_1d(ji) ) )
761          zihsn   = 1.0 - MAX( zzero , SIGN( zone , -h_snow_1d(ji) ) )
762          !--In the case of total ablation (all the ice ice has melted) frld = 1
763          frld_1d(ji)  = ( 1.0 - zihic ) + zihic * zfrl_old(ji)
764          !--Part of solar radiation absorbing inside the ice and going
765          !--through the ocean
766          fscbq_1d(ji) = ( 1.0 - zfrl_old(ji) ) * ( 1.0 - thcm_1d(ji) ) * fstbif_1d(ji)
767          !--Total remaining energy after bottom melting/growing
768          qfvbq_1d(ji) = zqsup(ji) + ( 1.0 - zihic ) * zqocea(ji)
769          !--Updating of total heat from the ocean
770          qldif_1d(ji)  = qldif_1d(ji) + qfvbq_1d(ji) + ( 1.0 - zihic ) * fscbq_1d(ji) * rdt_ice
771          !--Computation of total heat inside the snow/ice system
772          zqice  = h_snow_1d(ji) * xlsn + h_ice_1d(ji) * xlic
773          zqicetot  = ( 1.0 - frld_1d(ji) ) * zqice
774          !--The concentration of ice is reduced (frld increases) if the heat
775          !--exchange between ice and ocean is positive
776          ziqf = MAX( zzero , SIGN( zone ,  zqicetot - qldif_1d(ji) ) )
777          zdfrl = qldif_1d(ji) / MAX( epsi20 , zqice ) 
778          frld_1d(ji)  = ( 1.0 - ziqf )    &
779             &       +         ziqf * ( frld_1d(ji) + MAX( zzero , zdfrl ) ) 
780          fltbif_1d(ji) = ( ( 1.0 - zfrl_old(ji) ) * qstbif_1d(ji) - zqicetot  ) / rdt_ice
781          !--  Opening of leads: Hakkinen & Mellor, 1992.
782          zdfrl = - ( zdhictop(ji) + zdhicbot(ji) ) * hakspl * ( 1.0 - zfrl_old(ji) ) &
783             &  / MAX( epsi13 , h_ice_1d(ji) + h_snow_1d(ji) * rhosn/rhoic ) 
784          zfrld_1d(ji) =  frld_1d(ji) + MAX( zzero , zdfrl )
785          !--Limitation of sea-ice fraction <= 1
786          zfrld_1d(ji) = ziqf * MIN( 0.99 * zone , zfrld_1d(ji) ) + ( 1 - ziqf )
787          !---Update surface and internal temperature and snow/ice thicknesses.
788          sist_1d(ji)   = sist_1d(ji)   + ( 1.0 - ziqf ) * ( tfu_1d(ji) - sist_1d(ji)   )
789          tbif_1d(ji,1) = tbif_1d(ji,1) + ( 1.0 - ziqf ) * ( tfu_1d(ji) - tbif_1d(ji,1) )
790          tbif_1d(ji,2) = tbif_1d(ji,2) + ( 1.0 - ziqf ) * ( tfu_1d(ji) - tbif_1d(ji,2) )
791          tbif_1d(ji,3) = tbif_1d(ji,3) + ( 1.0 - ziqf ) * ( tfu_1d(ji) - tbif_1d(ji,3) )
792          !--variation of ice volume and ice mass
793          dvlbq_1d(ji)   = zihic * ( zfrl_old(ji) - frld_1d(ji) ) * h_ice_1d(ji)
794          rdmicif_1d(ji) = rdmicif_1d(ji) + dvlbq_1d(ji) * rhoic
795          !--variation of snow volume and snow mass
796          zdvsnvol    = zihsn * ( zfrl_old(ji) - frld_1d(ji) ) * h_snow_1d(ji)
797          rdmsnif_1d(ji) = rdmsnif_1d(ji) + zdvsnvol * rhosn
798          h_snow_1d(ji)  = ziqf * h_snow_1d(ji)
799
800          zdrfrl1 = ziqf * ( 1.0 -  frld_1d(ji) ) / MAX( epsi20 , 1.0 - zfrld_1d(ji) )
801          zdrfrl2 = ziqf * ( 1.0 - zfrl_old(ji) ) / MAX( epsi20 , 1.0 - zfrld_1d(ji) )
802
803          h_snow_1d (ji) = zdrfrl1 * h_snow_1d(ji)
804          h_ice_1d  (ji) = zdrfrl1 * h_ice_1d(ji)
805          qstbif_1d(ji) = zdrfrl2 * qstbif_1d(ji)
806          frld_1d(ji)    = zfrld_1d(ji)
807          !
808       END DO
809       !
810       IF(wrk_not_released(1, 1,  2, 3, 4, 5, 6, 7, 8, 9,10, &
811                              11,12,13,14,15,16,17,18,19,20, &
812                              21,22,23,24,25,26,27))THEN
813          CALL ctl_stop('lim_thd_zdf_2 : failed to release workspace arrays.')
814       END IF
815       !
816    END SUBROUTINE lim_thd_zdf_2
817
818#else
819   !!----------------------------------------------------------------------
820   !!   Default Option                                     NO sea-ice model
821   !!----------------------------------------------------------------------
822CONTAINS
823   SUBROUTINE lim_thd_zdf_2          ! Empty routine
824   END SUBROUTINE lim_thd_zdf_2
825#endif
826
827   !!======================================================================
828END MODULE limthd_zdf_2
Note: See TracBrowser for help on using the repository browser.