57
58
65
66
67
68 integer, intent(in) :: ng, tile, itrc, ic
69 integer, intent(in) :: LBi, UBi, LBj, UBj, UBk, UBt
70 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
71 integer, intent(in) :: nstp, nout
72
73# ifdef ASSUMED_SHAPE
74 real(r8), intent(inout) :: ad_t(LBi:,LBj:,:,:,:)
75# else
76 real(r8), intent(inout) :: ad_t(LBi:UBi,LBj:UBj,UBk,3,UBt)
77# endif
78
79
80
81 integer :: i, j, k
82
83 real(r8) :: Ce, Cx, cff
84 real(r8) :: obc_in, obc_out, tau
85 real(r8) :: adfac
86
87 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ad_grad
88
89# include "set_bounds.h"
90
91
92
93
94
95 ad_grad(lbi:ubi,lbj:ubj)=0.0_r8
96
97
98
99
100
102 IF (
domain(ng)%NorthEast_Corner(tile))
THEN
106
107
108
109
110
111
112 adfac=0.5_r8*ad_t(iend+1,jend+1,k,nout,itrc)
113 ad_t(iend+1,jend ,k,nout,itrc)=ad_t(iend+1,jend ,k, &
114 & nout,itrc)+ &
115 & adfac
116 ad_t(iend ,jend+1,k,nout,itrc)=ad_t(iend ,jend+1,k, &
117 & nout,itrc)+ &
118 & adfac
119 ad_t(iend+1,jend+1,k,nout,itrc)=0.0_r8
120 END DO
121 END IF
122 END IF
123 IF (
domain(ng)%NorthWest_Corner(tile))
THEN
127
128
129
130
131
132
133 adfac=0.5_r8*ad_t(istr-1,jend+1,k,nout,itrc)
134 ad_t(istr-1,jend ,k,nout,itrc)=ad_t(istr-1,jend ,k, &
135 & nout,itrc)+ &
136 & adfac
137 ad_t(istr ,jend+1,k,nout,itrc)=ad_t(istr ,jend+1,k, &
138 & nout,itrc)+ &
139 & adfac
140 ad_t(istr-1,jend+1,k,nout,itrc)=0.0_r8
141 END DO
142 END IF
143 END IF
144 IF (
domain(ng)%SouthEast_Corner(tile))
THEN
148
149
150
151
152
153
154 adfac=0.5_r8*ad_t(iend+1,jstr-1,k,nout,itrc)
155 ad_t(iend ,jstr-1,k,nout,itrc)=ad_t(iend ,jstr-1,k, &
156 & nout,itrc)+ &
157 & adfac
158 ad_t(iend+1,jstr ,k,nout,itrc)=ad_t(iend+1,jstr ,k, &
159 & nout,itrc)+ &
160 & adfac
161 ad_t(iend+1,jstr-1,k,nout,itrc)=0.0_r8
162 END DO
163 END IF
164 END IF
165 IF (
domain(ng)%SouthWest_Corner(tile))
THEN
169
170
171
172
173
174
175 adfac=0.5_r8*ad_t(istr-1,jstr-1,k,nout,itrc)
176 ad_t(istr ,jstr-1,k,nout,itrc)=ad_t(istr ,jstr-1,k, &
177 & nout,itrc)+ &
178 & adfac
179 ad_t(istr-1,jstr ,k,nout,itrc)=ad_t(istr-1,jstr ,k, &
180 & nout,itrc)+ &
181 & adfac
182 ad_t(istr-1,jstr-1,k,nout,itrc)=0.0_r8
183 END DO
184 END IF
185 END IF
186 END IF
187
188
189
190
191
192 IF (
domain(ng)%Northern_Edge(tile))
THEN
193
194
195
197 IF (
iic(ng).ne.0)
THEN
199 DO i=istr,iend
201# if defined CELERITY_READ && defined FORWARD_READ
204 obc_out=
clima(ng)%Tnudgcof(i,jend+1,k,ic)
205 obc_in =
obcfac(ng)*obc_out
206 ELSE
209 END IF
210 IF (
boundary(ng)%t_north_Ce(i,k,itrc).lt. &
211 & 0.0_r8) THEN
212 tau=obc_in
213 ELSE
214 tau=obc_out
215 END IF
217 END IF
218# ifdef RADIATION_2D
219 cx=
boundary(ng)%t_north_Cx(i,k,itrc)
220# else
221 cx=0.0_r8
222# endif
223 ce=
boundary(ng)%t_north_Ce(i,k,itrc)
224 cff=
boundary(ng)%t_north_C2(i,k,itrc)
225# endif
226# ifdef MASKING
227
228
229
230
231 ad_t(i,jend+1,k,nout,itrc)=ad_t(i,jend+1,k,nout, &
232 & itrc)* &
233 &
grid(ng)%rmask(i,jend+1)
234# endif
236
237
238
239
240
241
242 ad_t(i,jend+1,k,nstp,itrc)=ad_t(i,jend+1,k,nstp, &
243 & itrc)- &
244 & tau* &
245 & ad_t(i,jend+1,k,nout, &
246 & itrc)
247 END IF
248
249
250
251
252
253
254
255
256
257
258
259
260 adfac=ad_t(i,jend+1,k,nout,itrc)/(cff+ce)
261 ad_grad(i ,jend+1)=ad_grad(i ,jend+1)- &
262 & max(cx,0.0_r8)*adfac
263 ad_grad(i+1,jend+1)=ad_grad(i+1,jend+1)- &
264 & min(cx,0.0_r8)*adfac
265 ad_t(i,jend ,k,nout,itrc)=ad_t(i,jend ,k,nout, &
266 & itrc)+ &
267 & ce *adfac
268 ad_t(i,jend+1,k,nstp,itrc)=ad_t(i,jend+1,k,nstp, &
269 & itrc)+ &
270 & cff*adfac
271 ad_t(i,jend+1,k,nout,itrc)=0.0_r8
272 END IF
273 END DO
274 END DO
275 END IF
276
277
278
281 DO i=istr,iend
283# ifdef MASKING
284
285
286
287 ad_t(i,jend+1,k,nout,itrc)=ad_t(i,jend+1,k,nout,itrc)* &
288 &
grid(ng)%rmask(i,jend+1)
289# endif
290# ifdef ADJUST_BOUNDARY
292
293
294
295 boundary(ng)%ad_t_north(i,k,itrc)= &
296 &
boundary(ng)%ad_t_north(i,k,itrc)+ &
297 & ad_t(i,jend+1,k, &
298 & nout,itrc)
299 ad_t(i,jend+1,k,nout,itrc)=0.0_r8
300 ELSE
301
302
303 ad_t(i,jend+1,k,nout,itrc)=0.0_r8
304 END IF
305# else
306
307
308 ad_t(i,jend+1,k,nout,itrc)=0.0_r8
309# endif
310 END IF
311 END DO
312 END DO
313
314
315
318 DO i=istr,iend
320# ifdef MASKING
321
322
323
324 ad_t(i,jend+1,k,nout,itrc)=ad_t(i,jend+1,k,nout,itrc)* &
325 &
grid(ng)%rmask(i,jend+1)
326# endif
327
328
329 ad_t(i,jend ,k,nout,itrc)=ad_t(i,jend ,k,nout,itrc)+ &
330 & ad_t(i,jend+1,k,nout,itrc)
331 ad_t(i,jend+1,k,nout,itrc)=0.0_r8
332 END IF
333 END DO
334 END DO
335
336
337
340 DO i=istr,iend
342# ifdef MASKING
343
344
345
346 ad_t(i,jend+1,k,nout,itrc)=ad_t(i,jend+1,k,nout,itrc)* &
347 &
grid(ng)%rmask(i,jend+1)
348# endif
349
350
351 ad_t(i,jend ,k,nout,itrc)=ad_t(i,jend ,k,nout,itrc)+ &
352 & ad_t(i,jend+1,k,nout,itrc)
353 ad_t(i,jend+1,k,nout,itrc)=0.0_r8
354 END IF
355 END DO
356 END DO
357 END IF
358 END IF
359
360
361
362
363
364 IF (
domain(ng)%Southern_Edge(tile))
THEN
365
366
367
369 IF (
iic(ng).ne.0)
THEN
371 DO i=istr,iend
373# if defined CELERITY_READ && defined FORWARD_READ
376 obc_out=
clima(ng)%Tnudgcof(i,jstr-1,k,ic)
377 obc_in =
obcfac(ng)*obc_out
378 ELSE
381 END IF
382 IF (
boundary(ng)%t_south_Ce(i,k,itrc).lt. &
383 & 0.0_r8) THEN
384 tau=obc_in
385 ELSE
386 tau=obc_out
387 END IF
389 END IF
390# ifdef RADIATION_2D
391 cx=
boundary(ng)%t_south_Cx(i,k,itrc)
392# else
393 cx=0.0_r8
394# endif
395 ce=
boundary(ng)%t_south_Ce(i,k,itrc)
396 cff=
boundary(ng)%t_south_C2(i,k,itrc)
397# endif
398# ifdef MASKING
399
400
401
402
403 ad_t(i,jstr-1,k,nout,itrc)=ad_t(i,jstr-1,k,nout, &
404 & itrc)* &
405 &
grid(ng)%rmask(i,jstr-1)
406# endif
408
409
410
411
412
413
414 ad_t(i,jstr-1,k,nstp,itrc)=ad_t(i,jstr-1,k,nstp, &
415 & itrc)- &
416 & tau* &
417 & ad_t(i,jstr-1,k,nout, &
418 & itrc)
419 END IF
420
421
422
423
424
425
426
427
428
429
430
431
432 adfac=ad_t(i,jstr-1,k,nout,itrc)/(cff+ce)
433 ad_grad(i ,jstr-1)=ad_grad(i ,jstr-1)- &
434 & max(cx,0.0_r8)*adfac
435 ad_grad(i+1,jstr-1)=ad_grad(i+1,jstr-1)- &
436 & min(cx,0.0_r8)*adfac
437 ad_t(i,jstr-1,k,nstp,itrc)=ad_t(i,jstr-1,k,nstp, &
438 & itrc)+ &
439 & cff*adfac
440 ad_t(i,jstr ,k,nout,itrc)=ad_t(i,jstr ,k,nout, &
441 & itrc)+ &
442 & ce *adfac
443 ad_t(i,jstr-1,k,nout,itrc)=0.0_r8
444 END IF
445 END DO
446 END DO
447 END IF
448
449
450
453 DO i=istr,iend
455# ifdef MASKING
456
457
458
459 ad_t(i,jstr-1,k,nout,itrc)=ad_t(i,jstr-1,k,nout,itrc)* &
460 &
grid(ng)%rmask(i,jstr-1)
461# endif
462# ifdef ADJUST_BOUNDARY
464
465
466
467 boundary(ng)%ad_t_south(i,k,itrc)= &
468 &
boundary(ng)%ad_t_south(i,k,itrc)+ &
469 & ad_t(i,jstr-1,k, &
470 & nout,itrc)
471 ad_t(i,jstr-1,k,nout,itrc)=0.0_r8
472 ELSE
473
474
475 ad_t(i,jstr-1,k,nout,itrc)=0.0_r8
476 END IF
477# else
478
479
480 ad_t(i,jstr-1,k,nout,itrc)=0.0_r8
481# endif
482 END IF
483 END DO
484 END DO
485
486
487
490 DO i=istr,iend
492# ifdef MASKING
493
494
495
496 ad_t(i,jstr-1,k,nout,itrc)=ad_t(i,jstr-1,k,nout,itrc)* &
497 &
grid(ng)%rmask(i,jstr-1)
498# endif
499
500
501 ad_t(i,jstr ,k,nout,itrc)=ad_t(i,jstr ,k,nout,itrc)+ &
502 & ad_t(i,jstr-1,k,nout,itrc)
503 ad_t(i,jstr-1,k,nout,itrc)=0.0_r8
504 END IF
505 END DO
506 END DO
507
508
509
512 DO i=istr,iend
514# ifdef MASKING
515
516
517
518 ad_t(i,jstr-1,k,nout,itrc)=ad_t(i,jstr-1,k,nout,itrc)* &
519 &
grid(ng)%rmask(i,jstr-1)
520# endif
521
522
523 ad_t(i,jstr ,k,nout,itrc)=ad_t(i,jstr ,k,nout,itrc)+ &
524 & ad_t(i,jstr-1,k,nout,itrc)
525 ad_t(i,jstr-1,k,nout,itrc)=0.0_r8
526 END IF
527 END DO
528 END DO
529 END IF
530 END IF
531
532
533
534
535
536 IF (
domain(ng)%Eastern_Edge(tile))
THEN
537
538
539
541 IF (
iic(ng).ne.0)
THEN
543 DO j=jstr,jend
545# if defined CELERITY_READ && defined FORWARD_READ
548 obc_out=
clima(ng)%Tnudgcof(iend+1,j,k,ic)
549 obc_in =
obcfac(ng)*obc_out
550 ELSE
553 END IF
554 IF (
boundary(ng)%t_east_Cx(j,k,itrc).lt. &
555 & 0.0_r8) THEN
556 tau=obc_in
557 ELSE
558 tau=obc_out
559 END IF
561 END IF
563# ifdef RADIATION_2D
565# else
566 ce=0.0_r8
567# endif
568 cff=
boundary(ng)%t_east_C2(j,k,itrc)
569# endif
570# ifdef MASKING
571
572
573
574
575 ad_t(iend+1,j,k,nout,itrc)=ad_t(iend+1,j,k,nout, &
576 & itrc)* &
577 &
grid(ng)%rmask(iend+1,j)
578# endif
580
581
582
583
584
585
586 ad_t(iend+1,j,k,nstp,itrc)=ad_t(iend+1,j,k,nstp, &
587 & itrc)- &
588 & tau* &
589 & ad_t(iend+1,j,k,nout, &
590 & itrc)
591 END IF
592
593
594
595
596
597
598
599
600
601
602
603
604 adfac=ad_t(iend+1,j,k,nout,itrc)/(cff+cx)
605 ad_grad(iend+1,j )=ad_grad(iend+1,j )- &
606 & max(ce,0.0_r8)*adfac
607 ad_grad(iend+1,j+1)=ad_grad(iend+1,j+1)- &
608 & min(ce,0.0_r8)*adfac
609 ad_t(iend ,j,k,nout,itrc)=ad_t(iend ,j,k,nout, &
610 & itrc)+ &
611 & cx *adfac
612 ad_t(iend+1,j,k,nstp,itrc)=ad_t(iend+1,j,k,nstp, &
613 & itrc)+ &
614 & cff*adfac
615 ad_t(iend+1,j,k,nout,itrc)=0.0_r8
616 END IF
617 END DO
618 END DO
619 END IF
620
621
622
625 DO j=jstr,jend
627# ifdef MASKING
628
629
630
631 ad_t(iend+1,j,k,nout,itrc)=ad_t(iend+1,j,k,nout,itrc)* &
632 &
grid(ng)%rmask(iend+1,j)
633# endif
634# ifdef ADJUST_BOUNDARY
636
637
638
640 &
boundary(ng)%ad_t_east(j,k,itrc)+ &
641 & ad_t(iend+1,j,k, &
642 & nout,itrc)
643 ad_t(iend+1,j,k,nout,itrc)=0.0_r8
644 ELSE
645
646
647 ad_t(iend+1,j,k,nout,itrc)=0.0_r8
648 END IF
649# else
650
651
652 ad_t(iend+1,j,k,nout,itrc)=0.0_r8
653# endif
654 END IF
655 END DO
656 END DO
657
658
659
662 DO j=jstr,jend
664# ifdef MASKING
665
666
667
668 ad_t(iend+1,j,k,nout,itrc)=ad_t(iend+1,j,k,nout,itrc)* &
669 &
grid(ng)%rmask(iend+1,j)
670# endif
671
672
673 ad_t(iend ,j,k,nout,itrc)=ad_t(iend ,j,k,nout,itrc)+ &
674 & ad_t(iend+1,j,k,nout,itrc)
675 ad_t(iend+1,j,k,nout,itrc)=0.0_r8
676 END IF
677 END DO
678 END DO
679
680
681
684 DO j=jstr,jend
686# ifdef MASKING
687
688
689
690 ad_t(iend+1,j,k,nout,itrc)=ad_t(iend+1,j,k,nout,itrc)* &
691 &
grid(ng)%rmask(iend+1,j)
692# endif
693
694
695 ad_t(iend ,j,k,nout,itrc)=ad_t(iend ,j,k,nout,itrc)+ &
696 & ad_t(iend+1,j,k,nout,itrc)
697 ad_t(iend+1,j,k,nout,itrc)=0.0_r8
698 END IF
699 END DO
700 END DO
701 END IF
702 END IF
703
704
705
706
707
708 IF (
domain(ng)%Western_Edge(tile))
THEN
709
710
711
713 IF (
iic(ng).ne.0)
THEN
715 DO j=jstr,jend
717# if defined CELERITY_READ && defined FORWARD_READ
720 obc_out=
clima(ng)%Tnudgcof(istr-1,j,k,ic)
721 obc_in =
obcfac(ng)*obc_out
722 ELSE
725 END IF
726 IF (
boundary(ng)%t_west_Cx(j,k,itrc).lt. &
727 & 0.0_r8) THEN
728 tau=obc_in
729 ELSE
730 tau=obc_out
731 END IF
733 END IF
735# ifdef RADIATION_2D
737# else
738 ce=0.0_r8
739# endif
740 cff=
boundary(ng)%t_west_C2(j,k,itrc)
741# endif
742# ifdef MASKING
743
744
745
746
747 ad_t(istr-1,j,k,nout,itrc)=ad_t(istr-1,j,k,nout, &
748 & itrc)* &
749 &
grid(ng)%rmask(istr-1,j)
750# endif
752
753
754
755
756
757
758 ad_t(istr-1,j,k,nstp,itrc)=ad_t(istr-1,j,k,nstp, &
759 & itrc)- &
760 & tau* &
761 & ad_t(istr-1,j,k,nout, &
762 & itrc)
763 END IF
764
765
766
767
768
769
770
771
772
773
774
775
776 adfac=ad_t(istr-1,j,k,nout,itrc)/(cff+cx)
777 ad_grad(istr-1,j )=ad_grad(istr-1,j )- &
778 & max(ce,0.0_r8)*adfac
779 ad_grad(istr-1,j+1)=ad_grad(istr-1,j+1)- &
780 & min(ce,0.0_r8)*adfac
781 ad_t(istr-1,j,k,nstp,itrc)=ad_t(istr-1,j,k,nstp, &
782 & itrc)+ &
783 & cff*adfac
784 ad_t(istr ,j,k,nout,itrc)=ad_t(istr ,j,k,nout, &
785 & itrc)+ &
786 & cx *adfac
787 ad_t(istr-1,j,k,nout,itrc)=0.0_r8
788 END IF
789 END DO
790 END DO
791 END IF
792
793
794
797 DO j=jstr,jend
799# ifdef MASKING
800
801
802
803 ad_t(istr-1,j,k,nout,itrc)=ad_t(istr-1,j,k,nout,itrc)* &
804 &
grid(ng)%rmask(istr-1,j)
805# endif
806# ifdef ADJUST_BOUNDARY
808
809
810
812 &
boundary(ng)%ad_t_west(j,k,itrc)+ &
813 & ad_t(istr-1,j,k, &
814 & nout,itrc)
815 ad_t(istr-1,j,k,nout,itrc)=0.0_r8
816 ELSE
817
818
819 ad_t(istr-1,j,k,nout,itrc)=0.0_r8
820 END IF
821# else
822
823
824 ad_t(istr-1,j,k,nout,itrc)=0.0_r8
825# endif
826 END IF
827 END DO
828 END DO
829
830
831
834 DO j=jstr,jend
836# ifdef MASKING
837
838
839
840 ad_t(istr-1,j,k,nout,itrc)=ad_t(istr-1,j,k,nout,itrc)* &
841 &
grid(ng)%rmask(istr-1,j)
842# endif
843
844
845 ad_t(istr ,j,k,nout,itrc)=ad_t(istr ,j,k,nout,itrc)+ &
846 & ad_t(istr-1,j,k,nout,itrc)
847 ad_t(istr-1,j,k,nout,itrc)=0.0_r8
848 END IF
849 END DO
850 END DO
851
852
853
856 DO j=jstr,jend
858# ifdef MASKING
859
860
861
862 ad_t(istr-1,j,k,nout,itrc)=ad_t(istr-1,j,k,nout,itrc)* &
863 &
grid(ng)%rmask(istr-1,j)
864# endif
865
866
867 ad_t(istr ,j,k,nout,itrc)=ad_t(istr ,j,k,nout,itrc)+ &
868 & ad_t(istr-1,j,k,nout,itrc)
869 ad_t(istr-1,j,k,nout,itrc)=0.0_r8
870 END IF
871 END DO
872 END DO
873 END IF
874 END IF
875
876 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 ad_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