64
65
73
74
75
76 integer, intent(in) :: ng, tile
77 integer, intent(in) :: LBi, UBi, LBj, UBj
78 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
79 integer, intent(in) :: krhs, kstp, kout
80
81# ifdef ASSUMED_SHAPE
82 real(r8), intent(in) :: ubar(LBi:,LBj:,:)
83 real(r8), intent(in) :: vbar(LBi:,LBj:,:)
84 real(r8), intent(in) :: zeta(LBi:,LBj:,:)
85 real(r8), intent(in) :: tl_ubar(LBi:,LBj:,:)
86 real(r8), intent(in) :: tl_zeta(LBi:,LBj:,:)
87
88 real(r8), intent(inout) :: tl_vbar(LBi:,LBj:,:)
89# else
90 real(r8), intent(in) :: ubar(LBi:UBi,LBj:UBj,:)
91 real(r8), intent(in) :: vbar(LBi:UBi,LBj:UBj,:)
92 real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,:)
93 real(r8), intent(in) :: tl_ubar(LBi:UBi,LBj:UBj,:)
94 real(r8), intent(in) :: tl_zeta(LBi:UBi,LBj:UBj,:)
95
96 real(r8), intent(inout) :: tl_vbar(LBi:UBi,LBj:UBj,:)
97# endif
98
99
100
101 integer :: Jmin, Jmax
102 integer :: i, j, know
103
104 real(r8) :: Ce, Cx, Ze
105 real(r8) :: bry_pgr, bry_cor, bry_str
106 real(r8) :: cff, cff1, cff2, cff3, dt2d
107 real(r8) :: obc_in, obc_out, tau
108# if defined ATM_PRESS && defined PRESS_COMPENSATE
109 real(r8) :: OneAtm, fac
110# endif
111
112 real(r8) :: tl_Ce, tl_Cx, tl_Ze
113 real(r8) :: tl_bry_pgr, tl_bry_cor, tl_bry_str, tl_bry_val
114 real(r8) :: tl_cff, tl_cff1, tl_cff2, tl_cff3
115
116 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_grad
117
118# include "set_bounds.h"
119
120
121
122
123
124 IF (first_2d_step) THEN
125 know=krhs
128 know=krhs
130 ELSE
131 know=kstp
133 END IF
134# if defined ATM_PRESS && defined PRESS_COMPENSATE
135 oneatm=1013.25_r8
136 fac=100.0_r8/(
g*
rho0)
137# endif
138
139
140
141
142
143 IF (
domain(ng)%Southern_Edge(tile))
THEN
144
145
146
148 IF (
iic(ng).ne.0)
THEN
149 DO i=istr,iend+1
150
151
152
153 tl_grad(i,jstr)=0.0_r8
154 END DO
155 DO i=istr,iend
157# if defined CELERITY_READ && defined FORWARD_READ
160 obc_out=0.5_r8* &
161 & (
clima(ng)%M2nudgcof(i,jstr-1)+ &
162 &
clima(ng)%M2nudgcof(i,jstr ))
163 obc_in =
obcfac(ng)*obc_out
164 ELSE
167 END IF
168 IF (
boundary(ng)%vbar_south_Ce(i).lt.0.0_r8)
THEN
169 tau=obc_in
170 ELSE
171 tau=obc_out
172 END IF
173 tau=tau*dt2d
174 END IF
175# ifdef RADIATION_2D
177# else
178 cx=0.0_r8
179# endif
182# endif
183
184
185
186
187
188
189 tl_vbar(i,jstr,kout)=(cff*tl_vbar(i,jstr ,know)+ &
190 & ce *tl_vbar(i,jstr+1,kout)- &
191 & max(cx,0.0_r8)* &
192 & tl_grad(i ,jstr)- &
193 & min(cx,0.0_r8)* &
194 & tl_grad(i+1,jstr))/ &
195 & (cff+ce)
196
198
199
200
201
202 tl_vbar(i,jstr,kout)=tl_vbar(i,jstr,kout)- &
203 & tau*tl_vbar(i,jstr,know)
204 END IF
205# ifdef MASKING
206
207
208
209 tl_vbar(i,jstr,kout)=tl_vbar(i,jstr,kout)* &
210 &
grid(ng)%vmask(i,jstr)
211# endif
212 END IF
213 END DO
214 END IF
215
216
217
219 DO i=istr,iend
221# if defined SSH_TIDES_NOT_YET && !defined UV_TIDES_NOT_YET
223 bry_pgr=-
g*(zeta(i,jstr,know)- &
225 & 0.5_r8*
grid(ng)%pn(i,jstr)
226 tl_bry_pgr=-
g*tl_zeta(i,jstr,know)* &
227 & 0.5_r8*
grid(ng)%pn(i,jstr)
228# ifdef ADJUST_BOUNDARY
230 tl_bry_pgr=tl_bry_pgr+ &
232 & 0.5_r8*
grid(ng)%pn(i,jstr)
233 END IF
234# endif
235 ELSE
236 bry_pgr=-
g*(zeta(i,jstr ,know)- &
237 & zeta(i,jstr-1,know))* &
238 & 0.5_r8*(
grid(ng)%pn(i,jstr-1)+ &
239 &
grid(ng)%pn(i,jstr ))
240 tl_bry_pgr=-
g*(tl_zeta(i,jstr ,know)- &
241 & tl_zeta(i,jstr-1,know))* &
242 & 0.5_r8*(
grid(ng)%pn(i,jstr-1)+ &
243 &
grid(ng)%pn(i,jstr ))
244 END IF
245# ifdef UV_COR
246 bry_cor=-0.125_r8*(ubar(i ,jstr-1,know)+ &
247 & ubar(i+1,jstr-1,know)+ &
248 & ubar(i ,jstr ,know)+ &
249 & ubar(i+1,jstr ,know))* &
250 & (
grid(ng)%f(i,jstr-1)+ &
251 &
grid(ng)%f(i,jstr ))
252 tl_bry_cor=-0.125_r8*(tl_ubar(i ,jstr-1,know)+ &
253 & tl_ubar(i+1,jstr-1,know)+ &
254 & tl_ubar(i ,jstr ,know)+ &
255 & tl_ubar(i+1,jstr ,know))* &
256 & (
grid(ng)%f(i,jstr-1)+ &
257 &
grid(ng)%f(i,jstr ))
258# else
259 bry_cor=0.0_r8
260 tl_bry_cor=0.0_r8
261# endif
262 cff1=1.0_r8/(0.5_r8*(
grid(ng)%h(i,jstr-1)+ &
263 & zeta(i,jstr-1,know)+ &
264 &
grid(ng)%h(i,jstr )+ &
265 & zeta(i,jstr ,know)))
266 tl_cff1=-cff1*cff1*(0.5_r8*(
grid(ng)%tl_h(i,jstr-1)+ &
267 & tl_zeta(i,jstr-1,know)+ &
268 &
grid(ng)%tl_h(i,jstr )+ &
269 & tl_zeta(i,jstr ,know)))
270 bry_str=cff1*(
forces(ng)%svstr(i,jstr)- &
271 &
forces(ng)%bvstr(i,jstr))
272 tl_bry_str=tl_cff1*(
forces(ng)%svstr(i,jstr)- &
273 &
forces(ng)%bvstr(i,jstr))+ &
274 & cff1*(
forces(ng)%tl_svstr(i,jstr)- &
275 &
forces(ng)%tl_bvstr(i,jstr))
276 ce=1.0_r8/sqrt(
g*0.5_r8*(
grid(ng)%h(i,jstr-1)+ &
277 & zeta(i,jstr-1,know)+ &
278 &
grid(ng)%h(i,jstr )+ &
279 & zeta(i,jstr ,know)))
280 tl_ce=-ce*ce*ce*0.25_r8*
g*(
grid(ng)%tl_h(i,jstr-1)+ &
281 & tl_zeta(i,jstr-1,know)+ &
282 &
grid(ng)%tl_h(i,jstr )+ &
283 & tl_zeta(i,jstr ,know))
284 cff2=
grid(ng)%on_v(i,jstr)*ce
285 tl_cff2=
grid(ng)%on_v(i,jstr)*tl_ce
286
287
288
289
290
291 tl_bry_val=tl_vbar(i,jstr+1,know)+ &
292 & tl_cff2*(bry_pgr+ &
293 & bry_cor+ &
294 & bry_str)+ &
295 & cff2*(tl_bry_pgr+ &
296 & tl_bry_cor+ &
297 & tl_bry_str)
298# else
299
300
301# ifdef ADJUST_BOUNDARY
303 tl_bry_val=
boundary(ng)%tl_vbar_south(i)
304 ELSE
305 tl_bry_val=0.0_r8
306 END IF
307# else
308 tl_bry_val=0.0_r8
309# endif
310# endif
311 cff=1.0_r8/(0.5_r8*(
grid(ng)%h(i,jstr-1)+ &
312 & zeta(i,jstr-1,know)+ &
313 &
grid(ng)%h(i,jstr )+ &
314 & zeta(i,jstr ,know)))
315 tl_cff=-cff*cff*(0.5_r8*(
grid(ng)%tl_h(i,jstr-1)+ &
316 & tl_zeta(i,jstr-1,know)+ &
317 &
grid(ng)%tl_h(i,jstr )+ &
318 & tl_zeta(i,jstr ,know)))
320 tl_ce=0.5_r8*
g*tl_cff/ce
321# if defined ATM_PRESS && defined PRESS_COMPENSATE
322
323
324
325
326
327
328
329
330
331 tl_vbar(i,jstr,kout)=tl_bry_val- &
332 & tl_ce* &
333 & (0.5_r8* &
334 & (zeta(i,jstr-1,know)+ &
335 & zeta(i,jstr ,know)+ &
336 & fac*(
forces(ng)%Pair(i,jstr-1)+ &
337 &
forces(ng)%Pair(i,jstr )- &
338 & 2.0_r8*oneatm))- &
340 & ce* &
341 & (0.5_r8*(tl_zeta(i,jstr-1,know)+ &
342 & tl_zeta(i,jstr ,know)))
343# else
344
345
346
347
348
349 tl_vbar(i,jstr,kout)=tl_bry_val- &
350 & tl_ce* &
351 & (0.5_r8*(zeta(i,jstr-1,know)+ &
352 & zeta(i,jstr ,know))- &
354 & ce* &
355 & (0.5_r8*(tl_zeta(i,jstr-1,know)+ &
356 & tl_zeta(i,jstr ,know)))
357# endif
358# ifdef ADJUST_BOUNDARY
360 tl_vbar(i,jstr,kout)=tl_vbar(i,jstr,kout)+ &
362 END IF
363# endif
364# ifdef MASKING
365
366
367
368 tl_vbar(i,jstr,kout)=tl_vbar(i,jstr,kout)* &
369 &
grid(ng)%vmask(i,jstr)
370# endif
371 END IF
372 END DO
373
374
375
377 DO i=istr,iend
379# if defined SSH_TIDES_NOT_YET && !defined UV_TIDES_NOT_YET
381 bry_pgr=-
g*(zeta(i,jstr,know)- &
383 & 0.5_r8*
grid(ng)%pn(i,jstr)
384 tl_bry_pgr=-
g*tl_zeta(i,jstr,know)* &
385 & 0.5_r8*
grid(ng)%pn(i,jstr)
386# ifdef ADJUST_BOUNDARY
388 tl_bry_pgr=tl_bry_pgr+ &
390 & 0.5_r8*
grid(ng)%pn(i,jstr)
391 END IF
392# endif
393 ELSE
394 bry_pgr=-
g*(zeta(i,jstr ,know)- &
395 & zeta(i,jstr-1,know))* &
396 & 0.5_r8*(
grid(ng)%pn(i,jstr-1)+ &
397 &
grid(ng)%pn(i,jstr ))
398 tl_bry_pgr=-
g*(tl_zeta(i,jstr ,know)- &
399 & tl_zeta(i,jstr-1,know))* &
400 & 0.5_r8*(
grid(ng)%pn(i,jstr-1)+ &
401 &
grid(ng)%pn(i,jstr ))
402 END IF
403# ifdef UV_COR
404 bry_cor=-0.125_r8*(ubar(i ,jstr-1,know)+ &
405 & ubar(i+1,jstr-1,know)+ &
406 & ubar(i ,jstr ,know)+ &
407 & ubar(i+1,jstr ,know))* &
408 & (
grid(ng)%f(i,jstr-1)+ &
409 &
grid(ng)%f(i,jstr ))
410 tl_bry_cor=-0.125_r8*(tl_ubar(i ,jstr-1,know)+ &
411 & tl_ubar(i+1,jstr-1,know)+ &
412 & tl_ubar(i ,jstr ,know)+ &
413 & tl_ubar(i+1,jstr ,know))* &
414 & (
grid(ng)%f(i,jstr-1)+ &
415 &
grid(ng)%f(i,jstr ))
416# else
417 bry_cor=0.0_r8
418 tl_bry_cor=0.0_r8
419# endif
420 cff1=1.0_r8/(0.5_r8*(
grid(ng)%h(i,jstr-1)+ &
421 & zeta(i,jstr-1,know)+ &
422 &
grid(ng)%h(i,jstr )+ &
423 & zeta(i,jstr ,know)))
424 tl_cff1=-cff1*cff1*(0.5_r8*(
grid(ng)%tl_h(i,jstr-1)+ &
425 & tl_zeta(i,jstr-1,know)+ &
426 &
grid(ng)%tl_h(i,jstr )+ &
427 & tl_zeta(i,jstr ,know)))
428 bry_str=cff1*(
forces(ng)%svstr(i,jstr)- &
429 &
forces(ng)%bvstr(i,jstr))
430 tl_bry_str=tl_cff1*(
forces(ng)%svstr(i,jstr)- &
431 &
forces(ng)%bvstr(i,jstr))+ &
432 & cff1*(
forces(ng)%tl_svstr(i,jstr)- &
433 &
forces(ng)%tl_bvstr(i,jstr))
434 ce=1.0_r8/sqrt(
g*0.5_r8*(
grid(ng)%h(i,jstr-1)+ &
435 & zeta(i,jstr-1,know)+ &
436 &
grid(ng)%h(i,jstr )+ &
437 & zeta(i,jstr ,know)))
438 tl_ce=-ce*ce*ce*0.25_r8*
g*(
grid(ng)%tl_h(i,jstr-1)+ &
439 & tl_zeta(i,jstr-1,know)+ &
440 &
grid(ng)%tl_h(i,jstr )+ &
441 & tl_zeta(i,jstr ,know))
442 cff2=
grid(ng)%on_v(i,jstr)*ce
443 tl_cff2=
grid(ng)%on_v(i,jstr)*tl_ce
444
445
446
447
448
449 tl_bry_val=tl_vbar(i,jstr+1,know)+ &
450 & tl_cff2*(bry_pgr+ &
451 & bry_cor+ &
452 & bry_str)+ &
453 & cff2*(tl_bry_pgr+ &
454 & tl_bry_cor+ &
455 & tl_bry_str)
456# else
457
458
459# ifdef ADJUST_BOUNDARY
461 tl_bry_val=
boundary(ng)%tl_vbar_south(i)
462 ELSE
463 tl_bry_val=0.0_r8
464 END IF
465# else
466 tl_bry_val=0.0_r8
467# endif
468# endif
469# ifdef WET_DRY_NOT_YET
470 cff=0.5_r8*(
grid(ng)%h(i,jstr-1)+ &
471 & zeta(i,jstr-1,know)+ &
472 &
grid(ng)%h(i,jstr )+ &
473 & zeta(i,jstr ,know))
474 tl_cff=0.5_r8*(
grid(ng)%tl_h(i,jstr-1)+ &
475 & tl_zeta(i,jstr-1,know)+ &
476 &
grid(ng)%tl_h(i,jstr )+ &
477 & tl_zeta(i,jstr ,know))
478# else
479 cff=0.5_r8*(
grid(ng)%h(i,jstr-1)+ &
480 &
grid(ng)%h(i,jstr ))
481 tl_cff=0.5_r8*(
grid(ng)%tl_h(i,jstr-1)+ &
482 &
grid(ng)%tl_h(i,jstr ))
483# endif
485 tl_cff1=-0.5_r8*cff1*tl_cff/cff
486 ce=dt2d*cff1*cff*0.5_r8*(
grid(ng)%pn(i,jstr-1)+ &
487 &
grid(ng)%pn(i,jstr ))
488 tl_ce=dt2d*0.5_r8*(
grid(ng)%pn(i,jstr-1)+ &
489 &
grid(ng)%pn(i,jstr ))* &
490 & (cff1*tl_cff+ &
491 & tl_cff1*cff)
492 ze=(0.5_r8+ce)*zeta(i,jstr ,know)+ &
493 & (0.5_r8-ce)*zeta(i,jstr-1,know)
494 tl_ze=(0.5_r8+ce)*tl_zeta(i,jstr ,know)+ &
495 & (0.5_r8-ce)*tl_zeta(i,jstr-1,know)+ &
496 & tl_ce*(zeta(i,jstr ,know)- &
497 & zeta(i,jstr-1,know))
499 cff2=(1.0_r8-
co/ce)**2
500 tl_cff2=2.0_r8*cff2*
co*tl_ce/(ce*ce)
501 cff3=zeta(i,jstr,kout)+ &
502 & ce*zeta(i,jstr-1,know)- &
503 & (1.0_r8+ce)*zeta(i,jstr,know)
504 tl_cff3=tl_zeta(i,jstr,kout)+ &
505 & ce*tl_zeta(i,jstr-1,know)+ &
506 & tl_ce*(zeta(i,jstr-1,know)+ &
507 & zeta(i,jstr ,know))- &
508 & (1.0_r8+ce)*tl_zeta(i,jstr,know)
509 ze=ze+cff2*cff3
510 tl_ze=tl_ze+cff2*tl_cff3+ &
511 & tl_cff2*cff3
512 END IF
513
514
515
516
517
518
519 tl_vbar(i,jstr,kout)=0.5_r8* &
520 & ((1.0_r8-ce)* &
521 & tl_vbar(i,jstr,know)- &
522 & tl_ce*(vbar(i,jstr ,know)- &
523 & vbar(i,jstr+1,know))+ &
524 & ce*tl_vbar(i,jstr+1,know)+ &
525 & tl_bry_val- &
526 & tl_cff1* &
527 & (ze-
boundary(ng)%zeta_south(i))- &
528 & cff1*tl_ze)
529# ifdef ADJUST_BOUNDARY
531 tl_vbar(i,jstr,kout)=tl_vbar(i,jstr,kout)+ &
532 & 0.5_r8*cff1* &
534 END IF
535# endif
536# ifdef MASKING
537
538
539
540 tl_vbar(i,jstr,kout)=tl_vbar(i,jstr,kout)* &
541 &
grid(ng)%vmask(i,jstr)
542# endif
543 END IF
544 END DO
545
546
547
549 DO i=istr,iend
551
552
553# ifdef ADJUST_BOUNDARY
555 tl_vbar(i,jstr,kout)=
boundary(ng)%tl_vbar_south(i)
556 ELSE
557 tl_vbar(i,jstr,kout)=0.0_r8
558 END IF
559# else
560 tl_vbar(i,jstr,kout)=0.0_r8
561# endif
562# ifdef MASKING
563
564
565
566 tl_vbar(i,jstr,kout)=tl_vbar(i,jstr,kout)* &
567 &
grid(ng)%vmask(i,jstr)
568# endif
569 END IF
570 END DO
571
572
573
575 DO i=istr,iend
577
578
579 tl_vbar(i,jstr,kout)=tl_vbar(i,jstr+1,kout)
580# ifdef MASKING
581
582
583
584 tl_vbar(i,jstr,kout)=tl_vbar(i,jstr,kout)* &
585 &
grid(ng)%vmask(i,jstr)
586# endif
587 END IF
588 END DO
589
590
591
593 DO i=istr,iend
596
597
598
599
600 tl_bry_pgr=-
g*tl_zeta(i,jstr,know)* &
601 & 0.5_r8*
grid(ng)%pn(i,jstr)
602# ifdef ADJUST_BOUNDARY
604 tl_bry_pgr=tl_bry_pgr+ &
606 & 0.5_r8*
grid(ng)%pn(i,jstr)
607 END IF
608# endif
609 ELSE
610
611
612
613
614
615 tl_bry_pgr=-
g*(tl_zeta(i,jstr ,know)- &
616 & tl_zeta(i,jstr-1,know))* &
617 & 0.5_r8*(
grid(ng)%pn(i,jstr-1)+ &
618 &
grid(ng)%pn(i,jstr ))
619 END IF
620# ifdef UV_COR
621
622
623
624
625
626
627
628 tl_bry_cor=-0.125_r8*(tl_ubar(i ,jstr-1,know)+ &
629 & tl_ubar(i+1,jstr-1,know)+ &
630 & tl_ubar(i ,jstr ,know)+ &
631 & tl_ubar(i+1,jstr ,know))* &
632 & (
grid(ng)%f(i,jstr-1)+ &
633 &
grid(ng)%f(i,jstr ))
634# else
635
636
637 tl_bry_cor=0.0_r8
638# endif
639 cff=1.0_r8/(0.5_r8*(
grid(ng)%h(i,jstr-1)+ &
640 & zeta(i,jstr-1,know)+ &
641 &
grid(ng)%h(i,jstr )+ &
642 & zeta(i,jstr ,know)))
643 tl_cff=-cff*cff*0.5_r8*(
grid(ng)%tl_h(i,jstr-1)+ &
644 & tl_zeta(i,jstr-1,know)+ &
645 &
grid(ng)%tl_h(i,jstr )+ &
646 & tl_zeta(i,jstr ,know))
647
648
649
650 tl_bry_str=tl_cff*(
forces(ng)%svstr(i,jstr)- &
651 &
forces(ng)%bvstr(i,jstr))+ &
652 & cff*(
forces(ng)%tl_svstr(i,jstr)- &
653 &
forces(ng)%tl_bvstr(i,jstr))
654
655
656
657
658
659
660 tl_vbar(i,jstr,kout)=tl_vbar(i,jstr,know)+ &
661 & dt2d*(tl_bry_pgr+ &
662 & tl_bry_cor+ &
663 & tl_bry_str)
664# ifdef MASKING
665
666
667
668 tl_vbar(i,jstr,kout)=tl_vbar(i,jstr,kout)* &
669 &
grid(ng)%vmask(i,jstr)
670# endif
671 END IF
672 END DO
673
674
675
677 DO i=istr,iend
679
680
681 tl_vbar(i,jstr,kout)=0.0_r8
682 END IF
683 END DO
684 END IF
685 END IF
686
687
688
689
690
691 IF (
domain(ng)%Northern_Edge(tile))
THEN
692
693
694
696 IF (
iic(ng).ne.0)
THEN
697 DO i=istr,iend+1
698
699
700
701 tl_grad(i,jend+1)=0.0_r8
702 END DO
703 DO i=istr,iend
705# if defined CELERITY_READ && defined FORWARD_READ
708 obc_out=0.5_r8* &
709 & (
clima(ng)%M2nudgcof(i,jend )+ &
710 &
clima(ng)%M2nudgcof(i,jend+1))
711 obc_in =
obcfac(ng)*obc_out
712 ELSE
715 END IF
716 IF (
boundary(ng)%vbar_north_Ce(i).lt.0.0_r8)
THEN
717 tau=obc_in
718 ELSE
719 tau=obc_out
720 END IF
721 tau=tau*dt2d
722 END IF
723# ifdef RADIATION_2D
725# else
726 cx=0.0_r8
727# endif
730# endif
731
732
733
734
735
736
737 tl_vbar(i,jend+1,kout)=(cff*tl_vbar(i,jend+1,know)+ &
738 & ce *tl_vbar(i,jend ,kout)- &
739 & max(cx,0.0_r8)* &
740 & tl_grad(i ,jend+1)- &
741 & min(cx,0.0_r8)* &
742 & tl_grad(i+1,jend+1))/ &
743 & (cff+ce)
744
746
747
748
749
750 tl_vbar(i,jend+1,kout)=tl_vbar(i,jend+1,kout)- &
751 & tau*tl_vbar(i,jend+1,know)
752 END IF
753# ifdef MASKING
754
755
756
757 tl_vbar(i,jend+1,kout)=tl_vbar(i,jend+1,kout)* &
758 &
grid(ng)%vmask(i,jend+1)
759# endif
760 END IF
761 END DO
762 END IF
763
764
765
767 DO i=istr,iend
769# if defined SSH_TIDES_NOT_YET && !defined UV_TIDES_NOT_YET
771 bry_pgr=-
g*(
boundary(ng)%zeta_north(i)- &
772 & zeta(i,jend,know))* &
773 & 0.5_r8*
grid(ng)%pn(i,jend)
774 tl_bry_pgr=
g*tl_zeta(i,jend,know)* &
775 & 0.5_r8*
grid(ng)%pn(i,jend)
776# ifdef ADJUST_BOUNDARY
778 tl_bry_pgr=tl_bry_pgr- &
780 & 0.5_r8*
grid(ng)%pn(i,jend)
781 END IF
782# endif
783 ELSE
784 bry_pgr=-
g*(zeta(i,jend+1,know)- &
785 & zeta(i,jend ,know))* &
786 & 0.5_r8*(
grid(ng)%pn(i,jend )+ &
787 &
grid(ng)%pn(i,jend+1))
788 tl_bry_pgr=-
g*(tl_zeta(i,jend+1,know)- &
789 & tl_zeta(i,jend ,know))* &
790 & 0.5_r8*(
grid(ng)%pn(i,jend )+ &
791 &
grid(ng)%pn(i,jend+1))
792 END IF
793# ifdef UV_COR
794 bry_cor=-0.125_r8*(ubar(i ,jend ,know)+ &
795 & ubar(i+1,jend ,know)+ &
796 & ubar(i ,jend+1,know)+ &
797 & ubar(i+1,jend+1,know))* &
798 & (
grid(ng)%f(i,jend )+ &
799 &
grid(ng)%f(i,jend+1))
800 tl_bry_cor=-0.125_r8*(tl_ubar(i ,jend ,know)+ &
801 & tl_ubar(i+1,jend ,know)+ &
802 & tl_ubar(i ,jend+1,know)+ &
803 & tl_ubar(i+1,jend+1,know))* &
804 & (
grid(ng)%f(i,jend )+ &
805 &
grid(ng)%f(i,jend+1))
806# else
807 bry_cor=0.0_r8
808 tl_bry_cor=0.0_r8
809# endif
810 cff1=1.0_r8/(0.5_r8*(
grid(ng)%h(i,jend )+ &
811 & zeta(i,jend ,know)+ &
812 &
grid(ng)%h(i,jend+1)+ &
813 & zeta(i,jend+1,know)))
814 tl_cff1=-cff1*cff1*0.5_r8*(
grid(ng)%tl_h(i,jend )+ &
815 & tl_zeta(i,jend ,know)+ &
816 &
grid(ng)%tl_h(i,jend+1)+ &
817 & tl_zeta(i,jend+1,know))
818 bry_str=cff1*(
forces(ng)%svstr(i,jend+1)- &
819 &
forces(ng)%bvstr(i,jend+1))
820 tl_bry_str=tl_cff1*(
forces(ng)%svstr(i,jend+1)- &
821 &
forces(ng)%bvstr(i,jend+1))+ &
822 & cff1*(
forces(ng)%tl_svstr(i,jend+1)- &
823 &
forces(ng)%tl_bvstr(i,jend+1))
824 ce=1.0_r8/sqrt(
g*0.5_r8*(
grid(ng)%h(i,jend+1)+ &
825 & zeta(i,jend+1,know)+ &
826 &
grid(ng)%h(i,jend )+ &
827 & zeta(i,jend ,know)))
828 tl_ce=-ce*ce*ce*0.25_r8*
g*(
grid(ng)%tl_h(i,jend+1)+ &
829 & tl_zeta(i,jend+1,know)+ &
830 &
grid(ng)%tl_h(i,jend )+ &
831 & tl_zeta(i,jend ,know))
832 cff2=
grid(ng)%on_v(i,jend+1)*ce
833 tl_cff2=
grid(ng)%on_v(i,jend+1)*tl_ce
834
835
836
837
838
839 tl_bry_val=tl_vbar(i,jend,know)+ &
840 & tl_cff2*(bry_pgr+ &
841 & bry_cor+ &
842 & bry_str)+ &
843 & cff2*(tl_bry_pgr+ &
844 & tl_bry_cor+ &
845 & tl_bry_str)
846# else
847
848
849# ifdef ADJUST_BOUNDARY
851 tl_bry_val=
boundary(ng)%tl_vbar_north(i)
852 ELSE
853 tl_bry_val=0.0_r8
854 END IF
855# else
856 tl_bry_val=0.0_r8
857# endif
858# endif
859 cff=1.0_r8/(0.5_r8*(
grid(ng)%h(i,jend )+ &
860 & zeta(i,jend ,know)+ &
861 &
grid(ng)%h(i,jend+1)+ &
862 & zeta(i,jend+1,know)))
863 tl_cff=-cff*cff*(0.5_r8*(
grid(ng)%tl_h(i,jend )+ &
864 & tl_zeta(i,jend ,know)+ &
865 &
grid(ng)%tl_h(i,jend+1)+ &
866 & tl_zeta(i,jend+1,know)))
868 tl_ce=0.5_r8*
g*tl_cff/ce
869# if defined ATM_PRESS && defined PRESS_COMPENSATE
870
871
872
873
874
875
876
877
878
879 tl_vbar(i,jend+1,kout)=tl_bry_val+ &
880 & tl_ce* &
881 & (0.5_r8* &
882 & (zeta(i,jend ,know)+ &
883 & zeta(i,jend+1,know)+ &
884 & fac*(
forces(ng)%Pair(i,jend )+ &
885 &
forces(ng)%Pair(i,jend+1)- &
886 & 2.0_r8*oneatm))- &
888 & ce* &
889 & (0.5_r8*(tl_zeta(i,jend ,know)+ &
890 & tl_zeta(i,jend+1,know)))
891# else
892
893
894
895
896
897 tl_vbar(i,jend+1,kout)=tl_bry_val+ &
898 & tl_ce* &
899 & (0.5_r8*(zeta(i,jend ,know)+ &
900 & zeta(i,jend+1,know))- &
902 & ce* &
903 & (0.5_r8*(tl_zeta(i,jend ,know)+ &
904 & tl_zeta(i,jend+1,know)))
905# endif
906# ifdef ADJUST_BOUNDARY
908 tl_vbar(i,jend+1,kout)=tl_vbar(i,jend+1,kout)- &
910 END IF
911# endif
912# ifdef MASKING
913
914
915
916 tl_vbar(i,jend+1,kout)=tl_vbar(i,jend+1,kout)* &
917 &
grid(ng)%vmask(i,jend+1)
918# endif
919 END IF
920 END DO
921
922
923
925 DO i=istr,iend
927# if defined SSH_TIDES_NOT_YET && !defined UV_TIDES_NOT_YET
929 bry_pgr=-
g*(
boundary(ng)%zeta_north(i)- &
930 & zeta(i,jend,know))* &
931 & 0.5_r8*
grid(ng)%pn(i,jend)
932 tl_bry_pgr=
g*tl_zeta(i,jend,know)* &
933 & 0.5_r8*
grid(ng)%pn(i,jend)
934# ifdef ADJUST_BOUNDARY
936 tl_bry_pgr=tl_bry_pgr- &
938 & 0.5_r8*
grid(ng)%pn(i,jend)
939 END IF
940# endif
941 ELSE
942 bry_pgr=-
g*(zeta(i,jend+1,know)- &
943 & zeta(i,jend ,know))* &
944 & 0.5_r8*(
grid(ng)%pn(i,jend )+ &
945 &
grid(ng)%pn(i,jend+1))
946 tl_bry_pgr=-
g*(tl_zeta(i,jend+1,know)- &
947 & tl_zeta(i,jend ,know))* &
948 & 0.5_r8*(
grid(ng)%pn(i,jend )+ &
949 &
grid(ng)%pn(i,jend+1))
950 END IF
951# ifdef UV_COR
952 bry_cor=-0.125_r8*(ubar(i ,jend ,know)+ &
953 & ubar(i+1,jend ,know)+ &
954 & ubar(i ,jend+1,know)+ &
955 & ubar(i+1,jend+1,know))* &
956 & (
grid(ng)%f(i,jend )+ &
957 &
grid(ng)%f(i,jend+1))
958 tl_bry_cor=-0.125_r8*(tl_ubar(i ,jend ,know)+ &
959 & tl_ubar(i+1,jend ,know)+ &
960 & tl_ubar(i ,jend+1,know)+ &
961 & tl_ubar(i+1,jend+1,know))* &
962 & (
grid(ng)%f(i,jend )+ &
963 &
grid(ng)%f(i,jend+1))
964# else
965 bry_cor=0.0_r8
966 tl_bry_cor=0.0_r8
967# endif
968 cff1=1.0_r8/(0.5_r8*(
grid(ng)%h(i,jend )+ &
969 & zeta(i,jend ,know)+ &
970 &
grid(ng)%h(i,jend+1)+ &
971 & zeta(i,jend+1,know)))
972 tl_cff1=-cff1*cff1*0.5_r8*(
grid(ng)%tl_h(i,jend )+ &
973 & tl_zeta(i,jend ,know)+ &
974 &
grid(ng)%tl_h(i,jend+1)+ &
975 & tl_zeta(i,jend+1,know))
976 bry_str=cff1*(
forces(ng)%svstr(i,jend+1)- &
977 &
forces(ng)%bvstr(i,jend+1))
978 tl_bry_str=tl_cff1*(
forces(ng)%svstr(i,jend+1)- &
979 &
forces(ng)%bvstr(i,jend+1))+ &
980 & cff1*(
forces(ng)%tl_svstr(i,jend+1)- &
981 &
forces(ng)%tl_bvstr(i,jend+1))
982 ce=1.0_r8/sqrt(
g*0.5_r8*(
grid(ng)%h(i,jend+1)+ &
983 & zeta(i,jend+1,know)+ &
984 &
grid(ng)%h(i,jend )+ &
985 & zeta(i,jend ,know)))
986 tl_ce=-ce*ce*ce*0.25_r8*
g*(
grid(ng)%tl_h(i,jend+1)+ &
987 & tl_zeta(i,jend+1,know)+ &
988 &
grid(ng)%tl_h(i,jend )+ &
989 & tl_zeta(i,jend ,know))
990 cff2=
grid(ng)%on_v(i,jend+1)*ce
991 tl_cff2=
grid(ng)%on_v(i,jend+1)*tl_ce
992
993
994
995
996
997 tl_bry_val=tl_vbar(i,jend,know)+ &
998 & tl_cff2*(bry_pgr+ &
999 & bry_cor+ &
1000 & bry_str)+ &
1001 & cff2*(tl_bry_pgr+ &
1002 & tl_bry_cor+ &
1003 & tl_bry_str)
1004# else
1005
1006
1007# ifdef ADJUST_BOUNDARY
1009 tl_bry_val=
boundary(ng)%tl_vbar_north(i)
1010 ELSE
1011 tl_bry_val=0.0_r8
1012 END IF
1013# else
1014 tl_bry_val=0.0_r8
1015# endif
1016# endif
1017# ifdef WET_DRY_NOT_YET
1018 cff=0.5_r8*(
grid(ng)%h(i,jend )+ &
1019 & zeta(i,jend ,know)+ &
1020 &
grid(ng)%h(i,jend+1)+ &
1021 & zeta(i,jend+1,know))
1022 tl_cff=0.5_r8*(
grid(ng)%tl_h(i,jend )+ &
1023 & tl_zeta(i,jend ,know)+ &
1024 &
grid(ng)%tl_h(i,jend+1)+ &
1025 & tl_zeta(i,jend+1,know))
1026# else
1027
1028 cff=0.5_r8*(
grid(ng)%h(i,jend )+ &
1029 &
grid(ng)%h(i,jend+1))
1030 tl_cff=0.5_r8*(
grid(ng)%tl_h(i,jend )+ &
1031 &
grid(ng)%tl_h(i,jend+1))
1032# endif
1034 tl_cff1=-0.5_r8*cff1*tl_cff/cff
1035 ce=dt2d*cff1*cff*0.5_r8*(
grid(ng)%pn(i,jend )+ &
1036 &
grid(ng)%pn(i,jend+1))
1037 tl_ce=dt2d*0.5_r8*(
grid(ng)%pn(i,jend )+ &
1038 &
grid(ng)%pn(i,jend+1))* &
1039 & (cff1*tl_cff+ &
1040 & tl_cff1*cff)
1041 ze=(0.5_r8+ce)*zeta(i,jend ,know)+ &
1042 & (0.5_r8-ce)*zeta(i,jend+1,know)
1043 tl_ze=(0.5_r8+ce)*tl_zeta(i,jend ,know)+ &
1044 & (0.5_r8-ce)*tl_zeta(i,jend+1,know)+ &
1045 & tl_ce*(zeta(i,jend ,know)- &
1046 & zeta(i,jend+1,know))
1048 cff2=(1.0_r8-
co/ce)**2
1049 tl_cff2=2.0_r8*cff2*
co*tl_ce/(ce*ce)
1050 cff3=zeta(i,jend,kout)+ &
1051 & ce*zeta(i,jend+1,know)- &
1052 & (1.0_r8+ce)*zeta(i,jend,know)
1053 tl_cff3=tl_zeta(i,jend,kout)+ &
1054 & ce*tl_zeta(i,jend+1,know)+ &
1055 & tl_ce*(zeta(i,jend ,know)+ &
1056 & zeta(i,jend+1,know))- &
1057 & (1.0_r8+ce)*tl_zeta(i,jend,know)
1058 ze=ze+cff2*cff3
1059 tl_ze=tl_ze+cff2*tl_cff3+ &
1060 & tl_cff2*cff3
1061 END IF
1062
1063
1064
1065
1066
1067
1068 tl_vbar(i,jend+1,kout)=0.5_r8* &
1069 & ((1.0_r8-ce)* &
1070 & tl_vbar(i,jend+1,know)+ &
1071 & tl_ce*(vbar(i,jend ,know)- &
1072 & vbar(i,jend+1,know))+ &
1073 & ce*tl_vbar(i,jend,know)+ &
1074 & tl_bry_val+ &
1075 & tl_cff1* &
1076 & (ze-
boundary(ng)%zeta_north(i))- &
1077 & cff1*tl_ze)
1078# ifdef ADJUST_BOUNDARY
1080 tl_vbar(i,jend+1,kout)=tl_vbar(i,jend+1,kout)- &
1081 & 0.5_r8*cff1* &
1083 END IF
1084# endif
1085# ifdef MASKING
1086
1087
1088
1089 tl_vbar(i,jend+1,kout)=tl_vbar(i,jend+1,kout)* &
1090 &
grid(ng)%vmask(i,jend+1)
1091# endif
1092 END IF
1093 END DO
1094
1095
1096
1098 DO i=istr,iend
1100
1101
1102# ifdef ADJUST_BOUNDARY
1104 tl_vbar(i,jend+1,kout)=
boundary(ng)%tl_vbar_north(i)
1105 ELSE
1106 tl_vbar(i,jend+1,kout)=0.0_r8
1107 END IF
1108# else
1109 tl_vbar(i,jend+1,kout)=0.0_r8
1110# endif
1111# ifdef MASKING
1112
1113
1114
1115 tl_vbar(i,jend+1,kout)=tl_vbar(i,jend+1,kout)* &
1116 &
grid(ng)%vmask(i,jend+1)
1117# endif
1118 END IF
1119 END DO
1120
1121
1122
1124 DO i=istr,iend
1126
1127
1128 tl_vbar(i,jend+1,kout)=tl_vbar(i,jend,kout)
1129# ifdef MASKING
1130
1131
1132
1133 tl_vbar(i,jend+1,kout)=tl_vbar(i,jend+1,kout)* &
1134 &
grid(ng)%vmask(i,jend+1)
1135# endif
1136 END IF
1137 END DO
1138
1139
1140
1142 DO i=istr,iend
1145
1146
1147
1148
1149 tl_bry_pgr=
g*tl_zeta(i,jend,know)* &
1150 & 0.5_r8*
grid(ng)%pn(i,jend)
1151# ifdef ADJUST_BOUNDARY
1153 tl_bry_pgr=tl_bry_pgr- &
1155 & 0.5_r8*
grid(ng)%pn(i,jend)
1156 END IF
1157# endif
1158 ELSE
1159
1160
1161
1162
1163
1164 tl_bry_pgr=-
g*(tl_zeta(i,jend+1,know)- &
1165 & tl_zeta(i,jend ,know))* &
1166 & 0.5_r8*(
grid(ng)%pn(i,jend )+ &
1167 &
grid(ng)%pn(i,jend+1))
1168 END IF
1169# ifdef UV_COR
1170
1171
1172
1173
1174
1175
1176
1177 tl_bry_cor=-0.125_r8*(tl_ubar(i ,jend ,know)+ &
1178 & tl_ubar(i+1,jend ,know)+ &
1179 & tl_ubar(i ,jend+1,know)+ &
1180 & tl_ubar(i+1,jend+1,know))* &
1181 & (
grid(ng)%f(i,jend )+ &
1182 &
grid(ng)%f(i,jend+1))
1183# else
1184
1185
1186 tl_bry_cor=0.0_r8
1187# endif
1188 cff=1.0_r8/(0.5_r8*(
grid(ng)%h(i,jend )+ &
1189 & zeta(i,jend ,know)+ &
1190 &
grid(ng)%h(i,jend+1)+ &
1191 & zeta(i,jend+1,know)))
1192 tl_cff=-cff*cff*0.5_r8*(
grid(ng)%tl_h(i,jend )+ &
1193 & tl_zeta(i,jend ,know)+ &
1194 &
grid(ng)%tl_h(i,jend+1)+ &
1195 & tl_zeta(i,jend+1,know))
1196
1197
1198
1199 tl_bry_str=tl_cff*(
forces(ng)%svstr(i,jend+1)- &
1200 &
forces(ng)%bvstr(i,jend+1))+ &
1201 & cff*(
forces(ng)%tl_svstr(i,jend+1)- &
1202 &
forces(ng)%tl_bvstr(i,jend+1))
1203
1204
1205
1206
1207
1208 tl_vbar(i,jend+1,kout)=tl_vbar(i,jend+1,know)+ &
1209 & dt2d*(tl_bry_pgr+ &
1210 & tl_bry_cor+ &
1211 & tl_bry_str)
1212# ifdef MASKING
1213
1214
1215
1216 tl_vbar(i,jend+1,kout)=tl_vbar(i,jend+1,kout)* &
1217 &
grid(ng)%vmask(i,jend+1)
1218# endif
1219 END IF
1220 END DO
1221
1222
1223
1225 DO i=istr,iend
1227
1228
1229 tl_vbar(i,jend+1,kout)=0.0_r8
1230 END IF
1231 END DO
1232 END IF
1233 END IF
1234
1235
1236
1237
1238
1239 IF (
domain(ng)%Western_Edge(tile))
THEN
1240
1241
1242
1244 IF (
iic(ng).ne.0)
THEN
1245 DO j=jstrv-1,jend
1246
1247
1248
1249 tl_grad(istr-1,j)=0.0_r8
1250 END DO
1251 DO j=jstrv,jend
1253# if defined CELERITY_READ && defined FORWARD_READ
1256 obc_out=0.5_r8* &
1257 & (
clima(ng)%M2nudgcof(istr-1,j-1)+ &
1258 &
clima(ng)%M2nudgcof(istr-1,j ))
1259 obc_in =
obcfac(ng)*obc_out
1260 ELSE
1263 END IF
1264 IF (
boundary(ng)%vbar_west_Cx(j).lt.0.0_r8)
THEN
1265 tau=obc_in
1266 ELSE
1267 tau=obc_out
1268 END IF
1269 tau=tau*dt2d
1270 END IF
1272# ifdef RADIATION_2D
1274# else
1275 ce=0.0_r8
1276# endif
1278# endif
1279
1280
1281
1282
1283
1284
1285 tl_vbar(istr-1,j,kout)=(cff*tl_vbar(istr-1,j,know)+ &
1286 & cx *tl_vbar(1,j,kout)- &
1287 & max(ce,0.0_r8)* &
1288 & tl_grad(istr-1,j-1)- &
1289 & min(ce,0.0_r8)* &
1290 & tl_grad(istr-1,j ))/ &
1291 & (cff+cx)
1292
1294
1295
1296
1297
1298 tl_vbar(istr-1,j,kout)=tl_vbar(istr-1,j,kout)- &
1299 & tau*tl_vbar(1,j,know)
1300 END IF
1301# ifdef MASKING
1302
1303
1304
1305 tl_vbar(istr-1,j,kout)=tl_vbar(istr-1,j,kout)* &
1306 &
grid(ng)%vmask(istr-1,j)
1307# endif
1308 END IF
1309 END DO
1310 END IF
1311
1312
1313
1317 DO j=jstrv,jend
1319 cff=dt2d*0.5_r8*(
grid(ng)%pm(istr,j-1)+ &
1320 &
grid(ng)%pm(istr,j ))
1321 cff1=sqrt(
g*0.5_r8*(
grid(ng)%h(istr,j-1)+ &
1322 & zeta(istr,j-1,know)+ &
1323 &
grid(ng)%h(istr,j )+ &
1324 & zeta(istr,j ,know)))
1325 tl_cff1=0.25_r8*
g*(
grid(ng)%tl_h(istr,j-1)+ &
1326 & tl_zeta(istr,j-1,know)+ &
1327 &
grid(ng)%tl_h(istr,j )+ &
1328 & tl_zeta(istr,j ,know))/cff1
1329 cx=cff*cff1
1330 tl_cx=cff*tl_cff1
1331 cff2=1.0_r8/(1.0_r8+cx)
1332 tl_cff2=-cff2*cff2*tl_cx
1333
1334
1335
1336 tl_vbar(istr-1,j,kout)=tl_cff2*(vbar(istr-1,j,know)+ &
1337 & cx*vbar(istr,j,kout))+ &
1338 & cff2*(tl_vbar(istr-1,j,know)+ &
1339 & tl_cx*vbar(istr,j,kout)+ &
1340 & cx*tl_vbar(istr,j,kout))
1341# ifdef MASKING
1342
1343
1344
1345 tl_vbar(istr-1,j,kout)=tl_vbar(istr-1,j,kout)* &
1346 &
grid(ng)%vmask(istr-1,j)
1347# endif
1348 END IF
1349 END DO
1350
1351
1352
1354 DO j=jstrv,jend
1356
1357
1358# ifdef ADJUST_BOUNDARY
1360 tl_vbar(istr-1,j,kout)=
boundary(ng)%tl_vbar_west(j)
1361 ELSE
1362 tl_vbar(istr-1,j,kout)=0.0_r8
1363 END IF
1364# else
1365 tl_vbar(istr-1,j,kout)=0.0_r8
1366# endif
1367# ifdef MASKING
1368
1369
1370
1371 tl_vbar(istr-1,j,kout)=tl_vbar(istr-1,j,kout)* &
1372 &
grid(ng)%vmask(istr-1,j)
1373# endif
1374 END IF
1375 END DO
1376
1377
1378
1380 DO j=jstrv,jend
1382
1383
1384 tl_vbar(istr-1,j,kout)=tl_vbar(istr,j,kout)
1385# ifdef MASKING
1386
1387
1388
1389 tl_vbar(istr-1,j,kout)=tl_vbar(istr-1,j,kout)* &
1390 &
grid(ng)%vmask(istr-1,j)
1391# endif
1392 END IF
1393 END DO
1394
1395
1396
1397
1400 jmin=jstrv
1401 jmax=jend
1402 ELSE
1403 jmin=jstr
1404 jmax=jendr
1405 END IF
1406 DO j=jmin,jmax
1408
1409
1410 tl_vbar(istr-1,j,kout)=
gamma2(ng)*tl_vbar(istr,j,kout)
1411# ifdef MASKING
1412
1413
1414
1415 tl_vbar(istr-1,j,kout)=tl_vbar(istr-1,j,kout)* &
1416 &
grid(ng)%vmask(istr-1,j)
1417# endif
1418 END IF
1419 END DO
1420 END IF
1421 END IF
1422
1423
1424
1425
1426
1427 IF (
domain(ng)%Eastern_Edge(tile))
THEN
1428
1429
1430
1432 IF (
iic(ng).ne.0)
THEN
1433 DO j=jstrv-1,jend
1434
1435
1436
1437 tl_grad(iend+1,j)=0.0_r8
1438 END DO
1439 DO j=jstrv,jend
1441# if defined CELERITY_READ && defined FORWARD_READ
1444 obc_out=0.5_r8* &
1445 & (
clima(ng)%M2nudgcof(iend+1,j-1)+ &
1446 &
clima(ng)%M2nudgcof(iend+1,j ))
1447 obc_in =
obcfac(ng)*obc_out
1448 ELSE
1451 END IF
1452 IF (
boundary(ng)%vbar_east_Cx(j).lt.0.0_r8)
THEN
1453 tau=obc_in
1454 ELSE
1455 tau=obc_out
1456 END IF
1457 tau=tau*dt2d
1458 END IF
1460# ifdef RADIATION_2D
1462# else
1463 ce=0.0_r8
1464# endif
1466# endif
1467
1468
1469
1470
1471
1472
1473 tl_vbar(iend+1,j,kout)=(cff*tl_vbar(iend+1,j,know)+ &
1474 & cx *tl_vbar(iend ,j,kout)- &
1475 & max(ce,0.0_r8)* &
1476 & tl_grad(iend+1,j-1)- &
1477 & min(ce,0.0_r8)* &
1478 & tl_grad(iend+1,j ))/ &
1479 & (cff+cx)
1480
1482
1483
1484
1485
1486 tl_vbar(iend+1,j,kout)=tl_vbar(iend+1,j,kout)- &
1487 & tau*tl_vbar(iend+1,j,know)
1488 END IF
1489# ifdef MASKING
1490
1491
1492
1493 tl_vbar(iend+1,j,kout)=tl_vbar(iend+1,j,kout)* &
1494 &
grid(ng)%vmask(iend+1,j)
1495# endif
1496 END IF
1497 END DO
1498 END IF
1499
1500
1501
1505 DO j=jstrv,jend
1507 cff=dt2d*0.5_r8*(
grid(ng)%pm(iend,j-1)+ &
1508 &
grid(ng)%pm(iend,j ))
1509 cff1=sqrt(
g*0.5_r8*(
grid(ng)%h(iend,j-1)+ &
1510 & zeta(iend,j-1,know)+ &
1511 &
grid(ng)%h(iend,j )+ &
1512 & zeta(iend,j ,know)))
1513 tl_cff1=0.25_r8*
g*(
grid(ng)%tl_h(iend,j-1)+ &
1514 & tl_zeta(iend,j-1,know)+ &
1515 &
grid(ng)%tl_h(iend,j )+ &
1516 & tl_zeta(iend,j ,know))/cff1
1517 cx=cff*cff1
1518 tl_cx=cff*tl_cff1
1519 cff2=1.0_r8/(1.0_r8+cx)
1520 tl_cff2=-cff2*cff2*tl_cx
1521
1522
1523
1524 tl_vbar(iend+1,j,kout)=tl_cff2*(vbar(iend+1,j,know)+ &
1525 & cx*vbar(iend,j,kout))+ &
1526 & cff2*(tl_vbar(iend+1,j,know)+ &
1527 & tl_cx*vbar(iend,j,kout)+ &
1528 & cx*tl_vbar(iend,j,kout))
1529# ifdef MASKING
1530
1531
1532
1533 tl_vbar(iend+1,j,kout)=tl_vbar(iend+1,j,kout)* &
1534 &
grid(ng)%vmask(iend+1,j)
1535# endif
1536 END IF
1537 END DO
1538
1539
1540
1542 DO j=jstrv,jend
1544
1545
1546# ifdef ADJUST_BOUNDARY
1548 tl_vbar(iend+1,j,kout)=
boundary(ng)%tl_vbar_east(j)
1549 ELSE
1550 tl_vbar(iend+1,j,kout)=0.0_r8
1551 END IF
1552# else
1553 tl_vbar(iend+1,j,kout)=0.0_r8
1554# endif
1555# ifdef MASKING
1556
1557
1558
1559 tl_vbar(iend+1,j,kout)=tl_vbar(iend+1,j,kout)* &
1560 &
grid(ng)%vmask(iend+1,j)
1561# endif
1562 END IF
1563 END DO
1564
1565
1566
1568 DO j=jstrv,jend
1570
1571
1572 tl_vbar(iend+1,j,kout)=tl_vbar(iend,j,kout)
1573# ifdef MASKING
1574
1575
1576
1577 tl_vbar(iend+1,j,kout)=tl_vbar(iend+1,j,kout)* &
1578 &
grid(ng)%vmask(iend+1,j)
1579# endif
1580 END IF
1581 END DO
1582
1583
1584
1585
1588 jmin=jstrv
1589 jmax=jend
1590 ELSE
1591 jmin=jstr
1592 jmax=jendr
1593 END IF
1594 DO j=jmin,jmax
1596
1597
1598 tl_vbar(iend+1,j,kout)=
gamma2(ng)*tl_vbar(iend,j,kout)
1599# ifdef MASKING
1600
1601
1602
1603 tl_vbar(iend+1,j,kout)=tl_vbar(iend+1,j,kout)* &
1604 &
grid(ng)%vmask(iend+1,j)
1605# endif
1606 END IF
1607 END DO
1608 END IF
1609 END IF
1610
1611
1612
1613
1614
1616 IF (
domain(ng)%SouthWest_Corner(tile))
THEN
1619
1620
1621
1622 tl_vbar(istr-1,jstr,kout)=0.5_r8* &
1623 & (tl_vbar(istr ,jstr ,kout)+ &
1624 & tl_vbar(istr-1,jstr+1,kout))
1625 END IF
1626 END IF
1627 IF (
domain(ng)%SouthEast_Corner(tile))
THEN
1630
1631
1632
1633 tl_vbar(iend+1,jstr,kout)=0.5_r8* &
1634 & (tl_vbar(iend ,jstr ,kout)+ &
1635 & tl_vbar(iend+1,jstr+1,kout))
1636 END IF
1637 END IF
1638 IF (
domain(ng)%NorthWest_Corner(tile))
THEN
1641
1642
1643
1644 tl_vbar(istr-1,jend+1,kout)=0.5_r8* &
1645 & (tl_vbar(istr-1,jend ,kout)+ &
1646 & tl_vbar(istr ,jend+1,kout))
1647 END IF
1648 END IF
1649 IF (
domain(ng)%NorthEast_Corner(tile))
THEN
1652
1653
1654
1655 tl_vbar(iend+1,jend+1,kout)=0.5_r8* &
1656 & (tl_vbar(iend+1,jend ,kout)+ &
1657 & tl_vbar(iend ,jend+1,kout))
1658 END IF
1659 END IF
1660 END IF
1661
1662# if defined WET_DRY_NOT_YET
1663
1664
1665
1666
1667
1668
1669
1671 IF (
domain(ng)%Western_Edge(tile))
THEN
1672 DO j=jstrv,jend
1675
1676
1677
1678
1679
1680
1681 END IF
1682 END DO
1683 END IF
1684 IF (
domain(ng)%Eastern_Edge(tile))
THEN
1685 DO j=jstrv,jend
1688
1689
1690
1691
1692
1693
1694 END IF
1695 END DO
1696 END IF
1697 END IF
1698
1700 IF (
domain(ng)%Southern_Edge(tile))
THEN
1701 DO i=istr,iend
1704
1705
1706
1707
1708
1709
1710 END IF
1711 END DO
1712 END IF
1713 IF (
domain(ng)%Northern_Edge(tile))
THEN
1714 DO i=istr,iend
1717
1718
1719
1720
1721
1722
1723 END IF
1724 END DO
1725 END IF
1726 END IF
1727
1729 IF (
domain(ng)%SouthWest_Corner(tile))
THEN
1734
1735
1736
1737
1738
1739
1740 END IF
1741 END IF
1742 IF (
domain(ng)%SouthEast_Corner(tile))
THEN
1747
1748
1749
1750
1751
1752
1753 END IF
1754 END IF
1755 IF (
domain(ng)%NorthWest_Corner(tile))
THEN
1760
1761
1762
1763
1764
1765
1766 END IF
1767 END IF
1768 IF (
domain(ng)%NorthEast_Corner(tile))
THEN
1773
1774
1775
1776
1777
1778
1779 END IF
1780 END IF
1781 END IF
1782# endif
1783
1784 RETURN
type(t_boundary), dimension(:), allocatable boundary
type(t_apply), dimension(:), allocatable lbc_apply
type(t_clima), dimension(:), allocatable clima
type(t_forces), dimension(:), allocatable forces
type(t_grid), dimension(:), allocatable grid
type(t_lbc), dimension(:,:,:), allocatable tl_lbc
type(t_lbc), dimension(:,:,:), allocatable lbc
type(t_domain), dimension(:), allocatable domain
logical, dimension(:), allocatable lnudgem2clm
integer, dimension(:), allocatable iic
logical, dimension(:,:,:), allocatable lobc
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
logical, dimension(:), allocatable predictor_2d_step
real(dp), dimension(:), allocatable obcfac
real(r8), dimension(:), allocatable gamma2
integer, parameter isouth
real(dp), dimension(:), allocatable dtfast
real(dp), dimension(:,:), allocatable m2obc_out
integer, parameter inorth
real(dp), dimension(:,:), allocatable m2obc_in