59
60
67
68
69
70 integer, intent(in) :: ng, tile
71 integer, intent(in) :: LBi, UBi, LBj, UBj, UBk
72 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
73 integer, intent(in) :: nstp, nout
74
75# ifdef ASSUMED_SHAPE
76 real(r8), intent(inout) :: tl_v(LBi:,LBj:,:,:)
77# else
78 real(r8), intent(inout) :: tl_v(LBi:UBi,LBj:UBj,UBk,2)
79# endif
80
81
82
83 integer :: Jmin, Jmax
84 integer :: i, j, k
85
86 real(r8) :: Ce, Cx, cff
87 real(r8) :: obc_in, obc_out, tau
88
89 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_grad
90
91# include "set_bounds.h"
92
93
94
95
96
97 IF (
domain(ng)%Southern_Edge(tile))
THEN
98
99
100
102 IF (
iic(ng).ne.0)
THEN
104 DO i=istr,iend+1
105
106
107
108 tl_grad(i,jstr)=0.0_r8
109 END DO
110 DO i=istr,iend
112# if defined CELERITY_READ && defined FORWARD_READ
115 obc_out=0.5_r8* &
116 & (
clima(ng)%M3nudgcof(i,jstr-1,k)+ &
117 &
clima(ng)%M3nudgcof(i,jstr ,k))
118 obc_in =
obcfac(ng)*obc_out
119 ELSE
122 END IF
123 IF (
boundary(ng)%v_south_Ce(i,k).lt.0.0_r8)
THEN
124 tau=obc_in
125 ELSE
126 tau=obc_out
127 END IF
129 END IF
130# ifdef RADIATION_2D
132# else
133 cx=0.0_r8
134# endif
137# endif
138
139
140
141
142
143
144 tl_v(i,jstr,k,nout)=(cff*tl_v(i,jstr ,k,nstp)+ &
145 & ce *tl_v(i,jstr+1,k,nout)- &
146 & max(cx,0.0_r8)* &
147 & tl_grad(i ,jstr)- &
148 & min(cx,0.0_r8)* &
149 & tl_grad(i+1,jstr))/ &
150 & (cff+ce)
151
153
154
155
156
157 tl_v(i,jstr,k,nout)=tl_v(i,jstr,k,nout)- &
158 & tau*tl_v(i,jstr,k,nstp)
159 END IF
160# ifdef MASKING
161
162
163
164 tl_v(i,jstr,k,nout)=tl_v(i,jstr,k,nout)* &
165 &
grid(ng)%vmask(i,jstr)
166# endif
167 END IF
168 END DO
169 END DO
170 END IF
171
172
173
176 DO i=istr,iend
178
179
180 tl_v(i,jstr,k,nout)=
boundary(ng)%tl_v_south(i,k)
181# ifdef MASKING
182
183
184
185 tl_v(i,jstr,k,nout)=tl_v(i,jstr,k,nout)* &
186 &
grid(ng)%vmask(i,jstr)
187# endif
188 END IF
189 END DO
190 END DO
191
192
193
196 DO i=istr,iend
198
199
200 tl_v(i,jstr,k,nout)=tl_v(i,jstr+1,k,nout)
201# ifdef MASKING
202
203
204
205 tl_v(i,jstr,k,nout)=tl_v(i,jstr,k,nout)* &
206 &
grid(ng)%vmask(i,jstr)
207# endif
208 END IF
209 END DO
210 END DO
211
212
213
216 DO i=istr,iend
218
219
220 tl_v(i,jstr,k,nout)=0.0_r8
221 END IF
222 END DO
223 END DO
224 END IF
225 END IF
226
227
228
229
230
231 IF (
domain(ng)%Northern_Edge(tile))
THEN
232
233
234
236 IF (
iic(ng).ne.0)
THEN
238 DO i=istr,iend+1
239
240
241
242 tl_grad(i,jend+1)=0.0_r8
243 END DO
244 DO i=istr,iend
246# if defined CELERITY_READ && defined FORWARD_READ
249 obc_out=0.5_r8* &
250 & (
clima(ng)%M3nudgcof(i,jend ,k)+ &
251 &
clima(ng)%M3nudgcof(i,jend+1,k))
252 obc_in =
obcfac(ng)*obc_out
253 ELSE
256 END IF
257 IF (
boundary(ng)%v_south_Ce(i,k).lt.0.0_r8)
THEN
258 tau=obc_in
259 ELSE
260 tau=obc_out
261 END IF
263 END IF
264# ifdef RADIATION_2D
266# else
267 cx=0.0_r8
268# endif
271# endif
272
273
274
275
276
277
278 tl_v(i,jend+1,k,nout)=(cff*tl_v(i,jend+1,k,nstp)+ &
279 & ce *tl_v(i,jend ,k,nout)- &
280 & max(cx,0.0_r8)* &
281 & tl_grad(i ,jend+1)- &
282 & min(cx,0.0_r8)* &
283 & tl_grad(i+1,jend+1))/ &
284 & (cff+ce)
285
287
288
289
290
291 tl_v(i,jend+1,k,nout)=tl_v(i,jend+1,k,nout)- &
292 & tau*tl_v(i,jend+1,k,nstp)
293 END IF
294# ifdef MASKING
295
296
297
298 tl_v(i,jend+1,k,nout)=tl_v(i,jend+1,k,nout)* &
299 &
grid(ng)%vmask(i,jend+1)
300# endif
301 END IF
302 END DO
303 END DO
304 END IF
305
306
307
310 DO i=istr,iend
312
313
314 tl_v(i,jend+1,k,nout)=
boundary(ng)%tl_v_north(i,k)
315# ifdef MASKING
316
317
318
319 tl_v(i,jend+1,k,nout)=tl_v(i,jend+1,k,nout)* &
320 &
grid(ng)%vmask(i,jend+1)
321# endif
322 END IF
323 END DO
324 END DO
325
326
327
330 DO i=istr,iend
332
333
334 tl_v(i,jend+1,k,nout)=tl_v(i,jend,k,nout)
335# ifdef MASKING
336
337
338
339 tl_v(i,jend+1,k,nout)=tl_v(i,jend+1,k,nout)* &
340 &
grid(ng)%vmask(i,jend+1)
341# endif
342 END IF
343 END DO
344 END DO
345
346
347
350 DO i=istr,iend
352
353
354 tl_v(i,jend+1,k,nout)=0.0_r8
355 END IF
356 END DO
357 END DO
358 END IF
359 END IF
360
361
362
363
364
365 IF (
domain(ng)%Western_Edge(tile))
THEN
366
367
368
370 IF (
iic(ng).ne.0)
THEN
372 DO j=jstrv-1,jend
373
374
375
376 tl_grad(istr-1,j)=0.0_r8
377 END DO
378 DO j=jstrv,jend
380# if defined CELERITY_READ && defined FORWARD_READ
383 obc_out=0.5_r8* &
384 & (
clima(ng)%M3nudgcof(istr-1,j-1,k)+ &
385 &
clima(ng)%M3nudgcof(istr-1,j ,k))
386 obc_in =
obcfac(ng)*obc_out
387 ELSE
390 END IF
391 IF (
boundary(ng)%v_west_Cx(j,k).lt.0.0_r8)
THEN
392 tau=obc_in
393 ELSE
394 tau=obc_out
395 END IF
397 END IF
399# ifdef RADIATION_2D
401# else
402 ce=0.0_r8
403# endif
405# endif
406
407
408
409
410
411
412 tl_v(istr-1,j,k,nout)=(cff*tl_v(istr-1,j,k,nstp)+ &
413 & cx *tl_v(istr ,j,k,nout)- &
414 & max(ce,0.0_r8)* &
415 & tl_grad(istr-1,j-1)- &
416 & min(ce,0.0_r8)* &
417 & tl_grad(istr-1,j ))/ &
418 & (cff+cx)
419
421
422
423
424
425 tl_v(istr-1,j,k,nout)=tl_v(istr-1,j,k,nout)- &
426 & tau*tl_v(istr-1,j,k,nstp)
427 END IF
428# ifdef MASKING
429
430
431
432 tl_v(istr-1,j,k,nout)=tl_v(istr-1,j,k,nout)* &
433 &
grid(ng)%vmask(istr-1,j)
434# endif
435 END IF
436 END DO
437 END DO
438 END IF
439
440
441
444 DO j=jstrv,jend
446
447
448 tl_v(istr-1,j,k,nout)=
boundary(ng)%tl_v_west(j,k)
449# ifdef MASKING
450
451
452
453 tl_v(istr-1,j,k,nout)=tl_v(istr-1,j,k,nout)* &
454 &
grid(ng)%vmask(istr-1,j)
455# endif
456 END IF
457 END DO
458 END DO
459
460
461
464 DO j=jstrv,jend
466
467
468 tl_v(istr-1,j,k,nout)=tl_v(istr,j,k,nout)
469# ifdef MASKING
470
471
472
473 tl_v(istr-1,j,k,nout)=tl_v(istr-1,j,k,nout)* &
474 &
grid(ng)%vmask(istr-1,j)
475# endif
476 END IF
477 END DO
478 END DO
479
480
481
482
485 jmin=jstrv
486 jmax=jend
487 ELSE
488 jmin=jstr
489 jmax=jendr
490 END IF
492 DO j=jmin,jmax
494
495
496 tl_v(istr-1,j,k,nout)=
gamma2(ng)*tl_v(istr,j,k,nout)
497# ifdef MASKING
498
499
500
501 tl_v(istr-1,j,k,nout)=tl_v(istr-1,j,k,nout)* &
502 &
grid(ng)%vmask(istr-1,j)
503# endif
504 END IF
505 END DO
506 END DO
507 END IF
508 END IF
509
510
511
512
513
514 IF (
domain(ng)%Eastern_Edge(tile))
THEN
515
516
517
519 IF (
iic(ng).ne.0)
THEN
521 DO j=jstrv-1,jend
522
523
524
525 tl_grad(iend+1,j)=0.0_r8
526 END DO
527 DO j=jstrv,jend
529# if defined CELERITY_READ && defined FORWARD_READ
532 obc_out=0.5_r8* &
533 & (
clima(ng)%M3nudgcof(iend+1,j-1,k)+ &
534 &
clima(ng)%M3nudgcof(iend+1,j ,k))
535 obc_in =
obcfac(ng)*obc_out
536 ELSE
539 END IF
540 IF (
boundary(ng)%v_east_Cx(j,k).lt.0.0_r8)
THEN
541 tau=obc_in
542 ELSE
543 tau=obc_out
544 END IF
546 END IF
548# ifdef RADIATION_2D
550# else
551 ce=0.0_r8
552# endif
554# endif
555
556
557
558
559
560
561 tl_v(iend+1,j,k,nout)=(cff*tl_v(iend+1,j,k,nstp)+ &
562 & cx *tl_v(iend ,j,k,nout)- &
563 & max(ce,0.0_r8)* &
564 & tl_grad(iend+1,j-1)- &
565 & min(ce,0.0_r8)* &
566 & tl_grad(iend+1,j ))/ &
567 & (cff+cx)
568
570
571
572
573
574 tl_v(iend+1,j,k,nout)=tl_v(iend+1,j,k,nout)- &
575 & tau*tl_v(iend+1,j,k,nstp)
576 END IF
577# ifdef MASKING
578
579
580
581 tl_v(iend+1,j,k,nout)=tl_v(iend+1,j,k,nout)* &
582 &
grid(ng)%vmask(iend+1,j)
583# endif
584 END IF
585 END DO
586 END DO
587 END IF
588
589
590
593 DO j=jstrv,jend
595
596
597 tl_v(iend+1,j,k,nout)=
boundary(ng)%tl_v_east(j,k)
598# ifdef MASKING
599
600
601
602 tl_v(iend+1,j,k,nout)=tl_v(iend+1,j,k,nout)* &
603 &
grid(ng)%vmask(iend+1,j)
604# endif
605 END IF
606 END DO
607 END DO
608
609
610
613 DO j=jstrv,jend
615
616
617 tl_v(iend+1,j,k,nout)=tl_v(iend,j,k,nout)
618# ifdef MASKING
619
620
621
622 tl_v(iend+1,j,k,nout)=tl_v(iend+1,j,k,nout)* &
623 &
grid(ng)%vmask(iend+1,j)
624# endif
625 END IF
626 END DO
627 END DO
628
629
630
631
634 jmin=jstrv
635 jmax=jend
636 ELSE
637 jmin=jstr
638 jmax=jendr
639 END IF
641 DO j=jmin,jmax
643
644
645 tl_v(iend+1,j,k,nout)=
gamma2(ng)*tl_v(iend,j,k,nout)
646# ifdef MASKING
647
648
649
650 tl_v(iend+1,j,k,nout)=tl_v(iend+1,j,k,nout)* &
651 &
grid(ng)%vmask(iend+1,j)
652# endif
653 END IF
654 END DO
655 END DO
656 END IF
657 END IF
658
659
660
661
662
664 IF (
domain(ng)%SouthWest_Corner(tile))
THEN
668
669
670
671 tl_v(istr-1,jstr,k,nout)=0.5_r8* &
672 & (tl_v(istr ,jstr ,k,nout)+ &
673 & tl_v(istr-1,jstr+1,k,nout))
674 END DO
675 END IF
676 END IF
677 IF (
domain(ng)%SouthEast_Corner(tile))
THEN
681
682
683
684 tl_v(iend+1,jstr,k,nout)=0.5_r8* &
685 & (tl_v(iend ,jstr ,k,nout)+ &
686 & tl_v(iend+1,jstr+1,k,nout))
687 END DO
688 END IF
689 END IF
690 IF (
domain(ng)%NorthWest_Corner(tile))
THEN
694
695
696
697 tl_v(istr-1,jend+1,k,nout)=0.5_r8* &
698 & (tl_v(istr-1,jend ,k,nout)+ &
699 & tl_v(istr ,jend+1,k,nout))
700 END DO
701 END IF
702 END IF
703 IF (
domain(ng)%NorthEast_Corner(tile))
THEN
707
708
709
710 tl_v(iend+1,jend+1,k,nout)=0.5_r8* &
711 & (tl_v(iend+1,jend ,k,nout)+ &
712 & tl_v(iend ,jend+1,k,nout))
713 END DO
714 END IF
715 END IF
716 END IF
717
718 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 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