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/2011/dev_r2802_UKMO8_sbccpl/NEMOGCM/NEMO/LIM_SRC_2 – NEMO

source: branches/2011/dev_r2802_UKMO8_sbccpl/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90 @ 2834

Last change on this file since 2834 was 2834, checked in by charris, 13 years ago

#662 Tidying of sbc_cpl_ice_flx (mainly related to LIM2). There is still scope for cleaning up the use of ice fraction and lead fraction in the sbccpl routines, but best to wait until the LIM3 functionality is properly sorted.

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