Line data Source code
1 : !=========================================================================
2 : !
3 : ! Update ice and snow internal temperatures and compute
4 : ! thermodynamic growth rates and atmospheric fluxes.
5 : !
6 : ! NOTE: The thermodynamic calculation is split in two for load balancing.
7 : ! First icepack_therm_vertical computes vertical growth rates and coupler
8 : ! fluxes. Then icepack_therm_itd does thermodynamic calculations not
9 : ! needed for coupling.
10 : !
11 : ! authors: William H. Lipscomb, LANL
12 : ! C. M. Bitz, UW
13 : ! Elizabeth C. Hunke, LANL
14 : !
15 : ! 2003: Vectorized by Clifford Chen (Fujitsu) and William Lipscomb
16 : ! 2004: Block structure added by William Lipscomb
17 : ! 2006: Streamlined for efficiency by Elizabeth Hunke
18 : ! Converted to free source form (F90)
19 :
20 : module icepack_therm_vertical
21 :
22 : use icepack_kinds
23 : use icepack_parameters, only: c0, c1, p001, p5, puny
24 : use icepack_parameters, only: pi, depressT, Lvap, hs_min, cp_ice, min_salin
25 : use icepack_parameters, only: cp_ocn, rhow, rhoi, rhos, Lfresh, rhofresh, ice_ref_salinity
26 : use icepack_parameters, only: ktherm, heat_capacity, calc_Tsfc
27 : use icepack_parameters, only: ustar_min, fbot_xfer_type, formdrag, calc_strair
28 : use icepack_parameters, only: rfracmin, rfracmax, pndaspect, dpscale, frzpnd
29 : use icepack_parameters, only: phi_i_mushy
30 :
31 : use icepack_tracers, only: tr_iage, tr_FY, tr_aero, tr_pond, tr_fsd, tr_iso
32 : use icepack_tracers, only: tr_pond_cesm, tr_pond_lvl, tr_pond_topo
33 : use icepack_tracers, only: n_aero, n_iso
34 :
35 : use icepack_therm_shared, only: ferrmax, l_brine
36 : use icepack_therm_shared, only: calculate_tin_from_qin, Tmin
37 : use icepack_therm_shared, only: hi_min
38 : use icepack_therm_bl99, only: temperature_changes
39 : use icepack_therm_0layer, only: zerolayer_temperature
40 : use icepack_therm_mushy, only: temperature_changes_salinity
41 :
42 : use icepack_warnings, only: warnstr, icepack_warnings_add
43 : use icepack_warnings, only: icepack_warnings_setabort, icepack_warnings_aborted
44 :
45 : use icepack_mushy_physics, only: icepack_mushy_temperature_mush
46 : use icepack_mushy_physics, only: liquidus_temperature_mush
47 : use icepack_mushy_physics, only: enthalpy_mush, enthalpy_of_melting
48 :
49 : use icepack_aerosol, only: update_aerosol
50 : use icepack_isotope, only: update_isotope
51 : use icepack_atmo, only: neutral_drag_coeffs, icepack_atm_boundary
52 : use icepack_age, only: increment_age
53 : use icepack_firstyear, only: update_FYarea
54 : use icepack_flux, only: set_sfcflux, merge_fluxes
55 : use icepack_meltpond_cesm, only: compute_ponds_cesm
56 : use icepack_meltpond_lvl, only: compute_ponds_lvl
57 : use icepack_meltpond_topo, only: compute_ponds_topo
58 :
59 : implicit none
60 :
61 : private
62 : public :: frzmlt_bottom_lateral, &
63 : thermo_vertical, &
64 : icepack_step_therm1
65 :
66 : !=======================================================================
67 :
68 : contains
69 :
70 : !=======================================================================
71 : !
72 : ! Driver for updating ice and snow internal temperatures and
73 : ! computing thermodynamic growth rates and atmospheric fluxes.
74 : !
75 : ! authors: William H. Lipscomb, LANL
76 : ! C. M. Bitz, UW
77 :
78 765790051 : subroutine thermo_vertical (nilyr, nslyr, &
79 : dt, aicen, &
80 : vicen, vsnon, &
81 765790051 : Tsf, zSin, &
82 765790051 : zqin, zqsn, &
83 : apond, hpond, &
84 : tr_pond_topo,&
85 : flw, potT, &
86 : Qa, rhoa, &
87 : fsnow, fpond, &
88 : fbot, Tbot, &
89 : Tsnice, sss, &
90 : lhcoef, shcoef, &
91 : fswsfc, fswint, &
92 765790051 : Sswabs, Iswabs, &
93 : fsurfn, fcondtopn, &
94 : fcondbotn, &
95 : fsensn, flatn, &
96 : flwoutn, evapn, &
97 : evapsn, evapin, &
98 : freshn, fsaltn, &
99 : fhocnn, meltt, &
100 : melts, meltb, &
101 : congel, snoice, &
102 : mlt_onset, frz_onset, &
103 : yday, dsnow, &
104 : prescribed_ice)
105 :
106 : integer (kind=int_kind), intent(in) :: &
107 : nilyr , & ! number of ice layers
108 : nslyr ! number of snow layers
109 :
110 : real (kind=dbl_kind), intent(in) :: &
111 : dt ! time step
112 :
113 : ! ice state variables
114 : real (kind=dbl_kind), intent(inout) :: &
115 : aicen , & ! concentration of ice
116 : vicen , & ! volume per unit area of ice (m)
117 : vsnon ! volume per unit area of snow (m)
118 :
119 : ! tracers
120 : real (kind=dbl_kind), intent(inout) :: &
121 : Tsf , & ! ice/snow top surface temp, same as Tsfcn (deg C)
122 : apond , & ! melt pond area fraction
123 : hpond ! melt pond depth (m)
124 : ! iage ! ice age (s)
125 :
126 : logical (kind=log_kind), intent(in) :: &
127 : tr_pond_topo ! if .true., use melt pond tracer
128 :
129 : logical (kind=log_kind), intent(in), optional :: &
130 : prescribed_ice ! if .true., use prescribed ice instead of computed
131 :
132 : real (kind=dbl_kind), dimension (:), intent(inout) :: &
133 : zqsn , & ! snow layer enthalpy, zqsn < 0 (J m-3)
134 : zqin , & ! ice layer enthalpy, zqin < 0 (J m-3)
135 : zSin ! internal ice layer salinities
136 :
137 : ! input from atmosphere
138 : real (kind=dbl_kind), &
139 : intent(in) :: &
140 : flw , & ! incoming longwave radiation (W/m^2)
141 : potT , & ! air potential temperature (K)
142 : Qa , & ! specific humidity (kg/kg)
143 : rhoa , & ! air density (kg/m^3)
144 : fsnow , & ! snowfall rate (kg m-2 s-1)
145 : shcoef , & ! transfer coefficient for sensible heat
146 : lhcoef ! transfer coefficient for latent heat
147 :
148 : real (kind=dbl_kind), &
149 : intent(inout) :: &
150 : fswsfc , & ! SW absorbed at ice/snow surface (W m-2)
151 : fswint , & ! SW absorbed in ice interior, below surface (W m-2)
152 : fpond ! fresh water flux to ponds (kg/m^2/s)
153 :
154 : real (kind=dbl_kind), dimension (:), intent(inout) :: &
155 : Sswabs , & ! SW radiation absorbed in snow layers (W m-2)
156 : Iswabs ! SW radiation absorbed in ice layers (W m-2)
157 :
158 : ! input from ocean
159 : real (kind=dbl_kind), intent(in) :: &
160 : fbot , & ! ice-ocean heat flux at bottom surface (W/m^2)
161 : Tbot , & ! ice bottom surface temperature (deg C)
162 : sss ! ocean salinity
163 :
164 : ! coupler fluxes to atmosphere
165 : real (kind=dbl_kind), intent(out):: &
166 : flwoutn , & ! outgoing longwave radiation (W/m^2)
167 : evapn , & ! evaporative water flux (kg/m^2/s)
168 : evapsn , & ! evaporative water flux over snow (kg/m^2/s)
169 : evapin ! evaporative water flux over ice (kg/m^2/s)
170 :
171 : ! Note: these are intent out if calc_Tsfc = T, otherwise intent in
172 : real (kind=dbl_kind), intent(inout):: &
173 : fsensn , & ! sensible heat flux (W/m^2)
174 : flatn , & ! latent heat flux (W/m^2)
175 : fsurfn , & ! net flux to top surface, excluding fcondtopn
176 : fcondtopn, & ! downward cond flux at top surface (W m-2)
177 : fcondbotn ! downward cond flux at bottom surface (W m-2)
178 :
179 : ! coupler fluxes to ocean
180 : real (kind=dbl_kind), intent(out):: &
181 : freshn , & ! fresh water flux to ocean (kg/m^2/s)
182 : fsaltn , & ! salt flux to ocean (kg/m^2/s)
183 : fhocnn ! net heat flux to ocean (W/m^2)
184 :
185 : ! diagnostic fields
186 : real (kind=dbl_kind), &
187 : intent(inout):: &
188 : Tsnice , & ! snow ice interface temperature (deg C)
189 : meltt , & ! top ice melt (m/step-->cm/day)
190 : melts , & ! snow melt (m/step-->cm/day)
191 : meltb , & ! basal ice melt (m/step-->cm/day)
192 : congel , & ! basal ice growth (m/step-->cm/day)
193 : snoice , & ! snow-ice formation (m/step-->cm/day)
194 : dsnow , & ! change in snow thickness (m/step-->cm/day)
195 : mlt_onset, & ! day of year that sfc melting begins
196 : frz_onset ! day of year that freezing begins (congel or frazil)
197 :
198 : real (kind=dbl_kind), intent(in) :: &
199 : yday ! day of year
200 :
201 : ! local variables
202 :
203 : integer (kind=int_kind) :: &
204 : k ! ice layer index
205 :
206 : real (kind=dbl_kind) :: &
207 54309042 : dhi , & ! change in ice thickness
208 54309042 : dhs ! change in snow thickness
209 :
210 : ! 2D state variables (thickness, temperature)
211 :
212 : real (kind=dbl_kind) :: &
213 54309042 : hilyr , & ! ice layer thickness
214 54309042 : hslyr , & ! snow layer thickness
215 54309042 : hin , & ! ice thickness (m)
216 54309042 : hsn , & ! snow thickness (m)
217 54309042 : hsn_new , & ! thickness of new snow (m)
218 54309042 : worki , & ! local work array
219 54309042 : works ! local work array
220 :
221 : real (kind=dbl_kind), dimension (nilyr) :: &
222 1858615190 : zTin ! internal ice layer temperatures
223 :
224 : real (kind=dbl_kind), dimension (nslyr) :: &
225 874408135 : zTsn ! internal snow layer temperatures
226 :
227 : ! other 2D flux and energy variables
228 :
229 : real (kind=dbl_kind) :: &
230 54309042 : einit , & ! initial energy of melting (J m-2)
231 54309042 : efinal , & ! final energy of melting (J m-2)
232 54309042 : einter ! intermediate energy
233 :
234 : real (kind=dbl_kind) :: &
235 54309042 : fadvocn ! advective heat flux to ocean
236 :
237 : character(len=*),parameter :: subname='(thermo_vertical)'
238 :
239 : !-----------------------------------------------------------------
240 : ! Initialize
241 : !-----------------------------------------------------------------
242 :
243 765790051 : flwoutn = c0
244 765790051 : evapn = c0
245 765790051 : evapsn = c0
246 765790051 : evapin = c0
247 765790051 : freshn = c0
248 765790051 : fsaltn = c0
249 765790051 : fhocnn = c0
250 765790051 : fadvocn = c0
251 :
252 765790051 : meltt = c0
253 765790051 : meltb = c0
254 765790051 : melts = c0
255 765790051 : congel = c0
256 765790051 : snoice = c0
257 765790051 : dsnow = c0
258 1531580102 : zTsn(:) = c0
259 5474519618 : zTin(:) = c0
260 :
261 765790051 : if (calc_Tsfc) then
262 739377182 : fsensn = c0
263 739377182 : flatn = c0
264 739377182 : fsurfn = c0
265 739377182 : fcondtopn = c0
266 : endif
267 :
268 : !-----------------------------------------------------------------
269 : ! Compute variables needed for vertical thermo calculation
270 : !-----------------------------------------------------------------
271 :
272 : call init_vertical_profile (nilyr, nslyr, &
273 : aicen, &
274 : vicen, vsnon, &
275 : hin, hilyr, &
276 : hsn, hslyr, &
277 0 : zqin, zTin, &
278 0 : zqsn, zTsn, &
279 0 : zSin, &
280 765790051 : einit )
281 765790051 : if (icepack_warnings_aborted(subname)) return
282 :
283 : ! Save initial ice and snow thickness (for fresh and fsalt)
284 765790051 : worki = hin
285 765790051 : works = hsn
286 :
287 : !-----------------------------------------------------------------
288 : ! Compute new surface temperature and internal ice and snow
289 : ! temperatures.
290 : !-----------------------------------------------------------------
291 :
292 765790051 : if (heat_capacity) then ! usual case
293 :
294 657156586 : if (ktherm == 2) then
295 :
296 : call temperature_changes_salinity(dt, &
297 : nilyr, nslyr, &
298 : rhoa, flw, &
299 : potT, Qa, &
300 : shcoef, lhcoef, &
301 : fswsfc, fswint, &
302 0 : Sswabs, Iswabs, &
303 : hilyr, hslyr, &
304 : apond, hpond, &
305 0 : zqin, zTin, &
306 0 : zqsn, zTsn, &
307 0 : zSin, &
308 : Tsf, Tbot, &
309 : sss, &
310 : fsensn, flatn, &
311 : flwoutn, fsurfn, &
312 : fcondtopn, fcondbotn, &
313 609320240 : fadvocn, snoice)
314 609320240 : if (icepack_warnings_aborted(subname)) return
315 :
316 : else ! ktherm
317 :
318 : call temperature_changes(dt, &
319 : nilyr, nslyr, &
320 : rhoa, flw, &
321 : potT, Qa, &
322 : shcoef, lhcoef, &
323 : fswsfc, fswint, &
324 0 : Sswabs, Iswabs, &
325 : hilyr, hslyr, &
326 0 : zqin, zTin, &
327 0 : zqsn, zTsn, &
328 0 : zSin, &
329 : Tsf, Tbot, &
330 : fsensn, flatn, &
331 : flwoutn, fsurfn, &
332 : fcondtopn, fcondbotn, &
333 47836346 : einit )
334 47836346 : if (icepack_warnings_aborted(subname)) return
335 :
336 : endif ! ktherm
337 :
338 : else
339 :
340 108633465 : if (calc_Tsfc) then
341 :
342 : call zerolayer_temperature(nilyr, nslyr, &
343 : rhoa, flw, &
344 : potT, Qa, &
345 : shcoef, lhcoef, &
346 : fswsfc, &
347 : hilyr, hslyr, &
348 : Tsf, Tbot, &
349 : fsensn, flatn, &
350 : flwoutn, fsurfn, &
351 108633465 : fcondtopn, fcondbotn )
352 108633465 : if (icepack_warnings_aborted(subname)) return
353 :
354 : else
355 :
356 : !------------------------------------------------------------
357 : ! Set fcondbot = fcondtop for zero layer thermodynamics
358 : ! fcondtop is set in call to set_sfcflux in step_therm1
359 : !------------------------------------------------------------
360 :
361 0 : fcondbotn = fcondtopn ! zero layer
362 :
363 : endif ! calc_Tsfc
364 :
365 : endif ! heat_capacity
366 :
367 : ! intermediate energy for error check
368 :
369 765790051 : einter = c0
370 1531580102 : do k = 1, nslyr
371 1531580102 : einter = einter + hslyr * zqsn(k)
372 : enddo ! k
373 5474519618 : do k = 1, nilyr
374 5474519618 : einter = einter + hilyr * zqin(k)
375 : enddo ! k
376 :
377 765790051 : Tsnice = c0
378 765790051 : if ((hslyr+hilyr) > puny) then
379 765790051 : if (hslyr > puny) then
380 636878016 : Tsnice = (hslyr*zTsn(nslyr) + hilyr*zTin(1)) / (hslyr+hilyr)
381 : else
382 128912035 : Tsnice = Tsf
383 : endif
384 : endif
385 :
386 765790051 : if (icepack_warnings_aborted(subname)) return
387 :
388 : !-----------------------------------------------------------------
389 : ! Compute growth and/or melting at the top and bottom surfaces.
390 : ! Add new snowfall.
391 : ! Repartition ice into equal-thickness layers, conserving energy.
392 : !-----------------------------------------------------------------
393 :
394 : call thickness_changes(nilyr, nslyr, &
395 : dt, yday, &
396 : efinal, &
397 : hin, hilyr, &
398 : hsn, hslyr, &
399 0 : zqin, zqsn, &
400 : fbot, Tbot, &
401 : flatn, fsurfn, &
402 : fcondtopn, fcondbotn, &
403 : fsnow, hsn_new, &
404 : fhocnn, evapn, &
405 : evapsn, evapin, &
406 : meltt, melts, &
407 : meltb, &
408 : congel, snoice, &
409 : mlt_onset, frz_onset, &
410 0 : zSin, sss, &
411 765790051 : dsnow)
412 765790051 : if (icepack_warnings_aborted(subname)) return
413 :
414 : !-----------------------------------------------------------------
415 : ! Check for energy conservation by comparing the change in energy
416 : ! to the net energy input
417 : !-----------------------------------------------------------------
418 :
419 : call conservation_check_vthermo(dt, &
420 : fsurfn, flatn, &
421 : fhocnn, fswint, &
422 : fsnow, einit, &
423 : einter, efinal, &
424 : fcondtopn, fcondbotn, &
425 765790051 : fadvocn, fbot )
426 765790051 : if (icepack_warnings_aborted(subname)) return
427 :
428 : !-----------------------------------------------------------------
429 : ! If prescribed ice, set hi back to old values
430 : !-----------------------------------------------------------------
431 :
432 : #ifdef CESMCOUPLED
433 : if (present(prescribed_ice)) then
434 : if (prescribed_ice) then
435 : hin = worki
436 : fhocnn = c0 ! for diagnostics
437 : endif
438 : endif
439 : #endif
440 :
441 : !-----------------------------------------------------------------
442 : ! Compute fluxes of water and salt from ice to ocean.
443 : ! evapn < 0 => sublimation, evapn > 0 => condensation
444 : ! aerosol flux is accounted for in icepack_aerosol.F90
445 : !-----------------------------------------------------------------
446 :
447 765790051 : dhi = hin - worki
448 765790051 : dhs = hsn - works - hsn_new
449 :
450 765790051 : freshn = freshn + evapn - (rhoi*dhi + rhos*dhs) / dt
451 765790051 : fsaltn = fsaltn - rhoi*dhi*ice_ref_salinity*p001/dt
452 765790051 : fhocnn = fhocnn + fadvocn ! for ktherm=2
453 :
454 765790051 : if (hin == c0) then
455 105512 : if (tr_pond_topo) fpond = fpond - aicen * apond * hpond
456 : endif
457 :
458 : !-----------------------------------------------------------------
459 : ! Given the vertical thermo state variables, compute the new ice
460 : ! state variables.
461 : !-----------------------------------------------------------------
462 :
463 : call update_state_vthermo(nilyr, nslyr, &
464 : Tbot, Tsf, &
465 : hin, hsn, &
466 0 : zqin, zSin, &
467 0 : zqsn, &
468 : aicen, &
469 765790051 : vicen, vsnon)
470 765790051 : if (icepack_warnings_aborted(subname)) return
471 :
472 : !-----------------------------------------------------------------
473 : ! Reload passive tracer array
474 : !-----------------------------------------------------------------
475 :
476 : end subroutine thermo_vertical
477 :
478 : !=======================================================================
479 : !
480 : ! Compute heat flux to bottom surface.
481 : ! Compute fraction of ice that melts laterally.
482 : !
483 : ! authors C. M. Bitz, UW
484 : ! William H. Lipscomb, LANL
485 : ! Elizabeth C. Hunke, LANL
486 :
487 716710152 : subroutine frzmlt_bottom_lateral (dt, ncat, &
488 : nilyr, nslyr, &
489 : aice, frzmlt, &
490 1433420304 : vicen, vsnon, &
491 1433420304 : qicen, qsnon, &
492 : sst, Tf, &
493 : ustar_min, &
494 45106800 : fbot_xfer_type, &
495 : strocnxT, strocnyT, &
496 : Tbot, fbot, &
497 : rside, Cdn_ocn, &
498 : fside)
499 :
500 : integer (kind=int_kind), intent(in) :: &
501 : ncat , & ! number of thickness categories
502 : nilyr , & ! number of ice layers
503 : nslyr ! number of snow layers
504 :
505 : real (kind=dbl_kind), intent(in) :: &
506 : dt ! time step
507 :
508 : real (kind=dbl_kind), intent(in) :: &
509 : aice , & ! ice concentration
510 : frzmlt , & ! freezing/melting potential (W/m^2)
511 : sst , & ! sea surface temperature (C)
512 : Tf , & ! freezing temperature (C)
513 : ustar_min,& ! minimum friction velocity for ice-ocean heat flux
514 : Cdn_ocn , & ! ocean-ice neutral drag coefficient
515 : strocnxT, & ! ice-ocean stress, x-direction
516 : strocnyT ! ice-ocean stress, y-direction
517 :
518 : character (char_len), intent(in) :: &
519 : fbot_xfer_type ! transfer coefficient type for ice-ocean heat flux
520 :
521 : real (kind=dbl_kind), dimension(:), intent(in) :: &
522 : vicen , & ! ice volume (m)
523 : vsnon ! snow volume (m)
524 :
525 : real (kind=dbl_kind), dimension(:,:), intent(in) :: &
526 : qicen , & ! ice layer enthalpy (J m-3)
527 : qsnon ! snow layer enthalpy (J m-3)
528 :
529 : real (kind=dbl_kind), intent(out) :: &
530 : Tbot , & ! ice bottom surface temperature (deg C)
531 : fbot , & ! heat flux to ice bottom (W/m^2)
532 : rside , & ! fraction of ice that melts laterally
533 : fside ! lateral heat flux (W/m^2)
534 :
535 : ! local variables
536 :
537 : integer (kind=int_kind) :: &
538 : n , & ! thickness category index
539 : k ! layer index
540 :
541 : real (kind=dbl_kind) :: &
542 45106800 : etot , & ! total energy in column
543 45106800 : qavg ! average enthalpy in column (approximate)
544 :
545 : real (kind=dbl_kind) :: &
546 45106800 : deltaT , & ! SST - Tbot >= 0
547 45106800 : ustar , & ! skin friction velocity for fbot (m/s)
548 45106800 : wlat , & ! lateral melt rate (m/s)
549 45106800 : xtmp ! temporary variable
550 :
551 : ! Parameters for bottom melting
552 :
553 : real (kind=dbl_kind) :: &
554 45106800 : cpchr ! -cp_ocn*rhow*exchange coefficient
555 :
556 : ! Parameters for lateral melting
557 :
558 : real (kind=dbl_kind), parameter :: &
559 : floediam = 300.0_dbl_kind, & ! effective floe diameter (m)
560 : floeshape = 0.66_dbl_kind , & ! constant from Steele (unitless)
561 : m1 = 1.6e-6_dbl_kind , & ! constant from Maykut & Perovich
562 : ! (m/s/deg^(-m2))
563 : m2 = 1.36_dbl_kind ! constant from Maykut & Perovich
564 : ! (unitless)
565 :
566 : character(len=*),parameter :: subname='(frzmlt_bottom_lateral)'
567 :
568 : !-----------------------------------------------------------------
569 : ! Identify grid cells where ice can melt.
570 : !-----------------------------------------------------------------
571 :
572 716710152 : rside = c0
573 716710152 : fside = c0
574 716710152 : Tbot = Tf
575 716710152 : fbot = c0
576 716710152 : wlat = c0
577 :
578 716710152 : if (aice > puny .and. frzmlt < c0) then ! ice can melt
579 :
580 : !-----------------------------------------------------------------
581 : ! Use boundary layer theory for fbot.
582 : ! See Maykut and McPhee (1995): JGR, 100, 24,691-24,703.
583 : !-----------------------------------------------------------------
584 :
585 66139621 : deltaT = max((sst-Tbot),c0)
586 :
587 : ! strocnx has units N/m^2 so strocnx/rho has units m^2/s^2
588 66139621 : ustar = sqrt (sqrt(strocnxT**2+strocnyT**2)/rhow)
589 66139621 : ustar = max (ustar,ustar_min)
590 :
591 66139621 : if (trim(fbot_xfer_type) == 'Cdn_ocn') then
592 : ! Note: Cdn_ocn has already been used for calculating ustar
593 : ! (formdrag only) --- David Schroeder (CPOM)
594 2760555 : cpchr = -cp_ocn*rhow*Cdn_ocn
595 : else ! fbot_xfer_type == 'constant'
596 : ! 0.006 = unitless param for basal heat flx ala McPhee and Maykut
597 63379066 : cpchr = -cp_ocn*rhow*0.006_dbl_kind
598 : endif
599 :
600 66139621 : fbot = cpchr * deltaT * ustar ! < 0
601 66139621 : fbot = max (fbot, frzmlt) ! frzmlt < fbot < 0
602 :
603 : !!! uncomment to use all frzmlt for standalone runs
604 : ! fbot = min (c0, frzmlt)
605 :
606 : !-----------------------------------------------------------------
607 : ! Compute rside. See these references:
608 : ! Maykut and Perovich (1987): JGR, 92, 7032-7044
609 : ! Steele (1992): JGR, 97, 17,729-17,738
610 : !-----------------------------------------------------------------
611 :
612 66139621 : wlat = m1 * deltaT**m2 ! Maykut & Perovich
613 66139621 : rside = wlat*dt*pi/(floeshape*floediam) ! Steele
614 66139621 : rside = max(c0,min(rside,c1))
615 :
616 : !-----------------------------------------------------------------
617 : ! Compute heat flux associated with this value of rside.
618 : !-----------------------------------------------------------------
619 :
620 394538906 : do n = 1, ncat
621 :
622 328399285 : etot = c0
623 328399285 : qavg = c0
624 :
625 : ! melting energy/unit area in each column, etot < 0
626 :
627 656798570 : do k = 1, nslyr
628 328399285 : etot = etot + qsnon(k,n) * vsnon(n)/real(nslyr,kind=dbl_kind)
629 656798570 : qavg = qavg + qsnon(k,n)
630 : enddo
631 :
632 2627194280 : do k = 1, nilyr
633 2298794995 : etot = etot + qicen(k,n) * vicen(n)/real(nilyr,kind=dbl_kind)
634 2627194280 : qavg = qavg + qicen(k,n)
635 : enddo ! nilyr
636 :
637 : ! lateral heat flux, fside < 0
638 394538906 : if (tr_fsd) then ! floe size distribution
639 13734570 : fside = fside + wlat*qavg
640 : else ! default floe size
641 314664715 : fside = fside + rside*etot/dt
642 : endif
643 :
644 : enddo ! n
645 :
646 : !-----------------------------------------------------------------
647 : ! Limit bottom and lateral heat fluxes if necessary.
648 : !-----------------------------------------------------------------
649 :
650 66139621 : xtmp = frzmlt/(fbot + fside + puny)
651 66139621 : xtmp = min(xtmp, c1)
652 66139621 : fbot = fbot * xtmp
653 66139621 : rside = rside * xtmp
654 66139621 : fside = fside * xtmp
655 :
656 : endif
657 :
658 716710152 : end subroutine frzmlt_bottom_lateral
659 :
660 : !=======================================================================
661 : !
662 : ! Given the state variables (vicen, vsnon, zqin, etc.),
663 : ! compute variables needed for the vertical thermodynamics
664 : ! (hin, hsn, zTin, etc.)
665 : !
666 : ! authors William H. Lipscomb, LANL
667 : ! C. M. Bitz, UW
668 :
669 765790051 : subroutine init_vertical_profile(nilyr, nslyr, &
670 : aicen, vicen, &
671 : vsnon, &
672 : hin, hilyr, &
673 : hsn, hslyr, &
674 765790051 : zqin, zTin, &
675 765790051 : zqsn, zTsn, &
676 765790051 : zSin, &
677 : einit )
678 :
679 : integer (kind=int_kind), intent(in) :: &
680 : nilyr , & ! number of ice layers
681 : nslyr ! number of snow layers
682 :
683 : real (kind=dbl_kind), intent(in) :: &
684 : aicen , & ! concentration of ice
685 : vicen , & ! volume per unit area of ice (m)
686 : vsnon ! volume per unit area of snow (m)
687 :
688 : real (kind=dbl_kind), intent(out):: &
689 : hilyr , & ! ice layer thickness
690 : hslyr , & ! snow layer thickness
691 : einit ! initial energy of melting (J m-2)
692 :
693 : real (kind=dbl_kind), intent(out):: &
694 : hin , & ! ice thickness (m)
695 : hsn ! snow thickness (m)
696 :
697 : real (kind=dbl_kind), dimension (:), intent(inout) :: &
698 : zqin , & ! ice layer enthalpy (J m-3)
699 : zTin ! internal ice layer temperatures
700 :
701 : real (kind=dbl_kind), dimension (:), intent(in) :: &
702 : zSin ! internal ice layer salinities
703 :
704 : real (kind=dbl_kind), dimension (:), &
705 : intent(inout) :: &
706 : zqsn , & ! snow enthalpy
707 : zTsn ! snow temperature
708 :
709 : ! local variables
710 : real (kind=dbl_kind), dimension(nilyr) :: &
711 1092825139 : Tmlts ! melting temperature
712 :
713 : integer (kind=int_kind) :: &
714 : k ! ice layer index
715 :
716 : real (kind=dbl_kind) :: &
717 54309042 : rnslyr, & ! real(nslyr)
718 54309042 : Tmax ! maximum allowed snow/ice temperature (deg C)
719 :
720 : logical (kind=log_kind) :: & ! for vector-friendly error checks
721 : tsno_high , & ! flag for zTsn > Tmax
722 : tice_high , & ! flag for zTin > Tmlt
723 : tsno_low , & ! flag for zTsn < Tmin
724 : tice_low ! flag for zTin < Tmin
725 :
726 : character(len=*),parameter :: subname='(init_vertical_profile)'
727 :
728 : !-----------------------------------------------------------------
729 : ! Initialize
730 : !-----------------------------------------------------------------
731 :
732 765790051 : rnslyr = real(nslyr,kind=dbl_kind)
733 :
734 765790051 : tsno_high = .false.
735 765790051 : tice_high = .false.
736 765790051 : tsno_low = .false.
737 765790051 : tice_low = .false.
738 :
739 765790051 : einit = c0
740 :
741 : !-----------------------------------------------------------------
742 : ! Surface temperature, ice and snow thickness
743 : ! Initialize internal energy
744 : !-----------------------------------------------------------------
745 :
746 765790051 : hin = vicen / aicen
747 765790051 : hsn = vsnon / aicen
748 765790051 : hilyr = hin / real(nilyr,kind=dbl_kind)
749 765790051 : hslyr = hsn / rnslyr
750 :
751 : !-----------------------------------------------------------------
752 : ! Snow enthalpy and maximum allowed snow temperature
753 : ! If heat_capacity = F, zqsn and zTsn are used only for checking
754 : ! conservation.
755 : !-----------------------------------------------------------------
756 :
757 1531580102 : do k = 1, nslyr
758 :
759 : !-----------------------------------------------------------------
760 : ! Tmax based on the idea that dT ~ dq / (rhos*cp_ice)
761 : ! dq ~ q dv / v
762 : ! dv ~ puny = eps11
763 : ! where 'd' denotes an error due to roundoff.
764 : !-----------------------------------------------------------------
765 :
766 765790051 : if (hslyr > hs_min/rnslyr .and. heat_capacity) then
767 : ! zqsn < 0
768 34109793 : Tmax = -zqsn(k)*puny*rnslyr / &
769 577946139 : (rhos*cp_ice*vsnon)
770 : else
771 187843912 : zqsn (k) = -rhos * Lfresh
772 187843912 : Tmax = puny
773 : endif
774 :
775 : !-----------------------------------------------------------------
776 : ! Compute snow temperatures from enthalpies.
777 : ! Note: zqsn <= -rhos*Lfresh, so zTsn <= 0.
778 : !-----------------------------------------------------------------
779 765790051 : zTsn(k) = (Lfresh + zqsn(k)/rhos)/cp_ice
780 :
781 : !-----------------------------------------------------------------
782 : ! Check for zTsn > Tmax (allowing for roundoff error) and zTsn < Tmin.
783 : !-----------------------------------------------------------------
784 1531580102 : if (zTsn(k) > Tmax) then
785 0 : tsno_high = .true.
786 765790051 : elseif (zTsn(k) < Tmin) then
787 0 : tsno_low = .true.
788 : endif
789 :
790 : enddo ! nslyr
791 :
792 : !-----------------------------------------------------------------
793 : ! If zTsn is out of bounds, print diagnostics and exit.
794 : !-----------------------------------------------------------------
795 :
796 765790051 : if (tsno_high .and. heat_capacity) then
797 0 : do k = 1, nslyr
798 :
799 0 : if (hslyr > hs_min/rnslyr) then
800 0 : Tmax = -zqsn(k)*puny*rnslyr / &
801 0 : (rhos*cp_ice*vsnon)
802 : else
803 0 : Tmax = puny
804 : endif
805 :
806 0 : if (zTsn(k) > Tmax) then
807 0 : write(warnstr,*) ' '
808 0 : call icepack_warnings_add(warnstr)
809 0 : write(warnstr,*) subname, 'Starting thermo, zTsn > Tmax'
810 0 : call icepack_warnings_add(warnstr)
811 0 : write(warnstr,*) subname, 'zTsn=',zTsn(k)
812 0 : call icepack_warnings_add(warnstr)
813 0 : write(warnstr,*) subname, 'Tmax=',Tmax
814 0 : call icepack_warnings_add(warnstr)
815 0 : write(warnstr,*) subname, 'zqsn',zqsn(k),-Lfresh*rhos,zqsn(k)+Lfresh*rhos
816 0 : call icepack_warnings_add(warnstr)
817 0 : call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
818 0 : call icepack_warnings_add(subname//" init_vertical_profile: Starting thermo, zTsn > Tmax" )
819 0 : return
820 : endif
821 :
822 : enddo ! nslyr
823 : endif ! tsno_high
824 :
825 765790051 : if (tsno_low .and. heat_capacity) then
826 0 : do k = 1, nslyr
827 :
828 0 : if (zTsn(k) < Tmin) then ! allowing for roundoff error
829 0 : write(warnstr,*) ' '
830 0 : call icepack_warnings_add(warnstr)
831 0 : write(warnstr,*) subname, 'Starting thermo, zTsn < Tmin'
832 0 : call icepack_warnings_add(warnstr)
833 0 : write(warnstr,*) subname, 'zTsn=', zTsn(k)
834 0 : call icepack_warnings_add(warnstr)
835 0 : write(warnstr,*) subname, 'Tmin=', Tmin
836 0 : call icepack_warnings_add(warnstr)
837 0 : write(warnstr,*) subname, 'zqsn', zqsn(k)
838 0 : call icepack_warnings_add(warnstr)
839 0 : write(warnstr,*) subname, hin
840 0 : call icepack_warnings_add(warnstr)
841 0 : write(warnstr,*) subname, hsn
842 0 : call icepack_warnings_add(warnstr)
843 0 : call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
844 0 : call icepack_warnings_add(subname//" init_vertical_profile: Starting thermo, zTsn < Tmin" )
845 0 : return
846 : endif
847 :
848 : enddo ! nslyr
849 : endif ! tsno_low
850 :
851 1531580102 : do k = 1, nslyr
852 :
853 765790051 : if (zTsn(k) > c0) then ! correct roundoff error
854 4010030 : zTsn(k) = c0
855 4010030 : zqsn(k) = -rhos*Lfresh
856 : endif
857 :
858 : !-----------------------------------------------------------------
859 : ! initial energy per unit area of ice/snow, relative to 0 C
860 : !-----------------------------------------------------------------
861 1531580102 : einit = einit + hslyr*zqsn(k)
862 :
863 : enddo ! nslyr
864 :
865 5474519618 : do k = 1, nilyr
866 :
867 : !---------------------------------------------------------------------
868 : ! Use initial salinity profile for thin ice
869 : !---------------------------------------------------------------------
870 :
871 4708729567 : if (ktherm == 1 .and. zSin(k) < min_salin-puny) then
872 0 : write(warnstr,*) ' '
873 0 : call icepack_warnings_add(warnstr)
874 0 : write(warnstr,*) subname, 'Starting zSin < min_salin, layer', k
875 0 : call icepack_warnings_add(warnstr)
876 0 : write(warnstr,*) subname, 'zSin =', zSin(k)
877 0 : call icepack_warnings_add(warnstr)
878 0 : write(warnstr,*) subname, 'min_salin =', min_salin
879 0 : call icepack_warnings_add(warnstr)
880 0 : call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
881 0 : call icepack_warnings_add(subname//" init_vertical_profile: Starting zSin < min_salin, layer" )
882 0 : return
883 : endif
884 :
885 4708729567 : if (ktherm == 2) then
886 4265241680 : Tmlts(k) = liquidus_temperature_mush(zSin(k))
887 : else
888 443487887 : Tmlts(k) = -zSin(k) * depressT
889 : endif
890 :
891 : !-----------------------------------------------------------------
892 : ! Compute ice enthalpy
893 : ! If heat_capacity = F, zqin and zTin are used only for checking
894 : ! conservation.
895 : !-----------------------------------------------------------------
896 :
897 : !-----------------------------------------------------------------
898 : ! Compute ice temperatures from enthalpies using quadratic formula
899 : !-----------------------------------------------------------------
900 :
901 4708729567 : if (ktherm == 2) then
902 4265241680 : zTin(k) = icepack_mushy_temperature_mush(zqin(k),zSin(k))
903 : else
904 443487887 : zTin(k) = calculate_Tin_from_qin(zqin(k),Tmlts(k))
905 : endif
906 :
907 4708729567 : if (l_brine) then
908 4600096102 : Tmax = Tmlts(k)
909 : else ! fresh ice
910 108633465 : Tmax = -zqin(k)*puny/(rhos*cp_ice*vicen)
911 : endif
912 :
913 : !-----------------------------------------------------------------
914 : ! Check for zTin > Tmax and zTin < Tmin
915 : !-----------------------------------------------------------------
916 4708729567 : if (zTin(k) > Tmax) then
917 0 : tice_high = .true.
918 4708729567 : elseif (zTin(k) < Tmin) then
919 0 : tice_low = .true.
920 : endif
921 :
922 : !-----------------------------------------------------------------
923 : ! If zTin is out of bounds, print diagnostics and exit.
924 : !-----------------------------------------------------------------
925 :
926 4708729567 : if (tice_high .and. heat_capacity) then
927 :
928 0 : if (l_brine) then
929 0 : Tmax = Tmlts(k)
930 : else ! fresh ice
931 0 : Tmax = -zqin(k)*puny/(rhos*cp_ice*vicen)
932 : endif
933 :
934 0 : if (zTin(k) > Tmax) then
935 0 : write(warnstr,*) ' '
936 0 : call icepack_warnings_add(warnstr)
937 0 : write(warnstr,*) subname, 'Starting thermo, T > Tmax, layer', k
938 0 : call icepack_warnings_add(warnstr)
939 0 : write(warnstr,*) subname, 'k:', k
940 0 : call icepack_warnings_add(warnstr)
941 0 : write(warnstr,*) subname, 'zTin =',zTin(k),', Tmax=',Tmax
942 0 : call icepack_warnings_add(warnstr)
943 0 : write(warnstr,*) subname, 'zSin =',zSin(k)
944 0 : call icepack_warnings_add(warnstr)
945 0 : write(warnstr,*) subname, 'hin =',hin
946 0 : call icepack_warnings_add(warnstr)
947 0 : write(warnstr,*) subname, 'zqin =',zqin(k)
948 0 : call icepack_warnings_add(warnstr)
949 0 : write(warnstr,*) subname, 'qmlt=',enthalpy_of_melting(zSin(k))
950 0 : call icepack_warnings_add(warnstr)
951 0 : write(warnstr,*) subname, 'Tmlt=',Tmlts(k)
952 0 : call icepack_warnings_add(warnstr)
953 :
954 0 : if (ktherm == 2) then
955 0 : zqin(k) = enthalpy_of_melting(zSin(k)) - c1
956 0 : zTin(k) = icepack_mushy_temperature_mush(zqin(k),zSin(k))
957 0 : write(warnstr,*) subname, 'Corrected quantities'
958 0 : call icepack_warnings_add(warnstr)
959 0 : write(warnstr,*) subname, 'zqin=',zqin(k)
960 0 : call icepack_warnings_add(warnstr)
961 0 : write(warnstr,*) subname, 'zTin=',zTin(k)
962 0 : call icepack_warnings_add(warnstr)
963 : else
964 0 : call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
965 0 : call icepack_warnings_add(subname//" init_vertical_profile: Starting thermo, T > Tmax, layer" )
966 0 : return
967 : endif
968 : endif
969 : endif ! tice_high
970 :
971 4708729567 : if (tice_low .and. heat_capacity) then
972 :
973 0 : if (zTin(k) < Tmin) then
974 0 : write(warnstr,*) ' '
975 0 : call icepack_warnings_add(warnstr)
976 0 : write(warnstr,*) subname, 'Starting thermo T < Tmin, layer', k
977 0 : call icepack_warnings_add(warnstr)
978 0 : write(warnstr,*) subname, 'zTin =', zTin(k)
979 0 : call icepack_warnings_add(warnstr)
980 0 : write(warnstr,*) subname, 'Tmin =', Tmin
981 0 : call icepack_warnings_add(warnstr)
982 0 : call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
983 0 : call icepack_warnings_add(subname//" init_vertical_profile: Starting thermo, T < Tmin, layer" )
984 0 : return
985 : endif
986 : endif ! tice_low
987 :
988 : !-----------------------------------------------------------------
989 : ! correct roundoff error
990 : !-----------------------------------------------------------------
991 :
992 4708729567 : if (ktherm /= 2) then
993 :
994 443487887 : if (zTin(k) > c0) then
995 20096405 : zTin(k) = c0
996 20096405 : zqin(k) = -rhoi*Lfresh
997 : endif
998 :
999 : endif
1000 :
1001 : ! echmod: is this necessary?
1002 : ! if (ktherm == 1) then
1003 : ! if (zTin(k)>= -zSin(k)*depressT) then
1004 : ! zTin(k) = -zSin(k)*depressT - puny
1005 : ! zqin(k) = -rhoi*cp_ocn*zSin(k)*depressT
1006 : ! endif
1007 : ! endif
1008 :
1009 : !-----------------------------------------------------------------
1010 : ! initial energy per unit area of ice/snow, relative to 0 C
1011 : !-----------------------------------------------------------------
1012 :
1013 5474519618 : einit = einit + hilyr*zqin(k)
1014 :
1015 : enddo ! nilyr
1016 :
1017 : end subroutine init_vertical_profile
1018 :
1019 : !=======================================================================
1020 : !
1021 : ! Compute growth and/or melting at the top and bottom surfaces.
1022 : ! Convert snow to ice if necessary.
1023 : !
1024 : ! authors William H. Lipscomb, LANL
1025 : ! C. M. Bitz, UW
1026 :
1027 765790051 : subroutine thickness_changes (nilyr, nslyr, &
1028 : dt, yday, &
1029 : efinal, &
1030 : hin, hilyr, &
1031 : hsn, hslyr, &
1032 765790051 : zqin, zqsn, &
1033 : fbot, Tbot, &
1034 : flatn, fsurfn, &
1035 : fcondtopn, fcondbotn, &
1036 : fsnow, hsn_new, &
1037 : fhocnn, evapn, &
1038 : evapsn, evapin, &
1039 : meltt, melts, &
1040 : meltb, &
1041 : congel, snoice, &
1042 : mlt_onset, frz_onset,&
1043 765790051 : zSin, sss, &
1044 : dsnow)
1045 :
1046 : integer (kind=int_kind), intent(in) :: &
1047 : nilyr , & ! number of ice layers
1048 : nslyr ! number of snow layers
1049 :
1050 : real (kind=dbl_kind), intent(in) :: &
1051 : dt , & ! time step
1052 : yday ! day of the year
1053 :
1054 : real (kind=dbl_kind), intent(in) :: &
1055 : fbot , & ! ice-ocean heat flux at bottom surface (W/m^2)
1056 : Tbot , & ! ice bottom surface temperature (deg C)
1057 : fsnow , & ! snowfall rate (kg m-2 s-1)
1058 : flatn , & ! surface downward latent heat (W m-2)
1059 : fsurfn , & ! net flux to top surface, excluding fcondtopn
1060 : fcondtopn ! downward cond flux at top surface (W m-2)
1061 :
1062 : real (kind=dbl_kind), intent(inout) :: &
1063 : fcondbotn ! downward cond flux at bottom surface (W m-2)
1064 :
1065 : real (kind=dbl_kind), dimension (:), intent(inout) :: &
1066 : zqin , & ! ice layer enthalpy (J m-3)
1067 : zqsn ! snow layer enthalpy (J m-3)
1068 :
1069 : real (kind=dbl_kind), intent(inout) :: &
1070 : hilyr , & ! ice layer thickness (m)
1071 : hslyr ! snow layer thickness (m)
1072 :
1073 : real (kind=dbl_kind), intent(inout) :: &
1074 : meltt , & ! top ice melt (m/step-->cm/day)
1075 : melts , & ! snow melt (m/step-->cm/day)
1076 : meltb , & ! basal ice melt (m/step-->cm/day)
1077 : congel , & ! basal ice growth (m/step-->cm/day)
1078 : snoice , & ! snow-ice formation (m/step-->cm/day)
1079 : dsnow , & ! snow formation (m/step-->cm/day)
1080 : ! iage , & ! ice age (s)
1081 : mlt_onset , & ! day of year that sfc melting begins
1082 : frz_onset ! day of year that freezing begins (congel or frazil)
1083 :
1084 : real (kind=dbl_kind), intent(inout) :: &
1085 : hin , & ! total ice thickness (m)
1086 : hsn ! total snow thickness (m)
1087 :
1088 : real (kind=dbl_kind), intent(out):: &
1089 : efinal ! final energy of melting (J m-2)
1090 :
1091 : real (kind=dbl_kind), intent(out):: &
1092 : fhocnn , & ! fbot, corrected for any surplus energy (W m-2)
1093 : evapn , & ! ice/snow mass sublimated/condensed (kg m-2 s-1)
1094 : evapsn , & ! ice/snow mass sublimated/condensed over snow (kg m-2 s-1)
1095 : evapin ! ice/snow mass sublimated/condensed over ice (kg m-2 s-1)
1096 :
1097 : real (kind=dbl_kind), intent(out):: &
1098 : hsn_new ! thickness of new snow (m)
1099 :
1100 : ! changes to zSin in this subroutine are not reloaded into the
1101 : ! trcrn array for ktherm /= 2, so we could remove ktherm=2 conditionals
1102 : real (kind=dbl_kind), dimension (:), intent(inout) :: &
1103 : zSin ! ice layer salinity (ppt)
1104 :
1105 : real (kind=dbl_kind), intent(in) :: &
1106 : sss ! ocean salinity (PSU)
1107 :
1108 : ! local variables
1109 :
1110 : integer (kind=int_kind) :: &
1111 : k ! vertical index
1112 :
1113 : real (kind=dbl_kind) :: &
1114 54309042 : esub , & ! energy for sublimation, > 0 (J m-2)
1115 54309042 : econ , & ! energy for condensation, < 0 (J m-2)
1116 54309042 : etop_mlt , & ! energy for top melting, > 0 (J m-2)
1117 54309042 : ebot_mlt , & ! energy for bottom melting, > 0 (J m-2)
1118 54309042 : ebot_gro , & ! energy for bottom growth, < 0 (J m-2)
1119 54309042 : emlt_atm , & ! total energy of brine, from atmosphere (J m-2)
1120 54309042 : emlt_ocn ! total energy of brine, to ocean (J m-2)
1121 :
1122 : real (kind=dbl_kind) :: &
1123 54309042 : qbotmax , & ! max enthalpy of ice growing at bottom
1124 54309042 : dhi , & ! change in ice thickness
1125 54309042 : dhs , & ! change in snow thickness
1126 54309042 : Ti , & ! ice temperature
1127 54309042 : Ts , & ! snow temperature
1128 54309042 : qbot , & ! enthalpy of ice growing at bottom surface (J m-3)
1129 54309042 : qsub , & ! energy/unit volume to sublimate ice/snow (J m-3)
1130 54309042 : hqtot , & ! sum of h*q for two layers
1131 54309042 : wk1 , & ! temporary variable
1132 54309042 : zqsnew , & ! enthalpy of new snow (J m-3)
1133 54309042 : hstot , & ! snow thickness including new snow (m)
1134 54309042 : Tmlts ! melting temperature
1135 :
1136 : real (kind=dbl_kind), dimension (nilyr+1) :: &
1137 1804306148 : zi1 , & ! depth of ice layer boundaries (m)
1138 1804306148 : zi2 ! adjusted depths, with equal hilyr (m)
1139 :
1140 : real (kind=dbl_kind), dimension (nslyr+1) :: &
1141 1585889144 : zs1 , & ! depth of snow layer boundaries (m)
1142 1585889144 : zs2 ! adjusted depths, with equal hslyr (m)
1143 :
1144 : real (kind=dbl_kind), dimension (nilyr) :: &
1145 1092825139 : dzi ! ice layer thickness after growth/melting
1146 :
1147 : real (kind=dbl_kind), dimension (nslyr) :: &
1148 1531580102 : dzs ! snow layer thickness after growth/melting
1149 :
1150 : real (kind=dbl_kind), dimension (nilyr) :: &
1151 1749997106 : qm , & ! energy of melting (J m-3) = zqin in BL99 formulation
1152 1147134181 : qmlt ! enthalpy of melted ice (J m-3) = zero in BL99 formulation
1153 :
1154 : real (kind=dbl_kind) :: &
1155 54309042 : qbotm , &
1156 54309042 : qbotp , &
1157 54309042 : qbot0
1158 :
1159 : character(len=*),parameter :: subname='(thickness_changes)'
1160 :
1161 : !-----------------------------------------------------------------
1162 : ! Initialize
1163 : !-----------------------------------------------------------------
1164 :
1165 765790051 : dhi = c0
1166 765790051 : dhs = c0
1167 765790051 : hsn_new = c0
1168 :
1169 5474519618 : do k = 1, nilyr
1170 5474519618 : dzi(k) = hilyr
1171 : enddo
1172 :
1173 1531580102 : do k = 1, nslyr
1174 1531580102 : dzs(k) = hslyr
1175 : enddo
1176 :
1177 5474519618 : do k = 1, nilyr
1178 4708729567 : if (ktherm == 2) then
1179 4265241680 : qmlt(k) = enthalpy_of_melting(zSin(k))
1180 : else
1181 443487887 : qmlt(k) = c0
1182 : endif
1183 4708729567 : qm(k) = zqin(k) - qmlt(k)
1184 4708729567 : emlt_atm = c0
1185 5474519618 : emlt_ocn = c0
1186 : enddo
1187 :
1188 : !-----------------------------------------------------------------
1189 : ! For l_brine = false (fresh ice), check for temperatures > 0.
1190 : ! Melt ice or snow as needed to bring temperatures back to 0.
1191 : ! For l_brine = true, this should not be necessary.
1192 : !-----------------------------------------------------------------
1193 :
1194 765790051 : if (.not. l_brine) then
1195 :
1196 217266930 : do k = 1, nslyr
1197 108633465 : Ts = (Lfresh + zqsn(k)/rhos) / cp_ice
1198 217266930 : if (Ts > c0) then
1199 0 : dhs = cp_ice*Ts*dzs(k) / Lfresh
1200 0 : dzs(k) = dzs(k) - dhs
1201 0 : zqsn(k) = -rhos*Lfresh
1202 : endif
1203 : enddo
1204 :
1205 217266930 : do k = 1, nilyr
1206 108633465 : Ti = (Lfresh + zqin(k)/rhoi) / cp_ice
1207 217266930 : if (Ti > c0) then
1208 0 : dhi = cp_ice*Ti*dzi(k) / Lfresh
1209 0 : dzi(k) = dzi(k) - dhi
1210 0 : zqin(k) = -rhoi*Lfresh
1211 : endif
1212 : enddo ! k
1213 :
1214 : endif ! .not. l_brine
1215 :
1216 : !-----------------------------------------------------------------
1217 : ! Compute energy available for sublimation/condensation, top melt,
1218 : ! and bottom growth/melt.
1219 : !-----------------------------------------------------------------
1220 :
1221 765790051 : wk1 = -flatn * dt
1222 765790051 : esub = max(wk1, c0) ! energy for sublimation, > 0
1223 765790051 : econ = min(wk1, c0) ! energy for condensation, < 0
1224 :
1225 765790051 : wk1 = (fsurfn - fcondtopn) * dt
1226 765790051 : etop_mlt = max(wk1, c0) ! etop_mlt > 0
1227 :
1228 765790051 : wk1 = (fcondbotn - fbot) * dt
1229 765790051 : ebot_mlt = max(wk1, c0) ! ebot_mlt > 0
1230 765790051 : ebot_gro = min(wk1, c0) ! ebot_gro < 0
1231 :
1232 : !--------------------------------------------------------------
1233 : ! Condensation (evapn > 0)
1234 : ! Note: evapn here has unit of kg/m^2. Divide by dt later.
1235 : ! This is the only case in which energy from the atmosphere
1236 : ! is used for changes in the brine energy (emlt_atm).
1237 : !--------------------------------------------------------------
1238 :
1239 765790051 : evapn = c0 ! initialize
1240 765790051 : evapsn = c0 ! initialize
1241 765790051 : evapin = c0 ! initialize
1242 :
1243 765790051 : if (hsn > puny) then ! add snow with enthalpy zqsn(1)
1244 636878016 : dhs = econ / (zqsn(1) - rhos*Lvap) ! econ < 0, dhs > 0
1245 636878016 : dzs(1) = dzs(1) + dhs
1246 636878016 : evapn = evapn + dhs*rhos
1247 636878016 : evapsn = evapsn + dhs*rhos
1248 : else ! add ice with enthalpy zqin(1)
1249 128912035 : dhi = econ / (qm(1) - rhoi*Lvap) ! econ < 0, dhi > 0
1250 128912035 : dzi(1) = dzi(1) + dhi
1251 128912035 : evapn = evapn + dhi*rhoi
1252 128912035 : evapin = evapin + dhi*rhoi
1253 : ! enthalpy of melt water
1254 128912035 : emlt_atm = emlt_atm - qmlt(1) * dhi
1255 : endif
1256 :
1257 : !--------------------------------------------------------------
1258 : ! Grow ice (bottom)
1259 : !--------------------------------------------------------------
1260 :
1261 765790051 : if (ktherm == 2) then
1262 :
1263 609320240 : qbotm = enthalpy_mush(Tbot, sss)
1264 609320240 : qbotp = -Lfresh * rhoi * (c1 - phi_i_mushy)
1265 609320240 : qbot0 = qbotm - qbotp
1266 :
1267 609320240 : dhi = ebot_gro / qbotp ! dhi > 0
1268 :
1269 609320240 : hqtot = dzi(nilyr)*zqin(nilyr) + dhi*qbotm
1270 609320240 : hstot = dzi(nilyr)*zSin(nilyr) + dhi*sss
1271 609320240 : emlt_ocn = emlt_ocn - qbot0 * dhi
1272 :
1273 : else
1274 :
1275 156469811 : Tmlts = -zSin(nilyr) * depressT
1276 :
1277 : ! enthalpy of new ice growing at bottom surface
1278 156469811 : if (heat_capacity) then
1279 47836346 : if (l_brine) then
1280 47836346 : qbotmax = -p5*rhoi*Lfresh ! max enthalpy of ice growing at bottom
1281 : qbot = -rhoi * (cp_ice * (Tmlts-Tbot) &
1282 : + Lfresh * (c1-Tmlts/Tbot) &
1283 47836346 : - cp_ocn * Tmlts)
1284 47836346 : qbot = min (qbot, qbotmax) ! in case Tbot is close to Tmlt
1285 : else
1286 0 : qbot = -rhoi * (-cp_ice * Tbot + Lfresh)
1287 : endif
1288 : else ! zero layer
1289 108633465 : qbot = -rhoi * Lfresh
1290 : endif
1291 :
1292 156469811 : dhi = ebot_gro / qbot ! dhi > 0
1293 :
1294 156469811 : hqtot = dzi(nilyr)*zqin(nilyr) + dhi*qbot
1295 156469811 : hstot = c0
1296 : endif ! ktherm
1297 :
1298 765790051 : dzi(nilyr) = dzi(nilyr) + dhi
1299 765790051 : if (dzi(nilyr) > puny) then
1300 765790051 : zqin(nilyr) = hqtot / dzi(nilyr)
1301 765790051 : if (ktherm == 2) then
1302 609320240 : zSin(nilyr) = hstot / dzi(nilyr)
1303 609320240 : qmlt(nilyr) = enthalpy_of_melting(zSin(nilyr))
1304 : else
1305 156469811 : qmlt(nilyr) = c0
1306 : endif
1307 765790051 : qm(nilyr) = zqin(nilyr) - qmlt(nilyr)
1308 : endif
1309 :
1310 : ! update ice age due to freezing (new ice age = dt)
1311 : ! if (tr_iage) &
1312 : ! iage = (iage*hin + dt*dhi) / (hin + dhi)
1313 :
1314 : ! history diagnostics
1315 765790051 : congel = congel + dhi
1316 765790051 : if (dhi > puny .and. frz_onset < puny) &
1317 395806 : frz_onset = yday
1318 :
1319 1531580102 : do k = 1, nslyr
1320 :
1321 : !--------------------------------------------------------------
1322 : ! Remove internal snow melt
1323 : !--------------------------------------------------------------
1324 :
1325 765790051 : if (ktherm == 2 .and. zqsn(k) > -rhos * Lfresh) then
1326 :
1327 6403933 : dhs = max(-dzs(k), &
1328 48474042 : -((zqsn(k) + rhos*Lfresh) / (rhos*Lfresh)) * dzs(k))
1329 48474042 : dzs(k) = dzs(k) + dhs
1330 48474042 : zqsn(k) = -rhos * Lfresh
1331 48474042 : melts = melts - dhs
1332 : ! delta E = zqsn(k) + rhos * Lfresh
1333 :
1334 : endif
1335 :
1336 : !--------------------------------------------------------------
1337 : ! Sublimation of snow (evapn < 0)
1338 : !--------------------------------------------------------------
1339 :
1340 765790051 : qsub = zqsn(k) - rhos*Lvap ! qsub < 0
1341 765790051 : dhs = max (-dzs(k), esub/qsub) ! esub > 0, dhs < 0
1342 765790051 : dzs(k) = dzs(k) + dhs
1343 765790051 : esub = esub - dhs*qsub
1344 765790051 : esub = max(esub, c0) ! in case of roundoff error
1345 765790051 : evapn = evapn + dhs*rhos
1346 765790051 : evapsn = evapsn + dhs*rhos
1347 :
1348 : !--------------------------------------------------------------
1349 : ! Melt snow (top)
1350 : !--------------------------------------------------------------
1351 :
1352 765790051 : dhs = max(-dzs(k), etop_mlt/zqsn(k))
1353 765790051 : dzs(k) = dzs(k) + dhs ! zqsn < 0, dhs < 0
1354 765790051 : etop_mlt = etop_mlt - dhs*zqsn(k)
1355 765790051 : etop_mlt = max(etop_mlt, c0) ! in case of roundoff error
1356 :
1357 : ! history diagnostics
1358 765790051 : if (dhs < -puny .and. mlt_onset < puny) &
1359 155216 : mlt_onset = yday
1360 1531580102 : melts = melts - dhs
1361 :
1362 : enddo ! nslyr
1363 :
1364 5474519618 : do k = 1, nilyr
1365 :
1366 : !--------------------------------------------------------------
1367 : ! Sublimation of ice (evapn < 0)
1368 : !--------------------------------------------------------------
1369 :
1370 4708729567 : qsub = qm(k) - rhoi*Lvap ! qsub < 0
1371 4708729567 : dhi = max (-dzi(k), esub/qsub) ! esub < 0, dhi < 0
1372 4708729567 : dzi(k) = dzi(k) + dhi
1373 4708729567 : esub = esub - dhi*qsub
1374 4708729567 : esub = max(esub, c0)
1375 4708729567 : evapn = evapn + dhi*rhoi
1376 4708729567 : evapin = evapin + dhi*rhoi
1377 4708729567 : emlt_ocn = emlt_ocn - qmlt(k) * dhi
1378 :
1379 : !--------------------------------------------------------------
1380 : ! Melt ice (top)
1381 : !--------------------------------------------------------------
1382 :
1383 4708729567 : if (qm(k) < c0) then
1384 4708690832 : dhi = max(-dzi(k), etop_mlt/qm(k))
1385 : else
1386 38735 : qm(k) = c0
1387 38735 : dhi = -dzi(k)
1388 : endif
1389 4708729567 : emlt_ocn = emlt_ocn - max(zqin(k),qmlt(k)) * dhi
1390 :
1391 4708729567 : dzi(k) = dzi(k) + dhi ! zqin < 0, dhi < 0
1392 4708729567 : etop_mlt = max(etop_mlt - dhi*qm(k), c0)
1393 :
1394 : ! history diagnostics
1395 4708729567 : if (dhi < -puny .and. mlt_onset < puny) &
1396 42045 : mlt_onset = yday
1397 5474519618 : meltt = meltt - dhi
1398 :
1399 : enddo ! nilyr
1400 :
1401 5474519618 : do k = nilyr, 1, -1
1402 :
1403 : !--------------------------------------------------------------
1404 : ! Melt ice (bottom)
1405 : !--------------------------------------------------------------
1406 :
1407 4708729567 : if (qm(k) < c0) then
1408 4708690832 : dhi = max(-dzi(k), ebot_mlt/qm(k))
1409 : else
1410 38735 : qm(k) = c0
1411 38735 : dhi = -dzi(k)
1412 : endif
1413 4708729567 : emlt_ocn = emlt_ocn - max(zqin(k),qmlt(k)) * dhi
1414 :
1415 4708729567 : dzi(k) = dzi(k) + dhi ! zqin < 0, dhi < 0
1416 4708729567 : ebot_mlt = max(ebot_mlt - dhi*qm(k), c0)
1417 :
1418 : ! history diagnostics
1419 5474519618 : meltb = meltb -dhi
1420 :
1421 : enddo ! nilyr
1422 :
1423 1531580102 : do k = nslyr, 1, -1
1424 :
1425 : !--------------------------------------------------------------
1426 : ! Melt snow (only if all the ice has melted)
1427 : !--------------------------------------------------------------
1428 :
1429 765790051 : dhs = max(-dzs(k), ebot_mlt/zqsn(k))
1430 765790051 : dzs(k) = dzs(k) + dhs ! zqsn < 0, dhs < 0
1431 765790051 : ebot_mlt = ebot_mlt - dhs*zqsn(k)
1432 765790051 : ebot_mlt = max(ebot_mlt, c0)
1433 :
1434 : ! Add this to the snow melt (J. Zhu)
1435 1531580102 : melts = melts - dhs
1436 :
1437 : enddo ! nslyr
1438 :
1439 : !-----------------------------------------------------------------
1440 : ! Compute heat flux used by the ice (<=0).
1441 : ! fhocn is the available ocean heat that is left after use by ice
1442 : !-----------------------------------------------------------------
1443 :
1444 : fhocnn = fbot &
1445 765790051 : + (esub + etop_mlt + ebot_mlt)/dt
1446 :
1447 : !---!-----------------------------------------------------------------
1448 : !---! Add new snowfall at top surface.
1449 : !---!-----------------------------------------------------------------
1450 :
1451 : !----------------------------------------------------------------
1452 : ! NOTE: If heat flux diagnostics are to work, new snow should
1453 : ! have T = 0 (i.e. q = -rhos*Lfresh) and should not be
1454 : ! converted to rain.
1455 : !----------------------------------------------------------------
1456 :
1457 765790051 : if (fsnow > c0) then
1458 :
1459 416323567 : hsn_new = fsnow/rhos * dt
1460 416323567 : zqsnew = -rhos*Lfresh
1461 416323567 : hstot = dzs(1) + hsn_new
1462 :
1463 416323567 : if (hstot > c0) then
1464 24474169 : zqsn(1) = (dzs(1) * zqsn(1) &
1465 416323567 : + hsn_new * zqsnew) / hstot
1466 : ! avoid roundoff errors
1467 416323567 : zqsn(1) = min(zqsn(1), -rhos*Lfresh)
1468 :
1469 416323567 : dzs(1) = hstot
1470 : endif
1471 : endif
1472 :
1473 : !-----------------------------------------------------------------
1474 : ! Find the new ice and snow thicknesses.
1475 : !-----------------------------------------------------------------
1476 :
1477 765790051 : hin = c0
1478 765790051 : hsn = c0
1479 :
1480 5474519618 : do k = 1, nilyr
1481 5474519618 : hin = hin + dzi(k)
1482 : enddo ! k
1483 :
1484 1531580102 : do k = 1, nslyr
1485 765790051 : hsn = hsn + dzs(k)
1486 1531580102 : dsnow = dsnow + dzs(k) - hslyr
1487 : enddo ! k
1488 :
1489 : !-------------------------------------------------------------------
1490 : ! Convert snow to ice if snow lies below freeboard.
1491 : !-------------------------------------------------------------------
1492 :
1493 765790051 : if (ktherm /= 2) &
1494 : call freeboard (nslyr, &
1495 : snoice, &
1496 : hin, hsn, &
1497 0 : zqin, zqsn, &
1498 0 : dzi, dzs, &
1499 156469811 : dsnow)
1500 765790051 : if (icepack_warnings_aborted(subname)) return
1501 :
1502 : !---!-------------------------------------------------------------------
1503 : !---! Repartition the ice and snow into equal-thickness layers,
1504 : !---! conserving energy.
1505 : !---!-------------------------------------------------------------------
1506 :
1507 : !-----------------------------------------------------------------
1508 : ! Compute desired layer thicknesses.
1509 : !-----------------------------------------------------------------
1510 :
1511 765790051 : if (hin > c0) then
1512 765684539 : hilyr = hin / real(nilyr,kind=dbl_kind)
1513 : else
1514 105512 : hin = c0
1515 105512 : hilyr = c0
1516 : endif
1517 765790051 : if (hsn > c0) then
1518 625607973 : hslyr = hsn / real(nslyr,kind=dbl_kind)
1519 : else
1520 140182078 : hsn = c0
1521 140182078 : hslyr = c0
1522 : endif
1523 :
1524 : !-----------------------------------------------------------------
1525 : ! Compute depths zi1 of old layers (unequal thickness).
1526 : ! Compute depths zi2 of new layers (equal thickness).
1527 : !-----------------------------------------------------------------
1528 :
1529 765790051 : zi1(1) = c0
1530 765790051 : zi1(1+nilyr) = hin
1531 :
1532 765790051 : zi2(1) = c0
1533 765790051 : zi2(1+nilyr) = hin
1534 :
1535 765790051 : if (heat_capacity) then
1536 :
1537 4600096102 : do k = 1, nilyr-1
1538 3942939516 : zi1(k+1) = zi1(k) + dzi(k)
1539 4600096102 : zi2(k+1) = zi2(k) + hilyr
1540 : enddo
1541 :
1542 : !-----------------------------------------------------------------
1543 : ! Conserving energy, compute the enthalpy of the new equal layers.
1544 : !-----------------------------------------------------------------
1545 :
1546 : call adjust_enthalpy (nilyr, &
1547 0 : zi1, zi2, &
1548 : hilyr, hin, &
1549 657156586 : zqin)
1550 657156586 : if (icepack_warnings_aborted(subname)) return
1551 :
1552 657156586 : if (ktherm == 2) &
1553 : call adjust_enthalpy (nilyr, &
1554 0 : zi1, zi2, &
1555 : hilyr, hin, &
1556 609320240 : zSin)
1557 657156586 : if (icepack_warnings_aborted(subname)) return
1558 :
1559 : else ! zero layer (nilyr=1)
1560 :
1561 108633465 : zqin(1) = -rhoi * Lfresh
1562 108633465 : zqsn(1) = -rhos * Lfresh
1563 :
1564 : endif
1565 :
1566 765790051 : if (nslyr > 1) then
1567 :
1568 : !-----------------------------------------------------------------
1569 : ! Compute depths zs1 of old layers (unequal thickness).
1570 : ! Compute depths zs2 of new layers (equal thickness).
1571 : !-----------------------------------------------------------------
1572 :
1573 0 : zs1(1) = c0
1574 0 : zs1(1+nslyr) = hsn
1575 :
1576 0 : zs2(1) = c0
1577 0 : zs2(1+nslyr) = hsn
1578 :
1579 0 : do k = 1, nslyr-1
1580 0 : zs1(k+1) = zs1(k) + dzs(k)
1581 0 : zs2(k+1) = zs2(k) + hslyr
1582 : enddo
1583 :
1584 : !-----------------------------------------------------------------
1585 : ! Conserving energy, compute the enthalpy of the new equal layers.
1586 : !-----------------------------------------------------------------
1587 :
1588 : call adjust_enthalpy (nslyr, &
1589 0 : zs1, zs2, &
1590 : hslyr, hsn, &
1591 0 : zqsn)
1592 0 : if (icepack_warnings_aborted(subname)) return
1593 :
1594 : endif ! nslyr > 1
1595 :
1596 : !-----------------------------------------------------------------
1597 : ! Remove very thin snow layers (ktherm = 2)
1598 : !-----------------------------------------------------------------
1599 :
1600 765790051 : if (ktherm == 2) then
1601 1218640480 : do k = 1, nslyr
1602 1218640480 : if (hsn <= puny) then
1603 : fhocnn = fhocnn &
1604 70331343 : + zqsn(k)*hsn/(real(nslyr,kind=dbl_kind)*dt)
1605 70331343 : zqsn(k) = -rhos*Lfresh
1606 70331343 : hslyr = c0
1607 : endif
1608 : enddo
1609 : endif
1610 :
1611 : !-----------------------------------------------------------------
1612 : ! Compute final ice-snow energy, including the energy of
1613 : ! sublimated/condensed ice.
1614 : !-----------------------------------------------------------------
1615 :
1616 765790051 : efinal = -evapn*Lvap
1617 765790051 : evapn = evapn/dt
1618 765790051 : evapsn = evapsn/dt
1619 765790051 : evapin = evapin/dt
1620 :
1621 1531580102 : do k = 1, nslyr
1622 1531580102 : efinal = efinal + hslyr*zqsn(k)
1623 : enddo
1624 :
1625 5474519618 : do k = 1, nilyr
1626 5474519618 : efinal = efinal + hilyr*zqin(k)
1627 : enddo ! k
1628 :
1629 765790051 : if (ktherm < 2) then
1630 156469811 : emlt_atm = c0
1631 156469811 : emlt_ocn = c0
1632 : endif
1633 :
1634 : ! melt water is no longer zero enthalpy with ktherm=2
1635 765790051 : fhocnn = fhocnn + emlt_ocn/dt
1636 765790051 : efinal = efinal + emlt_atm ! for conservation check
1637 :
1638 : end subroutine thickness_changes
1639 :
1640 : !=======================================================================
1641 : !
1642 : ! If there is enough snow to lower the ice/snow interface below
1643 : ! sea level, convert enough snow to ice to bring the interface back
1644 : ! to sea level.
1645 : !
1646 : ! authors William H. Lipscomb, LANL
1647 : ! Elizabeth C. Hunke, LANL
1648 :
1649 156469811 : subroutine freeboard (nslyr, &
1650 : snoice, &
1651 : hin, hsn, &
1652 312939622 : zqin, zqsn, &
1653 312939622 : dzi, dzs, &
1654 : dsnow)
1655 :
1656 : integer (kind=int_kind), intent(in) :: &
1657 : nslyr ! number of snow layers
1658 :
1659 : ! real (kind=dbl_kind), intent(in) :: &
1660 : ! dt ! time step
1661 :
1662 : real (kind=dbl_kind), &
1663 : intent(inout) :: &
1664 : snoice , & ! snow-ice formation (m/step-->cm/day)
1665 : dsnow ! change in snow thickness after snow-ice formation (m)
1666 : ! iage ! ice age (s)
1667 :
1668 : real (kind=dbl_kind), &
1669 : intent(inout) :: &
1670 : hin , & ! ice thickness (m)
1671 : hsn ! snow thickness (m)
1672 :
1673 : real (kind=dbl_kind), dimension (:), intent(in) :: &
1674 : zqsn ! snow layer enthalpy (J m-3)
1675 :
1676 : real (kind=dbl_kind), dimension (:), intent(inout) :: &
1677 : zqin , & ! ice layer enthalpy (J m-3)
1678 : dzi , & ! ice layer thicknesses (m)
1679 : dzs ! snow layer thicknesses (m)
1680 :
1681 : ! local variables
1682 :
1683 : integer (kind=int_kind) :: &
1684 : k ! vertical index
1685 :
1686 : real (kind=dbl_kind) :: &
1687 21857539 : dhin , & ! change in ice thickness (m)
1688 21857539 : dhsn , & ! change in snow thickness (m)
1689 21857539 : hqs ! sum of h*q for snow (J m-2)
1690 :
1691 : real (kind=dbl_kind) :: &
1692 21857539 : wk1 , & ! temporary variable
1693 21857539 : dhs ! snow to remove from layer (m)
1694 :
1695 : character(len=*),parameter :: subname='(freeboard)'
1696 :
1697 : !-----------------------------------------------------------------
1698 : ! Determine whether snow lies below freeboard.
1699 : !-----------------------------------------------------------------
1700 :
1701 156469811 : dhin = c0
1702 156469811 : dhsn = c0
1703 156469811 : hqs = c0
1704 :
1705 156469811 : wk1 = hsn - hin*(rhow-rhoi)/rhos
1706 :
1707 156469811 : if (wk1 > puny .and. hsn > puny) then ! snow below freeboard
1708 1339107 : dhsn = min(wk1*rhoi/rhow, hsn) ! snow to remove
1709 1339107 : dhin = dhsn * rhos/rhoi ! ice to add
1710 : endif
1711 :
1712 : !-----------------------------------------------------------------
1713 : ! Adjust snow layer thickness.
1714 : ! Compute energy to transfer from snow to ice.
1715 : !-----------------------------------------------------------------
1716 :
1717 312939622 : do k = nslyr, 1, -1
1718 312939622 : if (dhin > puny) then
1719 1339107 : dhs = min(dhsn, dzs(k)) ! snow to remove from layer
1720 1339107 : hsn = hsn - dhs
1721 1339107 : dsnow = dsnow -dhs !new snow addition term
1722 1339107 : dzs(k) = dzs(k) - dhs
1723 1339107 : dhsn = dhsn - dhs
1724 1339107 : dhsn = max(dhsn,c0)
1725 1339107 : hqs = hqs + dhs * zqsn(k)
1726 : endif ! dhin > puny
1727 : enddo
1728 :
1729 : !-----------------------------------------------------------------
1730 : ! Transfer volume and energy from snow to top ice layer.
1731 : !-----------------------------------------------------------------
1732 :
1733 156469811 : if (dhin > puny) then
1734 : ! update ice age due to freezing (new ice age = dt)
1735 : ! if (tr_iage) &
1736 : ! iage = (iage*hin+dt*dhin)/(hin+dhin)
1737 :
1738 1339107 : wk1 = dzi(1) + dhin
1739 1339107 : hin = hin + dhin
1740 1339107 : zqin(1) = (dzi(1)*zqin(1) + hqs) / wk1
1741 1339107 : dzi(1) = wk1
1742 :
1743 : ! history diagnostic
1744 1339107 : snoice = snoice + dhin
1745 : endif ! dhin > puny
1746 :
1747 156469811 : end subroutine freeboard
1748 :
1749 : !=======================================================================
1750 : !
1751 : ! Conserving energy, compute the new enthalpy of equal-thickness ice
1752 : ! or snow layers.
1753 : !
1754 : ! authors William H. Lipscomb, LANL
1755 : ! C. M. Bitz, UW
1756 :
1757 1266476826 : subroutine adjust_enthalpy (nlyr, &
1758 1266476826 : z1, z2, &
1759 : hlyr, hn, &
1760 1266476826 : qn)
1761 :
1762 : integer (kind=int_kind), intent(in) :: &
1763 : nlyr ! number of layers (nilyr or nslyr)
1764 :
1765 : real (kind=dbl_kind), dimension (:), intent(in) :: &
1766 : z1 , & ! interface depth for old, unequal layers (m)
1767 : z2 ! interface depth for new, equal layers (m)
1768 :
1769 : real (kind=dbl_kind), intent(in) :: &
1770 : hlyr ! new layer thickness (m)
1771 :
1772 : real (kind=dbl_kind), intent(in) :: &
1773 : hn ! total thickness (m)
1774 :
1775 : real (kind=dbl_kind), dimension (:), intent(inout) :: &
1776 : qn ! layer quantity (enthalpy, salinity...)
1777 :
1778 : ! local variables
1779 :
1780 : integer (kind=int_kind) :: &
1781 : k, k1, k2 ! vertical indices
1782 :
1783 : real (kind=dbl_kind) :: &
1784 68854337 : hovlp ! overlap between old and new layers (m)
1785 :
1786 : real (kind=dbl_kind) :: &
1787 68854337 : rhlyr ! 1./hlyr
1788 :
1789 : real (kind=dbl_kind), dimension (nlyr) :: &
1790 2946079674 : hq ! h * q for a layer
1791 :
1792 : character(len=*),parameter :: subname='(adjust_enthalpy)'
1793 :
1794 : !-----------------------------------------------------------------
1795 : ! Compute reciprocal layer thickness.
1796 : !-----------------------------------------------------------------
1797 :
1798 1266476826 : rhlyr = c0
1799 1266476826 : if (hn > puny) rhlyr = c1 / hlyr
1800 :
1801 : !-----------------------------------------------------------------
1802 : ! Compute h*q for new layers (k2) given overlap with old layers (k1)
1803 : !-----------------------------------------------------------------
1804 :
1805 10131814608 : do k2 = 1, nlyr
1806 10131814608 : hq(k2) = c0
1807 : enddo ! k
1808 1266476826 : k1 = 1
1809 1266476826 : k2 = 1
1810 17729398038 : do while (k1 <= nlyr .and. k2 <= nlyr)
1811 1789985326 : hovlp = min (z1(k1+1), z2(k2+1)) &
1812 18252906538 : - max (z1(k1), z2(k2))
1813 16462921212 : hovlp = max (hovlp, c0)
1814 16462921212 : hq(k2) = hq(k2) + hovlp*qn(k1)
1815 17729398038 : if (z1(k1+1) > z2(k2+1)) then
1816 7597601854 : k2 = k2 + 1
1817 : else
1818 8865319358 : k1 = k1 + 1
1819 : endif
1820 : enddo ! while
1821 :
1822 : !-----------------------------------------------------------------
1823 : ! Compute new enthalpies.
1824 : !-----------------------------------------------------------------
1825 :
1826 10131814608 : do k = 1, nlyr
1827 10131814608 : qn(k) = hq(k) * rhlyr
1828 : enddo ! k
1829 :
1830 1266476826 : end subroutine adjust_enthalpy
1831 :
1832 : !=======================================================================
1833 : !
1834 : ! Check for energy conservation by comparing the change in energy
1835 : ! to the net energy input.
1836 : !
1837 : ! authors William H. Lipscomb, LANL
1838 : ! C. M. Bitz, UW
1839 : ! Adrian K. Turner, LANL
1840 :
1841 765790051 : subroutine conservation_check_vthermo(dt, &
1842 : fsurfn, flatn, &
1843 : fhocnn, fswint, &
1844 : fsnow, &
1845 : einit, einter, &
1846 : efinal, &
1847 : fcondtopn,fcondbotn, &
1848 : fadvocn, fbot )
1849 :
1850 : real (kind=dbl_kind), intent(in) :: &
1851 : dt ! time step
1852 :
1853 : real (kind=dbl_kind), intent(in) :: &
1854 : fsurfn , & ! net flux to top surface, excluding fcondtopn
1855 : flatn , & ! surface downward latent heat (W m-2)
1856 : fhocnn , & ! fbot, corrected for any surplus energy
1857 : fswint , & ! SW absorbed in ice interior, below surface (W m-2)
1858 : fsnow , & ! snowfall rate (kg m-2 s-1)
1859 : fcondtopn , &
1860 : fadvocn , &
1861 : fbot
1862 :
1863 : real (kind=dbl_kind), intent(in) :: &
1864 : einit , & ! initial energy of melting (J m-2)
1865 : einter , & ! intermediate energy of melting (J m-2)
1866 : efinal , & ! final energy of melting (J m-2)
1867 : fcondbotn
1868 :
1869 : ! local variables
1870 :
1871 : real (kind=dbl_kind) :: &
1872 54309042 : einp , & ! energy input during timestep (J m-2)
1873 54309042 : ferr ! energy conservation error (W m-2)
1874 :
1875 : character(len=*),parameter :: subname='(conservation_check_vthermo)'
1876 :
1877 : !----------------------------------------------------------------
1878 : ! If energy is not conserved, print diagnostics and exit.
1879 : !----------------------------------------------------------------
1880 :
1881 : !-----------------------------------------------------------------
1882 : ! Note that fsurf - flat = fsw + flw + fsens; i.e., the latent
1883 : ! heat is not included in the energy input, since (efinal - einit)
1884 : ! is the energy change in the system ice + vapor, and the latent
1885 : ! heat lost by the ice is equal to that gained by the vapor.
1886 : !-----------------------------------------------------------------
1887 :
1888 : einp = (fsurfn - flatn + fswint - fhocnn &
1889 765790051 : - fsnow*Lfresh - fadvocn) * dt
1890 765790051 : ferr = abs(efinal-einit-einp) / dt
1891 :
1892 765790051 : if (ferr > ferrmax) then
1893 0 : call icepack_warnings_setabort(.true.,__FILE__,__LINE__)
1894 0 : call icepack_warnings_add(subname//" conservation_check_vthermo: Thermo energy conservation error" )
1895 :
1896 0 : write(warnstr,*) subname, 'Thermo energy conservation error'
1897 0 : call icepack_warnings_add(warnstr)
1898 0 : write(warnstr,*) subname, 'Flux error (W/m^2) =', ferr
1899 0 : call icepack_warnings_add(warnstr)
1900 0 : write(warnstr,*) subname, 'Energy error (J) =', ferr*dt
1901 0 : call icepack_warnings_add(warnstr)
1902 0 : write(warnstr,*) subname, 'Initial energy =', einit
1903 0 : call icepack_warnings_add(warnstr)
1904 0 : write(warnstr,*) subname, 'Final energy =', efinal
1905 0 : call icepack_warnings_add(warnstr)
1906 0 : write(warnstr,*) subname, 'efinal - einit =', efinal-einit
1907 0 : call icepack_warnings_add(warnstr)
1908 0 : write(warnstr,*) subname, 'fsurfn,flatn,fswint,fhocn, fsnow*Lfresh:'
1909 0 : call icepack_warnings_add(warnstr)
1910 0 : write(warnstr,*) subname, fsurfn,flatn,fswint,fhocnn, fsnow*Lfresh
1911 0 : call icepack_warnings_add(warnstr)
1912 0 : write(warnstr,*) subname, 'Input energy =', einp
1913 0 : call icepack_warnings_add(warnstr)
1914 0 : write(warnstr,*) subname, 'fbot,fcondbot:'
1915 0 : call icepack_warnings_add(warnstr)
1916 0 : write(warnstr,*) subname, fbot,fcondbotn
1917 0 : call icepack_warnings_add(warnstr)
1918 :
1919 : ! if (ktherm == 2) then
1920 0 : write(warnstr,*) subname, 'Intermediate energy =', einter
1921 0 : call icepack_warnings_add(warnstr)
1922 0 : write(warnstr,*) subname, 'efinal - einter =', &
1923 0 : efinal-einter
1924 0 : call icepack_warnings_add(warnstr)
1925 0 : write(warnstr,*) subname, 'einter - einit =', &
1926 0 : einter-einit
1927 0 : call icepack_warnings_add(warnstr)
1928 0 : write(warnstr,*) subname, 'Conduction Error =', (einter-einit) &
1929 0 : - (fcondtopn*dt - fcondbotn*dt + fswint*dt)
1930 0 : call icepack_warnings_add(warnstr)
1931 0 : write(warnstr,*) subname, 'Melt/Growth Error =', (einter-einit) &
1932 0 : + ferr*dt - (fcondtopn*dt - fcondbotn*dt + fswint*dt)
1933 0 : call icepack_warnings_add(warnstr)
1934 0 : write(warnstr,*) subname, 'Advection Error =', fadvocn*dt
1935 0 : call icepack_warnings_add(warnstr)
1936 : ! endif
1937 :
1938 : ! write(warnstr,*) subname, fsurfn,flatn,fswint,fhocnn
1939 : ! call icepack_warnings_add(warnstr)
1940 :
1941 0 : write(warnstr,*) subname, 'dt*(fsurfn, flatn, fswint, fhocn, fsnow*Lfresh, fadvocn):'
1942 0 : call icepack_warnings_add(warnstr)
1943 0 : write(warnstr,*) subname, fsurfn*dt, flatn*dt, &
1944 0 : fswint*dt, fhocnn*dt, &
1945 0 : fsnow*Lfresh*dt, fadvocn*dt
1946 0 : call icepack_warnings_add(warnstr)
1947 0 : return
1948 : endif
1949 :
1950 : end subroutine conservation_check_vthermo
1951 :
1952 : !=======================================================================
1953 : !
1954 : ! Given the vertical thermo state variables (hin, hsn),
1955 : ! compute the new ice state variables (vicen, vsnon).
1956 : ! Zero out state variables if ice has melted entirely.
1957 : !
1958 : ! authors William H. Lipscomb, LANL
1959 : ! C. M. Bitz, UW
1960 : ! Elizabeth C. Hunke, LANL
1961 :
1962 765790051 : subroutine update_state_vthermo(nilyr, nslyr, &
1963 : Tf, Tsf, &
1964 : hin, hsn, &
1965 765790051 : zqin, zSin, &
1966 765790051 : zqsn, &
1967 : aicen, vicen, &
1968 : vsnon)
1969 :
1970 : integer (kind=int_kind), intent(in) :: &
1971 : nilyr , & ! number of ice layers
1972 : nslyr ! number of snow layers
1973 :
1974 : real (kind=dbl_kind), intent(in) :: &
1975 : Tf ! freezing temperature (C)
1976 :
1977 : real (kind=dbl_kind), intent(inout) :: &
1978 : Tsf ! ice/snow surface temperature, Tsfcn
1979 :
1980 : real (kind=dbl_kind), intent(in) :: &
1981 : hin , & ! ice thickness (m)
1982 : hsn ! snow thickness (m)
1983 :
1984 : real (kind=dbl_kind), dimension (:), intent(inout) :: &
1985 : zqin , & ! ice layer enthalpy (J m-3)
1986 : zSin , & ! ice salinity (ppt)
1987 : zqsn ! snow layer enthalpy (J m-3)
1988 :
1989 : real (kind=dbl_kind), intent(inout) :: &
1990 : aicen , & ! concentration of ice
1991 : vicen , & ! volume per unit area of ice (m)
1992 : vsnon ! volume per unit area of snow (m)
1993 :
1994 : ! local variables
1995 :
1996 : integer (kind=int_kind) :: &
1997 : k ! ice layer index
1998 :
1999 : character(len=*),parameter :: subname='(update_state_vthermo)'
2000 :
2001 765790051 : if (hin <= c0) then
2002 105512 : aicen = c0
2003 105512 : vicen = c0
2004 105512 : vsnon = c0
2005 105512 : Tsf = Tf
2006 844096 : do k = 1, nilyr
2007 844096 : zqin(k) = c0
2008 : enddo
2009 105512 : if (ktherm == 2) then
2010 844096 : do k = 1, nilyr
2011 844096 : zSin(k) = c0
2012 : enddo
2013 : endif
2014 211024 : do k = 1, nslyr
2015 211024 : zqsn(k) = c0
2016 : enddo
2017 : else
2018 : ! aicen is already up to date
2019 765684539 : vicen = aicen * hin
2020 765684539 : vsnon = aicen * hsn
2021 : endif
2022 :
2023 765790051 : end subroutine update_state_vthermo
2024 :
2025 : !=======================================================================
2026 : !autodocument_start icepack_step_therm1
2027 : ! Driver for thermodynamic changes not needed for coupling:
2028 : ! transport in thickness space, lateral growth and melting.
2029 : !
2030 : ! authors: William H. Lipscomb, LANL
2031 : ! Elizabeth C. Hunke, LANL
2032 :
2033 716710152 : subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, &
2034 716710152 : aicen_init , &
2035 716710152 : vicen_init , vsnon_init , &
2036 716710152 : aice , aicen , &
2037 716710152 : vice , vicen , &
2038 716710152 : vsno , vsnon , &
2039 : uvel , vvel , &
2040 1433420304 : Tsfc , zqsn , &
2041 1433420304 : zqin , zSin , &
2042 716710152 : alvl , vlvl , &
2043 716710152 : apnd , hpnd , &
2044 716710152 : ipnd , &
2045 716710152 : iage , FY , &
2046 716710152 : aerosno , aeroice , &
2047 716710152 : isosno , isoice , &
2048 : uatm , vatm , &
2049 : wind , zlvl , &
2050 : Qa , rhoa , &
2051 716710152 : Qa_iso , &
2052 : Tair , Tref , &
2053 : Qref , Uref , &
2054 716710152 : Qref_iso , &
2055 : Cdn_atm_ratio, &
2056 : Cdn_ocn , Cdn_ocn_skin, &
2057 : Cdn_ocn_floe, Cdn_ocn_keel, &
2058 : Cdn_atm , Cdn_atm_skin, &
2059 : Cdn_atm_floe, Cdn_atm_pond, &
2060 : Cdn_atm_rdg , hfreebd , &
2061 : hdraft , hridge , &
2062 : distrdg , hkeel , &
2063 : dkeel , lfloe , &
2064 : dfloe , &
2065 : strax , stray , &
2066 : strairxT , strairyT , &
2067 : potT , sst , &
2068 : sss , Tf , &
2069 : strocnxT , strocnyT , &
2070 : fbot , &
2071 : Tbot , Tsnice , &
2072 : frzmlt , rside , &
2073 : fside , &
2074 : fsnow , frain , &
2075 : fpond , &
2076 716710152 : fsurf , fsurfn , &
2077 716710152 : fcondtop , fcondtopn , &
2078 716710152 : fcondbot , fcondbotn , &
2079 716710152 : fswsfcn , fswintn , &
2080 716710152 : fswthrun , &
2081 716710152 : fswthrun_vdr, &
2082 716710152 : fswthrun_vdf, &
2083 716710152 : fswthrun_idr, &
2084 716710152 : fswthrun_idf, &
2085 : fswabs , &
2086 : flwout , &
2087 716710152 : Sswabsn , Iswabsn , &
2088 : flw , &
2089 716710152 : fsens , fsensn , &
2090 716710152 : flat , flatn , &
2091 : evap , &
2092 : evaps , evapi , &
2093 : fresh , fsalt , &
2094 : fhocn , &
2095 : fswthru , &
2096 : fswthru_vdr , &
2097 : fswthru_vdf , &
2098 : fswthru_idr , &
2099 : fswthru_idf , &
2100 716710152 : flatn_f , fsensn_f , &
2101 716710152 : fsurfn_f , fcondtopn_f , &
2102 716710152 : faero_atm , faero_ocn , &
2103 716710152 : fiso_atm , fiso_ocn , &
2104 716710152 : fiso_evap , &
2105 : HDO_ocn , H2_16O_ocn , &
2106 : H2_18O_ocn , &
2107 716710152 : dhsn , ffracn , &
2108 716710152 : meltt , melttn , &
2109 716710152 : meltb , meltbn , &
2110 716710152 : melts , meltsn , &
2111 716710152 : congel , congeln , &
2112 716710152 : snoice , snoicen , &
2113 716710152 : dsnown , &
2114 : lmask_n , lmask_s , &
2115 : mlt_onset , frz_onset , &
2116 : yday , prescribed_ice)
2117 :
2118 : integer (kind=int_kind), intent(in) :: &
2119 : ncat , & ! number of thickness categories
2120 : nilyr , & ! number of ice layers
2121 : nslyr ! number of snow layers
2122 :
2123 : real (kind=dbl_kind), intent(in) :: &
2124 : dt , & ! time step
2125 : uvel , & ! x-component of velocity (m/s)
2126 : vvel , & ! y-component of velocity (m/s)
2127 : strax , & ! wind stress components (N/m^2)
2128 : stray , & !
2129 : yday ! day of year
2130 :
2131 : logical (kind=log_kind), intent(in) :: &
2132 : lmask_n , & ! northern hemisphere mask
2133 : lmask_s ! southern hemisphere mask
2134 :
2135 : logical (kind=log_kind), intent(in), optional :: &
2136 : prescribed_ice ! if .true., use prescribed ice instead of computed
2137 :
2138 : real (kind=dbl_kind), intent(inout) :: &
2139 : aice , & ! sea ice concentration
2140 : vice , & ! volume per unit area of ice (m)
2141 : vsno , & ! volume per unit area of snow (m)
2142 : zlvl , & ! atm level height (m)
2143 : uatm , & ! wind velocity components (m/s)
2144 : vatm , &
2145 : wind , & ! wind speed (m/s)
2146 : potT , & ! air potential temperature (K)
2147 : Tair , & ! air temperature (K)
2148 : Qa , & ! specific humidity (kg/kg)
2149 : rhoa , & ! air density (kg/m^3)
2150 : frain , & ! rainfall rate (kg/m^2 s)
2151 : fsnow , & ! snowfall rate (kg/m^2 s)
2152 : fpond , & ! fresh water flux to ponds (kg/m^2/s)
2153 : fresh , & ! fresh water flux to ocean (kg/m^2/s)
2154 : fsalt , & ! salt flux to ocean (kg/m^2/s)
2155 : fhocn , & ! net heat flux to ocean (W/m^2)
2156 : fswthru , & ! shortwave penetrating to ocean (W/m^2)
2157 : fsurf , & ! net surface heat flux (excluding fcondtop)(W/m^2)
2158 : fcondtop , & ! top surface conductive flux (W/m^2)
2159 : fcondbot , & ! bottom surface conductive flux (W/m^2)
2160 : fsens , & ! sensible heat flux (W/m^2)
2161 : flat , & ! latent heat flux (W/m^2)
2162 : fswabs , & ! shortwave flux absorbed in ice and ocean (W/m^2)
2163 : flw , & ! incoming longwave radiation (W/m^2)
2164 : flwout , & ! outgoing longwave radiation (W/m^2)
2165 : evap , & ! evaporative water flux (kg/m^2/s)
2166 : evaps , & ! evaporative water flux over snow (kg/m^2/s)
2167 : evapi , & ! evaporative water flux over ice (kg/m^2/s)
2168 : congel , & ! basal ice growth (m/step-->cm/day)
2169 : snoice , & ! snow-ice formation (m/step-->cm/day)
2170 : Tref , & ! 2m atm reference temperature (K)
2171 : Qref , & ! 2m atm reference spec humidity (kg/kg)
2172 : Uref , & ! 10m atm reference wind speed (m/s)
2173 : Cdn_atm , & ! atm drag coefficient
2174 : Cdn_ocn , & ! ocn drag coefficient
2175 : hfreebd , & ! freeboard (m)
2176 : hdraft , & ! draft of ice + snow column (Stoessel1993)
2177 : hridge , & ! ridge height
2178 : distrdg , & ! distance between ridges
2179 : hkeel , & ! keel depth
2180 : dkeel , & ! distance between keels
2181 : lfloe , & ! floe length
2182 : dfloe , & ! distance between floes
2183 : Cdn_atm_skin, & ! neutral skin drag coefficient
2184 : Cdn_atm_floe, & ! neutral floe edge drag coefficient
2185 : Cdn_atm_pond, & ! neutral pond edge drag coefficient
2186 : Cdn_atm_rdg , & ! neutral ridge drag coefficient
2187 : Cdn_ocn_skin, & ! skin drag coefficient
2188 : Cdn_ocn_floe, & ! floe edge drag coefficient
2189 : Cdn_ocn_keel, & ! keel drag coefficient
2190 : Cdn_atm_ratio,& ! ratio drag atm / neutral drag atm
2191 : strairxT , & ! stress on ice by air, x-direction
2192 : strairyT , & ! stress on ice by air, y-direction
2193 : strocnxT , & ! ice-ocean stress, x-direction
2194 : strocnyT , & ! ice-ocean stress, y-direction
2195 : fbot , & ! ice-ocean heat flux at bottom surface (W/m^2)
2196 : frzmlt , & ! freezing/melting potential (W/m^2)
2197 : rside , & ! fraction of ice that melts laterally
2198 : fside , & ! lateral heat flux (W/m^2)
2199 : sst , & ! sea surface temperature (C)
2200 : Tf , & ! freezing temperature (C)
2201 : Tbot , & ! ice bottom surface temperature (deg C)
2202 : Tsnice , & ! snow ice interface temperature (deg C)
2203 : sss , & ! sea surface salinity (ppt)
2204 : meltt , & ! top ice melt (m/step-->cm/day)
2205 : melts , & ! snow melt (m/step-->cm/day)
2206 : meltb , & ! basal ice melt (m/step-->cm/day)
2207 : mlt_onset , & ! day of year that sfc melting begins
2208 : frz_onset ! day of year that freezing begins (congel or frazil)
2209 :
2210 : real (kind=dbl_kind), intent(inout), optional :: &
2211 : fswthru_vdr , & ! vis dir shortwave penetrating to ocean (W/m^2)
2212 : fswthru_vdf , & ! vis dif shortwave penetrating to ocean (W/m^2)
2213 : fswthru_idr , & ! nir dir shortwave penetrating to ocean (W/m^2)
2214 : fswthru_idf ! nir dif shortwave penetrating to ocean (W/m^2)
2215 :
2216 : real (kind=dbl_kind), dimension(:), optional, intent(inout) :: &
2217 : Qa_iso , & ! isotope specific humidity (kg/kg)
2218 : Qref_iso , & ! isotope 2m atm reference spec humidity (kg/kg)
2219 : fiso_atm , & ! isotope deposition rate (kg/m^2 s)
2220 : fiso_ocn , & ! isotope flux to ocean (kg/m^2/s)
2221 : fiso_evap ! isotope evaporation (kg/m^2/s)
2222 :
2223 : real (kind=dbl_kind), optional, intent(in) :: &
2224 : HDO_ocn , & ! ocean concentration of HDO (kg/kg)
2225 : H2_16O_ocn , & ! ocean concentration of H2_16O (kg/kg)
2226 : H2_18O_ocn ! ocean concentration of H2_18O (kg/kg)
2227 :
2228 : real (kind=dbl_kind), dimension(:), intent(inout) :: &
2229 : aicen_init , & ! fractional area of ice
2230 : vicen_init , & ! volume per unit area of ice (m)
2231 : vsnon_init , & ! volume per unit area of snow (m)
2232 : aicen , & ! concentration of ice
2233 : vicen , & ! volume per unit area of ice (m)
2234 : vsnon , & ! volume per unit area of snow (m)
2235 : Tsfc , & ! ice/snow surface temperature, Tsfcn
2236 : alvl , & ! level ice area fraction
2237 : vlvl , & ! level ice volume fraction
2238 : apnd , & ! melt pond area fraction
2239 : hpnd , & ! melt pond depth (m)
2240 : ipnd , & ! melt pond refrozen lid thickness (m)
2241 : iage , & ! volume-weighted ice age
2242 : FY , & ! area-weighted first-year ice area
2243 : fsurfn , & ! net flux to top surface, excluding fcondtop
2244 : fcondtopn , & ! downward cond flux at top surface (W m-2)
2245 : fcondbotn , & ! downward cond flux at bottom surface (W m-2)
2246 : flatn , & ! latent heat flux (W m-2)
2247 : fsensn , & ! sensible heat flux (W m-2)
2248 : fsurfn_f , & ! net flux to top surface, excluding fcondtop
2249 : fcondtopn_f , & ! downward cond flux at top surface (W m-2)
2250 : flatn_f , & ! latent heat flux (W m-2)
2251 : fsensn_f , & ! sensible heat flux (W m-2)
2252 : fswsfcn , & ! SW absorbed at ice/snow surface (W m-2)
2253 : fswthrun , & ! SW through ice to ocean (W/m^2)
2254 : fswintn , & ! SW absorbed in ice interior, below surface (W m-2)
2255 : faero_atm , & ! aerosol deposition rate (kg/m^2 s)
2256 : faero_ocn , & ! aerosol flux to ocean (kg/m^2/s)
2257 : dhsn , & ! depth difference for snow on sea ice and pond ice
2258 : ffracn , & ! fraction of fsurfn used to melt ipond
2259 : meltsn , & ! snow melt (m)
2260 : melttn , & ! top ice melt (m)
2261 : meltbn , & ! bottom ice melt (m)
2262 : congeln , & ! congelation ice growth (m)
2263 : snoicen , & ! snow-ice growth (m)
2264 : dsnown ! change in snow thickness (m/step-->cm/day)
2265 :
2266 : real (kind=dbl_kind), optional, dimension(:), intent(inout) :: &
2267 : fswthrun_vdr , & ! vis dir SW through ice to ocean (W/m^2)
2268 : fswthrun_vdf , & ! vis dif SW through ice to ocean (W/m^2)
2269 : fswthrun_idr , & ! nir dir SW through ice to ocean (W/m^2)
2270 : fswthrun_idf ! nir dif SW through ice to ocean (W/m^2)
2271 :
2272 : real (kind=dbl_kind), dimension(:,:), intent(inout) :: &
2273 : zqsn , & ! snow layer enthalpy (J m-3)
2274 : zqin , & ! ice layer enthalpy (J m-3)
2275 : zSin , & ! internal ice layer salinities
2276 : Sswabsn , & ! SW radiation absorbed in snow layers (W m-2)
2277 : Iswabsn ! SW radiation absorbed in ice layers (W m-2)
2278 :
2279 : real (kind=dbl_kind), dimension(:,:,:), intent(inout) :: &
2280 : aerosno , & ! snow aerosol tracer (kg/m^2)
2281 : aeroice ! ice aerosol tracer (kg/m^2)
2282 :
2283 : real (kind=dbl_kind), dimension(:,:), optional, intent(inout) :: &
2284 : isosno , & ! snow isotope tracer (kg/m^2)
2285 : isoice ! ice isotope tracer (kg/m^2)
2286 : !autodocument_end
2287 :
2288 : ! local variables
2289 :
2290 : integer (kind=int_kind) :: &
2291 : n ! category index
2292 :
2293 : real (kind=dbl_kind) :: &
2294 45106800 : worka, workb ! temporary variables
2295 :
2296 : ! 2D coupler variables (computed for each category, then aggregated)
2297 : real (kind=dbl_kind) :: &
2298 45106800 : fswabsn , & ! shortwave absorbed by ice (W/m^2)
2299 45106800 : flwoutn , & ! upward LW at surface (W/m^2)
2300 45106800 : evapn , & ! flux of vapor, atmos to ice (kg m-2 s-1)
2301 45106800 : evapsn , & ! flux of vapor, atmos to ice over snow (kg m-2 s-1)
2302 45106800 : evapin , & ! flux of vapor, atmos to ice over ice (kg m-2 s-1)
2303 45106800 : freshn , & ! flux of water, ice to ocean (kg/m^2/s)
2304 45106800 : fsaltn , & ! flux of salt, ice to ocean (kg/m^2/s)
2305 45106800 : fhocnn , & ! fbot corrected for leftover energy (W/m^2)
2306 45106800 : strairxn , & ! air/ice zonal stress, (N/m^2)
2307 45106800 : strairyn , & ! air/ice meridional stress, (N/m^2)
2308 45106800 : Cdn_atm_ratio_n, & ! drag coefficient ratio
2309 45106800 : Trefn , & ! air tmp reference level (K)
2310 45106800 : Urefn , & ! air speed reference level (m/s)
2311 45106800 : Qrefn , & ! air sp hum reference level (kg/kg)
2312 45106800 : shcoef , & ! transfer coefficient for sensible heat
2313 45106800 : lhcoef , & ! transfer coefficient for latent heat
2314 45106800 : rfrac ! water fraction retained for melt ponds
2315 :
2316 : real (kind=dbl_kind), dimension(n_iso) :: &
2317 1388889936 : Qrefn_iso , & ! isotope air sp hum reference level (kg/kg)
2318 1388889936 : fiso_ocnn , & ! isotope flux to ocean (kg/m^2/s)
2319 1479103536 : fiso_evapn ! isotope evaporation (kg/m^2/s)
2320 :
2321 : real (kind=dbl_kind), allocatable, dimension(:,:) :: &
2322 716710152 : l_isosno , & ! local snow isotope tracer (kg/m^2)
2323 716710152 : l_isoice ! local ice isotope tracer (kg/m^2)
2324 :
2325 : real (kind=dbl_kind), allocatable, dimension(:) :: &
2326 716710152 : l_Qa_iso , & ! local isotope specific humidity (kg/kg)
2327 716710152 : l_Qref_iso , & ! local isotope 2m atm reference spec humidity (kg/kg)
2328 716710152 : l_fiso_atm , & ! local isotope deposition rate (kg/m^2 s)
2329 716710152 : l_fiso_ocn , & ! local isotope flux to ocean (kg/m^2/s)
2330 716710152 : l_fiso_evap ! local isotope evaporation (kg/m^2/s)
2331 :
2332 : real (kind=dbl_kind) :: &
2333 45106800 : l_HDO_ocn , & ! local ocean concentration of HDO (kg/kg)
2334 45106800 : l_H2_16O_ocn, & ! local ocean concentration of H2_16O (kg/kg)
2335 45106800 : l_H2_18O_ocn ! local ocean concentration of H2_18O (kg/kg)
2336 :
2337 : real (kind=dbl_kind) :: &
2338 45106800 : l_fswthru_vdr , & ! vis dir SW through ice to ocean (W/m^2)
2339 45106800 : l_fswthru_vdf , & ! vis dif SW through ice to ocean (W/m^2)
2340 45106800 : l_fswthru_idr , & ! nir dir SW through ice to ocean (W/m^2)
2341 45106800 : l_fswthru_idf ! nir dif SW through ice to ocean (W/m^2)
2342 :
2343 : real (kind=dbl_kind), dimension(:), allocatable :: &
2344 716710152 : l_fswthrun_vdr , & ! vis dir SW through ice to ocean (W/m^2)
2345 716710152 : l_fswthrun_vdf , & ! vis dif SW through ice to ocean (W/m^2)
2346 716710152 : l_fswthrun_idr , & ! nir dir SW through ice to ocean (W/m^2)
2347 716710152 : l_fswthrun_idf ! nir dif SW through ice to ocean (W/m^2)
2348 :
2349 : real (kind=dbl_kind) :: &
2350 45106800 : pond ! water retained in ponds (m)
2351 :
2352 : character(len=*),parameter :: subname='(icepack_step_therm1)'
2353 :
2354 : !-----------------------------------------------------------------
2355 : ! allocate local optional arguments
2356 : !-----------------------------------------------------------------
2357 :
2358 716710152 : if (present(isosno) ) then
2359 716710152 : allocate(l_isosno(size(isosno,dim=1),size(isosno,dim=2)))
2360 4533715872 : l_isosno = isosno
2361 : else
2362 0 : allocate(l_isosno(1,1))
2363 0 : l_isosno = c0
2364 : endif
2365 :
2366 716710152 : if (present(isoice) ) then
2367 716710152 : allocate(l_isoice(size(isoice,dim=1),size(isoice,dim=2)))
2368 4533715872 : l_isoice = isoice
2369 : else
2370 0 : allocate(l_isoice(1,1))
2371 0 : l_isoice = c0
2372 : endif
2373 :
2374 716710152 : if (present(Qa_iso) ) then
2375 716710152 : allocate(l_Qa_iso(size(Qa_iso)))
2376 2866840608 : l_Qa_iso = Qa_iso
2377 : else
2378 0 : allocate(l_Qa_iso(1))
2379 0 : l_Qa_iso = c0
2380 : endif
2381 :
2382 716710152 : if (present(Qref_iso) ) then
2383 716710152 : allocate(l_Qref_iso(size(Qref_iso)))
2384 2866840608 : l_Qref_iso = Qref_iso
2385 : else
2386 0 : allocate(l_Qref_iso(1))
2387 0 : l_Qref_iso = c0
2388 : endif
2389 :
2390 716710152 : if (present(fiso_atm) ) then
2391 716710152 : allocate(l_fiso_atm(size(fiso_atm)))
2392 2866840608 : l_fiso_atm = fiso_atm
2393 : else
2394 0 : allocate(l_fiso_atm(1))
2395 0 : l_fiso_atm = c0
2396 : endif
2397 :
2398 716710152 : if (present(fiso_ocn) ) then
2399 716710152 : allocate(l_fiso_ocn(size(fiso_ocn)))
2400 2866840608 : l_fiso_ocn = fiso_ocn
2401 : else
2402 0 : allocate(l_fiso_ocn(1))
2403 0 : l_fiso_ocn = c0
2404 : endif
2405 :
2406 716710152 : if (present(fiso_evap) ) then
2407 716710152 : allocate(l_fiso_evap(size(fiso_evap)))
2408 2866840608 : l_fiso_evap = fiso_evap
2409 : else
2410 0 : allocate(l_fiso_evap(1))
2411 0 : l_fiso_evap = c0
2412 : endif
2413 :
2414 716710152 : l_HDO_ocn = c0
2415 716710152 : if (present(HDO_ocn) ) l_HDO_ocn = HDO_ocn
2416 :
2417 716710152 : l_H2_16O_ocn = c0
2418 716710152 : if (present(H2_16O_ocn)) l_H2_16O_ocn = H2_16O_ocn
2419 :
2420 716710152 : l_H2_18O_ocn = c0
2421 716710152 : if (present(H2_18O_ocn)) l_H2_18O_ocn = H2_18O_ocn
2422 :
2423 716710152 : l_fswthru_vdr = c0
2424 716710152 : if (present(fswthru_vdr) ) l_fswthru_vdr = fswthru_vdr
2425 :
2426 716710152 : l_fswthru_vdf = c0
2427 716710152 : if (present(fswthru_vdf) ) l_fswthru_vdf = fswthru_vdf
2428 :
2429 716710152 : l_fswthru_idr = c0
2430 716710152 : if (present(fswthru_idr) ) l_fswthru_idr = fswthru_idr
2431 :
2432 716710152 : l_fswthru_idf = c0
2433 716710152 : if (present(fswthru_idf) ) l_fswthru_idf = fswthru_idf
2434 :
2435 716710152 : allocate(l_fswthrun_vdr(ncat))
2436 716710152 : allocate(l_fswthrun_vdf(ncat))
2437 716710152 : allocate(l_fswthrun_idr(ncat))
2438 716710152 : allocate(l_fswthrun_idf(ncat))
2439 :
2440 4228206912 : l_fswthrun_vdr = c0
2441 4228206912 : if (present(fswthrun_vdr) ) l_fswthrun_vdr = fswthrun_vdr
2442 :
2443 4228206912 : l_fswthrun_vdf = c0
2444 4228206912 : if (present(fswthrun_vdf) ) l_fswthrun_vdf = fswthrun_vdf
2445 :
2446 4228206912 : l_fswthrun_idr = c0
2447 4228206912 : if (present(fswthrun_idr) ) l_fswthrun_idr = fswthrun_idr
2448 :
2449 4228206912 : l_fswthrun_idf = c0
2450 4228206912 : if (present(fswthrun_idf) ) l_fswthrun_idf = fswthrun_idf
2451 :
2452 : !-----------------------------------------------------------------
2453 : ! Adjust frzmlt to account for ice-ocean heat fluxes since last
2454 : ! call to coupler.
2455 : ! Compute lateral and bottom heat fluxes.
2456 : !-----------------------------------------------------------------
2457 :
2458 : call frzmlt_bottom_lateral (dt, ncat, &
2459 : nilyr, nslyr, &
2460 : aice, frzmlt, &
2461 0 : vicen, vsnon, &
2462 0 : zqin, zqsn, &
2463 : sst, Tf, &
2464 : ustar_min, &
2465 : fbot_xfer_type, &
2466 : strocnxT, strocnyT, &
2467 : Tbot, fbot, &
2468 : rside, Cdn_ocn, &
2469 716710152 : fside)
2470 :
2471 716710152 : if (icepack_warnings_aborted(subname)) return
2472 :
2473 : !-----------------------------------------------------------------
2474 : ! Update the neutral drag coefficients to account for form drag
2475 : ! Oceanic and atmospheric drag coefficients
2476 : !-----------------------------------------------------------------
2477 :
2478 716710152 : if (formdrag) then
2479 0 : call neutral_drag_coeffs (apnd , &
2480 0 : hpnd , ipnd , &
2481 0 : alvl , vlvl , &
2482 : aice , vice, &
2483 0 : vsno , aicen , &
2484 0 : vicen , &
2485 : Cdn_ocn , Cdn_ocn_skin, &
2486 : Cdn_ocn_floe, Cdn_ocn_keel, &
2487 : Cdn_atm , Cdn_atm_skin, &
2488 : Cdn_atm_floe, Cdn_atm_pond, &
2489 : Cdn_atm_rdg , hfreebd , &
2490 : hdraft , hridge , &
2491 : distrdg , hkeel , &
2492 : dkeel , lfloe , &
2493 20367264 : dfloe , ncat)
2494 20367264 : if (icepack_warnings_aborted(subname)) return
2495 : endif
2496 :
2497 4228206912 : do n = 1, ncat
2498 :
2499 3511496760 : meltsn (n) = c0
2500 3511496760 : melttn (n) = c0
2501 3511496760 : meltbn (n) = c0
2502 3511496760 : congeln(n) = c0
2503 3511496760 : snoicen(n) = c0
2504 3511496760 : dsnown (n) = c0
2505 :
2506 3511496760 : Trefn = c0
2507 3511496760 : Qrefn = c0
2508 3817005720 : Qrefn_iso(:) = c0
2509 3817005720 : fiso_ocnn(:) = c0
2510 3817005720 : fiso_evapn(:) = c0
2511 3511496760 : Urefn = c0
2512 3511496760 : lhcoef = c0
2513 3511496760 : shcoef = c0
2514 3511496760 : worka = c0
2515 3511496760 : workb = c0
2516 :
2517 3511496760 : if (aicen_init(n) > puny) then
2518 :
2519 765790051 : if (calc_Tsfc .or. calc_strair) then
2520 :
2521 : !-----------------------------------------------------------------
2522 : ! Atmosphere boundary layer calculation; compute coefficients
2523 : ! for sensible and latent heat fluxes.
2524 : !
2525 : ! NOTE: The wind stress is computed here for later use if
2526 : ! calc_strair = .true. Otherwise, the wind stress
2527 : ! components are set to the data values.
2528 : !-----------------------------------------------------------------
2529 :
2530 : call icepack_atm_boundary('ice', &
2531 54309042 : Tsfc(n), potT, &
2532 : uatm, vatm, &
2533 : wind, zlvl, &
2534 : Qa, rhoa, &
2535 : strairxn, strairyn, &
2536 : Trefn, Qrefn, &
2537 : worka, workb, &
2538 : lhcoef, shcoef, &
2539 : Cdn_atm, &
2540 : Cdn_atm_ratio_n, &
2541 : Qa_iso=l_Qa_iso, &
2542 0 : Qref_iso=Qrefn_iso, &
2543 : uvel=uvel, vvel=vvel, &
2544 765790051 : Uref=Urefn)
2545 765790051 : if (icepack_warnings_aborted(subname)) return
2546 :
2547 : endif ! calc_Tsfc or calc_strair
2548 :
2549 765790051 : if (.not.(calc_strair)) then
2550 : #ifndef CICE_IN_NEMO
2551 : ! Set to data values (on T points)
2552 0 : strairxn = strax
2553 0 : strairyn = stray
2554 : #else
2555 : ! NEMO wind stress is supplied on u grid, multipied
2556 : ! by ice concentration and set directly in evp, so
2557 : ! strairxT/yT = 0. Zero u-components here for safety.
2558 : strairxn = c0
2559 : strairyn = c0
2560 : #endif
2561 : endif
2562 :
2563 : !-----------------------------------------------------------------
2564 : ! Update ice age
2565 : ! This is further adjusted for freezing in the thermodynamics.
2566 : ! Melting does not alter the ice age.
2567 : !-----------------------------------------------------------------
2568 :
2569 765790051 : if (tr_iage) call increment_age (dt, iage(n))
2570 765790051 : if (icepack_warnings_aborted(subname)) return
2571 765790051 : if (tr_FY) call update_FYarea (dt, &
2572 : lmask_n, lmask_s, &
2573 633409665 : yday, FY(n))
2574 765790051 : if (icepack_warnings_aborted(subname)) return
2575 :
2576 : !-----------------------------------------------------------------
2577 : ! Vertical thermodynamics: Heat conduction, growth and melting.
2578 : !-----------------------------------------------------------------
2579 :
2580 765790051 : if (.not.(calc_Tsfc)) then
2581 :
2582 : ! If not calculating surface temperature and fluxes, set
2583 : ! surface fluxes (flatn, fsurfn, and fcondtopn) to be used
2584 : ! in thickness_changes
2585 :
2586 : ! hadgem routine sets fluxes to default values in ice-only mode
2587 3773267 : call set_sfcflux(aicen (n), &
2588 3773267 : flatn_f (n), fsensn_f (n), &
2589 3773267 : fcondtopn_f(n), &
2590 3773267 : fsurfn_f (n), &
2591 3773267 : flatn (n), fsensn (n), &
2592 3773267 : fsurfn (n), &
2593 26412869 : fcondtopn (n))
2594 26412869 : if (icepack_warnings_aborted(subname)) return
2595 : endif
2596 :
2597 : call thermo_vertical(nilyr, nslyr, &
2598 54309042 : dt, aicen (n), &
2599 54309042 : vicen (n), vsnon (n), &
2600 54309042 : Tsfc (n), zSin (:,n), &
2601 0 : zqin (:,n), zqsn (:,n), &
2602 54309042 : apnd (n), hpnd (n), &
2603 : tr_pond_topo, &
2604 : flw, potT, &
2605 : Qa, rhoa, &
2606 : fsnow, fpond, &
2607 : fbot, Tbot, &
2608 : Tsnice, sss, &
2609 : lhcoef, shcoef, &
2610 54309042 : fswsfcn (n), fswintn (n), &
2611 0 : Sswabsn(:,n), Iswabsn(:,n), &
2612 54309042 : fsurfn (n), fcondtopn(n), &
2613 54309042 : fcondbotn(n), &
2614 54309042 : fsensn (n), flatn (n), &
2615 : flwoutn, evapn, &
2616 : evapsn, evapin, &
2617 : freshn, fsaltn, &
2618 : fhocnn, &
2619 54309042 : melttn (n), meltsn (n), &
2620 54309042 : meltbn (n), &
2621 54309042 : congeln (n), snoicen (n), &
2622 : mlt_onset, frz_onset, &
2623 54309042 : yday, dsnown (n), &
2624 874408135 : prescribed_ice)
2625 :
2626 765790051 : if (icepack_warnings_aborted(subname)) then
2627 0 : call icepack_warnings_add(subname//' ice: Vertical thermo error: ')
2628 0 : return
2629 : endif
2630 :
2631 : !-----------------------------------------------------------------
2632 : ! Total absorbed shortwave radiation
2633 : !-----------------------------------------------------------------
2634 :
2635 765790051 : fswabsn = fswsfcn(n) + fswintn(n) + fswthrun(n)
2636 :
2637 : !-----------------------------------------------------------------
2638 : ! Aerosol update
2639 : !-----------------------------------------------------------------
2640 :
2641 765790051 : if (tr_aero) then
2642 : call update_aerosol (dt, &
2643 : nilyr, nslyr, n_aero, &
2644 3951331 : melttn (n), meltsn (n), &
2645 3951331 : meltbn (n), congeln (n), &
2646 3951331 : snoicen (n), fsnow, &
2647 0 : aerosno(:,:,n), aeroice(:,:,n), &
2648 3951331 : aicen_init (n), vicen_init (n), &
2649 3951331 : vsnon_init (n), &
2650 3951331 : vicen (n), vsnon (n), &
2651 3951331 : aicen (n), &
2652 51787677 : faero_atm , faero_ocn)
2653 47836346 : if (icepack_warnings_aborted(subname)) return
2654 : endif
2655 :
2656 765790051 : if (tr_iso) then
2657 : call update_isotope (dt = dt, &
2658 : nilyr = nilyr, nslyr = nslyr, &
2659 205894 : meltt = melttn(n),melts = meltsn(n), &
2660 205894 : meltb = meltbn(n),congel=congeln(n), &
2661 205894 : snoice=snoicen(n),evap=evapn, &
2662 205894 : fsnow=fsnow, Tsfc=Tsfc(n), &
2663 0 : Qref_iso=Qrefn_iso(:), &
2664 0 : isosno=l_isosno(:,n),isoice=l_isoice(:,n), &
2665 205894 : aice_old=aicen_init(n),vice_old=vicen_init(n), &
2666 205894 : vsno_old=vsnon_init(n), &
2667 205894 : vicen=vicen(n),vsnon=vsnon(n), &
2668 205894 : aicen=aicen(n), &
2669 : fiso_atm=l_fiso_atm(:), &
2670 0 : fiso_evapn=fiso_evapn(:), &
2671 0 : fiso_ocnn=fiso_ocnn(:), &
2672 : HDO_ocn=l_HDO_ocn,H2_16O_ocn=l_H2_16O_ocn, &
2673 22164656 : H2_18O_ocn=l_H2_18O_ocn)
2674 21958762 : if (icepack_warnings_aborted(subname)) return
2675 : endif
2676 : endif ! aicen_init
2677 :
2678 : !-----------------------------------------------------------------
2679 : ! Melt ponds
2680 : ! If using tr_pond_cesm, the full calculation is performed here.
2681 : ! If using tr_pond_topo, the rest of the calculation is done after
2682 : ! the surface fluxes are merged, below.
2683 : !-----------------------------------------------------------------
2684 :
2685 : !call ice_timer_start(timer_ponds)
2686 3511496760 : if (tr_pond) then
2687 :
2688 3269375400 : if (tr_pond_cesm) then
2689 101836320 : rfrac = rfracmin + (rfracmax-rfracmin) * aicen(n)
2690 : call compute_ponds_cesm(dt, hi_min, &
2691 : pndaspect, rfrac, &
2692 960720 : melttn(n), meltsn(n), &
2693 : frain, &
2694 960720 : aicen (n), vicen (n), &
2695 960720 : Tsfc (n), &
2696 101836320 : apnd (n), hpnd (n))
2697 101836320 : if (icepack_warnings_aborted(subname)) return
2698 :
2699 3167539080 : elseif (tr_pond_lvl) then
2700 3046488360 : rfrac = rfracmin + (rfracmax-rfracmin) * aicen(n)
2701 : call compute_ponds_lvl(dt, nilyr, &
2702 : ktherm, &
2703 : hi_min, &
2704 : dpscale, frzpnd, &
2705 : pndaspect, rfrac, &
2706 148911600 : melttn(n), meltsn(n), &
2707 : frain, Tair, &
2708 148911600 : fsurfn(n), &
2709 148911600 : dhsn (n), ffracn(n), &
2710 148911600 : aicen (n), vicen (n), &
2711 148911600 : vsnon (n), &
2712 0 : zqin(:,n), zSin(:,n), &
2713 148911600 : Tsfc (n), alvl (n), &
2714 148911600 : apnd (n), hpnd (n), &
2715 3195399960 : ipnd (n))
2716 3046488360 : if (icepack_warnings_aborted(subname)) return
2717 :
2718 121050720 : elseif (tr_pond_topo) then
2719 121050720 : if (aicen_init(n) > puny) then
2720 :
2721 : ! collect liquid water in ponds
2722 : ! assume salt still runs off
2723 26412869 : rfrac = rfracmin + (rfracmax-rfracmin) * aicen(n)
2724 3773267 : pond = rfrac/rhofresh * (melttn(n)*rhoi &
2725 3773267 : + meltsn(n)*rhos &
2726 26412869 : + frain *dt)
2727 :
2728 : ! if pond does not exist, create new pond over full ice area
2729 : ! otherwise increase pond depth without changing pond area
2730 26412869 : if (apnd(n) < puny) then
2731 26402040 : hpnd(n) = c0
2732 26402040 : apnd(n) = c1
2733 : endif
2734 26412869 : hpnd(n) = (pond + hpnd(n)*apnd(n)) / apnd(n)
2735 26412869 : fpond = fpond + pond * aicen(n) ! m
2736 : endif ! aicen_init
2737 : endif
2738 :
2739 : endif ! tr_pond
2740 : !call ice_timer_stop(timer_ponds)
2741 :
2742 : !-----------------------------------------------------------------
2743 : ! Increment area-weighted fluxes.
2744 : !-----------------------------------------------------------------
2745 :
2746 3511496760 : if (aicen_init(n) > puny) &
2747 54309042 : call merge_fluxes (aicen=aicen_init(n), &
2748 : flw=flw, &
2749 : strairxn=strairxn, strairyn=strairyn,&
2750 : Cdn_atm_ratio_n=Cdn_atm_ratio_n, &
2751 54309042 : fsurfn=fsurfn(n), fcondtopn=fcondtopn(n),&
2752 54309042 : fcondbotn=fcondbotn(n), &
2753 54309042 : fsensn=fsensn(n), flatn=flatn(n), &
2754 : fswabsn=fswabsn, flwoutn=flwoutn, &
2755 : evapn=evapn, &
2756 : evapsn=evapsn, evapin=evapin, &
2757 : Trefn=Trefn, Qrefn=Qrefn, &
2758 : freshn=freshn, fsaltn=fsaltn, &
2759 : fhocnn=fhocnn, &
2760 54309042 : fswthrun=fswthrun(n), &
2761 0 : fswthrun_vdr=l_fswthrun_vdr(n), &
2762 0 : fswthrun_vdf=l_fswthrun_vdf(n), &
2763 0 : fswthrun_idr=l_fswthrun_idr(n), &
2764 0 : fswthrun_idf=l_fswthrun_idf(n), &
2765 : strairxT=strairxT, strairyT=strairyT,&
2766 : Cdn_atm_ratio=Cdn_atm_ratio, &
2767 : fsurf=fsurf, fcondtop=fcondtop,&
2768 : fcondbot=fcondbot, &
2769 : fsens=fsens, flat=flat, &
2770 : fswabs=fswabs, flwout=flwout, &
2771 : evap=evap, &
2772 : evaps=evaps, evapi=evapi, &
2773 : Tref=Tref, Qref=Qref, &
2774 : fresh=fresh, fsalt=fsalt, &
2775 : fhocn=fhocn, &
2776 : fswthru=fswthru, &
2777 : fswthru_vdr=l_fswthru_vdr, &
2778 : fswthru_vdf=l_fswthru_vdf, &
2779 : fswthru_idr=l_fswthru_idr, &
2780 : fswthru_idf=l_fswthru_idf, &
2781 54309042 : melttn=melttn (n), meltsn=meltsn(n), &
2782 54309042 : meltbn=meltbn (n), congeln=congeln(n),&
2783 54309042 : snoicen=snoicen(n), &
2784 : meltt=meltt, melts=melts, &
2785 : meltb=meltb, congel=congel, &
2786 : snoice=snoice, &
2787 : Uref=Uref, Urefn=Urefn, &
2788 : Qref_iso=l_Qref_iso, &
2789 0 : Qrefn_iso=Qrefn_iso, &
2790 : fiso_ocn=l_fiso_ocn, &
2791 0 : fiso_ocnn=fiso_ocnn, &
2792 : fiso_evap=l_fiso_evap, &
2793 820099093 : fiso_evapn=fiso_evapn)
2794 :
2795 4228206912 : if (icepack_warnings_aborted(subname)) return
2796 :
2797 : enddo ! ncat
2798 :
2799 4533715872 : if (present(isosno) ) isosno = l_isosno
2800 4533715872 : if (present(isoice) ) isoice = l_isoice
2801 2866840608 : if (present(Qa_iso) ) Qa_iso = l_Qa_iso
2802 2866840608 : if (present(Qref_iso) ) Qref_iso = l_Qref_iso
2803 2866840608 : if (present(fiso_atm) ) fiso_atm = l_fiso_atm
2804 2866840608 : if (present(fiso_ocn) ) fiso_ocn = l_fiso_ocn
2805 2866840608 : if (present(fiso_evap)) fiso_evap= l_fiso_evap
2806 4228206912 : if (present(fswthrun_vdr)) fswthrun_vdr= l_fswthrun_vdr
2807 4228206912 : if (present(fswthrun_vdf)) fswthrun_vdf= l_fswthrun_vdf
2808 4228206912 : if (present(fswthrun_idr)) fswthrun_idr= l_fswthrun_idr
2809 4228206912 : if (present(fswthrun_idf)) fswthrun_idf= l_fswthrun_idf
2810 716710152 : if (present(fswthru_vdr)) fswthru_vdr= l_fswthru_vdr
2811 716710152 : if (present(fswthru_vdf)) fswthru_vdf= l_fswthru_vdf
2812 716710152 : if (present(fswthru_idr)) fswthru_idr= l_fswthru_idr
2813 716710152 : if (present(fswthru_idf)) fswthru_idf= l_fswthru_idf
2814 716710152 : deallocate(l_isosno)
2815 716710152 : deallocate(l_isoice)
2816 716710152 : deallocate(l_Qa_iso)
2817 716710152 : deallocate(l_Qref_iso)
2818 716710152 : deallocate(l_fiso_atm)
2819 716710152 : deallocate(l_fiso_ocn)
2820 716710152 : deallocate(l_fiso_evap)
2821 716710152 : deallocate(l_fswthrun_vdr)
2822 716710152 : deallocate(l_fswthrun_vdf)
2823 716710152 : deallocate(l_fswthrun_idr)
2824 716710152 : deallocate(l_fswthrun_idf)
2825 :
2826 : !-----------------------------------------------------------------
2827 : ! Calculate ponds from the topographic scheme
2828 : !-----------------------------------------------------------------
2829 : !call ice_timer_start(timer_ponds)
2830 716710152 : if (tr_pond_topo) then
2831 : call compute_ponds_topo(dt, ncat, nilyr, &
2832 : ktherm, heat_capacity, &
2833 0 : aice, aicen, &
2834 0 : vice, vicen, &
2835 0 : vsno, vsnon, &
2836 : meltt, &
2837 : fsurf, fpond, &
2838 0 : Tsfc, Tf, &
2839 0 : zqin, zSin, &
2840 20175120 : apnd, hpnd, ipnd )
2841 20175120 : if (icepack_warnings_aborted(subname)) return
2842 : endif
2843 : !call ice_timer_stop(timer_ponds)
2844 :
2845 716710152 : end subroutine icepack_step_therm1
2846 :
2847 : !=======================================================================
2848 :
2849 : end module icepack_therm_vertical
2850 :
2851 : !=======================================================================
|
