31 SUBROUTINE ice_bc2d_tile (ng, tile, model, ifld, &
32 & LBi, UBi, LBj, UBj, &
33 & IminS, ImaxS, JminS, JmaxS, &
40 integer,
intent(in) :: ng, tile, model, ifld
41 integer,
intent(in) :: LBi, UBi, LBj, UBj
42 integer,
intent(in) :: IminS, ImaxS, JminS, JmaxS
43 integer,
intent(in) :: liold, linew
45 TYPE(T_LBC),
intent(in) :: S(4)
48 real(r8),
intent(in) :: ui(LBi:,LBj:,:)
49 real(r8),
intent(in) :: vi(LBi:,LBj:,:)
50 real(r8),
intent(inout) :: field(LBi:,LBj:,:)
52 real(r8),
intent(in) :: ui(LBi:UBi,LBj:UBj,2)
53 real(r8),
intent(in) :: vi(LBi:UBi,LBj:UBj,2)
54 real(r8),
intent(inout) :: field(LBi:UBi,LBj:UBj,2)
61 real(r8),
parameter :: eps =1.0e-20_r8
62 real(r8) :: Ce, Cx, cff, dTde, dTdt, dTdx, tau
64 real(r8),
dimension(IminS:ImaxS,JminS:JmaxS) :: grad
66#include "set_bounds.h"
78 IF (
domain(ng)%Western_Edge(tile))
THEN
82 IF (s(
iwest)%radiation)
THEN
84 grad(istr-1,j)=field(istr-1,j,know)-field(istr-1,j-1,know)
86 grad(istr-1,j)=grad(istr-1,j)*
grid(ng)%vmask(istr-1,j)
88 grad(istr,j)=field(istr,j,know)-field(istr,j-1,know)
90 grad(istr,j)=grad(istr,j)*
grid(ng)%vmask(istr,j)
94 dtdt=field(istr,j,know )-field(istr ,j,linew)
95 dtdx=field(istr,j,linew)-field(istr+1,j,linew)
96 IF (s(
iwest)%nudging)
THEN
101 IF ((dtdt*dtdx).lt.0.0_r8) dtdt=0.0_r8
102 IF ((dtdt*(grad(istr,j)+grad(istr,j+1))).gt.0.0_r8)
THEN
107 cff=max(dtdx*dtdx+dtde*dtde,eps)
110 ce=min(cff,max(dtdt*dtde,-cff))
114 field(istr-1,j,linew)=(cff*field(istr-1,j,know)+ &
115 & cx *field(istr ,j,linew)- &
116 & max(ce,0.0_r8)*grad(istr-1,j )- &
117 & min(ce,0.0_r8)*grad(istr-1,j+1))/ &
119 IF (s(
iwest)%nudging)
THEN
120 field(istr-1,j,linew)=field(istr-1,j,linew)+ &
121 & tau*(
ice_lobc(ifld,ng)%ice_west(j)- &
122 & field(istr-1,j,know))
125 field(istr-1,j,linew)=field(istr-1,j,linew)* &
126 &
grid(ng)%rmask(istr-1,j)
132 ELSE IF (s(
iwest)%clamped)
THEN
134 field(istr-1,j,linew)=
ice_lobc(ifld,ng)%ice_west(j)
136 field(istr-1,j,linew)=field(istr-1,j,linew)* &
137 &
grid(ng)%rmask(istr-1,j)
140 field(istr-1,j,linew)=field(istr-1,j,linew)* &
141 &
grid(ng)%rmask_wet(istr-1,j)
147 ELSE IF (s(
iwest)%mixed)
THEN
149 IF (ui(1,j,linew).ge.0.0_r8)
THEN
150 field(istr-1,j,linew)=
ice_lobc(ifld,ng)%ice_west(j)
152 field(istr-1,j,linew)=field(istr-1,j,linew)* &
153 &
grid(ng)%rmask(istr-1,j)
156 field(istr-1,j,linew)=field(istr-1,j,linew)* &
157 &
grid(ng)%rmask_wet(istr-1,j)
160 field(istr-1,j,linew)=field(istr,j,liold)
162 field(istr-1,j,linew)=field(istr-1,j,linew)* &
163 &
grid(ng)%rmask(istr-1,j)
166 field(istr-1,j,linew)=field(istr-1,j,linew)* &
167 &
grid(ng)%rmask_wet(istr-1,j)
174 ELSE IF (s(
iwest)%closed)
THEN
176 field(istr-1,j,linew)=field(istr,j,linew)
178 field(istr-1,j,linew)=field(istr-1,j,linew)* &
179 &
grid(ng)%rmask(istr-1,j)
182 field(istr-1,j,linew)=field(istr-1,j,linew)* &
183 &
grid(ng)%rmask_wet(istr-1,j)
193 IF (
domain(ng)%Eastern_Edge(tile))
THEN
197 IF (s(
ieast)%radiation)
THEN
199 grad(iend,j)=field(iend,j,know)-field(iend,j-1,know)
201 grad(iend,j)=grad(iend,j)*
grid(ng)%vmask(iend ,j)
203 grad(iend+1,j)=field(iend+1,j,know)-field(iend+1,j-1,know)
205 grad(iend+1,j)=grad(iend+1,j)*
grid(ng)%vmask(iend+1,j)
209 dtdt=field(iend,j,know )-field(iend ,j,linew)
210 dtdx=field(iend,j,linew)-field(iend-1,j,linew)
211 IF (s(
ieast)%nudging)
THEN
216 IF ((dtdt*dtdx).lt.0.0_r8) dtdt=0.0_r8
217 IF ((dtdt*(grad(iend,j)+grad(iend,j+1))).gt.0.0_r8)
THEN
222 cff=max(dtdx*dtdx+dtde*dtde,eps)
225 ce=min(cff,max(dtdt*dtde,-cff))
229 field(iend+1,j,linew)=(cff*field(iend+1,j,know)+ &
230 & cx *field(iend ,j,linew)- &
231 & max(ce,0.0_r8)*grad(iend+1,j )- &
232 & min(ce,0.0_r8)*grad(iend+1,j+1))/ &
234 IF (s(
ieast)%nudging)
THEN
235 field(iend+1,j,linew)=field(iend+1,j,linew)+ &
236 & tau*(
ice_lobc(ifld,ng)%ice_east(j)- &
237 & field(iend+1,j,know))
240 field(iend+1,j,linew)=field(iend+1,j,linew)* &
241 &
grid(ng)%rmask(iend+1,j)
247 ELSE IF (s(
ieast)%clamped)
THEN
249 field(iend+1,j,linew)=
ice_lobc(ifld,ng)%ice_east(j)
251 field(iend+1,j,linew)=field(iend+1,j,linew)* &
252 &
grid(ng)%rmask(iend+1,j)
255 field(iend+1,j,linew)=field(iend+1,j,linew)* &
256 &
grid(ng)%rmask_wet(iend+1,j)
262 ELSE IF (s(
ieast)%mixed)
THEN
264 IF (ui(iend+1,j,linew).le.0.0_r8)
THEN
265 field(iend+1,j,linew)=
ice_lobc(ifld,ng)%ice_east(j)
267 field(iend+1,j,linew)=field(iend+1,j,linew)* &
268 &
grid(ng)%rmask(iend+1,j)
271 field(iend+1,j,linew)=field(iend+1,j,linew)* &
272 &
grid(ng)%rmask_wet(iend+1,j)
275 field(iend+1,j,linew)=field(iend,j,liold)
277 field(iend+1,j,linew)=field(iend+1,j,linew)* &
278 &
grid(ng)%rmask(iend+1,j)
281 field(iend+1,j,linew)=field(iend+1,j,linew)* &
282 &
grid(ng)%rmask_wet(iend+1,j)
289 ELSE IF (s(
ieast)%closed)
THEN
291 field(iend+1,j,linew)=field(iend,j,linew)
293 field(iend+1,j,linew)=field(iend+1,j,linew)* &
294 &
grid(ng)%rmask(iend+1,j)
297 field(iend+1,j,linew)=field(iend+1,j,linew)* &
298 &
grid(ng)%rmask_wet(iend+1,j)
308 IF (
domain(ng)%Southern_Edge(tile))
THEN
312 IF (s(
isouth)%radiation)
THEN
314 grad(i,jstr)=field(i,jstr,know)-field(i-1,jstr,know)
316 grad(i,jstr)=grad(i,jstr)*
grid(ng)%umask(i,jstr)
318 grad(i,jstr-1)=field(i,jstr-1,know)-field(i-1,jstr-1,know)
320 grad(i,jstr-1)=grad(i,jstr-1)*
grid(ng)%umask(i,jstr-1)
324 dtdt=field(i,jstr,know )-field(i,jstr ,linew)
325 dtde=field(i,jstr,linew)-field(i,jstr+1,linew)
326 IF (s(
isouth)%nudging)
THEN
331 IF ((dtdt*dtde).lt.0.0_r8) dtdt=0.0_r8
332 IF ((dtdt*(grad(i,jstr)+grad(i+1,jstr))).gt.0.0_r8)
THEN
337 cff=max(dtdx*dtdx+dtde*dtde,eps)
339 cx=min(cff,max(dtdt*dtdx,-cff))
344 field(i,jstr-1,linew)=(cff*field(i,jstr-1,know)+ &
345 & ce *field(i,jstr ,linew)- &
346 & max(cx,0.0_r8)*grad(i ,jstr-1)- &
347 & min(cx,0.0_r8)*grad(i+1,jstr-1))/ &
349 IF (s(
isouth)%nudging)
THEN
350 field(i,jstr-1,linew)=field(i,jstr-1,linew)+ &
351 & tau*(
ice_lobc(ifld,ng)%ice_south(i)-&
352 & field(i,jstr-1,know))
355 field(i,jstr-1,linew)=field(i,jstr-1,linew)* &
356 &
grid(ng)%rmask(i,jstr-1)
362 ELSE IF (s(
isouth)%clamped)
THEN
364 field(i,jstr-1,linew)=
ice_lobc(ifld,ng)%ice_south(i)
366 field(i,jstr-1,linew)=field(i,jstr-1,linew)* &
367 &
grid(ng)%rmask(i,jstr-1)
370 field(i,jstr-1,linew)=field(i,jstr-1,linew)* &
371 &
grid(ng)%rmask_wet(i,jstr-1)
377 ELSE IF (s(
isouth)%mixed)
THEN
379 IF (vi(i,1,linew).ge.0._r8)
THEN
380 field(i,jstr-1,linew)=
ice_lobc(ifld,ng)%ice_south(i)
382 field(i,jstr-1,linew)=field(i,jstr-1,linew)* &
383 &
grid(ng)%rmask(i,jstr-1)
386 field(i,jstr-1,linew)=field(i,jstr-1,linew)* &
387 &
grid(ng)%rmask_wet(i,jstr-1)
390 field(i,jstr-1,linew)=field(i,jstr,liold)
392 field(i,jstr-1,linew)=field(i,jstr-1,linew)* &
393 &
grid(ng)%rmask(i,jstr-1)
396 field(i,jstr-1,linew)=field(i,jstr-1,linew)* &
397 &
grid(ng)%rmask_wet(i,jstr-1)
404 ELSE IF (s(
isouth)%closed)
THEN
406 field(i,jstr-1,linew)=field(i,jstr,linew)
408 field(i,jstr-1,linew)=field(i,jstr-1,linew)* &
409 &
grid(ng)%rmask(i,jstr-1)
412 field(i,jstr-1,linew)=field(i,jstr-1,linew)* &
413 &
grid(ng)%rmask_wet(i,jstr-1)
423 IF (
domain(ng)%Northern_Edge(tile))
THEN
427 IF (s(
inorth)%radiation)
THEN
429 grad(i,jend)=field(i,jend,know)-field(i-1,jend,know)
431 grad(i,jend)=grad(i,jend)*
grid(ng)%umask(i,jend)
433 grad(i,jend+1)=field(i,jend+1,know)-field(i-1,jend+1,know)
435 grad(i,jend+1)=grad(i,jend+1)*
grid(ng)%umask(i,jend+1)
439 dtdt=field(i,jend,know )-field(i,jend ,linew)
440 dtde=field(i,jend,linew)-field(i,jend-1,linew)
441 IF (s(
inorth)%nudging)
THEN
446 IF ((dtdt*dtde).lt.0.0_r8) dtdt=0.0_r8
447 IF ((dtdt*(grad(i,jend)+grad(i+1,jend))).gt.0.0_r8)
THEN
452 cff=max(dtdx*dtdx+dtde*dtde,eps)
454 cx=min(cff,max(dtdt*dtdx,-cff))
459 field(i,jend+1,linew)=(cff*field(i,jend+1,know)+ &
460 & ce *field(i,jend ,linew)- &
461 & max(cx,0.0_r8)*grad(i ,jend+1)- &
462 & min(cx,0.0_r8)*grad(i+1,jend+1))/ &
464 IF (s(
inorth)%nudging)
THEN
465 field(i,jend+1,linew)=field(i,jend+1,linew)+ &
466 & tau*(
ice_lobc(ifld,ng)%ice_north(i)-&
467 & field(i,jend+1,know))
470 field(i,jend+1,linew)=field(i,jend+1,linew)* &
471 &
grid(ng)%rmask(i,jend+1)
477 ELSE IF (s(
inorth)%clamped)
THEN
479 field(i,jend+1,linew)=
ice_lobc(ifld,ng)%ice_north(i)
481 field(i,jend+1,linew)=field(i,jend+1,linew)* &
482 &
grid(ng)%rmask(i,jend+1)
485 field(i,jend+1,linew)=field(i,jend+1,linew)* &
486 &
grid(ng)%rmask_wet(i,jend+1)
492 ELSE IF (s(
inorth)%mixed)
THEN
494 IF (vi(i,jend+1,linew).le.0.0_r8)
THEN
495 field(i,jend+1,linew)=
ice_lobc(ifld,ng)%ice_north(i)
497 field(i,jend+1,linew)=field(i,
mm(ng)+1,linew)* &
498 &
grid(ng)%rmask(i,jend+1)
501 field(i,jend+1,linew)=field(i,jend+1,linew)* &
502 &
grid(ng)%rmask_wet(i,jend+1)
505 field(i,jend+1,linew)=field(i,jend,liold)
507 field(i,jend+1,linew)=field(i,jend+1,linew)* &
508 &
grid(ng)%rmask(i,jend+1)
511 field(i,jend+1,linew)=field(i,jend+1,linew)* &
512 &
grid(ng)%rmask_wet(i,jend+1)
519 ELSE IF (s(
inorth)%closed)
THEN
521 field(i,jend+1,linew)=field(i,jend,linew)
523 field(i,jend+1,linew)=field(i,jend+1,linew)* &
524 &
grid(ng)%rmask(i,jend+1)
527 field(i,jend+1,linew)=field(i,jend+1,linew)* &
528 &
grid(ng)%rmask_wet(i,jend+1)
539 IF (
domain(ng)%SouthWest_Corner(tile))
THEN
540 field(istr-1,jstr-1,linew)=0.5_r8* &
541 & (field(istr ,jstr-1,linew)+ &
542 & field(istr-1,jstr ,linew))
544 IF (
domain(ng)%SouthEast_Corner(tile))
THEN
545 field(iend+1,jstr-1,linew)=0.5_r8* &
546 & (field(iend+1,jstr ,linew)+ &
547 & field(iend ,jstr-1,linew))
549 IF (
domain(ng)%NorthWest_Corner(tile))
THEN
550 field(istr-1,jend+1,linew)=0.5_r8* &
551 & (field(istr-1,jend ,linew)+ &
552 & field(istr ,jend+1,linew))
554 IF (
domain(ng)%NorthEast_Corner(tile))
THEN
555 field(iend+1,jend+1,linew)=0.5_r8* &
556 & (field(iend+1,jend ,linew)+ &
557 & field(iend ,jend+1,linew))
561 END SUBROUTINE ice_bc2d_tile
type(t_grid), dimension(:), allocatable grid
type(t_ice_lobc), dimension(:,:), allocatable ice_lobc
type(t_domain), dimension(:), allocatable domain
integer, dimension(:), allocatable mm
real(dp), dimension(:), allocatable dt
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
real(dp), dimension(:,:,:), allocatable tobc_out
real(dp), dimension(:,:,:), allocatable tobc_in
integer, parameter isouth
integer, parameter inorth