ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
ice_thermo_mod Module Reference

Functions/Subroutines

subroutine, public ice_thermo (ng, tile, model)
 
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)
 

Function/Subroutine Documentation

◆ ice_thermo()

subroutine, public ice_thermo_mod::ice_thermo ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 108 of file ice_mk.h.

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
mod_stepping
Definition mod_stepping.F:2
mod_stepping::nrhs
integer, dimension(:), allocatable nrhs
Definition mod_stepping.F:70
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

References mod_clima::clima, mod_coupling::coupling, mod_forces::forces, mod_grid::grid, mod_ice::ice, ice_thermo_tile(), mod_stepping::nrhs, mod_ocean::ocean, wclock_off(), and wclock_on().

Here is the call graph for this function:

◆ ice_thermo_tile()

subroutine, private ice_thermo_mod::ice_thermo_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) nrhs,
integer, intent(in) liold,
integer, intent(in) linew,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask_wet,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) zice,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(in) z_r,
real(r8), dimension(lbi:ubi,lbj:ubj,0:n(ng)), intent(in) z_w,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) h,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) zt_avg1,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) aiclm,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) hiclm,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) ainudgcof,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),3,nt(ng)), intent(in) t,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) sustr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) svstr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) qnet_ai,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) qnet_ao,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) snow,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rain,
real(r8), dimension(lbi:ubi,lbj:ubj,nt(ng)), intent(inout) stflx,
real(r8), dimension(lbi:ubi,lbj:ubj,nicef), intent(inout) fi,
real(r8), dimension(lbi:ubi,lbj:ubj,2,nices), intent(inout) si )
private

Definition at line 169 of file ice_mk.h.

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

References mod_ice::airrho, bc_2d_mod::bc_r2d_tile(), mod_ice::dtice, mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mod_ice::ibice, mod_ice::ice_emiss, mod_ice::icerho, mod_ice::iciomf, mod_ice::icisst, mod_ice::icqcon, mod_ice::icqrhs, mod_ice::ics0mk, mod_ice::ict0mk, mod_ice::icw_ai, mod_ice::icw_ao, mod_ice::icw_fr, mod_ice::icw_io, mod_ice::icw_ro, mod_ice::isaice, mod_scalars::isalt, mod_ice::isenth, mod_ice::ishage, mod_ice::ishice, mod_ice::ishmel, mod_ice::ishsno, mod_ice::isiage, mod_ice::istice, mod_ice::isuice, mod_ice::isvice, mod_scalars::itemp, mod_param::lbc, mod_ice::max_ai, mod_ice::max_hmelt, mod_ice::min_ai, mod_ice::min_hi, mp_exchange_mod::mp_exchange2d(), mod_param::n, mod_param::nghostpoints, mod_scalars::nsperiodic, mod_scalars::sec2day, mod_ice::snowdryrho, mod_ice::snowwetrho, mod_ice::spec_heat_air, mod_scalars::stefbo, mod_ice::sublimation, and mod_ice::trans_coeff.

Referenced by ice_thermo().

Here is the call graph for this function:
Here is the caller graph for this function: