178
179
183
187# ifdef DISTRIBUTE
189# endif
190# ifdef ZETA_ELLIPTIC
193# endif
194
195
196
197 integer, intent(in) :: ng, tile
198 integer, intent(in) :: LBi, UBi, LBj, UBj, LBij, UBij
199 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
200 integer, intent(in) :: Lbck, Linp
201
202# ifdef ASSUMED_SHAPE
203 real(r8), intent(in) :: f(LBi:,LBj:)
204 real(r8), intent(in) :: pm(LBi:,LBj:)
205 real(r8), intent(in) :: pn(LBi:,LBj:)
206# ifdef ZETA_ELLIPTIC
207 real(r8), intent(in) :: h(LBi:,LBj:)
208 real(r8), intent(in) :: pmon_u(LBi:,LBj:)
209 real(r8), intent(in) :: pnom_v(LBi:,LBj:)
210# endif
211# ifdef SOLVE3D
212 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
213 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
214 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
215# endif
216# ifdef MASKING
217 real(r8), intent(in) :: rmask(LBi:,LBj:)
218 real(r8), intent(in) :: umask(LBi:,LBj:)
219 real(r8), intent(in) :: vmask(LBi:,LBj:)
220# endif
221# ifdef SOLVE3D
222 real(r8), intent(in) :: alpha(LBi:,LBj:)
223 real(r8), intent(in) :: beta(LBi:,LBj:)
224 real(r8), intent(in) :: t(LBi:,LBj:,:,:,:)
225 real(r8), intent(inout) :: tl_t(LBi:,LBj:,:,:,:)
226 real(r8), intent(inout) :: tl_u(LBi:,LBj:,:,:)
227 real(r8), intent(inout) :: tl_v(LBi:,LBj:,:,:)
228# endif
229 real(r8), intent(inout) :: tl_zeta(LBi:,LBj:,:)
230# ifdef SOLVE3D
231 real(r8), intent(out) :: tl_rho(LBi:,LBj:,:)
232# endif
233# ifdef ZETA_ELLIPTIC
234 real(r8), intent(in) :: bc_ak(:)
235 real(r8), intent(in) :: bc_bk(:)
236 real(r8), intent(in) :: zdf1(:)
237 real(r8), intent(in) :: zdf2(:)
238 real(r8), intent(in) :: zdf3(:)
239 real(r8), intent(inout) :: pc_r2d(LBi:,LBj:)
240 real(r8), intent(inout) :: r_r2d(LBi:,LBj:,:)
241 real(r8), intent(inout) :: br_r2d(LBi:,LBj:,:)
242 real(r8), intent(inout) :: p_r2d(LBi:,LBj:,:)
243 real(r8), intent(inout) :: bp_r2d(LBi:,LBj:,:)
244 real(r8), intent(inout) :: tl_rhs_r2d(LBi:,LBj:)
245 real(r8), intent(inout) :: tl_zeta_ref(LBi:,LBj:)
246# endif
247
248# else
249
250 real(r8), intent(in) :: f(LBi:UBi,LBj:UBj)
251 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
252 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
253# ifdef ZETA_ELLIPTIC
254 real(r8), intent(in) :: h(LBi:UBi,LBj:UBj)
255 real(r8), intent(in) :: pmon_u(LBi:UBi,LBj:UBj)
256 real(r8), intent(in) :: pnom_v(LBi:UBi,LBj:UBj)
257# endif
258# ifdef SOLVE3D
259 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
260 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
261 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
262# endif
263# ifdef MASKING
264 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
265 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
266 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
267# endif
268# ifdef SOLVE3D
269 real(r8), intent(in) :: alpha(LBi:UBi,LBj:UBj)
270 real(r8), intent(in) :: beta(LBi:UBi,LBj:UBj)
271 real(r8), intent(in) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
272 real(r8), intent(inout) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
273 real(r8), intent(inout) :: tl_u(LBi:UBi,LBj:UBj,2,N(ng))
274 real(r8), intent(inout) :: tl_v(LBi:UBi,LBj:UBj,2,N(ng))
275# endif
276 real(r8), intent(inout) :: tl_zeta(LBi:UBi,LBj:UBj,:)
277# ifdef SOLVE3D
278 real(r8), intent(out) :: tl_rho(LBi:UBi,LBj:UBj,N(ng))
279# endif
280# ifdef ZETA_ELLIPTIC
281 real(r8), intent(in) :: bc_ak(Nbico(ng))
282 real(r8), intent(in) :: bc_bk(Nbico(ng))
283 real(r8), intent(in) :: zdf1(Nbico(ng))
284 real(r8), intent(in) :: zdf2(Nbico(ng))
285 real(r8), intent(in) :: zdf3(Nbico(ng))
286 real(r8), intent(inout) :: pc_r2d(LBi:UBi,LBj:UBj)
287 real(r8), intent(inout) :: r_r2d(LBi:UBi,LBj:UBj,Nbico(ng))
288 real(r8), intent(inout) :: br_r2d(LBi:UBi,LBj:UBj,Nbico(ng))
289 real(r8), intent(inout) :: p_r2d(LBi:UBi,LBj:UBj,Nbico(ng))
290 real(r8), intent(inout) :: bp_r2d(LBi:UBi,LBj:UBj,Nbico(ng))
291 real(r8), intent(inout) :: tl_rhs_r2d(LBi:UBi,LBj:UBj)
292 real(r8), intent(inout) :: tl_zeta_ref(LBi:UBi,LBj:UBj)
293# endif
294
295# endif
296
297
298
299 integer :: i, j, k, order
300 integer :: Norder = 2
301
302 real(r8) :: fac, fac1, fac2, fac3, gamma
303 real(r8) :: cff, cff1, cff2, cff3, cff4
304 real(r8) :: tl_cff, tl_cff1, tl_cff2
305 real(r8) :: dzdT, zphi, zphi1, zwbot, zwtop
306
307 real(r8), dimension(20) :: filter_coef = &
308 & (/ 2.500000E-1_r8, 6.250000E-2_r8, 1.562500E-2_r8, &
309 & 3.906250E-3_r8, 9.765625E-4_r8, 2.44140625E-4_r8, &
310 & 6.103515625E-5_r8, 1.5258789063E-5_r8, 3.814697E-6_r8, &
311 & 9.536743E-7_r8, 2.384186E-7_r8, 5.960464E-8_r8, &
312 & 1.490116E-8_r8, 3.725290E-9_r8, 9.313226E-10_r8, &
313 & 2.328306E-10_r8, 5.820766E-11_r8, 1.455192E-11_r8, &
314 & 3.637979E-12_r8, 9.094947E-13_r8 /)
315
316 real(r8), dimension(N(ng)) :: dSdT, dSdT_filter
317
318 real(r8), dimension(IminS:ImaxS) :: tl_phie
319 real(r8), dimension(IminS:ImaxS) :: tl_phix
320
321# ifdef SALINITY
322 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: FC
323
324 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,0:N(ng)) :: dTdz
325 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,0:N(ng)) :: dSdz
326# endif
327 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,N(ng)) :: tl_gradP
328
329# ifdef ZETA_ELLIPTIC
330 real(r8), dimension(IminS:ImaxS,N(ng)) :: tl_phi
331
332 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_gradPx
333 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_gradPy
334 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_r2d_rhs
335# endif
336
337# include "set_bounds.h"
338
339# ifdef SALINITY
340
341
342
343
344
346
347
348
349 DO j=jstrr,jendr
350 DO i=istrr,iendr
351 fc(i,0)=0.0_r8
352 dtdz(i,j,0)=0.0_r8
353 dsdz(i,j,0)=0.0_r8
354 END DO
356 DO i=istrr,iendr
357 cff=1.0_r8/(2.0_r8*hz(i,j,k+1)+ &
358 & hz(i,j,k)*(2.0_r8-fc(i,k-1)))
359 fc(i,k)=cff*hz(i,j,k+1)
360 dtdz(i,j,k)=cff*(6.0_r8*(t(i,j,k+1,lbck,
itemp)- &
361 & t(i,j,k ,lbck,
itemp))- &
362 & hz(i,j,k)*dtdz(i,j,k-1))
363 dsdz(i,j,k)=cff*(6.0_r8*(t(i,j,k+1,lbck,
isalt)- &
364 & t(i,j,k ,lbck,
isalt))- &
365 & hz(i,j,k)*dsdz(i,j,k-1))
366 END DO
367 END DO
368 DO i=istrr,iendr
369 dtdz(i,j,
n(ng))=0.0_r8
370 dsdz(i,j,
n(ng))=0.0_r8
371 END DO
373 DO i=istrr,iendr
374 dtdz(i,j,k)=dtdz(i,j,k)-fc(i,k)*dtdz(i,j,k+1)
375 dsdz(i,j,k)=dsdz(i,j,k)-fc(i,k)*dsdz(i,j,k+1)
376 END DO
377 END DO
378 END DO
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393 DO j=jstrr,jendr
394 DO i=istrr,iendr
396 cff=0.5_r8*(dtdz(i,j,k-1)+dtdz(i,j,k))
398 dzdt=0.0_r8
399 ELSE
400 dzdt=1.0_r8/cff
401 END IF
402 dsdt(k)=(0.5_r8*(dsdz(i,j,k-1)+ &
403 & dsdz(i,j,k )))*dzdt
404 END DO
405
406
407
408 DO order=1,norder/2
409 IF (order.ne.norder/2) THEN
410 dsdt_filter(1)=2.0_r8*(dsdt(1)-dsdt(2))
411 dsdt_filter(
n(ng))=2.0_r8*(dsdt(
n(ng))-dsdt(
n(ng)-1))
412 ELSE
413 dsdt_filter(1)=0.0_r8
414 dsdt_filter(
n(ng))=0.0_r8
415 END IF
417 dsdt_filter(k)=2.0_r8*dsdt(k)-dsdt(k-1)-dsdt(k+1)
418 END DO
420 dsdt(k)=dsdt(k)-filter_coef(norder/2)*dsdt_filter(k)
421 END DO
422 END DO
423
425 cff=(1.0_r8-exp(z_r(i,j,k)/
ml_depth(ng)))*dsdt(k)
426 tl_t(i,j,k,linp,
isalt)=tl_t(i,j,k,linp,
isalt)+ &
427 & cff*tl_t(i,j,k,linp,
itemp)
428# ifdef MASKING
429 tl_t(i,j,k,linp,
isalt)=tl_t(i,j,k,linp,
isalt)*rmask(i,j)
430# endif
431 END DO
432 END DO
433 END DO
434
437 & lbi, ubi, lbj, ubj, 1,
n(ng), &
438 & tl_t(:,:,:,linp,
isalt))
439 END IF
440# ifdef DISTRIBUTE
442 & lbi, ubi, lbj, ubj, 1,
n(ng), &
445 & tl_t(:,:,:,linp,
isalt))
446# endif
447 END IF
448# endif
449
450
451
452
453
454
455
457 DO j=jstrr,jendr
459 DO i=istrr,iendr
460 tl_rho(i,j,k)=-
rho0*alpha(i,j)*tl_t(i,j,k,linp,
itemp)
461# ifdef SALINITY
462 tl_rho(i,j,k)=tl_rho(i,j,k)+ &
464# endif
465# ifdef MASKING
466 tl_rho(i,j,k)=tl_rho(i,j,k)*rmask(i,j)
467# endif
468 END DO
469 END DO
470 END DO
471
474 & lbi, ubi, lbj, ubj, 1,
n(ng), &
475 & tl_rho)
476 END IF
477# ifdef DISTRIBUTE
479 & lbi, ubi, lbj, ubj, 1,
n(ng), &
482 & tl_rho)
483# endif
484 END IF
485
486
487
488
489
490
491
492
493
494
496
497 fac2=0.0_r8
499
500# ifdef ZETA_ELLIPTIC
501
502
503
504 DO j=jmins,jmaxs
505 DO i=imins,imaxs
506 tl_gradpx(i,j)=0.0_r8
507 tl_gradpy(i,j)=0.0_r8
508 END DO
509 END DO
510# endif
511
512
513
514
516 DO j=jstr,jend+1
517 DO i=istr-1,iend
518 cff1=z_w(i,j ,
n(ng))-z_r(i,j ,
n(ng))+ &
519 & z_w(i,j-1,
n(ng))-z_r(i,j-1,
n(ng))
520 tl_phie(i)=fac1*(tl_rho(i,j ,
n(ng))- &
521 & tl_rho(i,j-1,
n(ng)))*cff1+ &
522 & fac2*(tl_zeta(i,j ,linp)- &
523 & tl_zeta(i,j-1,linp))
524 tl_gradp(i,j,
n(ng))=0.5_r8*tl_phie(i)* &
525 & (pn(i,j-1)+pn(i,j))/(f(i,j-1)+f(i,j))
526# ifdef ZETA_ELLIPTIC
527 tl_phi(i,
n(ng))=tl_phie(i)
528# endif
529 END DO
530
531
532
533
535 DO i=istr-1,iend
536 cff1=1.0_r8/((z_r(i,j ,k+1)-z_r(i,j ,k))* &
537 & (z_r(i,j-1,k+1)-z_r(i,j-1,k)))
538 cff2=z_r(i,j ,k )-z_r(i,j-1,k )+ &
539 & z_r(i,j ,k+1)-z_r(i,j-1,k+1)
540 cff3=z_r(i,j ,k+1)-z_r(i,j ,k )- &
541 & z_r(i,j-1,k+1)+z_r(i,j-1,k )
542 gamma=0.125_r8*cff1*cff2*cff3
543
544 tl_cff1=(1.0_r8+gamma)*(tl_rho(i,j ,k+1)- &
545 & tl_rho(i,j-1,k+1))+ &
546 & (1.0_r8-gamma)*(tl_rho(i,j ,k )- &
547 & tl_rho(i,j-1,k ))
548 tl_cff2=tl_rho(i,j,k+1)+tl_rho(i,j-1,k+1)- &
549 & tl_rho(i,j,k )-tl_rho(i,j-1,k )
550 cff3=z_r(i,j,k+1)+z_r(i,j-1,k+1)- &
551 & z_r(i,j,k )-z_r(i,j-1,k )
552 cff4=(1.0_r8+gamma)*(z_r(i,j,k+1)-z_r(i,j-1,k+1))+ &
553 & (1.0_r8-gamma)*(z_r(i,j,k )-z_r(i,j-1,k ))
554 tl_phie(i)=tl_phie(i)+ &
555 & fac3*(tl_cff1*cff3-tl_cff2*cff4)
556 tl_gradp(i,j,k)=0.5_r8*tl_phie(i)* &
557 & (pn(i,j-1)+pn(i,j))/(f(i,j-1)+f(i,j))
558# ifdef ZETA_ELLIPTIC
559 tl_phi(i,k)=tl_phie(i)
560# endif
561 END DO
562 END DO
563
564# ifdef ZETA_ELLIPTIC
565
566
567
568
571 DO i=istr-1,iend
572 tl_cff=0.5_r8*(hz(i,j-1,k)+hz(i,j,k))*tl_phi(i,k)
573# ifdef MASKING
574 tl_cff=tl_cff*vmask(i,j)
575# endif
576 tl_gradpy(i,j)=tl_gradpy(i,j)+tl_cff
577 END DO
578 END DO
579 END IF
580# endif
581 END DO
582 END IF
583
584
585
588 DO j=jstr,jend
589 DO i=istru,iend
590 tl_u(i,j,k,linp)=tl_u(i,j,k,linp)- &
591 & 0.25_r8*(tl_gradp(i-1,j ,k)+ &
592 & tl_gradp(i ,j ,k)+ &
593 & tl_gradp(i-1,j+1,k)+ &
594 & tl_gradp(i ,j+1,k))
595# ifdef MASKING
596 tl_u(i,j,k,linp)=tl_u(i,j,k,linp)*umask(i,j)
597# endif
598 END DO
599 END DO
600 END DO
601 END IF
602
603
604
605
607 DO j=jstr-1,jend
608 DO i=istr,iend+1
609 cff1=z_w(i ,j,
n(ng))-z_r(i ,j,
n(ng))+ &
610 & z_w(i-1,j,
n(ng))-z_r(i-1,j,
n(ng))
611 tl_phix(i)=fac1*(tl_rho(i ,j,
n(ng))- &
612 & tl_rho(i-1,j,
n(ng)))*cff1+ &
613 & fac2*(tl_zeta(i ,j,linp)- &
614 & tl_zeta(i-1,j,linp))
615 tl_gradp(i,j,
n(ng))=0.5_r8*tl_phix(i)* &
616 & (pm(i-1,j)+pm(i,j))/(f(i-1,j)+f(i,j))
617# ifdef ZETA_ELLIPTIC
618 tl_phi(i,
n(ng))=tl_phix(i)
619# endif
620 END DO
621
622
623
624
626 DO i=istr,iend+1
627 cff1=1.0_r8/((z_r(i ,j,k+1)-z_r(i ,j,k))* &
628 & (z_r(i-1,j,k+1)-z_r(i-1,j,k)))
629 cff2=z_r(i ,j,k )-z_r(i-1,j,k )+ &
630 & z_r(i ,j,k+1)-z_r(i-1,j,k+1)
631 cff3=z_r(i ,j,k+1)-z_r(i ,j,k )- &
632 & z_r(i-1,j,k+1)+z_r(i-1,j,k )
633 gamma=0.125_r8*cff1*cff2*cff3
634
635 tl_cff1=(1.0_r8+gamma)*(tl_rho(i ,j,k+1)- &
636 & tl_rho(i-1,j,k+1))+ &
637 & (1.0_r8-gamma)*(tl_rho(i ,j,k )- &
638 & tl_rho(i-1,j,k ))
639 tl_cff2=tl_rho(i,j,k+1)+tl_rho(i-1,j,k+1)- &
640 & tl_rho(i,j,k )-tl_rho(i-1,j,k )
641 cff3=z_r(i,j,k+1)+z_r(i-1,j,k+1)- &
642 & z_r(i,j,k )-z_r(i-1,j,k )
643 cff4=(1.0_r8+gamma)*(z_r(i,j,k+1)-z_r(i-1,j,k+1))+ &
644 & (1.0_r8-gamma)*(z_r(i,j,k )-z_r(i-1,j,k ))
645 tl_phix(i)=tl_phix(i)+ &
646 & fac3*(tl_cff1*cff3-tl_cff2*cff4)
647 tl_gradp(i,j,k)=0.5_r8*tl_phix(i)* &
648 & (pm(i-1,j)+pm(i,j))/(f(i-1,j)+f(i,j))
649# ifdef ZETA_ELLIPTIC
650 tl_phi(i,k)=tl_phix(i)
651# endif
652 END DO
653 END DO
654
655# ifdef ZETA_ELLIPTIC
656
657
658
659
662 DO i=istr,iend+1
663 tl_cff=0.5_r8*(hz(i-1,j,k)+hz(i,j,k))*tl_phi(i,k)
664# ifdef MASKING
665 tl_cff=tl_cff*umask(i,j)
666# endif
667 tl_gradpx(i,j)=tl_gradpx(i,j)+tl_cff
668 END DO
669 END DO
670 END IF
671# endif
672 END DO
673 END IF
674
675
676
679 DO j=jstrv,jend
680 DO i=istr,iend
681 tl_v(i,j,k,linp)=tl_v(i,j,k,linp)+ &
682 & 0.25_r8*(tl_gradp(i ,j-1,k)+ &
683 & tl_gradp(i+1,j-1,k)+ &
684 & tl_gradp(i ,j ,k)+ &
685 & tl_gradp(i+1,j ,k))
686# ifdef MASKING
687 tl_v(i,j,k,linp)=tl_v(i,j,k,linp)*vmask(i,j)
688# endif
689 END DO
690 END DO
691 END DO
692
695 & lbi, ubi, lbj, ubj, 1,
n(ng), &
696 & tl_u(:,:,:,linp))
698 & lbi, ubi, lbj, ubj, 1,
n(ng), &
699 & tl_v(:,:,:,linp))
700 END IF
701# ifdef DISTRIBUTE
703 & lbi, ubi, lbj, ubj, 1,
n(ng), &
706 & tl_u(:,:,:,linp), tl_v(:,:,:,linp))
707# endif
708 END IF
709
710
711
712
713
714
716
717# ifdef ZETA_ELLIPTIC
718
719
720
722 & imins, imaxs, jmins, jmaxs, &
723 & tl_gradpx)
725 & imins, imaxs, jmins, jmaxs, &
726 & tl_gradpy)
727
728
729
730 DO j=jstr,jend
731 DO i=istr,iend
732 tl_rhs_r2d(i,j)=-pm(i,j)*pn(i,j)* &
733 & (pmon_u(i+1,j)*tl_gradpx(i+1,j)- &
734 & pmon_u(i ,j)*tl_gradpx(i ,j)+ &
735 & pnom_v(i,j+1)*tl_gradpy(i,j+1)- &
736 & pnom_v(i,j )*tl_gradpy(i,j ))
737# ifdef MASKING
738 tl_rhs_r2d(i,j)=tl_rhs_r2d(i,j)*rmask(i,j)
739# endif
740 END DO
741 END DO
742
744 & lbi, ubi, lbj, ubj, &
745 & tl_rhs_r2d)
746# ifdef DISTRIBUTE
748 & lbi, ubi, lbj, ubj, &
751 & tl_rhs_r2d)
752# endif
753
754
755
756 DO j=jstr,jend
757 DO i=istr,iend
758 tl_zeta_ref(i,j)=0.0_r8
759 END DO
760 END DO
761
762
763
765 & lbi, ubi, lbj, ubj, &
766 & imins, imaxs, jmins, jmaxs, &
767 & lbck, &
768 & h, pmon_u, pnom_v, pm, pn, &
769# ifdef MASKING
770 & umask, vmask, rmask, &
771# endif
772 & bc_ak, bc_bk, zdf1, zdf2, zdf3, &
773 & pc_r2d, r_r2d, br_r2d, p_r2d, bp_r2d, &
774 & tl_zeta_ref, tl_rhs_r2d)
775
776
777
778
779 DO j=jstr,jend
780 DO i=istr,iend
781 tl_zeta(i,j,linp)=tl_zeta(i,j,linp)+tl_zeta_ref(i,j)
782 END DO
783 END DO
784
785# else
786
787
788
792 DO j=jstr,jend
793 DO i=istr,iend
794 tl_cff=-cff1*tl_rho(i,j,k)*hz(i,j,k)
795# ifdef MASKING
796 tl_cff=tl_cff*rmask(i,j)
797# endif
798 tl_zeta(i,j,linp)=tl_zeta(i,j,linp)+tl_cff
799 END DO
800 END DO
801 END DO
802
803
804
805
806
807
808
809
812 DO j=jstr,jend
813 DO i=istr,iend
815 zwtop=abs(z_w(i,j,k ))
816 zwbot=abs(z_w(i,j,k-1))
818 tl_cff=-cff1*tl_rho(i,j,k)*hz(i,j,k)
819# ifdef MASKING
820 tl_cff=tl_cff*rmask(i,j)
821# endif
822 tl_zeta(i,j,linp)=tl_zeta(i,j,linp)+tl_cff
825 zphi=abs(z_r(i,j,k))
828 tl_cff=-cff1*tl_rho(i,j,k)*hz(i,j,k)
829 ELSE
830 zphi1=abs(z_r(i,j,k+1))
832 tl_cff=-cff1* &
833 & (tl_rho(i,j,k+1)+ &
834 & fac*(tl_rho(i,j,k)-tl_rho(i,j,k+1)))* &
836 END IF
837 ELSE
838 IF (k.eq.1) THEN
839 tl_cff=-cff1*tl_rho(i,j,k)*hz(i,j,k)
840 ELSE
841 zphi1=abs(z_r(i,j,k-1))
843 tl_cff=-cff1* &
844 & (tl_rho(i,j,k)+ &
845 & fac*(tl_rho(i,j,k-1)-tl_rho(i,j,k)))* &
847 END IF
848 END IF
849# ifdef MASKING
850 tl_cff=tl_cff*rmask(i,j)
851# endif
852 tl_zeta(i,j,linp)=tl_zeta(i,j,linp)+tl_cff
853 END IF
854 END DO
855 END DO
856 END DO
857 END IF
858# endif
859
862 & lbi, ubi, lbj, ubj, &
863 & tl_zeta(:,:,linp))
864 END IF
865# ifdef DISTRIBUTE
867 & lbi, ubi, lbj, ubj, &
870 & tl_zeta(:,:,linp))
871# endif
872 END IF
873
874 RETURN
subroutine exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
subroutine exchange_u3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
subroutine exchange_r3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
subroutine exchange_v3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
integer, dimension(:), allocatable istvar
integer, dimension(:), allocatable n
real(r8), dimension(:), allocatable ml_depth
real(r8), dimension(:), allocatable dtdz_min
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
logical, dimension(:), allocatable balance
real(r8), dimension(:), allocatable lnm_depth
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)
subroutine, public u2d_bc(ng, tile, lbi, ubi, lbj, ubj, a)
subroutine, public r2d_bc(ng, tile, lbi, ubi, lbj, ubj, a)
subroutine, public v2d_bc(ng, tile, lbi, ubi, lbj, ubj, a)
subroutine, public tl_biconj_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, lbck, h, pmon_u, pnom_v, pm, pn, umask, vmask, rmask, bc_ak, bc_bk, zdf1, zdf2, zdf3, pc_r2d, r_r2d, br_r2d, p_r2d, bp_r2d, tl_r2d_ref, tl_rhs_r2d)