58
59
66
67
68
69 integer, intent(in) :: ng, tile, itrc, ic
70 integer, intent(in) :: LBi, UBi, LBj, UBj, UBk, UBt
71 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
72 integer, intent(in) :: nstp, nout
73
74# ifdef ASSUMED_SHAPE
75 real(r8), intent(inout) :: tl_t(LBi:,LBj:,:,:,:)
76# else
77 real(r8), intent(inout) :: tl_t(LBi:UBi,LBj:UBj,UBk,3,UBt)
78# endif
79
80
81
82 integer :: i, j, k
83
84 real(r8) :: Ce, Cx, cff
85 real(r8) :: obc_in, obc_out, tau
86
87 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_grad
88
89# include "set_bounds.h"
90
91
92
93
94
95 IF (
domain(ng)%Western_Edge(tile))
THEN
96
97
98
100 IF (
iic(ng).ne.0)
THEN
102 DO j=jstr,jend+1
103
104
105
106 tl_grad(istr-1,j)=0.0_r8
107 END DO
108 DO j=jstr,jend
110# if defined CELERITY_READ && defined FORWARD_READ
113 obc_out=
clima(ng)%Tnudgcof(istr-1,j,k,ic)
114 obc_in =
obcfac(ng)*obc_out
115 ELSE
118 END IF
119 IF (
boundary(ng)%t_west_Cx(j,k,itrc).lt. &
120 & 0.0_r8) THEN
121 tau=obc_in
122 ELSE
123 tau=obc_out
124 END IF
126 END IF
128# ifdef RADIATION_2D
130# else
131 ce=0.0_r8
132# endif
133 cff=
boundary(ng)%t_west_C2(j,k,itrc)
134# endif
135
136
137
138
139
140
141
142
143 tl_t(istr-1,j,k,nout,itrc)=(cff* &
144 & tl_t(istr-1,j,k,nstp, &
145 & itrc)+ &
146 & cx* &
147 & tl_t(istr ,j,k,nout, &
148 & itrc)- &
149 & max(ce,0.0_r8)* &
150 & tl_grad(istr-1,j )- &
151 & min(ce,0.0_r8)* &
152 & tl_grad(istr-1,j+1))/ &
153 & (cff+cx)
154
156
157
158
159
160
161
162 tl_t(istr-1,j,k,nout,itrc)=tl_t(istr-1,j,k,nout, &
163 & itrc)- &
164 & tau* &
165 & tl_t(istr-1,j,k,nstp, &
166 & itrc)
167 END IF
168# ifdef MASKING
169
170
171
172 tl_t(istr-1,j,k,nout,itrc)=tl_t(istr-1,j,k,nout, &
173 & itrc)* &
174 &
grid(ng)%rmask(istr-1,j)
175# endif
176 END IF
177 END DO
178 END DO
179 END IF
180
181
182
185 DO j=jstr,jend
187
188
189 tl_t(istr-1,j,k,nout,itrc)=
boundary(ng)% &
190 & tl_t_west(j,k,itrc)
191# ifdef MASKING
192
193
194
195 tl_t(istr-1,j,k,nout,itrc)=tl_t(istr-1,j,k,nout,itrc)* &
196 &
grid(ng)%rmask(istr-1,j)
197# endif
198 END IF
199 END DO
200 END DO
201
202
203
206 DO j=jstr,jend
208
209
210 tl_t(istr-1,j,k,nout,itrc)=tl_t(istr,j,k,nout,itrc)
211# ifdef MASKING
212
213
214
215 tl_t(istr-1,j,k,nout,itrc)=tl_t(istr-1,j,k,nout,itrc)* &
216 &
grid(ng)%rmask(istr-1,j)
217# endif
218 END IF
219 END DO
220 END DO
221
222
223
226 DO j=jstr,jend
228
229
230 tl_t(istr-1,j,k,nout,itrc)=tl_t(istr,j,k,nout,itrc)
231# ifdef MASKING
232
233
234
235 tl_t(istr-1,j,k,nout,itrc)=tl_t(istr-1,j,k,nout,itrc)* &
236 &
grid(ng)%rmask(istr-1,j)
237# endif
238 END IF
239 END DO
240 END DO
241 END IF
242 END IF
243
244
245
246
247
248 IF (
domain(ng)%Eastern_Edge(tile))
THEN
249
250
251
253 IF (
iic(ng).ne.0)
THEN
255 DO j=jstr,jend+1
256
257
258
259 tl_grad(iend+1,j)=0.0_r8
260 END DO
261 DO j=jstr,jend
263# if defined CELERITY_READ && defined FORWARD_READ
266 obc_out=
clima(ng)%Tnudgcof(iend+1,j,k,ic)
267 obc_in =
obcfac(ng)*obc_out
268 ELSE
271 END IF
272 IF (
boundary(ng)%t_east_Cx(j,k,itrc).lt. &
273 & 0.0_r8) THEN
274 tau=obc_in
275 ELSE
276 tau=obc_out
277 END IF
279 END IF
281# ifdef RADIATION_2D
283# else
284 ce=0.0_r8
285# endif
286 cff=
boundary(ng)%t_east_C2(j,k,itrc)
287# endif
288
289
290
291
292
293
294
295
296 tl_t(iend+1,j,k,nout,itrc)=(cff* &
297 & tl_t(iend+1,j,k,nstp, &
298 & itrc)+ &
299 & cx* &
300 & tl_t(iend ,j,k,nout, &
301 & itrc)- &
302 & max(ce,0.0_r8)* &
303 & tl_grad(iend+1,j )- &
304 & min(ce,0.0_r8)* &
305 & tl_grad(iend+1,j+1))/ &
306 & (cff+cx)
307
309
310
311
312
313
314
315 tl_t(iend+1,j,k,nout,itrc)=tl_t(iend+1,j,k,nout, &
316 & itrc)- &
317 & tau* &
318 & tl_t(iend+1,j,k,nstp, &
319 & itrc)
320 END IF
321# ifdef MASKING
322
323
324
325 tl_t(iend+1,j,k,nout,itrc)=tl_t(iend+1,j,k,nout, &
326 & itrc)* &
327 &
grid(ng)%rmask(iend+1,j)
328# endif
329 END IF
330 END DO
331 END DO
332 END IF
333
334
335
338 DO j=jstr,jend
340
341
342 tl_t(iend+1,j,k,nout,itrc)=
boundary(ng)% &
343 & tl_t_east(j,k,itrc)
344# ifdef MASKING
345
346
347
348 tl_t(iend+1,j,k,nout,itrc)=tl_t(iend+1,j,k,nout,itrc)* &
349 &
grid(ng)%rmask(iend+1,j)
350# endif
351 END IF
352 END DO
353 END DO
354
355
356
359 DO j=jstr,jend
361
362
363 tl_t(iend+1,j,k,nout,itrc)=tl_t(iend,j,k,nout,itrc)
364# ifdef MASKING
365
366
367
368 tl_t(iend+1,j,k,nout,itrc)=tl_t(iend+1,j,k,nout,itrc)* &
369 &
grid(ng)%rmask(iend+1,j)
370# endif
371 END IF
372 END DO
373 END DO
374
375
376
379 DO j=jstr,jend
381
382
383 tl_t(iend+1,j,k,nout,itrc)=tl_t(iend,j,k,nout,itrc)
384# ifdef MASKING
385
386
387
388 tl_t(iend+1,j,k,nout,itrc)=tl_t(iend+1,j,k,nout,itrc)* &
389 &
grid(ng)%rmask(iend+1,j)
390# endif
391 END IF
392 END DO
393 END DO
394 END IF
395 END IF
396
397
398
399
400
401 IF (
domain(ng)%Southern_Edge(tile))
THEN
402
403
404
406 IF (
iic(ng).ne.0)
THEN
408 DO i=istr,iend+1
409
410
411
412 tl_grad(i,jstr-1)=0.0_r8
413 END DO
414 DO i=istr,iend
416# if defined CELERITY_READ && defined FORWARD_READ
419 obc_out=
clima(ng)%Tnudgcof(i,jstr-1,k,ic)
420 obc_in =
obcfac(ng)*obc_out
421 ELSE
424 END IF
425 IF (
boundary(ng)%t_south_Ce(i,k,itrc).lt. &
426 & 0.0_r8) THEN
427 tau=obc_in
428 ELSE
429 tau=obc_out
430 END IF
432 END IF
433# ifdef RADIATION_2D
434 cx=
boundary(ng)%t_south_Cx(i,k,itrc)
435# else
436 cx=0.0_r8
437# endif
438 ce=
boundary(ng)%t_south_Ce(i,k,itrc)
439 cff=
boundary(ng)%t_south_C2(i,k,itrc)
440# endif
441
442
443
444
445
446
447
448
449 tl_t(i,jstr-1,k,nout,itrc)=(cff* &
450 & tl_t(i,jstr-1,k,nstp, &
451 & itrc)+ &
452 & ce* &
453 & tl_t(i,jstr ,k,nout, &
454 & itrc)- &
455 & max(cx,0.0_r8)* &
456 & tl_grad(i ,jstr-1)- &
457 & min(cx,0.0_r8)* &
458 & tl_grad(i+1,jstr-1))/ &
459 & (cff+ce)
460
462
463
464
465
466
467
468 tl_t(i,jstr-1,k,nout,itrc)=tl_t(i,jstr-1,k,nout, &
469 & itrc)- &
470 & tau* &
471 & tl_t(i,jstr-1,k,nstp, &
472 & itrc)
473 END IF
474# ifdef MASKING
475
476
477
478 tl_t(i,jstr-1,k,nout,itrc)=tl_t(i,jstr-1,k,nout, &
479 & itrc)* &
480 &
grid(ng)%rmask(i,jstr-1)
481# endif
482 END IF
483 END DO
484 END DO
485 END IF
486
487
488
491 DO i=istr,iend
493
494
495 tl_t(i,jstr-1,k,nout,itrc)=
boundary(ng)% &
496 & tl_t_south(i,k,itrc)
497# ifdef MASKING
498
499
500
501 tl_t(i,jstr-1,k,nout,itrc)=tl_t(i,jstr-1,k,nout,itrc)* &
502 &
grid(ng)%rmask(i,jstr-1)
503# endif
504 END IF
505 END DO
506 END DO
507
508
509
512 DO i=istr,iend
514
515
516 tl_t(i,jstr-1,k,nout,itrc)=tl_t(i,jstr,k,nout,itrc)
517# ifdef MASKING
518
519
520
521 tl_t(i,jstr-1,k,nout,itrc)=tl_t(i,jstr-1,k,nout,itrc)* &
522 &
grid(ng)%rmask(i,jstr-1)
523# endif
524 END IF
525 END DO
526 END DO
527
528
529
532 DO i=istr,iend
534
535
536 tl_t(i,jstr-1,k,nout,itrc)=tl_t(i,jstr,k,nout,itrc)
537# ifdef MASKING
538
539
540
541 tl_t(i,jstr-1,k,nout,itrc)=tl_t(i,jstr-1,k,nout,itrc)* &
542 &
grid(ng)%rmask(i,jstr-1)
543# endif
544 END IF
545 END DO
546 END DO
547 END IF
548 END IF
549
550
551
552
553
554 IF (
domain(ng)%Northern_Edge(tile))
THEN
555
556
557
559 IF (
iic(ng).ne.0)
THEN
561 DO i=istr,iend+1
562
563
564
565 tl_grad(i,jend+1)=0.0_r8
566 END DO
567 DO i=istr,iend
569# if defined CELERITY_READ && defined FORWARD_READ
572 obc_out=
clima(ng)%Tnudgcof(i,jend+1,k,ic)
573 obc_in =
obcfac(ng)*obc_out
574 ELSE
577 END IF
578 IF (
boundary(ng)%t_north_Ce(i,k,itrc).lt. &
579 & 0.0_r8) THEN
580 tau=obc_in
581 ELSE
582 tau=obc_out
583 END IF
585 END IF
586# ifdef RADIATION_2D
587 cx=
boundary(ng)%t_north_Cx(i,k,itrc)
588# else
589 cx=0.0_r8
590# endif
591 ce=
boundary(ng)%t_north_Ce(i,k,itrc)
592 cff=
boundary(ng)%t_north_C2(i,k,itrc)
593# endif
594
595
596
597
598
599
600
601
602 tl_t(i,jend+1,k,nout,itrc)=(cff* &
603 & tl_t(i,jend+1,k,nstp, &
604 & itrc)+ &
605 & ce* &
606 & tl_t(i,jend ,k,nout, &
607 & itrc)- &
608 & max(cx,0.0_r8)* &
609 & tl_grad(i ,jend+1)- &
610 & min(cx,0.0_r8)* &
611 & tl_grad(i+1,jend+1))/ &
612 & (cff+ce)
613
615
616
617
618
619
620
621 tl_t(i,jend+1,k,nout,itrc)=tl_t(i,jend+1,k,nout, &
622 & itrc)- &
623 & tau* &
624 & tl_t(i,jend+1,k,nstp, &
625 & itrc)
626 END IF
627# ifdef MASKING
628
629
630
631 tl_t(i,jend+1,k,nout,itrc)=tl_t(i,jend+1,k,nout, &
632 & itrc)* &
633 &
grid(ng)%rmask(i,jend+1)
634# endif
635 END IF
636 END DO
637 END DO
638 END IF
639
640
641
644 DO i=istr,iend
646
647
648 tl_t(i,jend+1,k,nout,itrc)=
boundary(ng)% &
649 & tl_t_north(i,k,itrc)
650# ifdef MASKING
651
652
653
654 tl_t(i,jend+1,k,nout,itrc)=tl_t(i,jend+1,k,nout,itrc)* &
655 &
grid(ng)%rmask(i,jend+1)
656# endif
657 END IF
658 END DO
659 END DO
660
661
662
665 DO i=istr,iend
667
668
669 tl_t(i,jend+1,k,nout,itrc)=tl_t(i,jend,k,nout,itrc)
670# ifdef MASKING
671
672
673
674 tl_t(i,jend+1,k,nout,itrc)=tl_t(i,jend+1,k,nout,itrc)* &
675 &
grid(ng)%rmask(i,jend+1)
676# endif
677 END IF
678 END DO
679 END DO
680
681
682
685 DO i=istr,iend
687
688
689 tl_t(i,jend+1,k,nout,itrc)=tl_t(i,jend,k,nout,itrc)
690# ifdef MASKING
691
692
693
694 tl_t(i,jend+1,k,nout,itrc)=tl_t(i,jend+1,k,nout,itrc)* &
695 &
grid(ng)%rmask(i,jend+1)
696# endif
697 END IF
698 END DO
699 END DO
700 END IF
701 END IF
702
703
704
705
706
708 IF (
domain(ng)%SouthWest_Corner(tile))
THEN
712
713
714
715
716
717
718 tl_t(istr-1,jstr-1,k,nout,itrc)=0.5_r8* &
719 & (tl_t(istr ,jstr-1,k, &
720 & nout,itrc)+ &
721 & tl_t(istr-1,jstr ,k, &
722 & nout,itrc))
723 END DO
724 END IF
725 END IF
726 IF (
domain(ng)%SouthEast_Corner(tile))
THEN
730
731
732
733
734
735
736 tl_t(iend+1,jstr-1,k,nout,itrc)=0.5_r8* &
737 & (tl_t(iend ,jstr-1,k, &
738 & nout,itrc)+ &
739 & tl_t(iend+1,jstr ,k, &
740 & nout,itrc))
741 END DO
742 END IF
743 END IF
744 IF (
domain(ng)%NorthWest_Corner(tile))
THEN
748
749
750
751
752
753
754 tl_t(istr-1,jend+1,k,nout,itrc)=0.5_r8* &
755 & (tl_t(istr-1,jend ,k, &
756 & nout,itrc)+ &
757 & tl_t(istr ,jend+1,k, &
758 & nout,itrc))
759 END DO
760 END IF
761 END IF
762 IF (
domain(ng)%NorthEast_Corner(tile))
THEN
766
767
768
769
770
771
772 tl_t(iend+1,jend+1,k,nout,itrc)=0.5_r8* &
773 & (tl_t(iend+1,jend ,k, &
774 & nout,itrc)+ &
775 & tl_t(iend ,jend+1,k, &
776 & nout,itrc))
777 END DO
778 END IF
779 END IF
780 END IF
781
782 RETURN
type(t_boundary), dimension(:), allocatable boundary
type(t_apply), dimension(:), allocatable lbc_apply
type(t_clima), dimension(:), allocatable clima
type(t_grid), dimension(:), allocatable grid
integer, dimension(:), allocatable istvar
type(t_lbc), dimension(:,:,:), allocatable tl_lbc
type(t_domain), dimension(:), allocatable domain
integer, dimension(:), allocatable iic
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
real(dp), dimension(:), allocatable obcfac
integer, parameter isouth
integer, parameter inorth
logical, dimension(:,:), allocatable lnudgetclm