31 SUBROUTINE ice_tibc (ng, tile, model)
38 integer,
intent(in) :: ng, tile, model
42 character (len=*),
parameter :: MyFile = &
48 CALL wclock_on (ng, model, 42, __line__, myfile)
50 CALL ice_tibc_tile (ng, tile, model, &
51 & lbi, ubi, lbj, ubj, &
52 & liold(ng), linew(ng), &
59 CALL wclock_off (ng, model, 42, __line__, myfile)
63 END SUBROUTINE ice_tibc
66 SUBROUTINE ice_tibc_tile (ng, tile, model, &
67 & LBi, UBi, LBj, UBj, &
69 & ui, vi, hi, ti, enthalpy)
74 integer,
intent(in) :: ng, tile, model
75 integer,
intent(in) :: LBi, UBi, LBj, UBj
76 integer,
intent(in) :: liold, linew
79 real(r8),
intent(in) :: ui(LBi:,LBj:,:)
80 real(r8),
intent(in) :: vi(LBi:,LBj:,:)
81 real(r8),
intent(in) :: hi(LBi:,LBj:,:)
82 real(r8),
intent(inout) :: ti(LBi:,LBj:,:)
83 real(r8),
intent(inout) :: enthalpy(LBi:,LBj:,:)
85 real(r8),
intent(in) :: ui(LBi:UBi,LBj:UBj,2)
86 real(r8),
intent(in) :: vi(LBi:UBi,LBj:UBj,2)
87 real(r8),
intent(in) :: hi(LBi:UBi,LBj:UBj,2)
88 real(r8),
intent(inout) :: ti(LBi:UBi,LBj:UBj,2)
89 real(r8),
intent(inout) :: enthalpy(LBi:UBi,LBj:UBj,2)
96 real(r8),
parameter :: eps=1.0e-6_r8
98#include "set_bounds.h"
110 IF (
domain(ng)%Western_Edge(tile))
THEN
119 enthalpy(istr-1,j,linew)=enthalpy(istr-1,j,linew)* &
120 &
grid(ng)%rmask(istr-1,j)
123 enthalpy(istr-1,j,linew)=enthalpy(istr-1,j,linew)* &
124 &
grid(ng)%rmask_wet(istr-1,j)
126 ti(istr-1,j,linew)=enthalpy(istr-1,j,linew)/ &
127 & max(hi(istr-1,j,linew),eps)
128 IF (hi(istr-1,j,linew).le.
min_hi(ng))
THEN
129 enthalpy(istr-1,j,linew)=0.0_r8
130 ti(istr-1,j,linew)=0.0_r8
138 IF (ui(istr,j,linew).ge.0.0_r8)
THEN
142 enthalpy(istr-1,j,linew)=enthalpy(istr-1,j,linew)* &
143 &
grid(ng)%rmask(istr-1,j)
146 enthalpy(istr-1,j,linew)=enthalpy(istr-1,j,linew)* &
147 &
grid(ng)%rmask_wet(istr-1,j)
150 enthalpy(istr-1,j,linew)=enthalpy(istr,j,liold)
152 enthalpy(istr-1,j,linew)=enthalpy(istr-1,j,linew)* &
153 &
grid(ng)%rmask(istr-1,j)
156 enthalpy(istr-1,j,linew)=enthalpy(istr-1,j,linew)* &
157 &
grid(ng)%rmask_wet(istr-1,j)
160 ti(istr-1,j,linew)=enthalpy(istr-1,j,linew)/ &
161 & max(hi(istr-1,j,linew),eps)
162 IF (hi(istr-1,j,linew).le.
min_hi(ng))
THEN
163 enthalpy(istr-1,j,linew)=0.0_r8
164 ti(istr-1,j,linew)=0.0_r8
172 enthalpy(istr-1,j,linew)=hi(istr,j,linew)* &
175 enthalpy(istr-1,j,linew)=enthalpy(istr-1,j,linew)* &
176 &
grid(ng)%rmask(istr-1,j)
179 enthalpy(istr-1,j,linew)=enthalpy(istr-1,j,linew)* &
180 &
grid(ng)%rmask_wet(istr-1,j)
182 ti(istr-1,j,linew)=enthalpy(istr-1,j,linew)/ &
183 & max(hi(istr-1,j,linew),eps)
184 IF (hi(istr-1,j,linew).le.
min_hi(ng))
THEN
185 enthalpy(istr-1,j,linew)=0.0_r8
186 ti(istr-1,j,linew)=0.0_r8
194 enthalpy(istr-1,j,linew)=hi(istr,j,linew)* &
197 enthalpy(istr-1,j,linew)=enthalpy(istr-1,j,linew)* &
198 &
grid(ng)%rmask(istr-1,j)
201 enthalpy(istr-1,j,linew)=enthalpy(istr-1,j,linew)* &
202 &
grid(ng)%rmask_wet(istr-1,j)
204 ti(istr-1,j,linew)=enthalpy(istr-1,j,linew)/ &
205 & max(hi(istr-1,j,linew),eps)
206 IF (hi(istr-1,j,linew).le.
min_hi(ng))
THEN
207 enthalpy(istr-1,j,linew)=0.0_r8
208 ti(istr-1,j,linew)=0.0_r8
218 IF (
domain(ng)%Eastern_Edge(tile))
THEN
227 enthalpy(iend+1,j,linew)=enthalpy(iend+1,j,linew)* &
228 &
grid(ng)%rmask(iend+1,j)
231 enthalpy(iend+1,j,linew)=enthalpy(iend+1,j,linew)* &
232 &
grid(ng)%rmask_wet(iend+1,j)
234 ti(iend+1,j,linew)=enthalpy(iend+1,j,linew)/ &
235 & max(hi(iend+1,j,linew),eps)
236 IF (hi(iend+1,j,linew).le.
min_hi(ng))
THEN
237 enthalpy(iend+1,j,linew)=0.0_r8
238 ti(iend+1,j,linew)=0.0_r8
246 IF (ui(iend+1,j,linew).le.0.0_r8)
THEN
250 enthalpy(iend+1,j,linew)=enthalpy(iend+1,j,linew)* &
251 &
grid(ng)%rmask(iend+1,j)
254 enthalpy(iend+1,j,linew)=enthalpy(iend+1,j,linew)* &
255 &
grid(ng)%rmask_wet(iend+1,j)
258 enthalpy(iend+1,j,linew)=hi(iend,j,liold)* &
261 enthalpy(iend+1,j,linew)=enthalpy(iend+1,j,linew)* &
262 &
grid(ng)%rmask(iend+1,j)
265 enthalpy(iend+1,j,linew)=enthalpy(iend+1,j,linew)* &
266 &
grid(ng)%rmask_wet(iend+1,j)
268 ti(iend+1,j,linew)=enthalpy(iend+1,j,linew)/ &
269 & max(hi(iend+1,j,linew),eps)
270 IF (hi(iend+1,j,linew).le.
min_hi(ng))
THEN
271 enthalpy(iend+1,j,linew)=0.0_r8
272 ti(iend+1,j,linew)=0.0_r8
281 enthalpy(iend+1,j,linew)=hi(iend,j,linew)* &
284 enthalpy(iend+1,j,linew)=enthalpy(iend+1,j,linew)* &
285 &
grid(ng)%rmask(iend+1,j)
288 enthalpy(iend+1,j,linew)=enthalpy(iend+1,j,linew)* &
289 &
grid(ng)%rmask_wet(iend+1,j)
291 ti(iend+1,j,linew)=enthalpy(iend+1,j,linew)/ &
292 & max(hi(iend+1,j,linew),eps)
293 IF (hi(iend+1,j,linew).le.
min_hi(ng))
THEN
294 enthalpy(iend+1,j,linew)=0.0_r8
295 ti(iend+1,j,linew)=0.0_r8
303 enthalpy(iend+1,j,linew)=hi(iend,j,linew)* &
306 enthalpy(iend+1,j,linew)=enthalpy(iend+1,j,linew)* &
307 &
grid(ng)%rmask(iend+1,j)
310 enthalpy(iend+1,j,linew)=enthalpy(iend+1,j,linew)* &
311 &
grid(ng)%rmask_wet(iend+1,j)
313 ti(iend+1,j,linew)=enthalpy(iend+1,j,linew)/ &
314 & max(hi(iend+1,j,linew),eps)
315 IF (hi(iend+1,j,linew).le.
min_hi(ng))
THEN
316 enthalpy(iend+1,j,linew)=0.0_r8
317 ti(iend+1,j,linew)=0.0_r8
327 IF (
domain(ng)%Southern_Edge(tile))
THEN
336 enthalpy(i,jstr-1,linew)=enthalpy(i,jstr-1,linew)* &
337 &
grid(ng)%rmask(i,jstr-1)
340 enthalpy(i,jstr-1,linew)=enthalpy(i,jstr-1,linew)* &
341 &
grid(ng)%rmask_wet(i,jstr-1)
343 ti(i,jstr-1,linew)=enthalpy(i,jstr-1,linew)/ &
344 & max(hi(i,jstr-1,linew),eps)
345 IF (hi(i,jstr-1,linew).le.
min_hi(ng))
THEN
346 enthalpy(i,jstr-1,linew)=0.0_r8
347 ti(i,jstr-1,linew)=0.0_r8
355 IF (vi(i,1,linew).ge.0.0_r8)
THEN
359 enthalpy(i,jstr-1,linew)=enthalpy(i,jstr-1,linew)* &
360 &
grid(ng)%rmask(i,jstr-1)
363 enthalpy(i,jstr-1,linew)=enthalpy(i,jstr-1,linew)* &
364 &
grid(ng)%rmask_wet(i,jstr-1)
367 enthalpy(i,jstr-1,linew)=enthalpy(i,jstr,liold)
369 enthalpy(i,jstr-1,linew)=enthalpy(i,jstr-1,linew)* &
370 &
grid(ng)%rmask(i,jstr-1)
373 enthalpy(i,jstr-1,linew)=enthalpy(i,jstr-1,linew)* &
374 &
grid(ng)%rmask_wet(i,jstr-1)
376 ti(i,jstr-1,linew)=enthalpy(i,jstr-1,linew)/ &
377 & max(hi(i,jstr-1,linew),eps)
378 IF (hi(i,jstr-1,linew).le.
min_hi(ng))
THEN
379 enthalpy(i,jstr-1,linew)=0.0_r8
380 ti(i,jstr-1,linew)=0.0_r8
389 enthalpy(i,jstr-1,linew)=hi(i,jstr,linew)* &
392 enthalpy(i,jstr-1,linew)=enthalpy(i,jstr-1,linew)* &
393 &
grid(ng)%rmask(i,jstr-1)
396 enthalpy(i,jstr-1,linew)=enthalpy(i,jstr-1,linew)* &
397 &
grid(ng)%rmask_wet(i,jstr-1)
399 ti(i,jstr-1,linew)=enthalpy(i,jstr-1,linew)/ &
400 & max(hi(i,jstr-1,linew),eps)
401 IF (hi(i,jstr-1,linew).le.
min_hi(ng))
THEN
402 enthalpy(i,jstr-1,linew)=0.0_r8
403 ti(i,jstr-1,linew)=0.0_r8
411 enthalpy(i,jstr-1,linew)=enthalpy(i,jstr,linew)
413 enthalpy(i,jstr-1,linew)=enthalpy(i,jstr-1,linew)* &
414 &
grid(ng)%rmask(i,jstr-1)
417 enthalpy(i,jstr-1,linew)=enthalpy(i,jstr-1,linew)* &
418 &
grid(ng)%rmask_wet(i,jstr-1)
420 ti(i,jstr-1,linew)=enthalpy(i,jstr-1,linew)/ &
421 & max(hi(i,jstr-1,linew),eps)
422 IF (hi(i,jstr-1,linew).le.
min_hi(ng))
THEN
423 enthalpy(i,jstr-1,linew)=0.0_r8
424 ti(i,jstr-1,linew)=0.0_r8
434 IF (
domain(ng)%Northern_Edge(tile))
THEN
443 enthalpy(i,jend+1,linew)=enthalpy(i,jend+1,linew)* &
444 &
grid(ng)%rmask(i,jend+1)
447 enthalpy(i,jend+1,linew)=enthalpy(i,jend+1,linew)* &
448 &
grid(ng)%rmask_wet(i,jend+1)
450 ti(i,jend+1,linew)=enthalpy(i,jend+1,linew)/ &
451 & max(hi(i,jend+1,linew),eps)
452 IF (hi(i,jend+1,linew).le.
min_hi(ng))
THEN
453 enthalpy(i,jend+1,linew)=0.0_r8
454 ti(i,jend+1,linew)=0.0_r8
462 IF (vi(i,jend+1,linew).le.0.0_r8)
THEN
466 enthalpy(i,jend+1,linew)=enthalpy(i,jend+1,linew)* &
467 &
grid(ng)%rmask(i,jend+1)
470 enthalpy(i,jend+1,linew)=enthalpy(i,jend+1,linew)* &
471 &
grid(ng)%rmask_wet(i,jend+1)
474 enthalpy(i,jend+1,linew)=enthalpy(i,jend,liold)
476 enthalpy(i,jend+1,linew)=enthalpy(i,jend+1,linew)* &
477 &
grid(ng)%rmask(i,jend+1)
480 enthalpy(i,jend+1,linew)=enthalpy(i,jend+1,linew)* &
481 &
grid(ng)%rmask_wet(i,jend+1)
484 ti(i,jend+1,linew)=enthalpy(i,jend+1,linew)/ &
485 & max(hi(i,jend+1,linew),eps)
486 IF (hi(i,jend+1,linew).le.
min_hi(ng))
THEN
487 enthalpy(i,jend+1,linew)=0.0_r8
488 ti(i,jend+1,linew)=0.0_r8
496 enthalpy(i,jend+1,linew)=hi(i,jend,linew)* &
499 enthalpy(i,jend+1,linew)=enthalpy(i,jend+1,linew)* &
500 &
grid(ng)%rmask(i,jend+1)
503 enthalpy(i,jend+1,linew)=enthalpy(i,jend+1,linew)* &
504 &
grid(ng)%rmask_wet(i,jend+1)
507 ti(i,jend+1,linew)=enthalpy(i,jend+1,linew)/ &
508 & max(hi(i,jend,linew),eps)
510 ti(i,jend+1,linew)=enthalpy(i,jend+1,linew)/ &
511 & max(hi(i,jend+1,linew),eps)
513 IF (hi(i,jend+1,linew).le.
min_hi(ng))
THEN
514 enthalpy(i,jend+1,linew)=0.0_r8
515 ti(i,jend+1,linew)=0.0_r8
523 enthalpy(i,jend+1,linew)=hi(i,jend,linew)* &
526 enthalpy(i,jend+1,linew)=enthalpy(i,jend+1,linew)* &
527 &
grid(ng)%rmask(i,jend+1)
530 enthalpy(i,jend+1,linew)=enthalpy(i,jend+1,linew)* &
531 &
grid(ng)%rmask_wet(i,jend+1)
533 ti(i,jend+1,linew)=enthalpy(i,jend+1,linew)/ &
534 & max(hi(i,jend+1,linew),eps)
535 IF (hi(i,jend+1,linew).le.
min_hi(ng))
THEN
536 enthalpy(i,jend+1,linew)=0.0_r8
537 ti(i,jend+1,linew)=0.0_r8
548 IF (
domain(ng)%SouthWest_Corner(tile))
THEN
549 enthalpy(istr-1,jstr-1,linew)=0.5_r8* &
550 & (enthalpy(istr ,jstr-1,linew)+ &
551 & enthalpy(istr-1,jstr ,linew))
553 enthalpy(istr-1,jstr-1,linew)=enthalpy(istr-1,jstr-1,linew)* &
554 &
grid(ng)%rmask(istr-1,jstr-1)
557 enthalpy(istr-1,jstr-1,linew)=enthalpy(istr-1,jstr-1,linew)* &
558 &
grid(ng)%rmask_wet(istr-1,jstr-1)
560 ti(istr-1,jstr-1,linew)=enthalpy(istr-1,jstr-1,linew)/ &
561 & max(hi(istr-1,jstr-1,linew),eps)
562 IF (hi(istr-1,jstr-1,linew).le.
min_hi(ng))
THEN
563 enthalpy(istr-1,jstr-1,linew)=0.0_r8
564 ti(istr-1,jstr-1,linew)=0.0_r8
567 IF (
domain(ng)%SouthEast_Corner(tile))
THEN
568 enthalpy(iend+1,jstr-1,linew)=0.5_r8* &
569 & (enthalpy(iend+1,jstr ,linew)+ &
570 & enthalpy(iend ,jstr-1,linew))
572 enthalpy(iend+1,jstr-1,linew)=enthalpy(iend+1,jstr-1,linew)* &
573 &
grid(ng)%rmask(iend+1,jstr-1)
576 enthalpy(iend+1,jstr-1,linew)=enthalpy(iend+1,jstr-1,linew)* &
577 &
grid(ng)%rmask_wet(iend+1,jstr-1)
579 ti(iend+1,jstr-1,linew)=enthalpy(iend+1,jstr-1,linew)/ &
580 & max(hi(iend+1,jstr-1,linew),eps)
581 IF (hi(iend+1,jstr-1,linew).LE.
min_hi(ng))
THEN
582 enthalpy(iend+1,jstr-1,linew)=0.0_r8
583 ti(iend+1,jstr-1,linew)=0.0_r8
586 IF (
domain(ng)%NorthWest_Corner(tile))
THEN
587 enthalpy(istr-1,jend+1,linew)=0.5_r8* &
588 & (enthalpy(istr-1,jend ,linew)+ &
589 & enthalpy(istr ,jend+1,linew))
591 enthalpy(istr-1,jend+1,linew)=enthalpy(istr-1,jend+1,linew)* &
592 &
grid(ng)%rmask(istr-1,jend+1)
595 enthalpy(istr-1,jend+1,linew)=enthalpy(istr-1,jend+1,linew)* &
596 &
grid(ng)%rmask_wet(istr-1,jend+1)
598 ti(istr-1,jend+1,linew)=enthalpy(istr-1,jend+1,linew)/ &
599 & max(hi(istr-1,jend+1,linew),eps)
600 IF (hi(istr-1,jend+1,linew).le.
min_hi(ng))
THEN
601 enthalpy(istr-1,jend+1,linew)=0.0_r8
602 ti(istr-1,jend+1,linew)=0.0_r8
605 IF (
domain(ng)%NorthEast_Corner(tile))
THEN
606 enthalpy(iend+1,jend+1,linew)=0.5_r8* &
607 & (enthalpy(iend+1,jend ,linew)+ &
608 & enthalpy(iend ,jend+1,linew))
610 enthalpy(iend+1,jend+1,linew)=enthalpy(iend+1,jend+1,linew)* &
611 &
grid(ng)%rmask(iend+1,jend+1)
614 enthalpy(iend+1,jend+1,linew)=enthalpy(iend+1,jend+1,linew)* &
615 &
grid(ng)%rmask_wet(iend+1,jend+1)
617 ti(iend+1,jend+1,linew)=enthalpy(iend+1,jend+1,linew)/ &
618 & max(hi(iend+1,jend+1,linew),eps)
619 IF (hi(iend+1,jend+1,linew).le.
min_hi(ng))
THEN
620 enthalpy(iend+1,jend+1,linew)=0.0_r8
621 ti(iend+1,jend+1,linew)=0.0_r8
627 END SUBROUTINE ice_tibc_tile
type(t_grid), dimension(:), allocatable grid
integer, parameter isvice
real(r8), dimension(:), allocatable min_hi
integer, parameter isenth
type(t_ice_lobc), dimension(:,:), allocatable ice_lobc
type(t_ice), dimension(:), allocatable ice
integer, parameter istice
integer, dimension(nices) ibice
integer, parameter isuice
integer, parameter ishice
type(t_lbc), dimension(:,:,:), allocatable lbc
type(t_domain), dimension(:), allocatable domain
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
integer, parameter isouth
integer, parameter inorth
recursive subroutine wclock_off(ng, model, region, line, routine)
recursive subroutine wclock_on(ng, model, region, line, routine)