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# ifdef ADJUST_BOUNDARY
191 tl_t(istr-1,j,k,nout,itrc)=
boundary(ng)% &
192 & tl_t_west(j,k,itrc)
193 ELSE
194 tl_t(istr-1,j,k,nout,itrc)=0.0_r8
195 END IF
196# else
197 tl_t(istr-1,j,k,nout,itrc)=0.0_r8
198# endif
199
200# ifdef MASKING
201
202
203
204 tl_t(istr-1,j,k,nout,itrc)=tl_t(istr-1,j,k,nout,itrc)* &
205 &
grid(ng)%rmask(istr-1,j)
206# endif
207 END IF
208 END DO
209 END DO
210
211
212
215 DO j=jstr,jend
217
218
219 tl_t(istr-1,j,k,nout,itrc)=tl_t(istr,j,k,nout,itrc)
220# ifdef MASKING
221
222
223
224 tl_t(istr-1,j,k,nout,itrc)=tl_t(istr-1,j,k,nout,itrc)* &
225 &
grid(ng)%rmask(istr-1,j)
226# endif
227 END IF
228 END DO
229 END DO
230
231
232
235 DO j=jstr,jend
237
238
239 tl_t(istr-1,j,k,nout,itrc)=tl_t(istr,j,k,nout,itrc)
240# ifdef MASKING
241
242
243
244 tl_t(istr-1,j,k,nout,itrc)=tl_t(istr-1,j,k,nout,itrc)* &
245 &
grid(ng)%rmask(istr-1,j)
246# endif
247 END IF
248 END DO
249 END DO
250 END IF
251 END IF
252
253
254
255
256
257 IF (
domain(ng)%Eastern_Edge(tile))
THEN
258
259
260
262 IF (
iic(ng).ne.0)
THEN
264 DO j=jstr,jend+1
265
266
267
268 tl_grad(iend+1,j)=0.0_r8
269 END DO
270 DO j=jstr,jend
272# if defined CELERITY_READ && defined FORWARD_READ
275 obc_out=
clima(ng)%Tnudgcof(iend+1,j,k,ic)
276 obc_in =
obcfac(ng)*obc_out
277 ELSE
280 END IF
281 IF (
boundary(ng)%t_east_Cx(j,k,itrc).lt. &
282 & 0.0_r8) THEN
283 tau=obc_in
284 ELSE
285 tau=obc_out
286 END IF
288 END IF
290# ifdef RADIATION_2D
292# else
293 ce=0.0_r8
294# endif
295 cff=
boundary(ng)%t_east_C2(j,k,itrc)
296# endif
297
298
299
300
301
302
303
304
305 tl_t(iend+1,j,k,nout,itrc)=(cff* &
306 & tl_t(iend+1,j,k,nstp, &
307 & itrc)+ &
308 & cx* &
309 & tl_t(iend ,j,k,nout, &
310 & itrc)- &
311 & max(ce,0.0_r8)* &
312 & tl_grad(iend+1,j )- &
313 & min(ce,0.0_r8)* &
314 & tl_grad(iend+1,j+1))/ &
315 & (cff+cx)
316
318
319
320
321
322
323
324 tl_t(iend+1,j,k,nout,itrc)=tl_t(iend+1,j,k,nout, &
325 & itrc)- &
326 & tau* &
327 & tl_t(iend+1,j,k,nstp, &
328 & itrc)
329 END IF
330# ifdef MASKING
331
332
333
334 tl_t(iend+1,j,k,nout,itrc)=tl_t(iend+1,j,k,nout, &
335 & itrc)* &
336 &
grid(ng)%rmask(iend+1,j)
337# endif
338 END IF
339 END DO
340 END DO
341 END IF
342
343
344
347 DO j=jstr,jend
349
350
351# ifdef ADJUST_BOUNDARY
353 tl_t(iend+1,j,k,nout,itrc)=
boundary(ng)% &
354 & tl_t_east(j,k,itrc)
355 ELSE
356 tl_t(iend+1,j,k,nout,itrc)=0.0_r8
357 END IF
358# else
359 tl_t(iend+1,j,k,nout,itrc)=0.0_r8
360# endif
361# ifdef MASKING
362
363
364
365 tl_t(iend+1,j,k,nout,itrc)=tl_t(iend+1,j,k,nout,itrc)* &
366 &
grid(ng)%rmask(iend+1,j)
367# endif
368 END IF
369 END DO
370 END DO
371
372
373
376 DO j=jstr,jend
378
379
380 tl_t(iend+1,j,k,nout,itrc)=tl_t(iend,j,k,nout,itrc)
381# ifdef MASKING
382
383
384
385 tl_t(iend+1,j,k,nout,itrc)=tl_t(iend+1,j,k,nout,itrc)* &
386 &
grid(ng)%rmask(iend+1,j)
387# endif
388 END IF
389 END DO
390 END DO
391
392
393
396 DO j=jstr,jend
398
399
400 tl_t(iend+1,j,k,nout,itrc)=tl_t(iend,j,k,nout,itrc)
401# ifdef MASKING
402
403
404
405 tl_t(iend+1,j,k,nout,itrc)=tl_t(iend+1,j,k,nout,itrc)* &
406 &
grid(ng)%rmask(iend+1,j)
407# endif
408 END IF
409 END DO
410 END DO
411 END IF
412 END IF
413
414
415
416
417
418 IF (
domain(ng)%Southern_Edge(tile))
THEN
419
420
421
423 IF (
iic(ng).ne.0)
THEN
425 DO i=istr,iend+1
426
427
428
429 tl_grad(i,jstr-1)=0.0_r8
430 END DO
431 DO i=istr,iend
433# if defined CELERITY_READ && defined FORWARD_READ
436 obc_out=
clima(ng)%Tnudgcof(i,jstr-1,k,ic)
437 obc_in =
obcfac(ng)*obc_out
438 ELSE
441 END IF
442 IF (
boundary(ng)%t_south_Ce(i,k,itrc).lt. &
443 & 0.0_r8) THEN
444 tau=obc_in
445 ELSE
446 tau=obc_out
447 END IF
449 END IF
450# ifdef RADIATION_2D
451 cx=
boundary(ng)%t_south_Cx(i,k,itrc)
452# else
453 cx=0.0_r8
454# endif
455 ce=
boundary(ng)%t_south_Ce(i,k,itrc)
456 cff=
boundary(ng)%t_south_C2(i,k,itrc)
457# endif
458
459
460
461
462
463
464
465
466 tl_t(i,jstr-1,k,nout,itrc)=(cff* &
467 & tl_t(i,jstr-1,k,nstp, &
468 & itrc)+ &
469 & ce* &
470 & tl_t(i,jstr ,k,nout, &
471 & itrc)- &
472 & max(cx,0.0_r8)* &
473 & tl_grad(i ,jstr-1)- &
474 & min(cx,0.0_r8)* &
475 & tl_grad(i+1,jstr-1))/ &
476 & (cff+ce)
477
479
480
481
482
483
484
485 tl_t(i,jstr-1,k,nout,itrc)=tl_t(i,jstr-1,k,nout, &
486 & itrc)- &
487 & tau* &
488 & tl_t(i,jstr-1,k,nstp, &
489 & itrc)
490 END IF
491# ifdef MASKING
492
493
494
495 tl_t(i,jstr-1,k,nout,itrc)=tl_t(i,jstr-1,k,nout, &
496 & itrc)* &
497 &
grid(ng)%rmask(i,jstr-1)
498# endif
499 END IF
500 END DO
501 END DO
502 END IF
503
504
505
508 DO i=istr,iend
510
511
512# ifdef ADJUST_BOUNDARY
514 tl_t(i,jstr-1,k,nout,itrc)=
boundary(ng)% &
515 & tl_t_south(i,k,itrc)
516 ELSE
517 tl_t(i,jstr-1,k,nout,itrc)=0.0_r8
518 END IF
519# else
520 tl_t(i,jstr-1,k,nout,itrc)=0.0_r8
521# endif
522# ifdef MASKING
523
524
525
526 tl_t(i,jstr-1,k,nout,itrc)=tl_t(i,jstr-1,k,nout,itrc)* &
527 &
grid(ng)%rmask(i,jstr-1)
528# endif
529 END IF
530 END DO
531 END DO
532
533
534
537 DO i=istr,iend
539
540
541 tl_t(i,jstr-1,k,nout,itrc)=tl_t(i,jstr,k,nout,itrc)
542# ifdef MASKING
543
544
545
546 tl_t(i,jstr-1,k,nout,itrc)=tl_t(i,jstr-1,k,nout,itrc)* &
547 &
grid(ng)%rmask(i,jstr-1)
548# endif
549 END IF
550 END DO
551 END DO
552
553
554
557 DO i=istr,iend
559
560
561 tl_t(i,jstr-1,k,nout,itrc)=tl_t(i,jstr,k,nout,itrc)
562# ifdef MASKING
563
564
565
566 tl_t(i,jstr-1,k,nout,itrc)=tl_t(i,jstr-1,k,nout,itrc)* &
567 &
grid(ng)%rmask(i,jstr-1)
568# endif
569 END IF
570 END DO
571 END DO
572 END IF
573 END IF
574
575
576
577
578
579 IF (
domain(ng)%Northern_Edge(tile))
THEN
580
581
582
584 IF (
iic(ng).ne.0)
THEN
586 DO i=istr,iend+1
587
588
589
590 tl_grad(i,jend+1)=0.0_r8
591 END DO
592 DO i=istr,iend
594# if defined CELERITY_READ && defined FORWARD_READ
597 obc_out=
clima(ng)%Tnudgcof(i,jend+1,k,ic)
598 obc_in =
obcfac(ng)*obc_out
599 ELSE
602 END IF
603 IF (
boundary(ng)%t_north_Ce(i,k,itrc).lt. &
604 & 0.0_r8) THEN
605 tau=obc_in
606 ELSE
607 tau=obc_out
608 END IF
610 END IF
611# ifdef RADIATION_2D
612 cx=
boundary(ng)%t_north_Cx(i,k,itrc)
613# else
614 cx=0.0_r8
615# endif
616 ce=
boundary(ng)%t_north_Ce(i,k,itrc)
617 cff=
boundary(ng)%t_north_C2(i,k,itrc)
618# endif
619
620
621
622
623
624
625
626
627 tl_t(i,jend+1,k,nout,itrc)=(cff* &
628 & tl_t(i,jend+1,k,nstp, &
629 & itrc)+ &
630 & ce* &
631 & tl_t(i,jend ,k,nout, &
632 & itrc)- &
633 & max(cx,0.0_r8)* &
634 & tl_grad(i ,jend+1)- &
635 & min(cx,0.0_r8)* &
636 & tl_grad(i+1,jend+1))/ &
637 & (cff+ce)
638
640
641
642
643
644
645
646 tl_t(i,jend+1,k,nout,itrc)=tl_t(i,jend+1,k,nout, &
647 & itrc)- &
648 & tau* &
649 & tl_t(i,jend+1,k,nstp, &
650 & itrc)
651 END IF
652# ifdef MASKING
653
654
655
656 tl_t(i,jend+1,k,nout,itrc)=tl_t(i,jend+1,k,nout, &
657 & itrc)* &
658 &
grid(ng)%rmask(i,jend+1)
659# endif
660 END IF
661 END DO
662 END DO
663 END IF
664
665
666
669 DO i=istr,iend
671
672
673# ifdef ADJUST_BOUNDARY
675 tl_t(i,jend+1,k,nout,itrc)=
boundary(ng)% &
676 & tl_t_north(i,k,itrc)
677 ELSE
678 tl_t(i,jend+1,k,nout,itrc)=0.0_r8
679 END IF
680# else
681 tl_t(i,jend+1,k,nout,itrc)=0.0_r8
682# endif
683# ifdef MASKING
684
685
686
687 tl_t(i,jend+1,k,nout,itrc)=tl_t(i,jend+1,k,nout,itrc)* &
688 &
grid(ng)%rmask(i,jend+1)
689# endif
690 END IF
691 END DO
692 END DO
693
694
695
698 DO i=istr,iend
700
701
702 tl_t(i,jend+1,k,nout,itrc)=tl_t(i,jend,k,nout,itrc)
703# ifdef MASKING
704
705
706
707 tl_t(i,jend+1,k,nout,itrc)=tl_t(i,jend+1,k,nout,itrc)* &
708 &
grid(ng)%rmask(i,jend+1)
709# endif
710 END IF
711 END DO
712 END DO
713
714
715
718 DO i=istr,iend
720
721
722 tl_t(i,jend+1,k,nout,itrc)=tl_t(i,jend,k,nout,itrc)
723# ifdef MASKING
724
725
726
727 tl_t(i,jend+1,k,nout,itrc)=tl_t(i,jend+1,k,nout,itrc)* &
728 &
grid(ng)%rmask(i,jend+1)
729# endif
730 END IF
731 END DO
732 END DO
733 END IF
734 END IF
735
736
737
738
739
741 IF (
domain(ng)%SouthWest_Corner(tile))
THEN
745
746
747
748
749
750
751 tl_t(istr-1,jstr-1,k,nout,itrc)=0.5_r8* &
752 & (tl_t(istr ,jstr-1,k, &
753 & nout,itrc)+ &
754 & tl_t(istr-1,jstr ,k, &
755 & nout,itrc))
756 END DO
757 END IF
758 END IF
759 IF (
domain(ng)%SouthEast_Corner(tile))
THEN
763
764
765
766
767
768
769 tl_t(iend+1,jstr-1,k,nout,itrc)=0.5_r8* &
770 & (tl_t(iend ,jstr-1,k, &
771 & nout,itrc)+ &
772 & tl_t(iend+1,jstr ,k, &
773 & nout,itrc))
774 END DO
775 END IF
776 END IF
777 IF (
domain(ng)%NorthWest_Corner(tile))
THEN
781
782
783
784
785
786
787 tl_t(istr-1,jend+1,k,nout,itrc)=0.5_r8* &
788 & (tl_t(istr-1,jend ,k, &
789 & nout,itrc)+ &
790 & tl_t(istr ,jend+1,k, &
791 & nout,itrc))
792 END DO
793 END IF
794 END IF
795 IF (
domain(ng)%NorthEast_Corner(tile))
THEN
799
800
801
802
803
804
805 tl_t(iend+1,jend+1,k,nout,itrc)=0.5_r8* &
806 & (tl_t(iend+1,jend ,k, &
807 & nout,itrc)+ &
808 & tl_t(iend ,jend+1,k, &
809 & nout,itrc))
810 END DO
811 END IF
812 END IF
813 END IF
814
815 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 lobc
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