42 SUBROUTINE ice_vbc (ng, tile, model)
49 integer,
intent(in) :: ng, tile, model
53 character (len=*),
parameter :: MyFile = &
59 CALL wclock_on (ng, model, 42, __line__, myfile)
61 CALL ice_vbc_tile (ng, tile, model, &
62 & lbi, ubi, lbj, ubj, &
63 & imins, imaxs, jmins, jmaxs, &
64 & liold(ng), liuol(ng), &
69 &
grid(ng) % umask_wet, &
70 &
grid(ng) % vmask_wet, &
81# ifdef ICE_BULK_FLUXES
92 CALL wclock_off (ng, model, 42, __line__, myfile)
96 END SUBROUTINE ice_vbc
99 SUBROUTINE ice_vbc_tile (ng, tile, model, &
100 & LBi, UBi, LBj, UBj, &
101 & IminS, ImaxS, JminS, JmaxS, &
107 & umask_wet, vmask_wet, &
115# ifdef ICE_BULK_FLUXES
116 & sustr_ai, svstr_ai, &
117 & sustr_ao, svstr_ao, &
125 integer,
intent(in) :: ng, tile, model
126 integer,
intent(in) :: LBi, UBi, LBj, UBj
127 integer,
intent(in) :: IminS, ImaxS, JminS, JmaxS
128 integer,
intent(in) :: liold, liuol
132 real(r8),
intent(in) :: h(LBi:,LBj:)
135 real(r8),
intent(in) :: umask_wet(LBi:,LBj:)
136 real(r8),
intent(in) :: vmask_wet(LBi:,LBj:)
138 real(r8),
intent(in) :: z_r(LBi:,LBj:,:)
139 real(r8),
intent(in) :: z_w(LBi:,LBj:,0:)
141 real(r8),
intent(in) :: zice(LBi:,LBj:)
143 real(r8),
intent(in) :: Zt_avg1(LBi:,LBj:)
144 real(r8),
intent(in) :: rho(LBi:,LBj:,:)
145 real(r8),
intent(in) :: u(LBi:,LBj:,:,:)
146 real(r8),
intent(in) :: v(LBi:,LBj:,:,:)
147# ifdef ICE_BULK_FLUXES
148 real(r8),
intent(in) :: sustr_ao(LBi:,LBj:)
149 real(r8),
intent(in) :: svstr_ao(LBi:,LBj:)
150 real(r8),
intent(in) :: sustr_ai(LBi:,LBj:)
151 real(r8),
intent(in) :: svstr_ai(LBi:,LBj:)
153 real(r8),
intent(in) :: Si(LBi:,LBj:,:,:)
154 real(r8),
intent(inout) :: sustr(LBi:,LBj:)
155 real(r8),
intent(inout) :: svstr(LBi:,LBj:)
156 real(r8),
intent(inout) :: Fi(LBi:,LBj:,:)
159 real(r8),
intent(in) :: h(LBi:UBi,LBj:UBj)
162 real(r8),
intent(in) :: umask_wet(LBi:UBi,LBj:UBj)
163 real(r8),
intent(in) :: vmask_wet(LBi:UBi,LBj:UBj)
165 real(r8),
intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
166 real(r8),
intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
168 real(r8),
intent(in) :: zice(LBi:UBi,LBj:UBj)
170 real(r8),
intent(in) :: Zt_avg1(LBi:UBi,LBj:UBj)
171 real(r8),
intent(in) :: rho(LBi:UBi,LBj:UBj,N(ng))
172 real(r8),
intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
173 real(r8),
intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
174# ifdef ICE_BULK_FLUXES
175 real(r8),
intent(in) :: sustr_ao(LBi:UBi,LBj:UBj)
176 real(r8),
intent(in) :: svstr_ao(LBi:UBi,LBj:UBj)
177 real(r8),
intent(in) :: sustr_ai(LBi:UBi,LBj:UBj)
178 real(r8),
intent(in) :: svstr_ai(LBi:UBi,LBj:UBj)
180 real(r8),
intent(in) :: Si(LBi:UBi,LBj:UBj,2,nIceS)
181 real(r8),
intent(inout) :: sustr(LBi:UBi,LBj:UBj)
182 real(r8),
intent(inout) :: svstr(LBi:UBi,LBj:UBj)
183 real(r8),
intent(inout) :: Fi(LBi:UBi,LBj:UBj,nIceF)
192 real(r8) :: aix, aiy, cff, chux, chuy, chuax, chuay, dztop
193 real(r8) :: hix, hiy, rhoO, spd, thic, zdz0, z0
194 real(r8) :: tauiwu, tauiwv
196 real(r8) :: clear, hh
199 real(r8),
parameter :: kappa = 0.4_r8
200 real(r8),
parameter :: z0ii = 0.01_r8
201 real(r8),
parameter :: eps = 1.0e-20
203 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: spdiw
204 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: chuiw
205 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: chuai
206 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: utauiw
208 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: uwind
209 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: vwind
210 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: wind_speed
211 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: windu
212 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: windv
215# include "set_bounds.h"
226 rhoo=
rho0+rho(i,j,n(ng))
229 spd=max(spd, 0.10_r8)
231 & min(zt_avg1(i,j), 0.0_r8)-0.9*si(i,j,liold,
ishice)
232 clear=max(clear, 0.001_r8)
233 IF (clear.lt.5.0_r8)
THEN
237 spd=max(spd, 0.15_r8)
241 chuiw(i,j)=
cd_io(ng)*spd
243 thic=si(i,j,liold,
ishice)/ &
249 z0=max(z0ii*thic, 0.01_r8)
251 dztop=z_w(i,j,n(ng))-z_r(i,j,n(ng))
260 IF (zdz0.lt.6.0_r8) zdz0=6.0_r8
261 utauiw(i,j)=sqrt(fi(i,j,
iciomt)*spd)
262 utauiw(i,j)=max(utauiw(i,j), 1.0e-04_r8)
263 chuiw(i,j)=kappa*utauiw(i,j)/log(zdz0)
268 chuai(i,j)=1.0_r8-cos(1.0_r8*
pi*min((thic+0.05_r8), 1.0_r8))
270 hh=h(i,j)+min(zt_avg1(i,j),0.0_r8)
271 clear=hh-0.9_r8*si(i,j,liold,
ishice)
272 clear=max(clear, 0.0_r8)
273 IF (clear.lt.5.0_r8) &
274 & chuiw(i,j)=(max(clear-1.0_r8, 0.0_r8)*0.25_r8)*chuiw(i,j)
284 rhoo=1000.0_r8+0.5_r8*(rho(i,j,n(ng))+rho(i-1,j,n(ng)))
285 aix =0.5_r8*(si(i,j,liold,
isaice)+si(i-1,j,liold,
isaice))
286 chux=0.5_r8*(chuiw(i,j)+chuiw(i-1,j))
291 fi(i,j,
icaius)=0.5_r8*aix* &
292 & (sustr_ai(i,j)+sustr_ai(i-1,j))/
icerho(ng)
294 chuax=0.5_r8*(chuai(i,j)+chuai(i-1,j))
295 fi(i,j,
icaius)=0.5_r8*aix*chuax* &
296 & (sustr_ai(i,j)+sustr_ai(i-1,j))/
icerho(ng)
301# ifdef ICE_BULK_FLUXES
304 icecavity=zice(i,j).ne.0.0_r8
308 IF (.not.icecavity)
THEN
309 sustr(i,j)=aix*chux*(si(i,j,liuol,
isuice)-fi(i,j,
icuavg))+ &
310 & (1.0_r8-aix)*sustr_ao(i,j)
312 sustr(i,j)=sustr(i,j)*umask_wet(i,j)
323 rhoo=1000.0_r8+0.5_r8*(rho(i,j,n(ng))+rho(i,j-1,n(ng)))
324 aiy =0.5_r8*(si(i,j,liold,
isaice)+si(i,j-1,liold,
isaice))
325 chuy=0.5_r8*(chuiw(i,j)+chuiw(i,j-1))
330 fi(i,j,
icaivs)=0.5_r8*aiy* &
331 & (svstr_ai(i,j)+svstr_ai(i,j-1))/
icerho(ng)
334 chuay=0.5_r8*(chuai(i,j)+chuai(i,j-1))
335 fi(i,j,
icaivs)=0.5_r8*aiy*chuay* &
336 & (svstr_ai(i,j)+svstr_ai(i,j-1))/
icerho(ng)
342# ifdef ICE_BULK_FLUXES
345 icecavity=zice(i,j).ne.0.0_r8
349 IF (.not.icecavity)
THEN
350 svstr(i,j)=aiy*chuy*(si(i,j,liuol,
isvice)-fi(i,j,
icvavg))+ &
351 & (1.0_r8-aiy)*svstr_ao(i,j)
353 svstr(i,j)=svstr(i,j)*vmask_wet(i,j)
367 windu(i,j)=0.5_r8*(uwind(i-1,j)+uwind(i,j))
372 windv(i,j)=0.5_r8*(vwind(i,j-1)+vwind(i,j))
379 spdiw(i,j)=cff*spd_iw(i,j)
380 spdiw(i,j)=max(spdiw(i,j), cff*0.1_r8)
381 wind_speed(i,j)=0.5*sqrt((windu(i,j)+windu(i+1,j))**2 + &
382 & (windv(i,j)+windv(i,j+1))**2)
384 clear=h(i,j)+min(zt_avg1(i,j), 0.0_r8)-0.9*hi(i,j,liold)
385 clear=max(clear, 0.001_r8)
386 IF (clear.lt.5.0_r8)
THEN
388 spdiw(i,j)=0.2_r8*clear*spdiw(i,j)
398 rhoo=1000.0_r8+0.5_r8*(rho(i,j,n(ng))+rho(i-1,j,n(ng)))
399 aix=0.5_r8*(si(i,j,liold,
isaice)+si(i-1,j,liold,
isaice))
400 hix=0.5_r8*(si(i,j,liold,
ishice)+si(i-1,j,liold,
ishice))
401 spd=0.5_r8*(wind_speed(i,j)+wind_speed(i-1,j))
403 & (1.0_r8*
cd_ai(ng)* &
404 & (1.0_r8-cos(1.0_r8*
pi* &
405 & min((hix/(aix+0.02_r8)+0.01_r8), &
407 & spd*windu(i,j)/
icerho(ng)
409# ifdef ICE_BULK_FLUXES
412 icecavity=zice(i,j).ne.0.0_r8
416 IF (.not.icecavity)
THEN
417 tauiwu=0.5_r8*(spdiw(i,j)+spdiw(i-1,j))* &
419 sustr(i,j)=tauiwu + &
421 & 0.5_r8*(sustr_ao(i,j)+sustr_ao(i-1,j))
423 sustr(i,j)=sustr(i,j)*umask_wet(i,j)
434 rhoo=1000.0_r8+0.5_r8*(rho(i,j,n(ng))+rho(i,j-1,n(ng)))
435 aiy=0.5_r8*(si(i,j,liold,
isaice)+si(i,j-1,liold,
isaice))
436 hiy=0.5_r8*(si(i,j,liold,
ishice)+si(i,j-1,liold,
ishice))
437 spd=0.5_r8*(wind_speed(i,j)+wind_speed(i,j-1))
439 & (0.5_r8*
cd_ai(ng)* &
440 & (1.0_r8-cos(2.0_r8*
pi* &
441 & min((hiy/(aiy+0.02_r8)+0.1_r8), &
443 & spd*windv(i,j)/
icerho(ng)
445# ifdef ICE_BULK_FLUXES
448 icecavity=zice(i,j).ne.0.0_r8
452 IF (.not.icecavity)
THEN
453 tauiwv=0.5_r8*(spdiw(i,j)+spdiw(i,j-1))* &
457 & 0.5_r8*(svstr_ao(i,j)+svstr_ao(i,j-1))
459 svstr(i,j)=svstr(i,j)*vmask_wet(i,j)
476 fi(i,j,
ichsse)=zt_avg1(i,j)
479 fi(i,j,
iciofv)=utauiw(i,j)
487 & lbi, ubi, lbj, ubj, &
491 & lbi, ubi, lbj, ubj, &
495 & lbi, ubi, lbj, ubj, &
500 & lbi, ubi, lbj, ubj, &
504 & lbi, ubi, lbj, ubj, &
508# ifdef ICE_BULK_FLUXES
510 & lbi, ubi, lbj, ubj, &
514 & lbi, ubi, lbj, ubj, &
521 & lbi, ubi, lbj, ubj, &
529 & lbi, ubi, lbj, ubj, &
535# ifdef ICE_BULK_FLUXES
537 & lbi, ubi, lbj, ubj, &
544 END SUBROUTINE ice_vbc_tile
subroutine bc_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
subroutine bc_v2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
subroutine bc_u2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
type(t_coupling), dimension(:), allocatable coupling
type(t_forces), dimension(:), allocatable forces
type(t_grid), dimension(:), allocatable grid
integer, parameter isvice
integer, parameter ichsse
integer, parameter icuavg
real(r8), dimension(:), allocatable airrho
real(r8), dimension(:), allocatable icerho
type(t_ice), dimension(:), allocatable ice
integer, parameter icvavg
integer, parameter iciomt
real(r8), dimension(:), allocatable min_ai
integer, parameter iciovs
integer, parameter iciofv
integer, parameter icaius
integer, parameter isaice
integer, parameter isuice
real(r8), dimension(:), allocatable cd_io
integer, parameter ishice
integer, parameter icaivs
real(r8), dimension(:), allocatable cd_ai
type(t_ocean), dimension(:), allocatable ocean
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
recursive subroutine wclock_off(ng, model, region, line, routine)
recursive subroutine wclock_on(ng, model, region, line, routine)