ROMS
Loading...
Searching...
No Matches
ice_mk.h
Go to the documentation of this file.
1 MODULE ice_thermo_mod
2!
3!git $Id$
4!=======================================================================
5! Copyright (c) 2002-2025 The ROMS Group Paul Budgell !
6! Licensed under a MIT/X style license Katherine Hedstrom !
7! See License_ROMS.md Scott M. Durski !
8!================================================== Hernan G. Arango ===
9! !
10! It computes the ice thermodynamic growth and decay term based on !
11! Mellor and Kantha (1989) and Parkinson and Washington (1979). !
12! !
13! It computes heat fluxes and ice production rates: !
14! !
15! Fi(i,j,icW_ai) = -(qai(i,j) - qi2(i,j)) /(hfus1(i,j)*RhoSW) !
16! !
17! and updates the internal ice temperature: !
18! !
19! Si(i,j,linew,isTice) = Si(i,j,linew,isTice) + dtice*RHS !
20! !
21! Required atmospheric fields: !
22! !
23! Qnet_ai(:,:) net heat flux at the air-ice interface !
24! Qnet_ao(:,:) net heat flux at the air-ocean interface !
25! rain(:,:) rain fall rate !
26! snow(:,:) snow fall rate !
27! sustr(:,:) surface u-wind stress !
28! svstr(:,:) surface v-wind stress !
29! !
30! Required ocean fields: !
31! !
32! dtice ice kernel timestep !
33! rmask(:,:) land/sea mask !
34! t(:,:,N(ng),:,:) surface ocean temperature and salinity !
35! !
36! Required ice variables: !
37! !
38! Fi(:,:,icQcon) gradient coefficient for heat conductivity !
39! Fi(:,:,icQrhs) downward heat conductivity term !
40! Fi(:,:,icS0mk) salinity of molecular sublayer under ice !
41! Fi(:,:,icT0mk) temperature of molecular sublayer under ice !
42! Fi(:,:,icIsst) temperature at snow-air interface !
43! Fi(:,:,icW_ai) rate of melt/freeze at air-ice interface !
44! Fi(:,:,icW_ao) rate of melt/freeze at air-ocena interface !
45! Fi(:,:,icW_fr) rate of ice accretion by frazil growth !
46! Fi(:,:,icW_io) rate of melt/freeze at ice-ocean interface !
47! Fi(:,:,icW_ro) rate of melt/freeze runoff into ocean !
48! Fi(:,:,icIOmf) ice-ocean mass flux !
49! !
50! Si(:,:,linew,isAice) ice concentration !
51! Si(:,:,linew,isIage) ice age !
52! Si(:,:,linew,isEnth) scaled perturbation ice heat content !
53! Si(:,:,linew,isHice) ice thickness, ice mass (divided by area) !
54! Si(:,:,linew,isHsno) snow thickness, mass snow per area !
55! Si(:,:,linew,isHmel) melt water thickness on ice !
56! Si(:,:,linew,isTice) ice interior temperature (ice layer middle) !
57! !
58! Relevant Internal variables: !
59! !
60! brnfr(:,:) brine fraction !
61! hfus1(:,:) latent heat of fusion (L_o or L_3) !
62! ice_thick(:,:) ice thickness !
63! qai(:,:) upward air-ice heat flux !
64! qio(:,:) upward ice-ocean heat flux !
65! qi2(:,:) heat flux in ice !
66! sice(:,:) ice salinity !
67! snow_thick(:,:) snow thickness !
68! t2(:,:) temperature at ice/snow interface !
69! wsm(:,:) snow melting rate !
70! !
71! References: !
72! !
73! Mellor, G.L. and L. Kantha, 1989: An Ice-Ocean Coupled Model, !
74! J. Geophys. Res., 94, 10937-10954. !
75! !
76!=======================================================================
77!
78 USE mod_param
79 USE mod_boundary
80#ifdef AICLM_NUDGING
81 USE mod_clima
82#endif
83#ifdef ICE_SHOREFAST
84 USE mod_coupling
85#endif
86 USE mod_forces
87 USE mod_grid
88 USE mod_ice
89 USE mod_ocean
90 USE mod_scalars
91!
92 USE bc_2d_mod, ONLY : bc_r2d_tile
93 USE exchange_2d_mod, ONLY : exchange_r2d_tile
94 USE ice_bc2d_mod, ONLY : ice_bc2d_tile
95 USE ice_tibc_mod, ONLY : ice_tibc_tile
96#ifdef DISTRIBUTE
97 USE mp_exchange_mod, ONLY : mp_exchange2d
98#endif
99!
100 implicit none
101!
102 PUBLIC :: ice_thermo
103 PRIVATE :: ice_thermo_tile
104!
105 CONTAINS
106!
107!***********************************************************************
108 SUBROUTINE ice_thermo (ng, tile, model)
109!***********************************************************************
110!
111 USE mod_stepping
112!
113! Imported variable declarations.
114!
115 integer, intent(in) :: ng, tile, model
116!
117! Local variable declarations.
118!
119 character (len=*), parameter :: myfile = &
120 & __FILE__
121!
122#include "tile.h"
123!
124#ifdef PROFILE
125 CALL wclock_on (ng, model, 42, __line__, myfile)
126#endif
127 CALL ice_thermo_tile (ng, tile, model, &
128 & lbi, ubi, lbj, ubj, &
129 & imins, imaxs, jmins, jmaxs, &
130 & nrhs(ng), liold(ng), linew(ng), &
131#ifdef MASKING
132 & grid(ng) % rmask, &
133#endif
134#ifdef WET_DRY
135 & grid(ng) % rmask_wet, &
136#endif
137#ifdef ICESHELF
138 & grid(ng) % zice, &
139#endif
140 & grid(ng) % z_r, &
141 & grid(ng) % z_w, &
142#ifdef ICE_SHOREFAST
143 & grid(ng) % h, &
144 & coupling(ng) % Zt_avg1, &
145#endif
146#ifdef AICLM_NUDGING
147 & clima(ng) % aiclm, &
148 & clima(ng) % hiclm, &
149 & clima(ng) % AInudgcof, &
150#endif
151 & ocean(ng) % t, &
152 & forces(ng) % sustr, &
153 & forces(ng) % svstr, &
154 & forces(ng) % Qnet_ai, &
155 & forces(ng) % Qnet_ao, &
156 & forces(ng) % snow, &
157 & forces(ng) % rain, &
158 & forces(ng) % stflx, &
159 & ice(ng) % Fi, &
160 & ice(ng) % Si)
161#ifdef PROFILE
162 CALL wclock_off (ng, model, 42, __line__, myfile)
163#endif
164!
165 RETURN
166 END SUBROUTINE ice_thermo
167!
168!***********************************************************************
169 SUBROUTINE ice_thermo_tile (ng, tile, model, &
170 & LBi, UBi, LBj, UBj, &
171 & IminS, ImaxS, JminS, JmaxS, &
172 & nrhs, liold, linew, &
173#ifdef MASKING
174 & rmask, &
175#endif
176#ifdef WET_DRY
177 & rmask_wet, &
178#endif
179#ifdef ICESHELF
180 & zice, &
181#endif
182 & z_r, z_w, &
183#ifdef ICE_SHOREFAST
184 & h, Zt_avg1, &
185#endif
186#ifdef AICLM_NUDGING
187 & aiclm, hiclm, AInudgcof, &
188#endif
189 & t, &
190 & sustr, svstr, &
191 & Qnet_ai, Qnet_ao, &
192 & snow, &
193 & rain, &
194 & stflx, &
195 & Fi, Si)
196!***********************************************************************
197!
198! Imported variable declarations.
199!
200 integer, intent(in) :: ng, tile, model
201 integer, intent(in) :: lbi, ubi, lbj, ubj
202 integer, intent(in) :: imins, imaxs, jmins, jmaxs
203 integer, intent(in) :: nrhs, liold, linew
204!
205#ifdef ASSUMED_SHAPE
206# ifdef MASKING
207 real(r8), intent(in) :: rmask(lbi:,lbj:)
208# endif
209# ifdef WET_DRY
210 real(r8), intent(in) :: rmask_wet(lbi:,lbj:)
211# endif
212# ifdef ICESHELF
213 real(r8), intent(in) :: zice(lbi:,lbj:)
214# endif
215# ifdef ICE_SHOREFAST
216 real(r8), intent(in) :: h(lbi:,lbj:)
217 real(r8), intent(in) :: zt_avg1(lbi:,lbj:)
218# endif
219# ifdef AICLM_NUDGING
220 real(r8), intent(in) :: aiclm(lbi:,lbj:)
221 real(r8), intent(in) :: hiclm(lbi:,lbj:)
222 real(r8), intent(in) :: ainudgcof(lbi:,lbj:)
223# endif
224 real(r8), intent(in) :: z_r(lbi:,lbj:,:)
225 real(r8), intent(in) :: z_w(lbi:,lbj:,0:)
226 real(r8), intent(in) :: t(lbi:,lbj:,:,:,:)
227 real(r8), intent(in) :: sustr(lbi:,lbj:)
228 real(r8), intent(in) :: svstr(lbi:,lbj:)
229 real(r8), intent(in) :: qnet_ai(lbi:,lbj:)
230 real(r8), intent(in) :: qnet_ao(lbi:,lbj:)
231 real(r8), intent(in) :: snow(lbi:,lbj:)
232 real(r8), intent(in) :: rain(lbi:,lbj:)
233 real(r8), intent(inout) :: stflx(lbi:,lbj:,:)
234 real(r8), intent(inout) :: fi(lbi:,lbj:,:)
235 real(r8), intent(inout) :: si(lbi:,lbj:,:,:)
236#else
237# ifdef MASKING
238 real(r8), intent(in) :: rmask(lbi:ubi,lbj:ubj)
239# endif
240# ifdef WET_DRY
241 real(r8), intent(in) :: rmask_wet(lbi:ubi,lbj:ubj)
242# endif
243# ifdef ICESHELF
244 real(r8), intent(in) :: zice(lbi:ubi,lbj:ubj)
245# endif
246# ifdef ICE_SHOREFAST
247 real(r8), intent(in) :: h(lbi:ubi,lbj:ubj)
248 real(r8), intent(in) :: zt_avg1(lbi:ubi,lbj:ubj)
249# endif
250# ifdef AICLM_NUDGING
251 real(r8), intent(in) :: aiclm(lbi:ubi,lbj:ubj)
252 real(r8), intent(in) :: hiclm(lbi:ubi,lbj:ubj)
253 real(r8), intent(in) :: ainudgcof(lbi:ubi,lbj:ubj)
254# endif
255 real(r8), intent(in) :: z_r(lbi:ubi,lbj:ubj,n(ng))
256 real(r8), intent(in) :: z_w(lbi:ubi,lbj:ubj,0:n(ng))
257 real(r8), intent(in) :: t(lbi:ubi,lbj:ubj,n(ng),3,nt(ng))
258 real(r8), intent(in) :: sustr(lbi:ubi,lbj:ubj)
259 real(r8), intent(in) :: svstr(lbi:ubi,lbj:ubj)
260 real(r8), intent(in) :: qnet_ai(lbi:ubi,lbj:ubj)
261 real(r8), intent(in) :: qnet_ao(lbi:ubi,lbj:ubj)
262 real(r8), intent(in) :: snow(lbi:ubi,lbj:ubj)
263 real(r8), intent(in) :: rain(lbi:ubi,lbj:ubj)
264 real(r8), intent(inout) :: stflx(lbi:ubi,lbj:ubj,nt(ng))
265 real(r8), intent(inout) :: fi(lbi:ubi,lbj:ubj,nicef)
266 real(r8), intent(inout) :: si(lbi:ubi,lbj:ubj,2,nices)
267#endif
268
269! Local variable definitions
270!
271 logical :: icecavity
272!
273 integer :: i, j
274!
275 real(r8), parameter :: alphic = 2.034_r8 ! [W m-1 K-1]
276 real(r8), parameter :: alphsn = 0.31_r8 ! [W m-1 K-1]
277 real(r8), parameter :: cp_i = 2093.0_r8 ! [J kg-1 K-1]
278 real(r8), parameter :: cp_w = 3990.0_r8 ! [J kg-1 K-1]
279 real(r8), parameter :: eps = 1.0e-4_r8 ! zero division
280 real(r8), parameter :: frln = -0.0543_r8 ! [psu C-1]
281 real(r8), parameter :: hfus = 3.347e+5_r8 ! [J kg-1]
282 real(r8), parameter :: kappa = 0.4_r8 ! von Karman
283 real(r8), parameter :: nu = 1.8e-6_r8 ! m2/s
284 real(r8), parameter :: prs = 2432.0_r8 ! S Schmidt Num.
285 real(r8), parameter :: prt = 13.0_r8 ! T Prandtl Num.
286 real(r8), parameter :: rhocpr = 0.2442754e-6_r8 ! [m s2 K kg-1]
287 real(r8), parameter :: rhosw = 1026.0_r8 ! [kg m-3]
288 real(r8), parameter :: sice_ref = 3.2_r8 ! [psu]
289 real(r8), parameter :: tpr = 0.85_r8 ! Turb. Prandtl
290 real(r8), parameter :: ykf = 3.14 ! Yaglom/Kader
291 real(r8), parameter :: z0ii = 0.02_r8 ! ice roughness
292!
293 real(r8) :: cff, cff1, cff2, cff3
294 real(r8) :: d1, d2i, d3, dztop, fac_shflx
295 real(r8) :: ai_tmp, corfac, cot, delta_mi
296 real(r8) :: hicehinv, hstar, mi_old, phi
297 real(r8) :: qsur, rno, termt, terms, tfrz, tfz
298 real(r8) :: xwai, xtot, z0, zdz0, xmelt
299#ifdef ICE_SHOREFAST
300 real(r8) :: clear, fac_sf, hh
301#endif
302!
303 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: alph
304 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: brnfr
305 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: b2d
306 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: chs
307 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: cht
308 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: coa
309 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: hfus1
310 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ice_thick
311 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: qai
312 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: qio
313 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: qi2
314 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: salt_top
315 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: sice
316 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: snow_thick
317 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: temp_top
318 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: t2
319 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: utau
320 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ws
321 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: wsm
322
323#include "set_bounds.h"
324!
325!-----------------------------------------------------------------------
326! Initalize.
327!-----------------------------------------------------------------------
328!
329! Set bulk sensible transfer coefficient (d1), latent heat transfer
330! over ice (d2i), and Stefan-Boltzan constant times surface
331! emissivity (d3).
332!
333 d1 =airrho(ng)*spec_heat_air*trans_coeff ! [J/(K m3)]
334 d2i=airrho(ng)*sublimation*trans_coeff ! [J/(K m3)]
335 d3 =stefbo*ice_emiss ! [W/(K^4 m2)]
336!
337! Extract ocean surface temperature and salinity. Compute surface
338! level thickness.
339!
340 DO j=jstr,jend
341 DO i=istr,iend
342 temp_top(i,j)=t(i,j,n(ng),nrhs,itemp)
343 salt_top(i,j)=t(i,j,n(ng),nrhs,isalt)
344 salt_top(i,j)=min(max(0.0_r8, salt_top(i,j)), 40.0_r8)
345 END DO
346 END DO
347!
348! Compute squared-root of surface wind stress magnitude.
349!
350 DO j=jstr,jend
351 DO i=istr,iend
352 utau(i,j)=sqrt(sqrt((0.5_r8*(sustr(i ,j)+ &
353 sustr(i+1,j)))**2+ &
354 & (0.5_r8*(svstr(i,j )+ &
355 & svstr(i,j+1)))**2))
356 utau(i,j)=max(utau(i,j), 1.0e-4_r8)
357 END DO
358 END DO
359!
360! Compute snow thickness, ice thickness, brine fraction, and
361! thermal conductivity.
362!
363 DO j=jstr,jend
364 DO i=istr,iend
365 sice(i,j)=min(sice_ref, salt_top(i,j))
366 ice_thick(i,j)=0.05_r8+ &
367 & si(i,j,linew,ishice)/ &
368 & (si(i,j,linew,isaice)+eps)
369 snow_thick(i,j)=si(i,j,linew,ishsno)/ &
370 (si(i,j,linew,isaice)+eps)
371 brnfr(i,j)=frln*sice(i,j)/(si(i,j,linew,istice)-eps)
372 brnfr(i,j)=min(brnfr(i,j),0.2_r8)
373 brnfr(i,j)=max(brnfr(i,j),0.0_r8)
374 alph(i,j)=alphic*max(1.0_r8-1.2_r8*brnfr(i,j), 0.25_r8)
375 cff=(si(i,j,linew,ishice)/1.0_r8)**2
376 corfac=1.0_r8/(0.5_r8*(1.0_r8+exp(-cff)))
377 alph(i,j)=alph(i,j)*corfac
378 coa(i,j)=2.0_r8*alph(i,j)*snow_thick(i,j)/ &
379 & (alphsn*ice_thick(i,j))
380 END DO
381 END DO
382!
383!-----------------------------------------------------------------------
384! Solve for temperature at the top of the ice layer.
385!-----------------------------------------------------------------------
386!
387 DO j=jstr,jend
388 DO i=istr,iend
389!
390! Gradient coefficient for heat conductivity term.
391!
392 b2d(i,j)=2.0_r8*alph(i,j)/(ice_thick(i,j)*(1.0_r8+coa(i,j)))
393 fi(i,j,icqcon)=fi(i,j,icqcon)+ &
394 & b2d(i,j)
395!
396! Downward conductivity term, assuming the ocean at the freezing point
397! (convert ice temperature to Kelvin).
398!
399 IF (si(i,j,linew,isaice).gt.min_ai(ng)) THEN
400 fi(i,j,icqrhs)=fi(i,j,icqrhs)+ &
401 & b2d(i,j)*(si(i,j,linew,istice)+273.15_r8)
402!
403! Compute temperature at the snow/ice interface (convert to Celsius).
404!
405 fi(i,j,icisst)=(fi(i,j,icqrhs)/fi(i,j,icqcon))-273.15_r8
406!
407! Bound value at zero Celsius for stability. It can occassionably be
408! unstable and take "icIsst" in the wrong direction.
409!
410 fi(i,j,icisst)=min(max(fi(i,j,icisst),-45.0_r8), 0.0_r8)
411 ELSE
412 fi(i,j,icisst)=temp_top(i,j)
413 END IF
414 END DO
415 END DO
416!
417! Calculate new interior ice temperature.
418!
419 DO j=jstr,jend
420 DO i=istr,iend
421!
422! The "cot" calculation derives from an assumption of a linear
423! relationship between ice temperature and salinity. As "isTice"
424! approaches zero Celsius, "cot" goes to infinity and any change
425! in "isTice" in the timestepping below is stymied, so keep the
426! denominator here below zero (SMD).
427!
428 IF (si(i,j,linew,isaice).gt.min_ai(ng)) THEN
429 cot=-frln*sice(i,j)*hfus/ &
430 & (min(si(i,j,linew,istice), frln*sice_ref))**2+cp_i
431 cff1=icerho(ng)*cot*ice_thick(i,j)**2
432 cff2=fi(i,j,icisst)-(2.0_r8+coa(i,j))*si(i,j,linew,istice)
433 cff3=1.0_r8+coa(i,j)
434 si(i,j,linew,istice)=si(i,j,linew,istice)+ &
435 & dtice(ng)* &
436 & (2.0_r8*alph(i,j)/cff1* &
437 & (fi(i,j,ict0mk)+cff2/cff3))
438 si(i,j,linew,istice)=max(si(i,j,linew,istice), -35.0_r8)
439!
440! Ensure that "isTice" remains below "frln*sice_ref" whenever ice is
441! present. Also ensure that it remains below the maximum of either
442! the ice surface temperature or the water temperature below. This
443! is imperfect as warmer ice can advect from elsewhere and alter
444! its heat content, or thick ice might actually have a warmer
445! interior temperature than either the surface or bottom. But in
446! general it does not make sense that ice forms at a warmer
447! temperature than exists in any of its surroundings (SMD).
448!
449 si(i,j,linew,istice)=min(si(i,j,linew,istice), &
450 & frln*sice_ref)
451 si(i,j,linew,istice)=min(si(i,j,linew,istice), &
452 & max(fi(i,j,icisst), &
453 & fi(i,j,ict0mk)))
454 ELSE
455 si(i,j,linew,istice)=temp_top(i,j)
456 END IF
457 END DO
458 END DO
459!
460! Calculate associated heat fluxes.
461!
462 DO j=jstr,jend
463 DO i=istr,iend
464 IF (si(i,j,linew,isaice).gt.min_ai(ng)) THEN
465 hicehinv=1.0_r8/(0.5_r8*ice_thick(i,j))
466 t2(i,j) =(fi(i,j,icisst)+coa(i,j)*si(i,j,linew,istice))/ &
467 & (1.0_r8+coa(i,j))
468 qi2(i,j)=alph(i,j)* &
469 & (si(i,j,linew,istice)-t2(i,j))*hicehinv
470 qio(i,j)=alph(i,j)* &
471 & (fi(i,j,ict0mk)-si(i,j,linew,istice))*hicehinv
472 END IF
473 qai(i,j)=qnet_ai(i,j) ! net heat flux from ice to atmosphere
474 END DO
475 END DO
476!
477! Open water case: set ice fluxes to zero.
478!
479 DO j = jstr,jend
480 DO i = istr,iend
481 IF (si(i,j,linew,isaice).le.min_ai(ng)) THEN
482 fi(i,j,icisst)=fi(i,j,ict0mk)
483 t2(i,j)=fi(i,j,ict0mk)
484 si(i,j,linew,istice)=-2.0_r8
485#ifdef MASKING
486 fi(i,j,icisst)=fi(i,j,icisst)*rmask(i,j)
487 t2(i,j)=t2(i,j)*rmask(i,j)
488 si(i,j,linew,istice)=si(i,j,linew,istice)*rmask(i,j)
489# ifdef WET_DRY
490 fi(i,j,icisst)=fi(i,j,icisst)*rmask_wet(i,j)
491 t2(i,j)=t2(i,j)*rmask_wet(i,j)
492 si(i,j,linew,istice)=si(i,j,linew,istice)*rmask_wet(i,j)
493# endif
494#endif
495#ifdef ICESHELF
496 IF (zice(i,j).ne.0.0_r8) THEN
497 fi(i,j,icisst)=0.0_r8
498 t2(i,j)=0.0_r8
499 si(i,j,linew,istice)=0.0_r8
500 END IF
501#endif
502 qi2(i,j)=0.0_r8
503 qai(i,j)=0.0_r8
504 qio(i,j)=0.0_r8
505 si(i,j,linew,ishsno)=0.0_r8
506 si(i,j,linew,ishmel)=0.0_r8
507 END IF
508 END DO
509 END DO
510!
511!-----------------------------------------------------------------------
512! Suface water accumulation: ice melting.
513!-----------------------------------------------------------------------
514!
515! Set snow fall rate to value derived from precipitation rate.
516!
517 DO j=jstr,jend
518 DO i=istr,iend
519 ws(i,j)=max(snow(i,j), 0.0_r8)
520 END DO
521 END DO
522!
523! Compute ice melt water thickness.
524!
525 DO j=jstr,jend
526 DO i=istr,iend
527 tfrz=frln*sice(i,j)
528 wsm(i,j)=0.0_r8
529 fi(i,j,icw_ai)=0.0_r8
530 fi(i,j,icw_ro)=0.0_r8
531!
532 IF (si(i,j,linew,isaice).gt.min_ai(ng)) THEN
533 cff=1.0_r8-brnfr(i,j)
534 hfus1(i,j)=hfus*cff+ &
535 & fi(i,j,icisst)*cp_w- &
536 & (cff*cp_i+brnfr(i,j)*cp_w)*si(i,j,linew,istice)
537 qai(i,j)=qnet_ai(i,j)
538 qi2(i,j)=b2d(i,j)*(si(i,j,linew,istice)-fi(i,j,icisst))
539
540 IF ((si(i,j,linew,ishsno).le.eps).and. &
541 & (si(i,j,linew,ishmel).le.eps)) THEN
542 qsur=-(qai(i,j)-qi2(i,j))/(hfus1(i,j)*rhosw)
543 ELSE IF ((si(i,j,linew,ishsno).le.eps).and. &
544 & (si(i,j,linew,ishmel).gt.eps)) THEN
545 qsur=-(qai(i,j)-qi2(i,j))/(hfus1(i,j)*1003.1_r8)
546 ELSE
547 qsur=-(qai(i,j)-qi2(i,j))/(hfus*snowwetrho(ng))
548 END IF
549
550 IF ((si(i,j,linew,ishsno).gt.eps).and. &
551 & (fi(i,j,icisst).ge.0.0_r8)) THEN
552 si(i,j,linew,ishsno)=si(i,j,linew,ishsno)- &
553 & si(i,j,linew,isaice)* &
554 & max(qsur, 0.0_r8)*dtice(ng)
555 si(i,j,linew,ishmel)=si(i,j,linew,ishmel)+ &
556 & si(i,j,linew,isaice)* &
557 & max(qsur, 0.0_r8)* &
558 & snowwetrho(ng)/rhosw*dtice(ng)
559 ELSE IF ((si(i,j,linew,ishmel).gt.eps).and. &
560 & (fi(i,j,icisst).le.tfrz)) THEN
561 fi(i,j,icw_ai)=min(qsur, 0.0_r8)
562 si(i,j,linew,ishmel)=si(i,j,linew,ishmel)+ &
563 & si(i,j,linew,isaice)* &
564 & min(qsur, 0.0_r8)*dtice(ng)
565 ELSE IF ((si(i,j,linew,ishsno).le.eps).and. &
566 & (si(i,j,linew,ishmel).ge.eps).and. &
567 & (fi(i,j,icisst).gt.tfrz)) THEN
568 fi(i,j,icw_ai)=max(qsur, 0.0_r8)
569 si(i,j,linew,ishmel)=si(i,j,linew,ishmel)+ &
570 & si(i,j,linew,isaice)* &
571 & max(qsur, 0.0_r8)*dtice(ng)
572 ELSE IF ((si(i,j,linew,ishsno).lt.eps).and. &
573 & (si(i,j,linew,ishmel).lt.eps).and. &
574 & (fi(i,j,icisst).gt.tfrz)) THEN
575 fi(i,j,icw_ai)=max(qsur, 0.0_r8)
576 si(i,j,linew,ishmel)=si(i,j,linew,ishmel)+ &
577 & si(i,j,linew,isaice)* &
578 & max(qsur, 0.0_r8)*dtice(ng)
579 END IF
580
581 IF (rain(i,j).le.0.0_r8) THEN
582 si(i,j,linew,ishsno)=si(i,j,linew,ishsno)+ &
583 & si(i,j,linew,isaice)* &
584 & ws(i,j)*dtice(ng)
585 ELSE IF ((si(i,j,linew,ishsno).gt.0.0_r8).and. &
586 & (si(i,j,linew,ishmel).eq.0.0_r8)) THEN
587 si(i,j,linew,ishsno)=max(0.0_r8, si(i,j,linew,ishsno)- &
588 & si(i,j,linew,isaice)*rain(i,j)/ &
589 & snowdryrho(ng))
590 fi(i,j,icw_ai)=fi(i,j,icw_ai)- &
591 & 2.0_r8*si(i,j,linew,isaice)* &
592 & rain(i,j)/icerho(ng)
593 ELSE IF ((si(i,j,linew,ishsno).gt.0.0_r8).and. &
594 & (si(i,j,linew,ishmel).gt.0.0_r8)) THEN
595 si(i,j,linew,ishsno)=max(0.0_r8, si(i,j,linew,ishsno)- &
596 & 0.5_r8*si(i,j,linew,isaice)* &
597 & rain(i,j)/snowdryrho(ng))
598 fi(i,j,icw_ai)=fi(i,j,icw_ai)- &
599 & 0.5_r8*si(i,j,linew,isaice)* &
600 & rain(i,j)/icerho(ng)
601 si(i,j,linew,ishmel)=si(i,j,linew,ishmel)+ &
602 & si(i,j,linew,isaice)* &
603 & 0.5_r8*rain(i,j)/rhosw*dtice(ng)
604 ELSE IF (si(i,j,linew,ishmel).gt.0.0_r8) THEN
605 si(i,j,linew,ishmel)=si(i,j,linew,ishmel)+ &
606 & si(i,j,linew,isaice)* &
607 & rain(i,j)/rhosw*dtice(ng)
608 ELSE
609 fi(i,j,icw_ai)=fi(i,j,icw_ai)- &
610 & si(i,j,linew,isaice)*rain(i,j)/icerho(ng)
611 END IF
612!
613! Limit the amount of surface water by the smaller of a max limit and
614! the ice thickness (SMD).
615!
616 IF (si(i,j,linew,ishmel).gt. &
617 min(max_hmelt(ng), si(i,j,linew,ishice))) THEN
618 fi(i,j,icw_ro)=(si(i,j,linew,ishmel)- &
619 & min(max_hmelt(ng), &
620 & si(i,j,linew,ishice)))/dtice(ng)
621 si(i,j,linew,ishmel)=min(max_hmelt(ng), &
622 & si(i,j,linew,ishice))
623 END IF
624 END IF
625 END DO
626 END DO
627!
628!-----------------------------------------------------------------------
629! Molecular sublayer under ice.
630!-----------------------------------------------------------------------
631!
632! Yaglom and Kader (1974) formulation for turbulent roughness length
633! scales "z0t" and "z0s".
634!
635 DO j=jstr,jend
636 DO i=istr,iend
637 z0=max(z0ii*ice_thick(i,j), 0.01_r8)
638 z0=min(z0, 0.1_r8)
639 dztop=z_w(i,j,n(ng))-z_r(i,j,n(ng))
640 zdz0=dztop/z0
641 zdz0=max(zdz0, 3.0_r8)
642 rno=utau(i,j)*0.09_r8/nu
643 termt=ykf*sqrt(rno)*prt**0.666667_r8
644 terms=ykf*sqrt(rno)*prs**0.666667_r8
645 cht(i,j)=utau(i,j)/(tpr*(log(zdz0)/kappa+termt))
646 chs(i,j)=utau(i,j)/(tpr*(log(zdz0)/kappa+terms))
647 END DO
648 END DO
649!
650! Temperature and salinity of molecular sublayer under ice.
651!
652 DO j=jstr,jend
653 DO i=istr,iend
654 tfz=frln*salt_top(i,j)
655 fi(i,j,icw_ao)=0.0_r8
656 fi(i,j,icw_io)=0.0_r8
657 xwai=max(0.0_r8, fi(i,j,icw_ai))
658 cff=1.0_r8-brnfr(i,j)
659 hfus1(i,j)=hfus*cff+ &
660 & fi(i,j,ict0mk)*cp_w- &
661 & (cff*cp_i+brnfr(i,j)*cp_w)*si(i,j,linew,istice)
662 IF (((temp_top(i,j).le.tfz).and.(qnet_ao(i,j).gt.0.0_r8)).or. &
663 & ((temp_top(i,j).ge.tfz).and.(qnet_ao(i,j).lt.0.0_r8).and. &
664 & (si(i,j,linew,isaice).gt.0.0_r8))) THEN
665 fi(i,j,icw_ao)=qnet_ao(i,j)/(hfus1(i,j)*rhosw)
666 END IF
667 IF ((si(i,j,linew,isaice).le.min_ai(ng)).or. &
668 & (si(i,j,linew,ishice).le.min_hi(ng))) THEN
669 fi(i,j,ics0mk)=salt_top(i,j)
670 fi(i,j,ict0mk)=temp_top(i,j)
671 fi(i,j,icw_ai)=0.0_r8
672 xtot=(1.0_r8-si(i,j,linew,isaice))*fi(i,j,icw_ao)
673 ELSE ! MK89 version
674 fi(i,j,icw_io)=(qio(i,j)/rhosw+ &
675 & cp_w*cht(i,j)*(fi(i,j,ict0mk)- &
676 & temp_top(i,j)))/hfus1(i,j)
677 xtot=si(i,j,linew,isaice)*fi(i,j,icw_io)+ &
678 & (1.0_r8-si(i,j,linew,isaice))*fi(i,j,icw_ao)
679!
680! Based on my reading of MK89, this calculation of "s0mk" does not
681! follow from the derivation. But it works quite well (SMD)! Some
682! alternatives are commented below.
683!
684 fi(i,j,ics0mk)=(chs(i,j)*salt_top(i,j)+ &
685 & (xwai-fi(i,j,icw_io))*sice(i,j))/ &
686 & (chs(i,j)+xwai+ &
687 & fi(i,j,icw_ro)-fi(i,j,icw_io))
688! SMD s02
689! Fi(i,j,icS0mk)=(chs(i,j)*salt_top(i,j)+ &
690! & (Si(i,j,linew,isAice)*Fi(i,j,icW_ro)- &
691! & xtot)*sice(i,j))/ &
692! & (chs(i,j)+
693! & Si(i,j,linew,isAice)*Fi(i,j,icW_ro)-xtot)
694!
695! SMD s03
696! Assume melt ponds are leaky, so replace "wro" with "xwai".
697!
698! Fi(i,j,icS0mk)=(chs(i,j)*salt_top(i,j)+ &
699! & (Si(i,j,linew,isAice)*xwai-xtot)*sice(i,j))/ &
700! & (chs(i,j)+Si(i,j,linew,isAice)*xwai-xtot)
701!
702! SDM s04
703! Modify the original formulation by considering the balance
704! only over the ice covered portion of the grid cell such that
705! "wao" does not enter the expression.
706!
707! Fi(i,j,icS0mk)=(chs(i,j)*salt_top(i,j)+ &
708! & Si(i,j,linew,isAice)* &
709! & (xwai-Fi(i,j,icW_io))*sice(i,j))/ &
710! & (chs(i,j)+
711! & Si(i,j,linew,isAice)*xwai-Fi(i,j,icW_io))
712!
713! SMD s05
714! If we are to use what looks to be MK98 original formulation
715! it would have the P-E term in the denominator here as well.
716! Our PE term has the (1-ai) term factored into it already
717! this is used with our 'MKorig' formulation.
718!
719! Fi(i,j,icS0mk)=(chs(i,j)*salt_top(i,j)+ &
720! & (Si(i,j,linew,isAice)*xwai- &
721! & xtot)*sice(i,j))/ &
722! & (chs(i,j)+Si(i,j,linew,isAice)*xwai-xtot+ &
723! & Si(i,j,linew,isAice)*stflx(i,j,isalt))
724!
725 fi(i,j,ics0mk)=max(fi(i,j,ics0mk), 0.0_r8)
726 fi(i,j,ics0mk)=min(fi(i,j,ics0mk), 40.0_r8)
727 fi(i,j,ict0mk)=frln*fi(i,j,ics0mk)
728 END IF
729!
730! Adjust surface heat flux.
731!
732 fac_shflx=1.0_r8
733#ifdef ICESHELF
734 icecavity=zice(i,j).ne.0.0_r8
735#else
736 icecavity=.false.
737#endif
738 IF (.not.icecavity) THEN
739 IF(si(i,j,linew,isaice).le.min_ai(ng)) THEN
740 stflx(i,j,itemp)=qnet_ao(i,j)*fac_shflx
741 ELSE
742#ifdef ICE_SHOREFAST
743 hh=h(i,j)+zt_avg1(i,j)
744 clear=hh-0.9_r8*si(i,j,liol,ishice)
745 clear=max(clear, 0.0_r8)
746 IF (clear.lt.1.5_r8) THEN
747 fac_sf=max(clear-0.5_r8, 0.0_r8)/1.0_r8
748 ELSE
749 fac_sf=1.0_r8
750 END IF
751 stflx(i,j,itemp)=(1.0_r8-si(i,j,linew,isaice))* &
752 & qnet_ao(i,j)*fac_shflx+ &
753 & (si(i,j,linew,isaice)*qio(i,j)- &
754 & xtot*hfus1(i,j))*fac_sf
755#else
756 stflx(i,j,itemp)=(1.0_r8-si(i,j,linew,isaice))* &
757 & qnet_ao(i,j)+ &
758 & si(i,j,linew,isaice)*qio(i,j)- &
759 & xtot*hfus1(i,j)*rhosw
760#endif
761 END IF
762!
763! Change surface heat flux back to ROMS convention (Celsius m/s).
764!
765 stflx(i,j,itemp)=-stflx(i,j,itemp)*rhocpr
766#ifdef MASKING
767 stflx(i,j,itemp)=stflx(i,j,itemp)*rmask(i,j)
768#endif
769!
770! Adjust surface freshwater flux.
771!
772#ifdef ICE_SHOREFAST
773 cff=min(max(fi(i,j,ics0mk), 0.0_r8), 60.0_r8)
774 stflx(i,j,isalt)=stflx(i,j,isalt)- &
775 & ((xtot-si(i,j,linew,isaice)*xwai)* &
776 & (sice(i,j)-cff)+ &
777 & si(i,j,linew,isaice)* &
778 & fi(i,j,icw_ro)*cff)*fac_sf
779#else
780 stflx(i,j,isalt)=stflx(i,j,isalt)+ &
781 & ((si(i,j,linew,isaice)* &
782 & (fi(i,j,icw_io)-fi(i,j,icw_ai))+ &
783 & (1.0_r8-si(i,j,linew,isaice))* &
784 & fi(i,j,icw_ao)+ &
785 & fi(i,j,icw_fr)))* &
786 & (salt_top(i,j)-sice(i,j))- &
787 & si(i,j,linew,isaice)* &
788 & (fi(i,j,icw_ro)-xwai)*salt_top(i,j)
789!
790! Fixed flux rate as a function of ice growth alone, MconsS case (SMD).
791!
792! stflx(i,j,isalt)=stflx(i,j,isalt)+ &
793! & (Si(i,j,linew,isAice)* &
794! & (Fi(i,j,icW_io)-Fi(i,j,icW_ai))+ &
795! & (1.0_r8-Si(i,j,linew,isAice))* &
796! & Fi(i,j,icW_ao)+ &
797! & Fi(i,j,icW_fr))*28.3_r8
798!
799! If we want ice to have no effect on salinity (SMD):
800!
801! IF ((Si(i,j,linew,isAice).gt.0.01_r8).and. &
802! & (stflx(i,j,isalt).lt.0.0_r8)) THEN
803! & stflx(i,j,isalt)=stflx(i,j,isalt)/ &
804! & (1.0_r8-Si(i,j,linew,isAice))
805! END IF
806!
807! Or alternatively we can include the precipitation over the ice (SMG).
808!
809! stflx(i,j,isalt)=stflx(i,j,isalt)- &
810! & Si(i,j,linew,isAice)* &
811! & (Fi(i,j,icW_ro)-xwai)*salt_top(i,j)
812#endif
813#ifdef MASKING
814 stflx(i,j,isalt)=stflx(i,j,isalt)*rmask(i,j)
815#endif
816#ifdef WET_DRY
817 stflx(i,j,isalt)=stflx(i,j,isalt)*rmask_wet(i,j)
818#endif
819!
820! Compute ice-ocean mass flux.
821!
822 fi(i,j,iciomf)=xtot- &
823 & si(i,j,linew,isaice)*xwai- &
824 & si(i,j,linew,isaice)*fi(i,j,icw_ro)+ &
825 & fi(i,j,icw_fr)
826#ifdef MASKING
827 fi(i,j,iciomf)=fi(i,j,iciomf)*rmask(i,j)
828#endif
829#ifdef WET_DRY
830 fi(i,j,iciomf)=fi(i,j,iciomf)*rmask_wet(i,j)
831#endif
832 ELSE
833 fi(i,j,iciomf)=0.0_r8
834 END IF
835 END DO
836 END DO
837!
838!-----------------------------------------------------------------------
839! Update ice properties.
840!-----------------------------------------------------------------------
841!
842! Track the amount of new ice produced thermodynamically to calculate
843! average ice age.
844!
845 DO j=jstr,jend
846 DO i=istr,iend
847 mi_old=si(i,j,linew,ishice) ! old ice mass
848 phi=3.0_r8
849 IF (fi(i,j,icw_ao).lt. 0.0_r8) phi=0.5_r8
850 xmelt=min((fi(i,j,icw_io)-fi(i,j,icw_ai)), 0.0_r8)
851 si(i,j,linew,ishice)=si(i,j,linew,ishice)+ &
852 & dtice(ng)* &
853 & (si(i,j,linew,isaice)* &
854 & (fi(i,j,icw_io)-fi(i,j,icw_ai))+ &
855 & (1.0_r8-si(i,j,linew,isaice))* &
856 & fi(i,j,icw_ao)+fi(i,j,icw_fr))
857
858 ai_tmp=si(i,j,linew,isaice) ! old ice concentration
859 si(i,j,linew,isaice)=si(i,j,linew,isaice)+ &
860 & dtice(ng)* &
861 & (1.0_r8-si(i,j,linew,isaice))* &
862 & (phi*fi(i,j,icw_ao)+fi(i,j,icw_fr))
863 si(i,j,linew,isaice)= min(si(i,j,linew,isaice), max_ai(ng))
864 IF (si(i,j,linew,isaice).lt.ai_tmp) THEN
865 si(i,j,linew,ishsno)=si(i,j,linew,ishsno)* &
866 & si(i,j,linew,isaice)/max(ai_tmp, eps)
867 END IF
868
869#ifdef ICE_CONVSNOW
870!
871! If snow base is below sea level, then raise the snow base to sea
872! level by converting some snow to ice (N.B. "hstar" is also weighted
873! by "isAice" like "isHsno" and "isHice").
874!
875 hstar=si(i,j,linew,ishsno)- &
876 & (rhosw-icerho(ng))*si(i,j,linew,ishice)/snowdryrho(ng)
877 IF (hstar.gt.0.0_r8) THEN
878 cff=hstar/rhosw
879 si(i,j,linew,ishsno)=si(i,j,linew,ishsno)- &
880 & icerho(ng)*cff
881 si(i,j,linew,ishice)=si(i,j,linew,ishice)+ &
882 & snowdryrho(ng)*cff
883 END IF
884#endif
885#ifdef AICLM_NUDGING
886 cff=ainudgcof(i,j)
887 si(i,j,linew,isaice)=si(i,j,linew,isaice)+ &
888 & dtice(ng)*cff* &
889 & (aiclm(i,j)-si(i,j,linew,isaice))
890 si(i,j,linew,ishice)=si(i,j,linew,ishice)+ &
891 & dtice(ng)*cff* &
892 & (hiclm(i,j)-si(i,j,linew,ishice))
893#endif
894!
895! Determine age of the sea ice. Any new ice production reduces the
896! overall age of the ice parcel.
897!
898 IF ((si(i,j,linew,isiage).le.0.0_r8).and. &
899 & (si(i,j,linew,ishice).gt.min_hi(ng))) THEN ! new
900 si(i,j,linew,isiage)=dtice(ng)*sec2day
901 ELSE IF((si(i,j,linew,isiage).gt.0.0_r8).and. &
902 & (si(i,j,linew,ishice).gt.min_hi(ng))) THEN ! older
903 delta_mi=min(max(si(i,j,linew,ishice)-mi_old, 0.0_r8)/ &
904 & si(i,j,linew,ishice), 1.0_r8)
905 si(i,j,linew,isiage)=si(i,j,linew,isiage)+ &
906 & dtice(ng)*sec2day- &
907 & si(i,j,linew,isiage)*delta_mi
908 ELSE ! melted
909 si(i,j,linew,isiage)=0.0_r8
910 ENDIF
911
912#ifdef MASKING
913 si(i,j,linew,isaice)=si(i,j,linew,isaice)*rmask(i,j)
914 si(i,j,linew,ishice)=si(i,j,linew,ishice)*rmask(i,j)
915#endif
916#ifdef WET_DRY
917! Si(i,j,linew,isAice)=Si(i,j,linew,isAice)*rmask_wet(i,j)
918! Si(i,j,linew,isHice)=Si(i,j,linew,isHice)*rmask_wet(i,j)
919#endif
920#ifdef ICESHELF
921 IF (zice(i,j).ne.0.0_r8) THEN
922 si(i,j,linew,isaice)=0.0_r8
923 si(i,j,linew,ishice)=0.0_r8
924 END IF
925#endif
926 END DO
927 END DO
928!
929! Limit the values.
930!
931 DO j=jstr,jend
932 DO i=istr,iend
933 si(i,j,linew,isaice)=min(si(i,j,linew,isaice), max_ai(ng))
934 si(i,j,linew,isaice)=max(si(i,j,linew,isaice), 0.0_r8)
935 si(i,j,linew,ishice)=max(si(i,j,linew,ishice), 0.0_r8)
936 si(i,j,linew,ishsno)=max(si(i,j,linew,ishsno), 0.0_r8)
937 si(i,j,linew,ishmel)=max(si(i,j,linew,ishmel), 0.0_r8)
938 si(i,j,linew,istice)=max(si(i,j,linew,istice), -70.0_r8)
939 IF (si(i,j,linew,ishice).le.0.0_r8) &
940 & si(i,j,linew,isaice)=0.0_r8
941 IF (si(i,j,linew,isaice).le.0.0_r8) &
942 & si(i,j,linew,ishice)=0.0_r8
943 END DO
944 END DO
945!
946!-----------------------------------------------------------------------
947! Lateral boundary conditions.
948!-----------------------------------------------------------------------
949!
950 CALL bc_r2d_tile (ng, tile, &
951 & lbi, ubi, lbj, ubj, &
952 & fi(:,:,icisst))
953
954 CALL bc_r2d_tile (ng, tile, &
955 & lbi, ubi, lbj, ubj, &
956 & fi(:,:,icqcon))
957
958 CALL bc_r2d_tile (ng, tile, &
959 & lbi, ubi, lbj, ubj, &
960 & fi(:,:,icqrhs))
961
962 CALL bc_r2d_tile (ng, tile, &
963 & lbi, ubi, lbj, ubj, &
964 & stflx(:,:,isalt))
965
966 CALL bc_r2d_tile (ng, tile, &
967 & lbi, ubi, lbj, ubj, &
968 & stflx(:,:,itemp))
969
970 CALL ice_bc2d_tile (ng, tile, model, isaice, &
971 & lbi, ubi, lbj, ubj, &
972 & imins, imaxs, jmins, jmaxs, &
973 & liold, linew, &
974 & si(:,:,:,isuice), &
975 & si(:,:,:,isvice), &
976 & si(:,:,:,isaice), &
977 & lbc(:,ibice(isaice),ng))
978
979 CALL ice_bc2d_tile (ng, tile, model, ishice, &
980 & lbi, ubi, lbj, ubj, &
981 & imins, imaxs, jmins, jmaxs, &
982 & liold, linew, &
983 & si(:,:,:,isuice), &
984 & si(:,:,:,isvice), &
985 & si(:,:,:,ishice), &
986 & lbc(:,ibice(ishice),ng))
987
988 CALL ice_bc2d_tile (ng, tile, model, ishsno, &
989 & lbi, ubi, lbj, ubj, &
990 & imins, imaxs, jmins, jmaxs, &
991 & liold, linew, &
992 & si(:,:,:,isuice), &
993 & si(:,:,:,isvice), &
994 & si(:,:,:,ishsno), &
995 & lbc(:,ibice(ishsno),ng))
996
997 CALL ice_bc2d_tile (ng, tile, model, ishmel, &
998 & lbi, ubi, lbj, ubj, &
999 & imins, imaxs, jmins, jmaxs, &
1000 & liold, linew, &
1001 & si(:,:,:,isuice), &
1002 & si(:,:,:,isvice), &
1003 & si(:,:,:,ishmel), &
1004 & lbc(:,ibice(ishmel),ng))
1005
1006 CALL ice_bc2d_tile (ng, tile, model, isiage, &
1007 & lbi, ubi, lbj, ubj, &
1008 & imins, imaxs, jmins, jmaxs, &
1009 & liold, linew, &
1010 & si(:,:,:,isuice), &
1011 & si(:,:,:,isvice), &
1012 & si(:,:,:,isiage), &
1013 & lbc(:,ibice(isiage),ng))
1014
1015 CALL ice_tibc_tile (ng, tile, model, &
1016 & lbi, ubi, lbj, ubj, &
1017 & liold, linew, &
1018 & si(:,:,:,isuice), &
1019 & si(:,:,:,isvice), &
1020 & si(:,:,:,ishice), &
1021 & si(:,:,:,istice), &
1022 & si(:,:,:,isenth))
1023!
1024 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
1025 CALL exchange_r2d_tile (ng, tile, &
1026 & lbi, ubi, lbj, ubj, &
1027 & si(:,:,linew,ishage))
1028
1029 CALL exchange_r2d_tile (ng, tile, &
1030 & lbi, ubi, lbj, ubj, &
1031 & si(:,:,linew,ishice))
1032
1033 CALL exchange_r2d_tile (ng, tile, &
1034 & lbi, ubi, lbj, ubj, &
1035 & si(:,:,linew,ishmel))
1036
1037 CALL exchange_r2d_tile (ng, tile, &
1038 & lbi, ubi, lbj, ubj, &
1039 & si(:,:,linew,ishsno))
1040
1041 CALL exchange_r2d_tile (ng, tile, &
1042 & lbi, ubi, lbj, ubj, &
1043 & si(:,:,linew,isaice))
1044
1045 CALL exchange_r2d_tile (ng, tile, &
1046 & lbi, ubi, lbj, ubj, &
1047 & si(:,:,linew,isiage))
1048
1049 CALL exchange_r2d_tile (ng, tile, &
1050 & lbi, ubi, lbj, ubj, &
1051 & si(:,:,linew,isenth))
1052
1053 CALL exchange_r2d_tile (ng, tile, &
1054 & lbi, ubi, lbj, ubj, &
1055 & si(:,:,linew,istice))
1056 END IF
1057
1058#ifdef DISTRIBUTE
1059!
1060 CALL mp_exchange2d (ng, tile, model, 4, &
1061 & lbi, ubi, lbj, ubj, &
1062 & nghostpoints, ewperiodic(ng), nsperiodic(ng), &
1063 & si(:,:,linew,ishage), &
1064 & si(:,:,linew,ishice), &
1065 & si(:,:,linew,ishmel), &
1066 & si(:,:,linew,ishsno))
1067
1068 CALL mp_exchange2d (ng, tile, model, 4, &
1069 & lbi, ubi, lbj, ubj, &
1070 & nghostpoints, ewperiodic(ng), nsperiodic(ng), &
1071 & si(:,:,linew,isaice), &
1072 & si(:,:,linew,isiage), &
1073 & si(:,:,linew,isenth), &
1074 & si(:,:,linew,istice))
1075#endif
1076!
1077 RETURN
1078 END SUBROUTINE ice_thermo_tile
1079!
1080 END MODULE ice_thermo_mod
bc_2d_mod
Definition bc_2d.F:2
bc_2d_mod::bc_r2d_tile
subroutine bc_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition bc_2d.F:44
exchange_2d_mod
Definition exchange_2d.F:2
exchange_2d_mod::exchange_r2d_tile
subroutine exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:253
ice_bc2d_mod
Definition ice_bc2d.F:2
ice_thermo_mod
Definition ice_mk.h:1
ice_thermo_mod::ice_thermo_tile
subroutine, private ice_thermo_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nrhs, liold, linew, rmask, rmask_wet, zice, z_r, z_w, h, zt_avg1, aiclm, hiclm, ainudgcof, t, sustr, svstr, qnet_ai, qnet_ao, snow, rain, stflx, fi, si)
Definition ice_mk.h:196
ice_thermo_mod::ice_thermo
subroutine, public ice_thermo(ng, tile, model)
Definition ice_mk.h:109
ice_tibc_mod
Definition ice_tibc.F:2
mod_boundary
Definition mod_boundary.F:2
mod_clima
Definition mod_clima.F:2
mod_clima::clima
type(t_clima), dimension(:), allocatable clima
Definition mod_clima.F:153
mod_coupling
Definition mod_coupling.F:2
mod_coupling::coupling
type(t_coupling), dimension(:), allocatable coupling
Definition mod_coupling.F:102
mod_forces
Definition mod_forces.F:2
mod_forces::forces
type(t_forces), dimension(:), allocatable forces
Definition mod_forces.F:554
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_ice
Definition ice_mod.h:1
mod_ice::isvice
integer, parameter isvice
Definition ice_mod.h:147
mod_ice::dtice
integer, dimension(:), allocatable dtice
Definition ice_mod.h:217
mod_ice::min_hi
real(r8), dimension(:), allocatable min_hi
Definition ice_mod.h:246
mod_ice::ishage
integer, parameter ishage
Definition ice_mod.h:149
mod_ice::iciomf
integer, parameter iciomf
Definition ice_mod.h:176
mod_ice::icw_ro
integer, parameter icw_ro
Definition ice_mod.h:194
mod_ice::icqcon
integer, parameter icqcon
Definition ice_mod.h:182
mod_ice::ics0mk
integer, parameter ics0mk
Definition ice_mod.h:185
mod_ice::isenth
integer, parameter isenth
Definition ice_mod.h:148
mod_ice::airrho
real(r8), dimension(:), allocatable airrho
Definition ice_mod.h:222
mod_ice::icw_ao
integer, parameter icw_ao
Definition ice_mod.h:191
mod_ice::icerho
real(r8), dimension(:), allocatable icerho
Definition ice_mod.h:223
mod_ice::ice_emiss
real(r8) ice_emiss
Definition ice_mod.h:267
mod_ice::ishsno
integer, parameter ishsno
Definition ice_mod.h:140
mod_ice::snowwetrho
real(r8), dimension(:), allocatable snowwetrho
Definition ice_mod.h:225
mod_ice::ice
type(t_ice), dimension(:), allocatable ice
Definition ice_mod.h:283
mod_ice::snowdryrho
real(r8), dimension(:), allocatable snowdryrho
Definition ice_mod.h:224
mod_ice::istice
integer, parameter istice
Definition ice_mod.h:145
mod_ice::nicef
integer, parameter nicef
Definition ice_mod.h:167
mod_ice::max_hmelt
real(r8), dimension(:), allocatable max_hmelt
Definition ice_mod.h:250
mod_ice::ibice
integer, dimension(nices) ibice
Definition ice_mod.h:162
mod_ice::min_ai
real(r8), dimension(:), allocatable min_ai
Definition ice_mod.h:241
mod_ice::spec_heat_air
real(r8) spec_heat_air
Definition ice_mod.h:268
mod_ice::ishmel
integer, parameter ishmel
Definition ice_mod.h:139
mod_ice::trans_coeff
real(r8) trans_coeff
Definition ice_mod.h:269
mod_ice::icw_fr
integer, parameter icw_fr
Definition ice_mod.h:192
mod_ice::icqrhs
integer, parameter icqrhs
Definition ice_mod.h:183
mod_ice::isiage
integer, parameter isiage
Definition ice_mod.h:141
mod_ice::isaice
integer, parameter isaice
Definition ice_mod.h:137
mod_ice::ict0mk
integer, parameter ict0mk
Definition ice_mod.h:186
mod_ice::max_ai
real(r8), dimension(:), allocatable max_ai
Definition ice_mod.h:242
mod_ice::sublimation
real(r8) sublimation
Definition ice_mod.h:270
mod_ice::isuice
integer, parameter isuice
Definition ice_mod.h:146
mod_ice::ishice
integer, parameter ishice
Definition ice_mod.h:138
mod_ice::nices
integer, parameter nices
Definition ice_mod.h:130
mod_ice::icw_io
integer, parameter icw_io
Definition ice_mod.h:193
mod_ice::icisst
integer, parameter icisst
Definition ice_mod.h:179
mod_ice::icw_ai
integer, parameter icw_ai
Definition ice_mod.h:190
mod_ocean
Definition mod_ocean.F:2
mod_ocean::ocean
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
mod_param
Definition mod_param.F:2
mod_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479
mod_param::nghostpoints
integer nghostpoints
Definition mod_param.F:710
mod_param::lbc
type(t_lbc), dimension(:,:,:), allocatable lbc
Definition mod_param.F:375
mod_param::nt
integer, dimension(:), allocatable nt
Definition mod_param.F:489
mod_scalars
Definition mod_scalars.F:2
mod_scalars::ewperiodic
logical, dimension(:), allocatable ewperiodic
Definition mod_scalars.F:510
mod_scalars::nsperiodic
logical, dimension(:), allocatable nsperiodic
Definition mod_scalars.F:511
mod_scalars::sec2day
real(dp), parameter sec2day
Definition mod_scalars.F:817
mod_scalars::isalt
integer isalt
Definition mod_scalars.F:127
mod_scalars::itemp
integer itemp
Definition mod_scalars.F:126
mod_scalars::stefbo
real(dp) stefbo
Definition mod_scalars.F:460
mod_stepping
Definition mod_stepping.F:2
mod_stepping::nrhs
integer, dimension(:), allocatable nrhs
Definition mod_stepping.F:70
mp_exchange_mod
Definition mp_exchange.F:2
mp_exchange_mod::mp_exchange2d
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:294
wclock_off
recursive subroutine wclock_off(ng, model, region, line, routine)
Definition timers.F:148
wclock_on
recursive subroutine wclock_on(ng, model, region, line, routine)
Definition timers.F:3