Line data Source code
1 : !=======================================================================
2 :
3 : ! Melt pond evolution based on the ice topography as inferred from
4 : ! the ice thickness distribution. This code is based on (but differs
5 : ! from) that described in
6 : !
7 : ! Flocco, D. and D. L. Feltham, 2007. A continuum model of melt pond
8 : ! evolution on Arctic sea ice. J. Geophys. Res. 112, C08016, doi:
9 : ! 10.1029/2006JC003836.
10 : !
11 : ! Flocco, D., D. L. Feltham and A. K. Turner, 2010. Incorporation of a
12 : ! physically based melt pond scheme into the sea ice component of a
13 : ! climate model. J. Geophys. Res. 115, C08012, doi: 10.1029/2009JC005568.
14 : !
15 : ! authors Daniela Flocco (UCL)
16 : ! Adrian Turner (UCL)
17 : ! 2010 ECH added module based on original code from Daniela Flocco, UCL
18 : ! 2012 DSCHR modifications
19 :
20 : module icepack_meltpond_topo
21 :
22 : use icepack_kinds
23 : use icepack_parameters, only: c0, c1, c2, p01, p1, p15, p4, p6
24 : use icepack_parameters, only: puny, viscosity_dyn, rhoi, rhos, rhow, Timelt, Lfresh
25 : use icepack_parameters, only: gravit, depressT, kice, ice_ref_salinity
26 : use icepack_warnings, only: warnstr, icepack_warnings_add
27 : use icepack_warnings, only: icepack_warnings_setabort, icepack_warnings_aborted
28 : use icepack_therm_shared, only: calculate_Tin_from_qin
29 :
30 : implicit none
31 :
32 : private
33 : public :: compute_ponds_topo
34 :
35 : !=======================================================================
36 :
37 : contains
38 :
39 : !=======================================================================
40 :
41 23057280 : subroutine compute_ponds_topo(dt, ncat, nilyr, &
42 : ktherm, heat_capacity, &
43 23057280 : aice, aicen, &
44 23057280 : vice, vicen, &
45 23057280 : vsno, vsnon, &
46 : meltt, &
47 : fsurf, fpond, &
48 23057280 : Tsfcn, Tf, &
49 23057280 : qicen, sicen, &
50 46114560 : apnd, hpnd, ipnd )
51 :
52 : integer (kind=int_kind), intent(in) :: &
53 : ncat , & ! number of thickness categories
54 : nilyr, & ! number of ice layers
55 : ktherm ! type of thermodynamics (0 0-layer, 1 BL99, 2 mushy)
56 :
57 : logical (kind=log_kind), intent(in) :: &
58 : heat_capacity ! if true, ice has nonzero heat capacity
59 : ! if false, use zero-layer thermodynamics
60 :
61 : real (kind=dbl_kind), intent(in) :: &
62 : dt ! time step (s)
63 :
64 : real (kind=dbl_kind), intent(in) :: &
65 : aice, & ! total ice area fraction
66 : vsno, & ! total snow volume (m)
67 : Tf ! ocean freezing temperature [= ice bottom temperature] (degC)
68 :
69 : real (kind=dbl_kind), intent(inout) :: &
70 : vice, & ! total ice volume (m)
71 : fpond ! fresh water flux to ponds (m)
72 :
73 : real (kind=dbl_kind), dimension (:), intent(in) :: &
74 : aicen, & ! ice area fraction, per category
75 : vsnon ! snow volume, per category (m)
76 :
77 : real (kind=dbl_kind), dimension (:), intent(inout) :: &
78 : vicen ! ice volume, per category (m)
79 :
80 : real (kind=dbl_kind), dimension (:), intent(in) :: &
81 : Tsfcn
82 :
83 : real (kind=dbl_kind), dimension (:,:), intent(in) :: &
84 : qicen, &
85 : sicen
86 :
87 : real (kind=dbl_kind), dimension (:), intent(inout) :: &
88 : apnd, &
89 : hpnd, &
90 : ipnd
91 :
92 : real (kind=dbl_kind), intent(in) :: &
93 : meltt, & ! total surface meltwater flux
94 : fsurf ! thermodynamic heat flux at ice/snow surface (W/m^2)
95 :
96 : ! local variables
97 :
98 : real (kind=dbl_kind), dimension (ncat) :: &
99 60525360 : volpn, & ! pond volume per unit area, per category (m)
100 60525360 : vuin ! water-equivalent volume of ice lid on melt pond ('upper ice', m)
101 :
102 : real (kind=dbl_kind), dimension (ncat) :: &
103 66289680 : apondn,& ! pond area fraction, per category
104 46114560 : hpondn ! pond depth, per category (m)
105 :
106 : real (kind=dbl_kind) :: &
107 2882160 : volp ! total volume of pond, per unit area of pond (m)
108 :
109 : real (kind=dbl_kind) :: &
110 2882160 : hi, & ! ice thickness (m)
111 2882160 : dHui, & ! change in thickness of ice lid (m)
112 2882160 : omega, & ! conduction
113 2882160 : dTice, & ! temperature difference across ice lid (C)
114 2882160 : dvice, & ! change in ice volume (m)
115 2882160 : Tavg, & ! mean surface temperature across categories (C)
116 2882160 : Tp, & ! pond freezing temperature (C)
117 2882160 : rhoi_L,& ! (J/m^3)
118 2882160 : dvn ! change in melt pond volume for fresh water budget
119 :
120 : integer (kind=int_kind) :: n ! loop indices
121 :
122 : real (kind=dbl_kind), parameter :: &
123 : hicemin = p1 , & ! minimum ice thickness with ponds (m)
124 : Td = p15 , & ! temperature difference for freeze-up (C)
125 : min_volp = 1.e-4_dbl_kind ! minimum pond volume (m)
126 :
127 : character(len=*),parameter :: subname='(compute_ponds_topo)'
128 :
129 : !---------------------------------------------------------------
130 : ! initialize
131 : !---------------------------------------------------------------
132 :
133 23057280 : volp = c0
134 23057280 : rhoi_L = Lfresh * rhoi ! (J/m^3)
135 :
136 161400960 : do n = 1, ncat
137 : ! load tracers
138 17292960 : volp = volp + hpnd(n) &
139 138343680 : * apnd(n) * aicen(n)
140 17292960 : vuin (n) = ipnd(n) &
141 138343680 : * apnd(n) * aicen(n)
142 :
143 138343680 : hpondn(n) = c0 ! pond depth, per category
144 161400960 : apondn(n) = c0 ! pond area, per category
145 : enddo
146 :
147 : ! The freezing temperature for meltponds is assumed slightly below 0C,
148 : ! as if meltponds had a little salt in them. The salt budget is not
149 : ! altered for meltponds, but if it were then an actual pond freezing
150 : ! temperature could be computed.
151 :
152 23057280 : Tp = Timelt - Td
153 :
154 : !-----------------------------------------------------------------
155 : ! Identify grid cells with ponds
156 : !-----------------------------------------------------------------
157 :
158 23057280 : hi = c0
159 23057280 : if (aice > puny) hi = vice/aice
160 23057280 : if ( aice > p01 .and. hi > hicemin .and. &
161 : volp > min_volp*aice) then
162 :
163 : !--------------------------------------------------------------
164 : ! calculate pond area and depth
165 : !--------------------------------------------------------------
166 : call pond_area(dt, ncat, nilyr, &
167 : ktherm, heat_capacity, &
168 : aice, vice, vsno, &
169 0 : aicen, vicen, vsnon, &
170 0 : qicen, sicen, &
171 0 : volpn, volp, &
172 0 : Tsfcn, Tf, &
173 1573 : apondn, hpondn, dvn )
174 1573 : if (icepack_warnings_aborted(subname)) return
175 :
176 1573 : fpond = fpond - dvn
177 :
178 : ! mean surface temperature
179 1573 : Tavg = c0
180 11011 : do n = 1, ncat
181 11011 : Tavg = Tavg + Tsfcn(n)*aicen(n)
182 : enddo
183 1573 : Tavg = Tavg / aice
184 :
185 11011 : do n = 1, ncat-1
186 :
187 9438 : if (vuin(n) > puny) then
188 :
189 : !----------------------------------------------------------------
190 : ! melting: floating upper ice layer melts in whole or part
191 : !----------------------------------------------------------------
192 : ! Use Tsfc for each category
193 836 : if (Tsfcn(n) > Tp) then
194 :
195 0 : dvice = min(meltt*apondn(n), vuin(n))
196 0 : if (dvice > puny) then
197 0 : vuin (n) = vuin (n) - dvice
198 0 : volpn(n) = volpn(n) + dvice
199 0 : volp = volp + dvice
200 0 : fpond = fpond + dvice
201 :
202 0 : if (vuin(n) < puny .and. volpn(n) > puny) then
203 : ! ice lid melted and category is pond covered
204 0 : volpn(n) = volpn(n) + vuin(n)
205 0 : fpond = fpond + vuin(n)
206 0 : vuin(n) = c0
207 : endif
208 0 : hpondn(n) = volpn(n) / apondn(n)
209 : endif
210 :
211 : !----------------------------------------------------------------
212 : ! freezing: existing upper ice layer grows
213 : !----------------------------------------------------------------
214 :
215 836 : else if (volpn(n) > puny) then ! Tsfcn(i,j,n) <= Tp
216 :
217 : ! differential growth of base of surface floating ice layer
218 434 : dTice = max(-Tsfcn(n)-Td, c0) ! > 0
219 434 : omega = kice*DTice/rhoi_L
220 48 : dHui = sqrt(c2*omega*dt + (vuin(n)/aicen(n))**2) &
221 434 : - vuin(n)/aicen(n)
222 :
223 434 : dvice = min(dHui*apondn(n), volpn(n))
224 434 : if (dvice > puny) then
225 434 : vuin (n) = vuin (n) + dvice
226 434 : volpn(n) = volpn(n) - dvice
227 434 : volp = volp - dvice
228 434 : fpond = fpond - dvice
229 434 : hpondn(n) = volpn(n) / apondn(n)
230 : endif
231 :
232 : endif ! Tsfcn(i,j,n)
233 :
234 : !----------------------------------------------------------------
235 : ! freezing: upper ice layer begins to form
236 : ! note: albedo does not change
237 : !----------------------------------------------------------------
238 : else ! vuin < puny
239 :
240 : ! thickness of newly formed ice
241 : ! the surface temperature of a meltpond is the same as that
242 : ! of the ice underneath (0C), and the thermodynamic surface
243 : ! flux is the same
244 7029 : dHui = max(-fsurf*dt/rhoi_L, c0)
245 7029 : dvice = min(dHui*apondn(n), volpn(n))
246 7029 : if (dvice > puny) then
247 1155 : vuin (n) = dvice
248 1155 : volpn(n) = volpn(n) - dvice
249 1155 : volp = volp - dvice
250 1155 : fpond = fpond - dvice
251 1155 : hpondn(n)= volpn(n) / apondn(n)
252 : endif
253 :
254 : endif ! vuin
255 :
256 : enddo ! ncat
257 :
258 : else ! remove ponds on thin ice
259 23055707 : fpond = fpond - volp
260 161389949 : volpn(:) = c0
261 161389949 : vuin (:) = c0
262 23055707 : volp = c0
263 : endif
264 :
265 : !---------------------------------------------------------------
266 : ! remove ice lid if there is no liquid pond
267 : ! vuin may be nonzero on category ncat due to dynamics
268 : !---------------------------------------------------------------
269 :
270 161400960 : do n = 1, ncat
271 17292960 : if (aicen(n) > puny .and. volpn(n) < puny &
272 138343680 : .and. vuin (n) > puny) then
273 1555 : vuin(n) = c0
274 : endif
275 :
276 : ! reload tracers
277 138343680 : if (apondn(n) > puny) then
278 1589 : ipnd(n) = vuin(n) / apondn(n)
279 : else
280 138342091 : vuin(n) = c0
281 138342091 : ipnd(n) = c0
282 : endif
283 161400960 : if (aicen(n) > puny) then
284 29876420 : apnd(n) = apondn(n) / aicen(n)
285 29876420 : hpnd(n) = hpondn(n)
286 : else
287 108467260 : apnd(n) = c0
288 108467260 : hpnd(n) = c0
289 108467260 : ipnd(n) = c0
290 : endif
291 : enddo ! n
292 :
293 : end subroutine compute_ponds_topo
294 :
295 : !=======================================================================
296 :
297 : ! Computes melt pond area, pond depth and melting rates
298 :
299 1573 : subroutine pond_area(dt, ncat, nilyr,&
300 : ktherm, heat_capacity, &
301 : aice, vice, vsno, &
302 1573 : aicen, vicen, vsnon,&
303 1573 : qicen, sicen, &
304 1573 : volpn, volp, &
305 1573 : Tsfcn, Tf, &
306 1573 : apondn,hpondn,dvolp )
307 :
308 : integer (kind=int_kind), intent(in) :: &
309 : ncat , & ! number of thickness categories
310 : nilyr, & ! number of ice layers
311 : ktherm ! type of thermodynamics (0 0-layer, 1 BL99, 2 mushy)
312 :
313 : logical (kind=log_kind), intent(in) :: &
314 : heat_capacity ! if true, ice has nonzero heat capacity
315 : ! if false, use zero-layer thermodynamics
316 :
317 : real (kind=dbl_kind), intent(in) :: &
318 : dt, aice, vice, vsno, Tf
319 :
320 : real (kind=dbl_kind), dimension(:), intent(in) :: &
321 : aicen, vicen, vsnon, Tsfcn
322 :
323 : real (kind=dbl_kind), dimension(:,:), intent(in) :: &
324 : qicen, &
325 : sicen
326 :
327 : real (kind=dbl_kind), dimension(:), intent(inout) :: &
328 : volpn
329 :
330 : real (kind=dbl_kind), intent(inout) :: &
331 : volp, dvolp
332 :
333 : real (kind=dbl_kind), dimension(:), intent(out) :: &
334 : apondn, hpondn
335 :
336 : ! local variables
337 :
338 : integer (kind=int_kind) :: &
339 : n, ns, &
340 : m_index, &
341 : permflag
342 :
343 : real (kind=dbl_kind), dimension(ncat) :: &
344 4111 : hicen, &
345 4111 : hsnon, &
346 4111 : asnon, &
347 4497 : alfan, &
348 4111 : betan, &
349 4111 : cum_max_vol, &
350 4111 : reduced_aicen
351 :
352 : real (kind=dbl_kind), dimension(0:ncat) :: &
353 3310 : cum_max_vol_tmp
354 :
355 : real (kind=dbl_kind) :: &
356 193 : hpond, &
357 193 : drain, &
358 193 : floe_weight, &
359 193 : pressure_head, &
360 193 : hsl_rel, &
361 193 : deltah, &
362 193 : perm
363 :
364 : character(len=*),parameter :: subname='(pond_area)'
365 :
366 : !-----------|
367 : ! |
368 : ! |-----------|
369 : !___________|___________|______________________________________sea-level
370 : ! | |
371 : ! | |---^--------|
372 : ! | | | |
373 : ! | | | |-----------| |-------
374 : ! | | |alfan(n)| | |
375 : ! | | | | |--------------|
376 : ! | | | | | |
377 : !---------------------------v-------------------------------------------
378 : ! | | ^ | | |
379 : ! | | | | |--------------|
380 : ! | | |betan(n)| | |
381 : ! | | | |-----------| |-------
382 : ! | | | |
383 : ! | |---v------- |
384 : ! | |
385 : ! |-----------|
386 : ! |
387 : !-----------|
388 :
389 : !-------------------------------------------------------------------
390 : ! initialize
391 : !-------------------------------------------------------------------
392 :
393 11011 : do n = 1, ncat
394 :
395 9438 : apondn(n) = c0
396 9438 : hpondn(n) = c0
397 :
398 9438 : if (aicen(n) < puny) then
399 0 : hicen(n) = c0
400 0 : hsnon(n) = c0
401 0 : reduced_aicen(n) = c0
402 0 : asnon(n) = c0
403 : else
404 9438 : hicen(n) = vicen(n) / aicen(n)
405 9438 : hsnon(n) = vsnon(n) / aicen(n)
406 9438 : reduced_aicen(n) = c1 ! n=ncat
407 9438 : if (n < ncat) reduced_aicen(n) = aicen(n) &
408 7865 : * max(0.2_dbl_kind,(-0.024_dbl_kind*hicen(n) + 0.832_dbl_kind))
409 9438 : asnon(n) = reduced_aicen(n)
410 : endif
411 :
412 : ! This choice for alfa and beta ignores hydrostatic equilibium of categories.
413 : ! Hydrostatic equilibium of the entire ITD is accounted for below, assuming
414 : ! a surface topography implied by alfa=0.6 and beta=0.4, and rigidity across all
415 : ! categories. alfa and beta partition the ITD - they are areas not thicknesses!
416 : ! Multiplying by hicen, alfan and betan (below) are thus volumes per unit area.
417 : ! Here, alfa = 60% of the ice area (and since hice is constant in a category,
418 : ! alfan = 60% of the ice volume) in each category lies above the reference line,
419 : ! and 40% below. Note: p6 is an arbitrary choice, but alfa+beta=1 is required.
420 :
421 9438 : alfan(n) = p6 * hicen(n)
422 9438 : betan(n) = p4 * hicen(n)
423 :
424 9438 : cum_max_vol(n) = c0
425 11011 : cum_max_vol_tmp(n) = c0
426 :
427 : enddo ! ncat
428 :
429 1573 : cum_max_vol_tmp(0) = c0
430 1573 : drain = c0
431 1573 : dvolp = c0
432 :
433 : !--------------------------------------------------------------------------
434 : ! the maximum amount of water that can be contained up to each ice category
435 : !--------------------------------------------------------------------------
436 :
437 9438 : do n = 1, ncat-1 ! last category can not hold any volume
438 :
439 7865 : if (alfan(n+1) >= alfan(n) .and. alfan(n+1) > c0) then
440 :
441 : ! total volume in level including snow
442 1930 : cum_max_vol_tmp(n) = cum_max_vol_tmp(n-1) + &
443 32425 : (alfan(n+1) - alfan(n)) * sum(reduced_aicen(1:n))
444 :
445 :
446 : ! subtract snow solid volumes from lower categories in current level
447 39325 : do ns = 1, n
448 2895 : cum_max_vol_tmp(n) = cum_max_vol_tmp(n) &
449 : - rhos/rhow * & ! fraction of snow that is occupied by solid
450 2895 : asnon(ns) * & ! area of snow from that category
451 31460 : max(min(hsnon(ns)+alfan(ns)-alfan(n), alfan(n+1)-alfan(n)), c0)
452 : ! thickness of snow from ns layer in n layer
453 : enddo
454 :
455 : else ! assume higher categories unoccupied
456 0 : cum_max_vol_tmp(n) = cum_max_vol_tmp(n-1)
457 : endif
458 9438 : if (cum_max_vol_tmp(n) < c0) then
459 0 : call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
460 0 : call icepack_warnings_add(subname//' topo ponds: negative melt pond volume')
461 0 : return
462 : endif
463 : enddo
464 1573 : cum_max_vol_tmp(ncat) = cum_max_vol_tmp(ncat-1) ! last category holds no volume
465 11011 : cum_max_vol (1:ncat) = cum_max_vol_tmp(1:ncat)
466 :
467 : !----------------------------------------------------------------
468 : ! is there more meltwater than can be held in the floe?
469 : !----------------------------------------------------------------
470 1573 : if (volp >= cum_max_vol(ncat)) then
471 0 : drain = volp - cum_max_vol(ncat) + puny
472 0 : volp = volp - drain
473 0 : dvolp = drain
474 0 : if (volp < puny) then
475 0 : dvolp = dvolp + volp
476 0 : volp = c0
477 : endif
478 : endif
479 :
480 : ! height and area corresponding to the remaining volume
481 :
482 0 : call calc_hpond(ncat, reduced_aicen, asnon, hsnon, &
483 1573 : alfan, volp, cum_max_vol, hpond, m_index)
484 1573 : if (icepack_warnings_aborted(subname)) return
485 :
486 3162 : do n=1, m_index
487 1589 : hpondn(n) = max((hpond - alfan(n) + alfan(1)), c0)
488 3162 : apondn(n) = reduced_aicen(n)
489 : enddo
490 :
491 : !------------------------------------------------------------------------
492 : ! drainage due to ice permeability - Darcy's law
493 : !------------------------------------------------------------------------
494 :
495 : ! sea water level
496 1573 : floe_weight = (vsno*rhos + rhoi*vice + rhow*volp) / aice
497 : hsl_rel = floe_weight / rhow &
498 11011 : - ((sum(betan(:)*aicen(:))/aice) + alfan(1))
499 :
500 1573 : deltah = hpond - hsl_rel
501 1573 : pressure_head = gravit * rhow * max(deltah, c0)
502 :
503 : ! drain if ice is permeable
504 1573 : permflag = 0
505 1573 : if (ktherm /= 2 .and. pressure_head > c0) then
506 2298 : do n = 1, ncat-1
507 2298 : if (hicen(n) > c0) then
508 : call permeability_phi(heat_capacity, nilyr, &
509 240 : qicen(:,n), sicen(:,n), Tsfcn(n), Tf, &
510 2155 : perm)
511 1915 : if (icepack_warnings_aborted(subname)) return
512 1915 : if (perm > c0) permflag = 1
513 1915 : drain = perm*apondn(n)*pressure_head*dt / (viscosity_dyn*hicen(n))
514 1915 : dvolp = dvolp + min(drain, volp)
515 1915 : volp = max(volp - drain, c0)
516 1915 : if (volp < puny) then
517 0 : dvolp = dvolp + volp
518 0 : volp = c0
519 : endif
520 : endif
521 : enddo
522 :
523 : ! adjust melt pond dimensions
524 383 : if (permflag > 0) then
525 : ! recompute pond depth
526 0 : call calc_hpond(ncat, reduced_aicen, asnon, hsnon, &
527 383 : alfan, volp, cum_max_vol, hpond, m_index)
528 383 : if (icepack_warnings_aborted(subname)) return
529 782 : do n=1, m_index
530 399 : hpondn(n) = hpond - alfan(n) + alfan(1)
531 782 : apondn(n) = reduced_aicen(n)
532 : enddo
533 : endif
534 : endif ! pressure_head
535 :
536 : !------------------------------------------------------------------------
537 : ! total melt pond volume in category does not include snow volume
538 : ! snow in melt ponds is not melted
539 : !------------------------------------------------------------------------
540 :
541 : ! Calculate pond volume for lower categories
542 1589 : do n=1,m_index-1
543 0 : volpn(n) = apondn(n) * hpondn(n) &
544 1589 : - (rhos/rhow) * asnon(n) * min(hsnon(n), hpondn(n))
545 : enddo
546 :
547 : ! Calculate pond volume for highest category = remaining pond volume
548 1573 : if (m_index == 1) volpn(m_index) = volp
549 1573 : if (m_index > 1) then
550 32 : if (volp > sum(volpn(1:m_index-1))) then
551 32 : volpn(m_index) = volp - sum(volpn(1:m_index-1))
552 : else
553 0 : volpn(m_index) = c0
554 0 : hpondn(m_index) = c0
555 0 : apondn(m_index) = c0
556 : ! If remaining pond volume is negative reduce pond volume of
557 : ! lower category
558 0 : if (volp+puny < sum(volpn(1:m_index-1))) &
559 0 : volpn(m_index-1) = volpn(m_index-1) - sum(volpn(1:m_index-1)) + &
560 0 : volp
561 : endif
562 : endif
563 :
564 3162 : do n=1,m_index
565 3162 : if (apondn(n) > puny) then
566 1589 : hpondn(n) = volpn(n) / apondn(n)
567 : else
568 0 : dvolp = dvolp + volpn(n)
569 0 : hpondn(n) = c0
570 0 : volpn(n) = c0
571 0 : apondn(n) = c0
572 : end if
573 : enddo
574 9422 : do n = m_index+1, ncat
575 7849 : hpondn(n) = c0
576 7849 : apondn(n) = c0
577 9422 : volpn (n) = c0
578 : enddo
579 :
580 : end subroutine pond_area
581 :
582 : !=======================================================================
583 :
584 3912 : subroutine calc_hpond(ncat, aicen, asnon, hsnon, &
585 3912 : alfan, volp, cum_max_vol, hpond, m_index)
586 :
587 : integer (kind=int_kind), intent(in) :: &
588 : ncat ! number of thickness categories
589 :
590 : real (kind=dbl_kind), dimension(:), intent(in) :: &
591 : aicen, &
592 : asnon, &
593 : hsnon, &
594 : alfan, &
595 : cum_max_vol
596 :
597 : real (kind=dbl_kind), intent(in) :: &
598 : volp
599 :
600 : real (kind=dbl_kind), intent(out) :: &
601 : hpond
602 :
603 : integer (kind=int_kind), intent(out) :: &
604 : m_index
605 :
606 : integer :: n, ns
607 :
608 : real (kind=dbl_kind), dimension(0:ncat+1) :: &
609 5599 : hitl, &
610 5599 : aicetl
611 :
612 : real (kind=dbl_kind) :: &
613 241 : rem_vol, &
614 241 : area, &
615 241 : vol, &
616 241 : tmp
617 :
618 : character(len=*),parameter :: subname='(calc_hpond)'
619 :
620 : !----------------------------------------------------------------
621 : ! hpond is zero if volp is zero - have we fully drained?
622 : !----------------------------------------------------------------
623 :
624 1956 : if (volp < puny) then
625 0 : hpond = c0
626 0 : m_index = 0
627 : else
628 :
629 : !----------------------------------------------------------------
630 : ! Calculate the category where water fills up to
631 : !----------------------------------------------------------------
632 :
633 : !----------|
634 : ! |
635 : ! |
636 : ! |----------| -- --
637 : !__________|__________|_________________________________________ ^
638 : ! | | rem_vol ^ | Semi-filled
639 : ! | |----------|-- -- -- - ---|-- ---- -- -- --v layer
640 : ! | | | |
641 : ! | | | |hpond
642 : ! | | |----------| | |-------
643 : ! | | | | | |
644 : ! | | | |---v-----|
645 : ! | | m_index | | |
646 : !-------------------------------------------------------------
647 :
648 1956 : m_index = 0 ! 1:m_index categories have water in them
649 1988 : do n = 1, ncat
650 1988 : if (volp <= cum_max_vol(n)) then
651 1956 : m_index = n
652 1956 : if (n == 1) then
653 1924 : rem_vol = volp
654 : else
655 32 : rem_vol = volp - cum_max_vol(n-1)
656 : endif
657 1956 : exit ! to break out of the loop
658 : endif
659 : enddo
660 1956 : m_index = min(ncat-1, m_index)
661 :
662 : !----------------------------------------------------------------
663 : ! semi-filled layer may have m_index different snows in it
664 : !----------------------------------------------------------------
665 :
666 : !----------------------------------------------------------- ^
667 : ! | alfan(m_index+1)
668 : ! |
669 : !hitl(3)--> |----------| |
670 : !hitl(2)--> |------------| * * * * *| |
671 : !hitl(1)--> |----------|* * * * * * |* * * * * | |
672 : !hitl(0)-->------------------------------------------------- | ^
673 : ! various snows from lower categories | |alfa(m_index)
674 :
675 : ! hitl - heights of the snow layers from thinner and current categories
676 : ! aicetl - area of each snow depth in this layer
677 :
678 17604 : hitl(:) = c0
679 17604 : aicetl(:) = c0
680 3944 : do n = 1, m_index
681 482 : hitl(n) = max(min(hsnon(n) + alfan(n) - alfan(m_index), &
682 2229 : alfan(m_index+1) - alfan(m_index)), c0)
683 1988 : aicetl(n) = asnon(n)
684 :
685 3944 : aicetl(0) = aicetl(0) + (aicen(n) - asnon(n))
686 : enddo
687 1956 : hitl(m_index+1) = alfan(m_index+1) - alfan(m_index)
688 1956 : aicetl(m_index+1) = c0
689 :
690 : !----------------------------------------------------------------
691 : ! reorder array according to hitl
692 : ! snow heights not necessarily in height order
693 : !----------------------------------------------------------------
694 :
695 5900 : do ns = 1, m_index+1
696 11864 : do n = 0, m_index - ns + 1
697 9908 : if (hitl(n) > hitl(n+1)) then ! swap order
698 0 : tmp = hitl(n)
699 0 : hitl(n) = hitl(n+1)
700 0 : hitl(n+1) = tmp
701 0 : tmp = aicetl(n)
702 0 : aicetl(n) = aicetl(n+1)
703 0 : aicetl(n+1) = tmp
704 : endif
705 : enddo
706 : enddo
707 :
708 : !----------------------------------------------------------------
709 : ! divide semi-filled layer into set of sublayers each vertically homogenous
710 : !----------------------------------------------------------------
711 :
712 : !hitl(3)----------------------------------------------------------------
713 : ! | * * * * * * * *
714 : ! |* * * * * * * * *
715 : !hitl(2)----------------------------------------------------------------
716 : ! | * * * * * * * * | * * * * * * * *
717 : ! |* * * * * * * * * |* * * * * * * * *
718 : !hitl(1)----------------------------------------------------------------
719 : ! | * * * * * * * * | * * * * * * * * | * * * * * * * *
720 : ! |* * * * * * * * * |* * * * * * * * * |* * * * * * * * *
721 : !hitl(0)----------------------------------------------------------------
722 : ! aicetl(0) aicetl(1) aicetl(2) aicetl(3)
723 :
724 : ! move up over layers incrementing volume
725 1956 : do n = 1, m_index+1
726 :
727 0 : area = sum(aicetl(:)) - & ! total area of sub-layer
728 31296 : (rhos/rhow) * sum(aicetl(n:ncat+1)) ! area of sub-layer occupied by snow
729 :
730 1956 : vol = (hitl(n) - hitl(n-1)) * area ! thickness of sub-layer times area
731 :
732 1956 : if (vol >= rem_vol) then ! have reached the sub-layer with the depth within
733 1956 : hpond = rem_vol / area + hitl(n-1) + alfan(m_index) - alfan(1)
734 1956 : exit
735 : else ! still in sub-layer below the sub-layer with the depth
736 0 : rem_vol = rem_vol - vol
737 : endif
738 :
739 : enddo
740 :
741 : endif
742 :
743 1956 : end subroutine calc_hpond
744 :
745 : !=======================================================================
746 :
747 : ! determine the liquid fraction of brine in the ice and the permeability
748 :
749 1915 : subroutine permeability_phi(heat_capacity, nilyr, &
750 1915 : qicen, sicen, Tsfcn, Tf, &
751 : perm)
752 :
753 : logical (kind=log_kind), intent(in) :: &
754 : heat_capacity ! if true, ice has nonzero heat capacity
755 : ! if false, use zero-layer thermodynamics
756 :
757 : integer (kind=int_kind), intent(in) :: &
758 : nilyr ! number of ice layers
759 :
760 : real (kind=dbl_kind), dimension(:), intent(in) :: &
761 : qicen, & ! energy of melting for each ice layer (J/m2)
762 : sicen ! salinity (ppt)
763 :
764 : real (kind=dbl_kind), intent(in) :: &
765 : Tsfcn, & ! sea ice surface skin temperature (degC)
766 : Tf ! ocean freezing temperature [= ice bottom temperature] (degC)
767 :
768 : real (kind=dbl_kind), intent(out) :: &
769 : perm ! permeability
770 :
771 : ! local variables
772 :
773 : real (kind=dbl_kind) :: &
774 240 : Tmlt, & ! melting temperature
775 240 : Sbr ! brine salinity
776 :
777 : real (kind=dbl_kind), dimension(nilyr) :: &
778 5270 : Tin, & ! ice temperature
779 4075 : phi ! liquid fraction
780 :
781 : integer (kind=int_kind) :: k
782 :
783 : character(len=*),parameter :: subname='(permeability_phi)'
784 :
785 : !-----------------------------------------------------------------
786 : ! Compute ice temperatures from enthalpies using quadratic formula
787 : ! NOTE this assumes Tmlt = Si * depressT
788 : !-----------------------------------------------------------------
789 :
790 1915 : if (heat_capacity) then
791 15320 : do k = 1,nilyr
792 13405 : Tmlt = -sicen(k) * depressT
793 15320 : Tin(k) = calculate_Tin_from_qin(qicen(k),Tmlt)
794 : enddo
795 : else
796 0 : Tin(1) = (Tsfcn + Tf) / c2
797 : endif
798 :
799 : !-----------------------------------------------------------------
800 : ! brine salinity and liquid fraction
801 : !-----------------------------------------------------------------
802 :
803 17235 : if (maxval(Tin) <= -c2) then
804 :
805 : ! Assur 1958
806 10112 : do k = 1,nilyr
807 : Sbr = - 1.2_dbl_kind &
808 1120 : -21.8_dbl_kind * Tin(k) &
809 1120 : - 0.919_dbl_kind * Tin(k)**2 &
810 8848 : - 0.01878_dbl_kind * Tin(k)**3
811 10112 : if (heat_capacity) then
812 8848 : phi(k) = sicen(k)/Sbr ! liquid fraction
813 : else
814 0 : phi(k) = ice_ref_salinity / Sbr ! liquid fraction
815 : endif
816 : enddo ! k
817 :
818 : else
819 :
820 : ! Notz 2005 thesis eq. 3.2
821 5208 : do k = 1,nilyr
822 560 : Sbr = -17.6_dbl_kind * Tin(k) &
823 560 : - 0.389_dbl_kind * Tin(k)**2 &
824 4557 : - 0.00362_dbl_kind* Tin(k)**3
825 4557 : if (Sbr == c0) then
826 0 : call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
827 0 : call icepack_warnings_add(subname//' topo ponds: zero brine salinity in permeability')
828 0 : return
829 : endif
830 5208 : if (heat_capacity) then
831 4557 : phi(k) = sicen(k) / Sbr ! liquid fraction
832 : else
833 0 : phi(k) = ice_ref_salinity / Sbr ! liquid fraction
834 : endif
835 :
836 : enddo
837 :
838 : endif
839 :
840 : !-----------------------------------------------------------------
841 : ! permeability
842 : !-----------------------------------------------------------------
843 :
844 17235 : perm = 3.0e-08_dbl_kind * (minval(phi))**3
845 :
846 : end subroutine permeability_phi
847 :
848 : !=======================================================================
849 :
850 : end module icepack_meltpond_topo
851 :
852 : !=======================================================================
|
