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 @ 13814

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

Compiling version

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