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

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

pre-test version

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