57
58
65
66
67
68 integer, intent(in) :: ng, tile
69 integer, intent(in) :: LBi, UBi, LBj, UBj, UBk
70 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
71 integer, intent(in) :: nstp, nout
72
73# ifdef ASSUMED_SHAPE
74 real(r8), intent(inout) :: tl_v(LBi:,LBj:,:,:)
75# else
76 real(r8), intent(inout) :: tl_v(LBi:UBi,LBj:UBj,UBk,2)
77# endif
78
79
80
81 integer :: Jmin, Jmax
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)%Southern_Edge(tile))
THEN
96
97
98
100 IF (
iic(ng).ne.0)
THEN
102 DO i=istr,iend+1
103
104
105
106 tl_grad(i,jstr)=0.0_r8
107 END DO
108 DO i=istr,iend
110# if defined CELERITY_READ && defined FORWARD_READ
113 obc_out=0.5_r8* &
114 & (
clima(ng)%M3nudgcof(i,jstr-1,k)+ &
115 &
clima(ng)%M3nudgcof(i,jstr ,k))
116 obc_in =
obcfac(ng)*obc_out
117 ELSE
120 END IF
121 IF (
boundary(ng)%v_south_Ce(i,k).lt.0.0_r8)
THEN
122 tau=obc_in
123 ELSE
124 tau=obc_out
125 END IF
127 END IF
128# ifdef RADIATION_2D
130# else
131 cx=0.0_r8
132# endif
135# endif
136
137
138
139
140
141
142 tl_v(i,jstr,k,nout)=(cff*tl_v(i,jstr ,k,nstp)+ &
143 & ce *tl_v(i,jstr+1,k,nout)- &
144 & max(cx,0.0_r8)* &
145 & tl_grad(i ,jstr)- &
146 & min(cx,0.0_r8)* &
147 & tl_grad(i+1,jstr))/ &
148 & (cff+ce)
149
151
152
153
154
155 tl_v(i,jstr,k,nout)=tl_v(i,jstr,k,nout)- &
156 & tau*tl_v(i,jstr,k,nstp)
157 END IF
158# ifdef MASKING
159
160
161
162 tl_v(i,jstr,k,nout)=tl_v(i,jstr,k,nout)* &
163 &
grid(ng)%vmask(i,jstr)
164# endif
165 END IF
166 END DO
167 END DO
168 END IF
169
170
171
174 DO i=istr,iend
176
177
178# ifdef ADJUST_BOUNDARY
180 tl_v(i,jstr,k,nout)=
boundary(ng)%tl_v_south(i,k)
181 ELSE
182 tl_v(i,jstr,k,nout)=0.0_r8
183 END IF
184# else
185 tl_v(i,jstr,k,nout)=0.0_r8
186# endif
187# ifdef MASKING
188
189
190
191 tl_v(i,jstr,k,nout)=tl_v(i,jstr,k,nout)* &
192 &
grid(ng)%vmask(i,jstr)
193# endif
194 END IF
195 END DO
196 END DO
197
198
199
202 DO i=istr,iend
204
205
206 tl_v(i,jstr,k,nout)=tl_v(i,jstr+1,k,nout)
207# ifdef MASKING
208
209
210
211 tl_v(i,jstr,k,nout)=tl_v(i,jstr,k,nout)* &
212 &
grid(ng)%vmask(i,jstr)
213# endif
214 END IF
215 END DO
216 END DO
217
218
219
222 DO i=istr,iend
224
225
226 tl_v(i,jstr,k,nout)=0.0_r8
227 END IF
228 END DO
229 END DO
230 END IF
231 END IF
232
233
234
235
236
237 IF (
domain(ng)%Northern_Edge(tile))
THEN
238
239
240
242 IF (
iic(ng).ne.0)
THEN
244 DO i=istr,iend+1
245
246
247
248 tl_grad(i,jend+1)=0.0_r8
249 END DO
250 DO i=istr,iend
252# if defined CELERITY_READ && defined FORWARD_READ
255 obc_out=0.5_r8* &
256 & (
clima(ng)%M3nudgcof(i,jend ,k)+ &
257 &
clima(ng)%M3nudgcof(i,jend+1,k))
258 obc_in =
obcfac(ng)*obc_out
259 ELSE
262 END IF
263 IF (
boundary(ng)%v_south_Ce(i,k).lt.0.0_r8)
THEN
264 tau=obc_in
265 ELSE
266 tau=obc_out
267 END IF
269 END IF
270# ifdef RADIATION_2D
272# else
273 cx=0.0_r8
274# endif
277# endif
278
279
280
281
282
283
284 tl_v(i,jend+1,k,nout)=(cff*tl_v(i,jend+1,k,nstp)+ &
285 & ce *tl_v(i,jend ,k,nout)- &
286 & max(cx,0.0_r8)* &
287 & tl_grad(i ,jend+1)- &
288 & min(cx,0.0_r8)* &
289 & tl_grad(i+1,jend+1))/ &
290 & (cff+ce)
291
293
294
295
296
297 tl_v(i,jend+1,k,nout)=tl_v(i,jend+1,k,nout)- &
298 & tau*tl_v(i,jend+1,k,nstp)
299 END IF
300# ifdef MASKING
301
302
303
304 tl_v(i,jend+1,k,nout)=tl_v(i,jend+1,k,nout)* &
305 &
grid(ng)%vmask(i,jend+1)
306# endif
307 END IF
308 END DO
309 END DO
310 END IF
311
312
313
316 DO i=istr,iend
318
319
320# ifdef ADJUST_BOUNDARY
322 tl_v(i,jend+1,k,nout)=
boundary(ng)%tl_v_north(i,k)
323 ELSE
324 tl_v(i,jend+1,k,nout)=0.0_r8
325 END IF
326# else
327 tl_v(i,jend+1,k,nout)=0.0_r8
328# endif
329# ifdef MASKING
330
331
332
333 tl_v(i,jend+1,k,nout)=tl_v(i,jend+1,k,nout)* &
334 &
grid(ng)%vmask(i,jend+1)
335# endif
336 END IF
337 END DO
338 END DO
339
340
341
344 DO i=istr,iend
346
347
348 tl_v(i,jend+1,k,nout)=tl_v(i,jend,k,nout)
349# ifdef MASKING
350
351
352
353 tl_v(i,jend+1,k,nout)=tl_v(i,jend+1,k,nout)* &
354 &
grid(ng)%vmask(i,jend+1)
355# endif
356 END IF
357 END DO
358 END DO
359
360
361
364 DO i=istr,iend
366
367
368 tl_v(i,jend+1,k,nout)=0.0_r8
369 END IF
370 END DO
371 END DO
372 END IF
373 END IF
374
375
376
377
378
379 IF (
domain(ng)%Western_Edge(tile))
THEN
380
381
382
384 IF (
iic(ng).ne.0)
THEN
386 DO j=jstrv-1,jend
387
388
389
390 tl_grad(istr-1,j)=0.0_r8
391 END DO
392 DO j=jstrv,jend
394# if defined CELERITY_READ && defined FORWARD_READ
397 obc_out=0.5_r8* &
398 & (
clima(ng)%M3nudgcof(istr-1,j-1,k)+ &
399 &
clima(ng)%M3nudgcof(istr-1,j ,k))
400 obc_in =
obcfac(ng)*obc_out
401 ELSE
404 END IF
405 IF (
boundary(ng)%v_west_Cx(j,k).lt.0.0_r8)
THEN
406 tau=obc_in
407 ELSE
408 tau=obc_out
409 END IF
411 END IF
413# ifdef RADIATION_2D
415# else
416 ce=0.0_r8
417# endif
419# endif
420
421
422
423
424
425
426 tl_v(istr-1,j,k,nout)=(cff*tl_v(istr-1,j,k,nstp)+ &
427 & cx *tl_v(istr ,j,k,nout)- &
428 & max(ce,0.0_r8)* &
429 & tl_grad(istr-1,j-1)- &
430 & min(ce,0.0_r8)* &
431 & tl_grad(istr-1,j ))/ &
432 & (cff+cx)
433
435
436
437
438
439 tl_v(istr-1,j,k,nout)=tl_v(istr-1,j,k,nout)- &
440 & tau*tl_v(istr-1,j,k,nstp)
441 END IF
442# ifdef MASKING
443
444
445
446 tl_v(istr-1,j,k,nout)=tl_v(istr-1,j,k,nout)* &
447 &
grid(ng)%vmask(istr-1,j)
448# endif
449 END IF
450 END DO
451 END DO
452 END IF
453
454
455
458 DO j=jstrv,jend
460
461
462# ifdef ADJUST_BOUNDARY
464 tl_v(istr-1,j,k,nout)=
boundary(ng)%tl_v_west(j,k)
465 ELSE
466 tl_v(istr-1,j,k,nout)=0.0_r8
467 END IF
468# else
469 tl_v(istr-1,j,k,nout)=0.0_r8
470# endif
471# ifdef MASKING
472
473
474
475 tl_v(istr-1,j,k,nout)=tl_v(istr-1,j,k,nout)* &
476 &
grid(ng)%vmask(istr-1,j)
477# endif
478 END IF
479 END DO
480 END DO
481
482
483
486 DO j=jstrv,jend
488
489
490 tl_v(istr-1,j,k,nout)=tl_v(istr,j,k,nout)
491# ifdef MASKING
492
493
494
495 tl_v(istr-1,j,k,nout)=tl_v(istr-1,j,k,nout)* &
496 &
grid(ng)%vmask(istr-1,j)
497# endif
498 END IF
499 END DO
500 END DO
501
502
503
504
507 jmin=jstrv
508 jmax=jend
509 ELSE
510 jmin=jstr
511 jmax=jendr
512 END IF
514 DO j=jmin,jmax
516
517
518 tl_v(istr-1,j,k,nout)=
gamma2(ng)*tl_v(istr,j,k,nout)
519# ifdef MASKING
520
521
522
523 tl_v(istr-1,j,k,nout)=tl_v(istr-1,j,k,nout)* &
524 &
grid(ng)%vmask(istr-1,j)
525# endif
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=jstrv-1,jend
544
545
546
547 tl_grad(iend+1,j)=0.0_r8
548 END DO
549 DO j=jstrv,jend
551# if defined CELERITY_READ && defined FORWARD_READ
554 obc_out=0.5_r8* &
555 & (
clima(ng)%M3nudgcof(iend+1,j-1,k)+ &
556 &
clima(ng)%M3nudgcof(iend+1,j ,k))
557 obc_in =
obcfac(ng)*obc_out
558 ELSE
561 END IF
562 IF (
boundary(ng)%v_east_Cx(j,k).lt.0.0_r8)
THEN
563 tau=obc_in
564 ELSE
565 tau=obc_out
566 END IF
568 END IF
570# ifdef RADIATION_2D
572# else
573 ce=0.0_r8
574# endif
576# endif
577
578
579
580
581
582
583 tl_v(iend+1,j,k,nout)=(cff*tl_v(iend+1,j,k,nstp)+ &
584 & cx *tl_v(iend ,j,k,nout)- &
585 & max(ce,0.0_r8)* &
586 & tl_grad(iend+1,j-1)- &
587 & min(ce,0.0_r8)* &
588 & tl_grad(iend+1,j ))/ &
589 & (cff+cx)
590
592
593
594
595
596 tl_v(iend+1,j,k,nout)=tl_v(iend+1,j,k,nout)- &
597 & tau*tl_v(iend+1,j,k,nstp)
598 END IF
599# ifdef MASKING
600
601
602
603 tl_v(iend+1,j,k,nout)=tl_v(iend+1,j,k,nout)* &
604 &
grid(ng)%vmask(iend+1,j)
605# endif
606 END IF
607 END DO
608 END DO
609 END IF
610
611
612
615 DO j=jstrv,jend
617
618
619# ifdef ADJUST_BOUNDARY
621 tl_v(iend+1,j,k,nout)=
boundary(ng)%tl_v_east(j,k)
622 ELSE
623 tl_v(iend+1,j,k,nout)=0.0_r8
624 END IF
625# else
626 tl_v(iend+1,j,k,nout)=0.0_r8
627# endif
628# ifdef MASKING
629
630
631
632 tl_v(iend+1,j,k,nout)=tl_v(iend+1,j,k,nout)* &
633 &
grid(ng)%vmask(iend+1,j)
634# endif
635 END IF
636 END DO
637 END DO
638
639
640
643 DO j=jstrv,jend
645
646
647 tl_v(iend+1,j,k,nout)=tl_v(iend,j,k,nout)
648# ifdef MASKING
649
650
651
652 tl_v(iend+1,j,k,nout)=tl_v(iend+1,j,k,nout)* &
653 &
grid(ng)%vmask(iend+1,j)
654# endif
655 END IF
656 END DO
657 END DO
658
659
660
661
664 jmin=jstrv
665 jmax=jend
666 ELSE
667 jmin=jstr
668 jmax=jendr
669 END IF
671 DO j=jmin,jmax
673
674
675 tl_v(iend+1,j,k,nout)=
gamma2(ng)*tl_v(iend,j,k,nout)
676# ifdef MASKING
677
678
679
680 tl_v(iend+1,j,k,nout)=tl_v(iend+1,j,k,nout)* &
681 &
grid(ng)%vmask(iend+1,j)
682# endif
683 END IF
684 END DO
685 END DO
686 END IF
687 END IF
688
689
690
691
692
694 IF (
domain(ng)%SouthWest_Corner(tile))
THEN
698
699
700
701 tl_v(istr-1,jstr,k,nout)=0.5_r8* &
702 & (tl_v(istr ,jstr ,k,nout)+ &
703 & tl_v(istr-1,jstr+1,k,nout))
704 END DO
705 END IF
706 END IF
707 IF (
domain(ng)%SouthEast_Corner(tile))
THEN
711
712
713
714 tl_v(iend+1,jstr,k,nout)=0.5_r8* &
715 & (tl_v(iend ,jstr ,k,nout)+ &
716 & tl_v(iend+1,jstr+1,k,nout))
717 END DO
718 END IF
719 END IF
720 IF (
domain(ng)%NorthWest_Corner(tile))
THEN
724
725
726
727 tl_v(istr-1,jend+1,k,nout)=0.5_r8* &
728 & (tl_v(istr-1,jend ,k,nout)+ &
729 & tl_v(istr ,jend+1,k,nout))
730 END DO
731 END IF
732 END IF
733 IF (
domain(ng)%NorthEast_Corner(tile))
THEN
737
738
739
740 tl_v(iend+1,jend+1,k,nout)=0.5_r8* &
741 & (tl_v(iend+1,jend ,k,nout)+ &
742 & tl_v(iend ,jend+1,k,nout))
743 END DO
744 END IF
745 END IF
746 END IF
747
748 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
type(t_lbc), dimension(:,:,:), allocatable tl_lbc
type(t_domain), dimension(:), allocatable domain
real(dp), dimension(:,:), allocatable m3obc_out
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 obcfac
real(r8), dimension(:), allocatable gamma2
logical, dimension(:), allocatable lnudgem3clm
integer, parameter isouth
integer, parameter inorth
real(dp), dimension(:,:), allocatable m3obc_in