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.
icethd_pnd.F90 in NEMO/branches/2020/SI3-05_MP/src/ICE – NEMO

source: NEMO/branches/2020/SI3-05_MP/src/ICE/icethd_pnd.F90 @ 13810

Last change on this file since 13810 was 13810, checked in by vancop, 3 years ago

Some quick fixes

  • Property svn:keywords set to Id
File size: 56.2 KB
Line 
1MODULE icethd_pnd 
2   !!======================================================================
3   !!                     ***  MODULE  icethd_pnd   ***
4   !!   sea-ice: Melt ponds on top of sea ice
5   !!======================================================================
6   !! history :       !  2012     (O. Lecomte)       Adaptation from Flocco and Turner
7   !!                 !  2017     (M. Vancoppenolle, O. Lecomte, C. Rousset) Implementation
8   !!            4.0  !  2018     (many people)      SI3 [aka Sea Ice cube]
9   !!----------------------------------------------------------------------
10#if defined key_si3
11   !!----------------------------------------------------------------------
12   !!   'key_si3' :                                     SI3 sea-ice model
13   !!----------------------------------------------------------------------
14   !!   ice_thd_pnd_init : some initialization and namelist read
15   !!   ice_thd_pnd      : main calling routine
16   !!----------------------------------------------------------------------
17   USE phycst         ! physical constants
18   USE dom_oce        ! ocean space and time domain
19   USE ice            ! sea-ice: variables
20   USE ice1D          ! sea-ice: thermodynamics variables
21   USE icetab         ! sea-ice: 1D <==> 2D transformation
22   !
23   USE in_out_manager ! I/O manager
24   USE lib_mpp        ! MPP library
25   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
26   USE timing         ! Timing
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   ice_thd_pnd_init    ! routine called by icestp.F90
32   PUBLIC   ice_thd_pnd         ! routine called by icestp.F90
33
34   INTEGER ::              nice_pnd    ! choice of the type of pond scheme
35   !                                   ! associated indices:
36   INTEGER, PARAMETER ::   np_pndNO   = 0   ! No pond scheme
37   INTEGER, PARAMETER ::   np_pndCST  = 1   ! Constant ice pond scheme
38   INTEGER, PARAMETER ::   np_pndLEV  = 2   ! Level ice pond scheme
39   INTEGER, PARAMETER ::   np_pndTOPO = 3   ! Level ice pond scheme
40
41   !! * Substitutions
42#  include "vectopt_loop_substitute.h90"
43   !!----------------------------------------------------------------------
44   !! NEMO/ICE 4.0 , NEMO Consortium (2018)
45   !! $Id$
46   !! Software governed by the CeCILL license (see ./LICENSE)
47   !!----------------------------------------------------------------------
48CONTAINS
49
50   SUBROUTINE ice_thd_pnd
51      !!-------------------------------------------------------------------
52      !!               ***  ROUTINE ice_thd_pnd   ***
53      !!               
54      !! ** Purpose :   change melt pond fraction and thickness
55      !!               
56      !!-------------------------------------------------------------------
57      !
58      SELECT CASE ( nice_pnd )
59      !
60      CASE (np_pndCST)   ;   CALL pnd_CST    !==  Constant melt ponds  ==!
61         !
62      CASE (np_pndLEV)   ;   CALL pnd_LEV    !==  Level ice melt ponds  ==!
63         !
64      CASE (np_pndTOPO)  ;   CALL pnd_TOPO   !==  Topographic melt ponds  ==!
65         !
66      END SELECT
67      !
68   END SUBROUTINE ice_thd_pnd 
69
70
71   SUBROUTINE pnd_CST 
72      !!-------------------------------------------------------------------
73      !!                ***  ROUTINE pnd_CST  ***
74      !!
75      !! ** Purpose :   Compute melt pond evolution
76      !!
77      !! ** Method  :   Melt pond fraction and thickness are prescribed
78      !!                to non-zero values when t_su = 0C
79      !!
80      !! ** Tunable parameters : pond fraction (rn_apnd), pond depth (rn_hpnd)
81      !!               
82      !! ** Note   : Coupling with such melt ponds is only radiative
83      !!             Advection, ridging, rafting... are bypassed
84      !!
85      !! ** References : Bush, G.W., and Trump, D.J. (2017)
86      !!-------------------------------------------------------------------
87      INTEGER  ::   ji        ! loop indices
88      !!-------------------------------------------------------------------
89      DO ji = 1, npti
90         !
91         IF( a_i_1d(ji) > 0._wp .AND. t_su_1d(ji) >= rt0 ) THEN
92            h_ip_1d(ji)      = rn_hpnd   
93            a_ip_1d(ji)      = rn_apnd * a_i_1d(ji)
94            h_il_1d(ji)      = 0._wp    ! no pond lids whatsoever
95         ELSE
96            h_ip_1d(ji)      = 0._wp   
97            a_ip_1d(ji)      = 0._wp
98            h_il_1d(ji)      = 0._wp
99         ENDIF
100         !
101      END DO
102      !
103   END SUBROUTINE pnd_CST
104
105
106   SUBROUTINE pnd_LEV
107      !!-------------------------------------------------------------------
108      !!                ***  ROUTINE pnd_LEV  ***
109      !!
110      !! ** Purpose : Compute melt pond evolution
111      !!
112      !! ** Method  : A fraction of meltwater is accumulated in ponds and sent to ocean when surface is freezing
113      !!              We  work with volumes and then redistribute changes into thickness and concentration
114      !!              assuming linear relationship between the two.
115      !!
116      !! ** Action  : - pond growth:      Vp = Vp + dVmelt                                          --- from Holland et al 2012 ---
117      !!                                     dVmelt = (1-r)/rhow * ( rhoi*dh_i + rhos*dh_s ) * a_i
118      !!                                        dh_i  = meltwater from ice surface melt
119      !!                                        dh_s  = meltwater from snow melt
120      !!                                        (1-r) = fraction of melt water that is not flushed
121      !!
122      !!              - limtations:       a_ip must not exceed (1-r)*a_i
123      !!                                  h_ip must not exceed 0.5*h_i
124      !!
125      !!              - pond shrinking:
126      !!                       if lids:   Vp = Vp -dH * a_ip
127      !!                                     dH = lid thickness change. Retrieved from this eq.:    --- from Flocco et al 2010 ---
128      !!
129      !!                                                                   rhoi * Lf * dH/dt = ki * MAX(Tp-Tsu,0) / H
130      !!                                                                      H = lid thickness
131      !!                                                                      Lf = latent heat of fusion
132      !!                                                                      Tp = -2C
133      !!
134      !!                                                                And solved implicitely as:
135      !!                                                                   H(t+dt)**2 -H(t) * H(t+dt) -ki * (Tp-Tsu) * dt / (rhoi*Lf) = 0
136      !!
137      !!                    if no lids:   Vp = Vp * exp(0.01*MAX(Tp-Tsu,0)/Tp)                      --- from Holland et al 2012 ---
138      !!
139      !!              - Flushing:         w = -perm/visc * rho_oce * grav * Hp / Hi                 --- from Flocco et al 2007 ---
140      !!                                     perm = permability of sea-ice
141      !!                                     visc = water viscosity
142      !!                                     Hp   = height of top of the pond above sea-level
143      !!                                     Hi   = ice thickness thru which there is flushing
144      !!
145      !!              - Corrections:      remove melt ponds when lid thickness is 10 times the pond thickness
146      !!
147      !!              - pond thickness and area is retrieved from pond volume assuming a linear relationship between h_ip and a_ip:
148      !!                                  a_ip/a_i = a_ip_frac = h_ip / zaspect
149      !!
150      !! ** Tunable parameters : ln_pnd_lids, rn_apnd_max, rn_apnd_min
151      !!
152      !! ** Note       :   mostly stolen from CICE
153      !!
154      !! ** References :   Flocco and Feltham (JGR, 2007)
155      !!                   Flocco et al       (JGR, 2010)
156      !!                   Holland et al      (J. Clim, 2012)
157      !!-------------------------------------------------------------------
158     
159      REAL(wp), DIMENSION(nlay_i) ::   ztmp           ! temporary array
160      !!
161      REAL(wp), PARAMETER ::   zaspect =  0.8_wp      ! pond aspect ratio
162      REAL(wp), PARAMETER ::   zTp     = -2._wp       ! reference temperature
163      REAL(wp), PARAMETER ::   zvisc   =  1.79e-3_wp  ! water viscosity
164      !!
165      REAL(wp) ::   zfr_mlt, zdv_mlt                  ! fraction and volume of available meltwater retained for melt ponding
166      REAL(wp) ::   zdv_frz, zdv_flush                ! Amount of melt pond that freezes, flushes
167      REAL(wp) ::   zhp                               ! heigh of top of pond lid wrt ssh
168      REAL(wp) ::   zv_ip_max                         ! max pond volume allowed
169      REAL(wp) ::   zdT                               ! zTp-t_su
170      REAL(wp) ::   zsbr                              ! Brine salinity
171      REAL(wp) ::   zperm                             ! permeability of sea ice
172      REAL(wp) ::   zfac, zdum                        ! temporary arrays
173      REAL(wp) ::   z1_rhow, z1_aspect, z1_Tp         ! inverse
174      !!
175      INTEGER  ::   ji, jk                            ! loop indices
176     
177      !!-------------------------------------------------------------------
178     
179      z1_rhow   = 1._wp / rhow 
180      z1_aspect = 1._wp / zaspect
181      z1_Tp     = 1._wp / zTp 
182
183      DO ji = 1, npti
184         !                                                            !----------------------------------------------------!
185         IF( h_i_1d(ji) < rn_himin .OR. a_i_1d(ji) < epsi10 ) THEN    ! Case ice thickness < rn_himin or tiny ice fraction !
186            !                                                         !----------------------------------------------------!
187            !--- Remove ponds on thin ice or tiny ice fractions
188            a_ip_1d(ji)      = 0._wp
189            h_ip_1d(ji)      = 0._wp
190            h_il_1d(ji)      = 0._wp
191            !                                                         !--------------------------------!
192         ELSE                                                         ! Case ice thickness >= rn_himin !
193            !                                                         !--------------------------------!
194            v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji)   ! retrieve volume from thickness
195            v_il_1d(ji) = h_il_1d(ji) * a_ip_1d(ji)
196            !
197            !------------------!
198            ! case ice melting !
199            !------------------!
200            !
201            !--- available meltwater for melt ponding ---!
202            zdum    = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji)
203            zfr_mlt = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i_1d(ji) !  = ( 1 - r ) = fraction of melt water that is not flushed
204            zdv_mlt = MAX( 0._wp, zfr_mlt * zdum ) ! >0, max for roundoff errors?
205            !
206            !--- overflow ---!
207            ! If pond area exceeds zfr_mlt * a_i_1d(ji) then reduce the pond volume
208            !    a_ip_max = zfr_mlt * a_i
209            !    => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as:
210            zv_ip_max = zfr_mlt**2 * a_i_1d(ji) * zaspect
211            zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) )
212
213            ! If pond depth exceeds half the ice thickness then reduce the pond volume
214            !    h_ip_max = 0.5 * h_i
215            !    => from zaspect = h_ip / (a_ip / a_i), set v_ip_max as:
216            zv_ip_max = z1_aspect * a_i_1d(ji) * 0.25 * h_i_1d(ji) * h_i_1d(ji) ! MV dimensions are wrong here or comment is unclear
217            zdv_mlt = MAX( 0._wp, MIN( zdv_mlt, zv_ip_max - v_ip_1d(ji) ) )
218           
219            !--- Pond growing ---!
220            v_ip_1d(ji) = v_ip_1d(ji) + zdv_mlt
221            !
222            !--- Lid melting ---!
223            IF( ln_pnd_lids )   v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) - zdv_mlt ) ! must be bounded by 0
224           
225            !
226            !--- mass flux ---!
227            IF( zdv_mlt > 0._wp ) THEN
228               ! MV add comment on what that mass flux means
229               ! water removed from fw flux due to melt pond growth
230               zfac = zdv_mlt * rhow * r1_rdtice                        ! melt pond mass flux < 0 [kg.m-2.s-1]
231               wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zfac
232               !
233               ! MV
234               ! why surface melt and snow fluxes must be adjusted is not clear
235               ! sounds like things are counted twice
236               !
237               zdum = zfac / ( wfx_snw_sum_1d(ji) + wfx_sum_1d(ji) )    ! adjust ice/snow melting flux > 0 to balance melt pond flux
238               wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) * (1._wp + zdum)
239               wfx_sum_1d(ji)     = wfx_sum_1d(ji)     * (1._wp + zdum)
240            ENDIF
241
242            !-------------------!
243            ! case ice freezing ! i.e. t_su_1d(ji) < (zTp+rt0)
244            !-------------------!
245            !
246            zdT = MAX( zTp+rt0 - t_su_1d(ji), 0._wp )
247            !
248            !--- Pond contraction (due to refreezing) ---!
249            IF( ln_pnd_lids ) THEN
250               !
251               !--- Lid growing and subsequent pond shrinking ---!
252               zdv_frz = 0.5_wp * MAX( 0._wp, -v_il_1d(ji) + & ! Flocco 2010 (eq. 5) solved implicitly as aH**2 + bH + c = 0
253                  &                    SQRT( v_il_1d(ji)**2 + a_ip_1d(ji)**2 * 4._wp * rcnd_i * zdT * rdt_ice / (rLfus * rhow) ) ) ! max for roundoff errors
254               
255               ! Lid growing
256               v_il_1d(ji) = MAX( 0._wp, v_il_1d(ji) + zdv_frz )
257               
258               ! Pond shrinking
259               v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) - zdv_frz )
260
261            ELSE
262               ! Pond shrinking
263               v_ip_1d(ji) = v_ip_1d(ji) * EXP( 0.01_wp * zdT * z1_Tp ) ! Holland 2012 (eq. 6)
264            ENDIF
265            !
266            !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac
267            ! v_ip     = h_ip * a_ip
268            ! a_ip/a_i = a_ip_frac = h_ip / zaspect (cf Holland 2012, fitting SHEBA so that knowing v_ip we can distribute it to a_ip and h_ip)
269            a_ip_1d(ji)      = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i
270            h_ip_1d(ji)      = zaspect * a_ip_1d(ji) / a_i_1d(ji)
271
272            !---------------!           
273            ! Pond flushing !
274            !---------------!
275            ! height of top of the pond above sea-level
276            zhp = ( h_i_1d(ji) * ( rau0 - rhoi ) + h_ip_1d(ji) * ( rau0 - rhow * a_ip_1d(ji) / a_i_1d(ji) ) ) * r1_rau0
277           
278            ! Calculate the permeability of the ice (Assur 1958, see Flocco 2010)
279            ! zsbr = - ( t_i_1d(ji,jk) - rt0 ) / rTmlt
280            DO jk = 1, nlay_i
281               zsbr = - 1.2_wp                                  &
282                  &   - 21.8_wp    * ( t_i_1d(ji,jk) - rt0 )    &
283                  &   - 0.919_wp   * ( t_i_1d(ji,jk) - rt0 )**2 &
284                  &   - 0.0178_wp  * ( t_i_1d(ji,jk) - rt0 )**3
285!               zsbr = - ( t_i_1d(ji,jk) - rt0 ) / rTmlt
286               ztmp(jk) = sz_i_1d(ji,jk) / zsbr 
287            END DO
288           
289            zperm = MAX( 0._wp, 3.e-08_wp * MINVAL(ztmp)**3 ) 
290           
291            ! Do the drainage using Darcy's law
292            zdv_flush   = -zperm * rau0 * grav * zhp * rdt_ice / (zvisc * h_i_1d(ji)) * a_ip_1d(ji)
293            zdv_flush   = MAX( zdv_flush, -v_ip_1d(ji) )
294            v_ip_1d(ji) = v_ip_1d(ji) + zdv_flush
295           
296            !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac
297            a_ip_1d(ji)      = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i
298            h_ip_1d(ji)      = zaspect * a_ip_1d(ji) / a_i_1d(ji)
299
300            !--- Corrections and lid thickness ---!
301            IF( ln_pnd_lids ) THEN
302               !--- retrieve lid thickness from volume ---!
303               IF( a_ip_1d(ji) > epsi10 ) THEN   ;   h_il_1d(ji) = v_il_1d(ji) / a_ip_1d(ji)
304               ELSE                              ;   h_il_1d(ji) = 0._wp
305               ENDIF
306               !--- remove ponds if lids are much larger than ponds ---!
307               IF ( h_il_1d(ji) > h_ip_1d(ji) * 10._wp ) THEN
308                  a_ip_1d(ji)      = 0._wp
309                  h_ip_1d(ji)      = 0._wp
310                  h_il_1d(ji)      = 0._wp
311               ENDIF
312            ENDIF
313            !
314         ENDIF
315         
316      END DO
317      !
318   END SUBROUTINE pnd_LEV
319   
320   SUBROUTINE pnd_TOPO    (aice,      aicen,     &
321                           vice,      vicen,     &
322                           vsnon,                &
323                           ticen,     salin,     &
324                           a_ip_frac, h_ip,      &
325                                      Tsfc )
326                                         
327      !!-------------------------------------------------------------------
328      !!                ***  ROUTINE pnd_TOPO  ***
329      !!
330      !! ** Purpose : Compute melt pond evolution
331      !!
332      !! ** Purpose :   Compute melt pond evolution based on the ice
333      !!                topography as inferred from the ice thickness
334      !!                distribution.
335      !!
336      !! ** Method  :   This code is initially based on Flocco and Feltham
337      !!                (2007) and Flocco et al. (2010). More to come...
338      !!
339      !! ** Tunable parameters :
340      !!
341      !! ** Note :
342      !!
343      !! ** References
344      !!    Flocco, D. and D. L. Feltham, 2007.  A continuum model of melt pond
345      !!    evolution on Arctic sea ice.  J. Geophys. Res. 112, C08016, doi:
346      !!    10.1029/2006JC003836.
347      !!    Flocco, D., D. L. Feltham and A. K. Turner, 2010.  Incorporation of
348      !!    a physically based melt pond scheme into the sea ice component of a
349      !!    climate model.  J. Geophys. Res. 115, C08012,
350      !!    doi: 10.1029/2009JC005568.
351      !!
352      !!-------------------------------------------------------------------
353
354       !js 190423: the lid on melt ponds appears only in the analog subroutine of CICE 5.1.2
355
356       REAL (wp), DIMENSION (jpi,jpj), &
357          INTENT(IN) :: &
358          aice, &    ! total ice area fraction
359          vice       ! total ice volume (m)
360
361       REAL (wp), DIMENSION (jpi,jpj,jpl), &
362          INTENT(IN) :: &
363          aicen, &   ! ice area fraction, per category
364          vsnon, &   ! snow volume, per category (m)
365          vicen      ! ice volume, per category (m)
366
367       REAL (wp), DIMENSION (jpi,jpj,nlay_i,jpl), &
368          INTENT(IN) :: &
369          ticen, &   ! ice temperature per category (K)
370          salin
371
372       REAL (wp), DIMENSION (jpi,jpj,jpl), &
373          INTENT(INOUT) :: &
374          a_ip_frac , &   ! pond area fraction of ice, per ice category
375          h_ip       ! pond depth, per ice category (m)
376
377       REAL (wp), DIMENSION (jpi,jpj,jpl), &
378          INTENT(IN) :: &
379          Tsfc       ! snow/sea ice surface temperature
380
381       ! local variables
382       REAL (wp), DIMENSION (jpi,jpj,jpl) :: &
383          zTsfcn, & ! ice/snow surface temperature (C)
384          zvolpn    ! pond volume per unit area, per category (m)
385
386       REAL (wp), DIMENSION (jpi,jpj,jpl) :: &
387          zrfrac, & ! fraction of available meltwater retained for melt ponding
388          zapondn,& ! pond area fraction, per category
389          zhpondn   ! pond depth, per category (m)
390
391       REAL (wp), DIMENSION (jpi,jpj) :: &
392          zvolp,    & ! total volume of pond, per unit area of pond (m)
393          zwfx_tmp    ! temporary array for melt water
394
395       REAL (wp) :: &
396          zhi,      & ! ice thickness (m)
397          zTavg,    & ! mean surface temperature across categories (C)
398          z1_rhow, & ! inverse freshwater density
399          zdTs,     & ! temperature difference for freeze-up (C)
400          zvpold,   & ! dummy pond volume
401          zdvn        ! change in melt pond volume for fresh water budget
402         
403       INTEGER, DIMENSION (jpi*jpj) :: &
404          indxi, indxj    ! compressed indices for cells with ice melting
405
406       INTEGER :: ij,icells,ji,jj,jl ! loop indices
407
408       REAL (wp), PARAMETER :: &
409          zr1_rlfus = 1._wp / 0.334e+6 / 917._wp , & ! (J/m^3)
410          zTp       = -0.15_wp, & ! pond freezing temperature (C)
411          zmin_volp = 1.e-4_wp, & ! minimum pond volume (m)
412          zrexp     = 0.01_wp,  & ! constant melt pond freeze-up rate
413          z01       = 0.01_wp,  &
414          z25       = 0.25_wp,  &
415          z5        = 0.5_wp
416
417      z1_rhow     = 1. / rhow
418
419      !---------------------------------------------------------------
420      ! Initialization
421      !---------------------------------------------------------------
422      zhpondn  (:,:,:) = 0._wp
423      zapondn  (:,:,:) = 0._wp
424      zvolpn   (:,:,:) = 0._wp
425
426      zTsfcn(:,:,:) = Tsfc(:,:,:) - rt0         ! Convert in Celsius
427
428      IF ( ln_pnd_fw ) THEN
429         v_ip_b(:,:,:) = v_ip(:,:,:)
430      ELSE
431         v_ip_b(:,:,:) = 0._wp
432      ENDIF
433
434      !------------------------------------------------------------------
435      ! Available melt water for melt ponding and corresponding fraction
436      !------------------------------------------------------------------
437      !js 03/05/19 unset restriction on sign of wfx_pnd_in;  mask values close to zero for future division
438      !wfx_pnd_in(:,:) = MAX( wfx_sum(:,:) + wfx_snw_sum(:,:), 0._wp )        ! available meltwater for melt ponding
439      !wfx_pnd_in(:,:) = MAX( wfx_sum(:,:) + wfx_snw_sum(:,:) , epsi10 ) * MAX( 0._wp, SIGN( 1._wp, wfx_sum(:,:) + wfx_snw_sum(:,:) - epsi10 ) )
440      !wfx_pnd_in(:,:) = (wfx_sum(:,:) + wfx_snw_sum(:,:)) * MAX( 0._wp, SIGN( 1._wp, ABS(wfx_sum(:,:) + wfx_snw_sum(:,:)) - epsi10 ) )
441
442      ! MV
443      ! NB: wfx_pnd_in can be slightly negative for very small values (why?)
444      ! This can in some occasions give negative
445      ! v_ip in the first category, which then gives crazy pond
446      ! fractions and crashes the code as soon as the melt-pond
447      ! radiative coupling is activated
448      ! if we understand and remove why wfx_sum or wfx_snw could be
449      ! negative, then, we can remove the MAX
450      ! NB: I now changed to wfx_snw_sum, this may fix the problem.
451      ! We should check
452
453
454      ! OLI 07/2017: when we (MV & OL) first started the inclusion of melt
455      ! ponds in the model, we removed the Holland et al. (2012, see
456      ! CESM scheme above) parameterization. I put it back here,
457      ! because I think it is needed. In summary, the sinks of FW for
458      ! ponds are: 1/ Runoff through cracks/leads => depends on the
459      !               total ice area only
460      !            2/ overflow, including Lüthje et al. (2006) limitation
461      !               (max a_ip fraction function of h_i). This is in
462      !               fact an other form of runoff that depends on the
463      !               ITD
464      !            3/ Flushing - losses by permeability
465      !            4/ Refreezing
466      !            5/ Removal of ponds on thin ice
467      ! I think 1 is needed because it is different from 2. However,
468      ! test runs should/could be done, to check the sensitivity and
469      ! the real usefulness of that stuff.
470      ! Note : the Holland et al. param was wrongly wired in NEMO3.1 (using
471      ! a_i instead of at_i), which might well explain why I had a too
472      ! weak melt pond cover in my simulations (compared to MODIS, in
473      ! situ obs. and CICE simulations.
474
475      !js 23/04/19: rewired back to a fraction with a_i
476      zrfrac(:,:,:) = rn_pnd_fracmin + ( rn_pnd_fracmax - rn_pnd_fracmin ) * aicen(:,:,:)
477      zwfx_tmp(:,:) = 0._wp
478
479! MV ---> use expression from level-ice ponds, clarify what is needed
480
481      !--- Add retained melt water to melt ponds
482      ! v_ip should never be negative, otherwise code crashes
483      ! Rq MV: as far as I saw, UM5 can create very small negative v_ip values
484      ! hence I added the max, which was not required with Prather (1 yr run)
485      ! OLI: Here I use vt_ip, so I don't know if the max is
486      ! required...
487      !zvolp(:,:) = MAX(vt_ip(:,:),0._wp) + zrfrac(:,:) * wfx_pnd_in(:,:) * z1_rhow * rdt_ice  ! Total available melt water, to be distributed as melt ponds
488      ! OLI: 07/2017 Bugfix above, removed " * aice(:,:)"
489      !js 19/04/18: change zrfrac to use aicen
490
491      zvolp(:,:) = vt_ip(:,:)
492
493      DO jl = 1, jpl
494         ! Melt water, to be distributed as melt ponds
495         zvolp(:,:) = zvolp(:,:) - zrfrac(:,:,jl)                                                  & 
496                                    * ( dh_i_pnd(:,:,jl)*rhoic + dh_s_pnd(:,:,jl)*rhosn )          & 
497                                    * z1_rhow * a_i(:,:,jl)
498      END DO
499
500! MV ---> use expression from level ice melt ponds (dv_mlt)
501
502      !js 03/05/19: we truncate negative values after calculating zvolp, in a
503      ! similar manner to the subroutine ice_thd_pnd_cesm. Variation dh_i_pnd and
504      ! dh_s_pnd are negative, indicating a loss of ice or snow. But we can expect them
505      ! to be negative for some reasons. We keep this behaviour as it is, for
506      ! fluxes conservation reasons. If some dh are positive, then we remove water
507      ! indirectly from the ponds.
508      zvolp(:,:) = MAX( zvolp(:,:) , 0._wp )
509
510
511      ! Fresh water flux going into the ponds
512      wfx_pnd_in(:,:) = wfx_pnd_in(:,:) + rhow * ( zvolp(:,:) - vt_ip(:,:) ) * r1_rdtice
513
514      !--- Remove retained meltwater from surface fluxes
515      IF ( ln_pnd_fw ) THEN
516         !wfx_snw_sum(:,:) = wfx_snw_sum(:,:) *  ( 1. - zrfrac(:,:) )
517         !wfx_sum(:,:)     = wfx_sum(:,:)     *  ( 1. - zrfrac(:,:) )
518
519         !js 190419: we change the code to use a_i in zrfrac. To be tested, but
520         !it should be conservative. zwfx_tmp is the flux accumulated in the
521         !ponds. wfx_pnd_in is the total surface melt fluxes.
522         zwfx_tmp(:,:) = MAX( wfx_sum(:,:) + wfx_snw_sum(:,:) , epsi10 )                           &
523            &            * MAX( 0._wp, SIGN( 1._wp, ABS(wfx_sum(:,:) + wfx_snw_sum(:,:)) - epsi10 ) )
524         WHERE ( ABS(zwfx_tmp(:,:)) > epsi10 )
525            zwfx_tmp(:,:) = wfx_pnd_in(:,:) / zwfx_tmp(:,:)
526         ELSEWHERE
527            zwfx_tmp(:,:) = 0._wp
528         ENDWHERE
529
530         wfx_sum(:,:)     = ( 1._wp - zwfx_tmp(:,:) ) * wfx_sum(:,:)
531         wfx_snw_sum(:,:) = ( 1._wp - zwfx_tmp(:,:) ) * wfx_snw_sum(:,:)
532      ENDIF
533
534       !-----------------------------------------------------------------
535       ! Identify grid cells with ponds
536       !-----------------------------------------------------------------
537
538       icells = 0
539       DO jj = 1, jpj
540         DO ji = 1, jpi
541            IF ( aice(ji,jj) > epsi10 ) THEN
542               zhi = vice(ji,jj) / aice(ji,jj)
543            ELSE
544               zhi = 0._wp
545            END IF
546
547            IF ( aice(ji,jj) > z01 .and. zhi > rn_himin .and. &
548                 zvolp(ji,jj) > zmin_volp*aice(ji,jj)) THEN
549               icells = icells + 1
550               indxi(icells) = ji
551               indxj(icells) = jj
552            ELSE  ! remove ponds on thin ice, or too small ponds
553               zvolpn(ji,jj,:) = 0._wp
554               zvolp (ji,jj) = 0._wp
555
556               a_ip(ji,jj,:)      = 0._wp
557               v_ip(ji,jj,:)      = 0._wp
558               a_ip_frac(ji,jj,:) = 0._wp
559               h_ip(ji,jj,:)      = 0._wp
560
561               vt_ip(ji,jj)       = 0._wp
562               at_ip(ji,jj)       = 0._wp
563
564!               IF ( ln_pnd_fw ) & !--- Give freshwater to the ocean
565!                   wfx_pnd_out(ji,jj)   = wfx_pnd_out(ji,jj) + zvolp(ji,jj) * rhow * r1_rdtice
566            END IF
567         END DO                     ! ji
568      END DO                     ! jj
569
570
571       DO ij = 1, icells
572       
573          ji = indxi(ij)
574          jj = indxj(ij)
575
576          !--------------------------------------------------------------
577          ! Shrink pond due to refreezing
578          !--------------------------------------------------------------
579          ! OLI 07/2017: Done like for empirical melt pond scheme (CESM).
580          ! Therefore, I chose to put this part of the code before the main
581          ! routines ice_thd_pnd_area/depth (contrary to the original code),
582          ! seeing the freeze-up as a global sink of
583          ! freshwater for melt ponds in the whole grid cell. If this was done
584          ! after, I would need to make an additional assumption on the shape of
585          ! melt ponds, which I don't want to do (for the CESM scheme, this
586          ! assumption was on the aspect ratio). So I remove some water due to
587          ! refreezing first (using zTavg instead of zTsfcn in each category) and
588          ! then let the FF07 routines do their job for the fractional areas and
589          ! depths of melt ponds.
590          ! The whole ice lid related stuff from FF07 was thus removed and replaced
591          ! by this. As mentionned below, this should be improved, but is much
592          ! easier to conserve heat and freshwater this way.
593
594          ! Average surface temperature is needed to compute freeze-up at the cell
595          ! scale
596          zTavg = 0._wp
597          DO jl = 1, jpl
598             zTavg = zTavg + zTsfcn(ji,jj,jl)*aicen(ji,jj,jl)
599          END DO
600          zTavg = zTavg / aice(ji,jj)
601
602          ! The freezing temperature for meltponds is assumed slightly below 0C,
603          ! as if meltponds had a little salt in them (hence the use of zTp).
604          ! The salt budget is not
605          ! altered for meltponds, but if it were then an actual pond freezing
606          ! temperature could be computed.
607
608          zdTs        = MAX ( zTp - zTavg, 0. )
609
610          zvpold      = zvolp(ji,jj)
611
612          zvolp(ji,jj)  = zvolp(ji,jj) * EXP( zrexp * zdTs / zTp )
613
614          !--- Dump meltwater due to refreezing ( of course this is wrong
615          !--- but this parameterization is too simple )
616!          IF ( ln_pnd_fw ) &
617!             wfx_pnd_out(ji,jj)   = wfx_pnd_out(ji,jj) + rhow * ( zvpold - zvolp(ji,jj) ) * r1_rdtice
618!             ! OLI 07/2017 : Bugfix above, zvpold - zvolp instead of the
619!             ! opposite, otherwise negative contribution
620
621          !--------------------------------------------------------------
622          ! calculate pond area and depth
623          !--------------------------------------------------------------
624          zdvn = 0._wp
625          CALL ice_thd_pnd_area(aice(ji,jj),vice(ji,jj), &
626                    aicen(ji,jj,:), vicen(ji,jj,:), vsnon(ji,jj,:), &
627                    ticen(ji,jj,:,:), salin(ji,jj,:,:), &
628                    zvolpn(ji,jj,:), zvolp(ji,jj), &
629                    zapondn(ji,jj,:),zhpondn(ji,jj,:), zdvn)
630          ! outputs are
631          ! - zdvn
632          ! - zvolpn
633          ! - zvolp
634          ! - zapondn
635          ! - zhpondn
636
637!          IF ( ln_pnd_fw ) &
638!             wfx_pnd_out(ji,jj) = wfx_pnd_out(ji,jj) + zdvn * rhow * r1_rdtice ! update flux from ponds to ocean
639
640          !---------------------------------------------------------------
641          ! Update pond volume and fraction
642          !---------------------------------------------------------------
643          DO jl = 1, jpl
644             a_ip(ji,jj,jl) = zapondn(ji,jj,jl)
645             v_ip(ji,jj,jl) = zvolpn(ji,jj,jl)
646             a_ip_frac(ji,jj,jl) = a_ip(ji,jj,jl) / MAX(aicen(ji,jj,jl), epsi10) &
647                                    * MAX(0._wp, SIGN(1._wp, aicen(ji,jj,jl) - epsi10))
648             h_ip     (ji,jj,jl) = zhpondn(ji,jj,jl)
649          END DO
650       END DO ! ij
651
652       IF ( ln_pnd_fw ) THEN
653          !js 15/05/19: water going out of the ponds give a positive freshwater
654          ! flux.
655          wfx_pnd_out(:,:) = SUM(MAX(0._wp, v_ip_b(:,:,:) - v_ip(:,:,:)), DIM=3) * rhow * r1_rdtice
656       ELSE
657         wfx_pnd_out(:,:) = 0._wp
658       ENDIF
659
660   END SUBROUTINE pnd_TOPO
661   
662       SUBROUTINE ice_thd_pnd_area(aice,  vice, &
663                           aicen, vicen, vsnon, ticen, &
664                           salin, zvolpn, zvolp,         &
665                           zapondn,zhpondn,dvolp)
666
667       !!-------------------------------------------------------------------
668       !!                ***  ROUTINE ice_thd_pnd_area ***
669       !!
670       !! ** Purpose : Given the total volume of meltwater, update
671       !!              pond fraction (a_ip) and depth (should be volume)
672       !!
673       !! **
674       !!
675       !!------------------------------------------------------------------
676
677       REAL (wp), INTENT(IN) :: &
678          aice, vice
679
680       REAL (wp), DIMENSION(jpl), INTENT(IN) :: &
681          aicen, vicen, vsnon
682
683       REAL (wp), DIMENSION(nlay_i,jpl), INTENT(IN) :: &
684          ticen, salin
685
686       REAL (wp), DIMENSION(jpl), INTENT(INOUT) :: &
687          zvolpn
688
689       REAL (wp), INTENT(INOUT) :: &
690          zvolp, dvolp
691
692       REAL (wp), DIMENSION(jpl), INTENT(OUT) :: &
693          zapondn, zhpondn
694
695       INTEGER :: &
696          n, ns,   &
697          m_index, &
698          permflag
699
700       REAL (wp), DIMENSION(jpl) :: &
701          hicen, &
702          hsnon, &
703          asnon, &
704          rhos,  &  ! OLI 07/2017 : for now this is useless, but will be useful with new snow scheme
705          alfan, &
706          betan, &
707          cum_max_vol, &
708          reduced_aicen
709
710       REAL (wp), DIMENSION(0:jpl) :: &
711          cum_max_vol_tmp
712
713       REAL (wp) :: &
714          hpond, &
715          drain, &
716          floe_weight, &
717          pressure_head, &
718          hsl_rel, &
719          deltah, &
720          perm, &
721          msno
722
723       REAL (wp), parameter :: &
724          viscosity = 1.79e-3_wp, &  ! kinematic water viscosity in kg/m/s
725          z0        = 0.0_wp    , &
726          c1        = 1.0_wp    , &
727          p4        = 0.4_wp    , &
728          p6        = 0.6_wp
729
730      !-----------|
731      !           |
732      !           |-----------|
733      !___________|___________|______________________________________sea-level
734      !           |           |
735      !           |           |---^--------|
736      !           |           |   |        |
737      !           |           |   |        |-----------|              |-------
738      !           |           |   |alfan(n)|           |              |
739      !           |           |   |        |           |--------------|
740      !           |           |   |        |           |              |
741      !---------------------------v-------------------------------------------
742      !           |           |   ^        |           |              |
743      !           |           |   |        |           |--------------|
744      !           |           |   |betan(n)|           |              |
745      !           |           |   |        |-----------|              |-------
746      !           |           |   |        |
747      !           |           |---v------- |
748      !           |           |
749      !           |-----------|
750      !           |
751      !-----------|
752
753       !-------------------------------------------------------------------
754       ! initialize
755       !-------------------------------------------------------------------
756
757       rhos(:) = rhosn ! OLI 07/2017 : same has above
758
759       DO n = 1, jpl
760
761          zapondn(n) = z0
762          zhpondn(n) = z0
763
764          !----------------------------------------
765          ! X) compute the effective snow fraction
766          !----------------------------------------
767          IF (aicen(n) < epsi10)  THEN
768             hicen(n) =  z0
769             hsnon(n) = z0
770             reduced_aicen(n) = z0
771             asnon(n) = z0          !js: in CICE 5.1.2: make sense as the compiler may not initiate the variables
772          ELSE
773             hicen(n) = vicen(n) / aicen(n)
774             hsnon(n) = vsnon(n) / aicen(n)
775             reduced_aicen(n) = c1 ! n=jpl
776
777             !js: initial code in NEMO_DEV
778             !IF (n < jpl) reduced_aicen(n) = aicen(n) &
779             !                     * (-0.024_wp*hicen(n) + 0.832_wp)
780
781             !js: from CICE 5.1.2: this limit reduced_aicen to 0.2 when hicen is too large
782             IF (n < jpl) reduced_aicen(n) = aicen(n) &
783                                  * max(0.2_wp,(-0.024_wp*hicen(n) + 0.832_wp))
784
785             asnon(n) = reduced_aicen(n)  ! effective snow fraction (empirical)
786             ! MV should check whether this makes sense to have the same effective snow fraction in here
787             ! OLI: it probably doesn't
788          END IF
789
790 ! This choice for alfa and beta ignores hydrostatic equilibium of categories.
791 ! Hydrostatic equilibium of the entire ITD is accounted for below, assuming
792 ! a surface topography implied by alfa=0.6 and beta=0.4, and rigidity across all
793 ! categories.  alfa and beta partition the ITD - they are areas not thicknesses!
794 ! Multiplying by hicen, alfan and betan (below) are thus volumes per unit area.
795 ! Here, alfa = 60% of the ice area (and since hice is constant in a category,
796 ! alfan = 60% of the ice volume) in each category lies above the reference line,
797 ! and 40% below. Note: p6 is an arbitrary choice, but alfa+beta=1 is required.
798
799 ! MV:
800 ! Note that this choice is not in the original FF07 paper and has been adopted in CICE
801 ! No reason why is explained in the doc, but I guess there is a reason. I'll try to investigate, maybe
802
803 ! Where does that choice come from ? => OLI : Coz' Chuck Norris said so...
804
805          alfan(n) = 0.6 * hicen(n)
806          betan(n) = 0.4 * hicen(n)
807
808          cum_max_vol(n)     = z0
809          cum_max_vol_tmp(n) = z0
810
811       END DO ! jpl
812
813       cum_max_vol_tmp(0) = z0
814       drain = z0
815       dvolp = z0
816
817       !----------------------------------------------------------
818       ! x) Drain overflow water, update pond fraction and volume
819       !----------------------------------------------------------
820
821       !--------------------------------------------------------------------------
822       ! the maximum amount of water that can be contained up to each ice category
823       !--------------------------------------------------------------------------
824
825       ! MV
826       ! If melt ponds are too deep to be sustainable given the ITD (OVERFLOW)
827       ! Then the excess volume cum_max_vol(jl) drains out of the system
828       ! It should be added to wfx_pnd_out
829       ! END MV
830       !js 18/04/19: XXX do something about this flux thing
831
832       DO n = 1, jpl-1 ! last category can not hold any volume
833
834          IF (alfan(n+1) >= alfan(n) .and. alfan(n+1) > z0) THEN
835
836             ! total volume in level including snow
837             cum_max_vol_tmp(n) = cum_max_vol_tmp(n-1) + &
838                (alfan(n+1) - alfan(n)) * sum(reduced_aicen(1:n))
839
840             ! subtract snow solid volumes from lower categories in current level
841             DO ns = 1, n
842                cum_max_vol_tmp(n) = cum_max_vol_tmp(n) &
843                   - rhos(ns)/rhow * &   ! free air fraction that can be filled by water
844                     asnon(ns)  * &    ! effective areal fraction of snow in that category
845                     max(min(hsnon(ns)+alfan(ns)-alfan(n), alfan(n+1)-alfan(n)), z0)
846             END DO
847
848          ELSE ! assume higher categories unoccupied
849             cum_max_vol_tmp(n) = cum_max_vol_tmp(n-1)
850          END IF
851          !IF (cum_max_vol_tmp(n) < z0) THEN
852          !   CALL abort_ice('negative melt pond volume')
853          !END IF
854       END DO
855       cum_max_vol_tmp(jpl) = cum_max_vol_tmp(jpl-1)  ! last category holds no volume
856       cum_max_vol  (1:jpl) = cum_max_vol_tmp(1:jpl)
857
858       !----------------------------------------------------------------
859       ! is there more meltwater than can be held in the floe?
860       !----------------------------------------------------------------
861       IF (zvolp >= cum_max_vol(jpl)) THEN
862          drain = zvolp - cum_max_vol(jpl) + epsi10
863          zvolp = zvolp - drain ! update meltwater volume available
864          dvolp = drain         ! this is the drained water
865          IF (zvolp < epsi10) THEN
866             dvolp = dvolp + zvolp
867             zvolp = z0
868          END IF
869       END IF
870
871       ! height and area corresponding to the remaining volume
872
873      CALL ice_thd_pnd_depth(reduced_aicen, asnon, hsnon, rhos, alfan, zvolp, cum_max_vol, hpond, m_index)
874
875       DO n=1, m_index
876          !zhpondn(n) = hpond - alfan(n) + alfan(1) ! here oui choulde update
877          !                                         !  volume instead, no ?
878          zhpondn(n) = max((hpond - alfan(n) + alfan(1)), z0)      !js: from CICE 5.1.2
879          zapondn(n) = reduced_aicen(n)
880          ! in practise, pond fraction depends on the empirical snow fraction
881          ! so in turn on ice thickness
882       END DO
883       !zapond = sum(zapondn(1:m_index))     !js: from CICE 5.1.2; not in Icepack1.1.0-6-gac6195d
884
885       !------------------------------------------------------------------------
886       ! Drainage through brine network (permeability)
887       !------------------------------------------------------------------------
888       !!! drainage due to ice permeability - Darcy's law
889
890       ! sea water level
891       msno = z0
892       DO n=1,jpl
893         msno = msno + vsnon(n) * rhos(n)
894       END DO
895       floe_weight = (msno + rhoic*vice + rau0*zvolp) / aice
896       hsl_rel = floe_weight / rau0 &
897               - ((sum(betan(:)*aicen(:))/aice) + alfan(1))
898
899       deltah = hpond - hsl_rel
900       pressure_head = grav * rau0 * max(deltah, z0)
901
902       ! drain if ice is permeable
903       permflag = 0
904       IF (pressure_head > z0) THEN
905          DO n = 1, jpl-1
906             IF (hicen(n) /= z0) THEN
907             !IF (hicen(n) > z0) THEN           !js: from CICE 5.1.2
908                perm = 0._wp ! MV ugly dummy patch
909                CALL ice_thd_pnd_perm(ticen(:,n), salin(:,n), perm)
910                IF (perm > z0) permflag = 1
911
912                drain = perm*zapondn(n)*pressure_head*rdt_ice / &
913                                         (viscosity*hicen(n))
914                dvolp = dvolp + min(drain, zvolp)
915                zvolp = max(zvolp - drain, z0)
916                IF (zvolp < epsi10) THEN
917                   dvolp = dvolp + zvolp
918                   zvolp = z0
919                END IF
920            END IF
921         END DO
922
923          ! adjust melt pond dimensions
924          IF (permflag > 0) THEN
925             ! recompute pond depth
926            CALL ice_thd_pnd_depth(reduced_aicen, asnon, hsnon, rhos, alfan, zvolp, cum_max_vol, hpond, m_index)
927             DO n=1, m_index
928                zhpondn(n) = hpond - alfan(n) + alfan(1)
929                zapondn(n) = reduced_aicen(n)
930             END DO
931             !zapond = sum(zapondn(1:m_index))       !js: from CICE 5.1.2; not in Icepack1.1.0-6-gac6195d
932          END IF
933       END IF ! pressure_head
934
935       !-------------------------------
936       ! X) remove water from the snow
937       !-------------------------------
938       !------------------------------------------------------------------------
939       ! total melt pond volume in category does not include snow volume
940       ! snow in melt ponds is not melted
941       !------------------------------------------------------------------------
942
943       ! Calculate pond volume for lower categories
944       DO n=1,m_index-1
945          zvolpn(n) = zapondn(n) * zhpondn(n) & ! what is not in the snow
946                   - (rhos(n)/rhow) * asnon(n) * min(hsnon(n), zhpondn(n))
947       END DO
948
949       ! Calculate pond volume for highest category = remaining pond volume
950
951       ! The following is completely unclear to Martin at least
952       ! Could we redefine properly and recode in a more readable way ?
953
954       ! m_index = last category with melt pond
955
956       IF (m_index == 1) zvolpn(m_index) = zvolp ! volume of mw in 1st category is the total volume of melt water
957
958       IF (m_index > 1) THEN
959         IF (zvolp > sum(zvolpn(1:m_index-1))) THEN
960           zvolpn(m_index) = zvolp - sum(zvolpn(1:m_index-1))
961         ELSE
962           zvolpn(m_index) = z0
963           zhpondn(m_index) = z0
964           zapondn(m_index) = z0
965           ! If remaining pond volume is negative reduce pond volume of
966           ! lower category
967           IF (zvolp+epsi10 < sum(zvolpn(1:m_index-1))) &
968             zvolpn(m_index-1) = zvolpn(m_index-1) - sum(zvolpn(1:m_index-1)) + zvolp
969         END IF
970       END IF
971
972       DO n=1,m_index
973          IF (zapondn(n) > epsi10) THEN
974              zhpondn(n) = zvolpn(n) / zapondn(n)
975          ELSE
976             dvolp = dvolp + zvolpn(n)
977             zhpondn(n) = z0
978             zvolpn(n) = z0
979             zapondn(n) = z0
980          END IF
981       END DO
982       DO n = m_index+1, jpl
983          zhpondn(n) = z0
984          zapondn(n) = z0
985          zvolpn (n) = z0
986       END DO
987
988    END SUBROUTINE ice_thd_pnd_area
989
990
991    SUBROUTINE ice_thd_pnd_depth(aicen, asnon, hsnon, rhos, alfan, zvolp, cum_max_vol, hpond, m_index)
992       !!-------------------------------------------------------------------
993       !!                ***  ROUTINE ice_thd_pnd_depth  ***
994       !!
995       !! ** Purpose :   Compute melt pond depth
996       !!-------------------------------------------------------------------
997
998       REAL (wp), DIMENSION(jpl), INTENT(IN) :: &
999          aicen, &
1000          asnon, &
1001          hsnon, &
1002          rhos,  &
1003          alfan, &
1004          cum_max_vol
1005
1006       REAL (wp), INTENT(IN) :: &
1007          zvolp
1008
1009       REAL (wp), INTENT(OUT) :: &
1010          hpond
1011
1012       INTEGER, INTENT(OUT) :: &
1013          m_index
1014
1015       INTEGER :: n, ns
1016
1017       REAL (wp), DIMENSION(0:jpl+1) :: &
1018          hitl, &
1019          aicetl
1020
1021       REAL (wp) :: &
1022          rem_vol, &
1023          area, &
1024          vol, &
1025          tmp, &
1026          z0   = 0.0_wp
1027
1028       !----------------------------------------------------------------
1029       ! hpond is zero if zvolp is zero - have we fully drained?
1030       !----------------------------------------------------------------
1031
1032       IF (zvolp < epsi10) THEN
1033        hpond = z0
1034        m_index = 0
1035       ELSE
1036
1037        !----------------------------------------------------------------
1038        ! Calculate the category where water fills up to
1039        !----------------------------------------------------------------
1040
1041        !----------|
1042        !          |
1043        !          |
1044        !          |----------|                                     -- --
1045        !__________|__________|_________________________________________ ^
1046        !          |          |             rem_vol     ^                | Semi-filled
1047        !          |          |----------|-- -- -- - ---|-- ---- -- -- --v layer
1048        !          |          |          |              |
1049        !          |          |          |              |hpond
1050        !          |          |          |----------|   |     |-------
1051        !          |          |          |          |   |     |
1052        !          |          |          |          |---v-----|
1053        !          |          | m_index  |          |         |
1054        !-------------------------------------------------------------
1055
1056        m_index = 0  ! 1:m_index categories have water in them
1057        DO n = 1, jpl
1058           IF (zvolp <= cum_max_vol(n)) THEN
1059              m_index = n
1060              IF (n == 1) THEN
1061                 rem_vol = zvolp
1062              ELSE
1063                 rem_vol = zvolp - cum_max_vol(n-1)
1064              END IF
1065              exit ! to break out of the loop
1066           END IF
1067        END DO
1068        m_index = min(jpl-1, m_index)
1069
1070        !----------------------------------------------------------------
1071        ! semi-filled layer may have m_index different snow in it
1072        !----------------------------------------------------------------
1073
1074        !-----------------------------------------------------------  ^
1075        !                                                             |  alfan(m_index+1)
1076        !                                                             |
1077        !hitl(3)-->                             |----------|          |
1078        !hitl(2)-->                |------------| * * * * *|          |
1079        !hitl(1)-->     |----------|* * * * * * |* * * * * |          |
1080        !hitl(0)-->-------------------------------------------------  |  ^
1081        !                various snow from lower categories          |  |alfa(m_index)
1082
1083        ! hitl - heights of the snow layers from thinner and current categories
1084        ! aicetl - area of each snow depth in this layer
1085
1086        hitl(:) = z0
1087        aicetl(:) = z0
1088        DO n = 1, m_index
1089           hitl(n)   = max(min(hsnon(n) + alfan(n) - alfan(m_index), &
1090                                  alfan(m_index+1) - alfan(m_index)), z0)
1091           aicetl(n) = asnon(n)
1092
1093           aicetl(0) = aicetl(0) + (aicen(n) - asnon(n))
1094        END DO
1095
1096        hitl(m_index+1) = alfan(m_index+1) - alfan(m_index)
1097        aicetl(m_index+1) = z0
1098
1099        !----------------------------------------------------------------
1100        ! reorder array according to hitl
1101        ! snow heights not necessarily in height order
1102        !----------------------------------------------------------------
1103
1104        DO ns = 1, m_index+1
1105           DO n = 0, m_index - ns + 1
1106              IF (hitl(n) > hitl(n+1)) THEN ! swap order
1107                 tmp = hitl(n)
1108                 hitl(n) = hitl(n+1)
1109                 hitl(n+1) = tmp
1110                 tmp = aicetl(n)
1111                 aicetl(n) = aicetl(n+1)
1112                 aicetl(n+1) = tmp
1113              END IF
1114           END DO
1115        END DO
1116
1117        !----------------------------------------------------------------
1118        ! divide semi-filled layer into set of sublayers each vertically homogenous
1119        !----------------------------------------------------------------
1120
1121        !hitl(3)----------------------------------------------------------------
1122        !                                                       | * * * * * * * *
1123        !                                                       |* * * * * * * * *
1124        !hitl(2)----------------------------------------------------------------
1125        !                                    | * * * * * * * *  | * * * * * * * *
1126        !                                    |* * * * * * * * * |* * * * * * * * *
1127        !hitl(1)----------------------------------------------------------------
1128        !                 | * * * * * * * *  | * * * * * * * *  | * * * * * * * *
1129        !                 |* * * * * * * * * |* * * * * * * * * |* * * * * * * * *
1130        !hitl(0)----------------------------------------------------------------
1131        !    aicetl(0)         aicetl(1)           aicetl(2)          aicetl(3)
1132
1133        ! move up over layers incrementing volume
1134        DO n = 1, m_index+1
1135
1136           area = sum(aicetl(:)) - &                 ! total area of sub-layer
1137                (rhos(n)/rau0) * sum(aicetl(n:jpl+1)) ! area of sub-layer occupied by snow
1138
1139           vol = (hitl(n) - hitl(n-1)) * area      ! thickness of sub-layer times area
1140
1141           IF (vol >= rem_vol) THEN  ! have reached the sub-layer with the depth within
1142              hpond = rem_vol / area + hitl(n-1) + alfan(m_index) - alfan(1)
1143
1144              exit
1145           ELSE  ! still in sub-layer below the sub-layer with the depth
1146              rem_vol = rem_vol - vol
1147           END IF
1148
1149        END DO
1150
1151       END IF
1152
1153    END SUBROUTINE ice_thd_pnd_depth
1154
1155
1156    SUBROUTINE ice_thd_pnd_perm(ticen, salin, perm)
1157       !!-------------------------------------------------------------------
1158       !!                ***  ROUTINE ice_thd_pnd_perm ***
1159       !!
1160       !! ** Purpose :   Determine the liquid fraction of brine in the ice
1161       !!                and its permeability
1162       !!-------------------------------------------------------------------
1163
1164       REAL (wp), DIMENSION(nlay_i), INTENT(IN) :: &
1165          ticen,  &     ! internal ice temperature (K)
1166          salin         ! salinity (ppt)     !js: ppt according to cice
1167
1168       REAL (wp), INTENT(OUT) :: &
1169          perm      ! permeability
1170
1171       REAL (wp) ::   &
1172          Sbr       ! brine salinity
1173
1174       REAL (wp), DIMENSION(nlay_i) ::   &
1175          Tin, &    ! ice temperature
1176          phi       ! liquid fraction
1177
1178       INTEGER :: k
1179
1180       !-----------------------------------------------------------------
1181       ! Compute ice temperatures from enthalpies using quadratic formula
1182       !-----------------------------------------------------------------
1183
1184       DO k = 1,nlay_i
1185          Tin(k) = ticen(k) - rt0   !js: from K to degC
1186       END DO
1187
1188       !-----------------------------------------------------------------
1189       ! brine salinity and liquid fraction
1190       !-----------------------------------------------------------------
1191
1192       DO k = 1, nlay_i
1193       
1194          Sbr    = - Tin(k) / rTmlt ! Consistent expression with SI3 (linear liquidus)
1195          ! Best expression to date is that one
1196          ! Sbr  = - 18.7 * Tin(k) − 0.519 * Tin(k)**2 − 0.00535 * Tin(k) ***3
1197          phi(k) = salin(k) / Sbr
1198         
1199       END DO
1200
1201       !-----------------------------------------------------------------
1202       ! permeability
1203       !-----------------------------------------------------------------
1204
1205       perm = 3.0e-08_wp * (minval(phi))**3 ! Golden et al. (2007)
1206
1207   END SUBROUTINE ice_thd_pnd_perm
1208   
1209   
1210!----------------------------------------------------------------------------------------------------------------------
1211
1212   SUBROUTINE ice_thd_pnd_init 
1213      !!-------------------------------------------------------------------
1214      !!                  ***  ROUTINE ice_thd_pnd_init   ***
1215      !!
1216      !! ** Purpose : Physical constants and parameters linked to melt ponds
1217      !!              over sea ice
1218      !!
1219      !! ** Method  :  Read the namthd_pnd  namelist and check the melt pond 
1220      !!               parameter values called at the first timestep (nit000)
1221      !!
1222      !! ** input   :   Namelist namthd_pnd 
1223      !!-------------------------------------------------------------------
1224      INTEGER  ::   ios, ioptio   ! Local integer
1225      !!
1226      NAMELIST/namthd_pnd/  ln_pnd, ln_pnd_LEV , rn_apnd_min, rn_apnd_max, &
1227         &                          ln_pnd_CST , rn_apnd, rn_hpnd,         &
1228         &                          ln_pnd_TOPO ,                          &
1229         &                          ln_pnd_lids, ln_pnd_alb
1230      !!-------------------------------------------------------------------
1231      !
1232      REWIND( numnam_ice_ref )              ! Namelist namthd_pnd  in reference namelist : Melt Ponds 
1233      READ  ( numnam_ice_ref, namthd_pnd, IOSTAT = ios, ERR = 901)
1234901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_pnd  in reference namelist' )
1235      REWIND( numnam_ice_cfg )              ! Namelist namthd_pnd  in configuration namelist : Melt Ponds
1236      READ  ( numnam_ice_cfg, namthd_pnd, IOSTAT = ios, ERR = 902 )
1237902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_pnd in configuration namelist' )
1238      IF(lwm) WRITE ( numoni, namthd_pnd )
1239      !
1240      IF(lwp) THEN                        ! control print
1241         WRITE(numout,*)
1242         WRITE(numout,*) 'ice_thd_pnd_init: ice parameters for melt ponds'
1243         WRITE(numout,*) '~~~~~~~~~~~~~~~~'
1244         WRITE(numout,*) '   Namelist namicethd_pnd:'
1245         WRITE(numout,*) '      Melt ponds activated or not                                 ln_pnd       = ', ln_pnd
1246         WRITE(numout,*) '         Topographic melt pond scheme                             ln_pnd_TOPO  = ', ln_pnd_TOPO
1247         WRITE(numout,*) '         Level ice melt pond scheme                               ln_pnd_LEV   = ', ln_pnd_LEV
1248         WRITE(numout,*) '            Minimum ice fraction that contributes to melt ponds   rn_apnd_min  = ', rn_apnd_min
1249         WRITE(numout,*) '            Maximum ice fraction that contributes to melt ponds   rn_apnd_max  = ', rn_apnd_max
1250         WRITE(numout,*) '         Constant ice melt pond scheme                            ln_pnd_CST   = ', ln_pnd_CST
1251         WRITE(numout,*) '            Prescribed pond fraction                              rn_apnd      = ', rn_apnd
1252         WRITE(numout,*) '            Prescribed pond depth                                 rn_hpnd      = ', rn_hpnd
1253         WRITE(numout,*) '         Frozen lids on top of melt ponds                         ln_pnd_lids  = ', ln_pnd_lids
1254         WRITE(numout,*) '         Melt ponds affect albedo or not                          ln_pnd_alb   = ', ln_pnd_alb
1255      ENDIF
1256      !
1257      !                             !== set the choice of ice pond scheme ==!
1258      ioptio = 0
1259      IF( .NOT.ln_pnd ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndNO     ;   ENDIF
1260      IF( ln_pnd_CST  ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndCST    ;   ENDIF
1261      IF( ln_pnd_LEV  ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndLEV    ;   ENDIF
1262      IF( ioptio /= 1 )   &
1263         & CALL ctl_stop( 'ice_thd_pnd_init: choose either none (ln_pnd=F) or only one pond scheme (ln_pnd_LEV or ln_pnd_CST)' )
1264      !
1265      SELECT CASE( nice_pnd )
1266      CASE( np_pndNO )         
1267         IF( ln_pnd_alb  ) THEN ; ln_pnd_alb  = .FALSE. ; CALL ctl_warn( 'ln_pnd_alb=false when no ponds' )  ; ENDIF
1268         IF( ln_pnd_lids ) THEN ; ln_pnd_lids = .FALSE. ; CALL ctl_warn( 'ln_pnd_lids=false when no ponds' ) ; ENDIF
1269      CASE( np_pndCST )         
1270         IF( ln_pnd_lids ) THEN ; ln_pnd_lids = .FALSE. ; CALL ctl_warn( 'ln_pnd_lids=false when constant ponds' ) ; ENDIF
1271      END SELECT
1272      !
1273   END SUBROUTINE ice_thd_pnd_init
1274   
1275#else
1276   !!----------------------------------------------------------------------
1277   !!   Default option          Empty module          NO SI3 sea-ice model
1278   !!----------------------------------------------------------------------
1279#endif 
1280
1281   !!======================================================================
1282END MODULE icethd_pnd 
Note: See TracBrowser for help on using the repository browser.