531
532
537
538
539
540 integer, intent(in) :: ng, tile
541 integer, intent(in) :: LBi, UBi, LBj, UBj, LBij, UBij
542 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
543 integer, intent(in) :: Linp
544
545# ifdef ASSUMED_SHAPE
546# ifdef MASKING
547 real(r8), intent(in) :: umask(LBi:,LBj:)
548 real(r8), intent(in) :: vmask(LBi:,LBj:)
549# endif
550 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
551 real(r8), intent(in) :: Hz_bry(LBij:,:,:)
552 real(r8), intent(in) :: tl_Hz(LBi:,LBj:,:)
553 real(r8), intent(in) :: tl_Hz_bry(LBij:,:,:)
554
555# else
556
557# ifdef MASKING
558 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
559 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
560# endif
561 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
562 real(r8), intent(in) :: Hz_bry(LBij:UBij,N(ng),4)
563 real(r8), intent(in) :: tl_Hz(LBi:UBi,LBj:UBj,N(ng))
564 real(r8), intent(in) :: tl_Hz_bry(LBij:UBij,N(ng),4)
565# endif
566
567
568
569 integer :: i, it1, it2, j, k
570
571 real(r8) :: fac, fac1, fac2
572 real(r8) :: cff1, cff2, tl_cff1, tl_cff2
573
574 real(r8), dimension(0:N(ng)) :: CF
575 real(r8), dimension(0:N(ng)) :: DC
576
577 real(r8), dimension(0:N(ng)) :: tl_CF
578 real(r8), dimension(0:N(ng)) :: tl_DC
579
580# include "set_bounds.h"
581
582
583
584
585
586
587
588 IF (
nbrec(ng).eq.1)
THEN
589 it1=1
590 it2=1
591 fac1=1.0_r8
592 fac2=0.0_r8
593 ELSE
594# ifdef GENERIC_DSTART
596# else
597 it1=max(0,(
iic(ng)-1)/
nobc(ng))+1
598# endif
599 it2=min(it1+1,
nbrec(ng))
602 fac=1.0_r8/(fac1+fac2)
603 fac1=fac*fac1
604 fac2=fac*fac2
605 END IF
606
607
608
609
612 &
domain(ng)%Western_Edge(tile))
THEN
614 DO j=jstr,jend
615 dc(0)=0.0_r8
616 tl_dc(0)=0.0_r8
617 cf(0)=0.0_r8
618 tl_cf(0)=0.0_r8
620 dc(k)=0.5_r8*(hz_bry(j,k,
iwest)+ &
621 & hz(i+1,j,k))
622 tl_dc(k)=0.5_r8*(tl_hz_bry(j,k,
iwest)+ &
623 & tl_hz(i+1,j,k))
624 dc(0)=dc(0)+dc(k)
625 tl_dc(0)=tl_dc(0)+tl_dc(k)
626 cf(0)=cf(0)+dc(k)*
boundary(ng)%u_west(j,k)
627 tl_cf(0)=tl_cf(0)+ &
628 & tl_dc(k)*
boundary(ng)%u_west(j,k)+ &
630 END DO
631 cff1=1.0_r8/dc(0)
632 tl_cff1=-cff1*cff1*tl_dc(0)
633 tl_cff2=tl_cf(0)*cff1+cf(0)*tl_cff1
634# ifdef MASKING
635 tl_cff2=tl_cff2*umask(i,j)
636# endif
637 boundary(ng)%tl_ubar_west(j)=tl_cff2
638 END DO
639 END IF
640
643 &
domain(ng)%Eastern_Edge(tile))
THEN
645 DO j=jstr,jend
646 dc(0)=0.0_r8
647 tl_dc(0)=0.0_r8
648 cf(0)=0.0_r8
649 tl_cf(0)=0.0_r8
651 dc(k)=0.5_r8*(hz(i-1,j,k)+ &
653 tl_dc(k)=0.5_r8*(tl_hz(i-1,j,k)+ &
654 & tl_hz_bry(j,k,
ieast))
655 dc(0)=dc(0)+dc(k)
656 tl_dc(0)=tl_dc(0)+tl_dc(k)
657 cf(0)=cf(0)+dc(k)*
boundary(ng)%u_east(j,k)
658 tl_cf(0)=tl_cf(0)+ &
659 & tl_dc(k)*
boundary(ng)%u_east(j,k)+ &
661 END DO
662 cff1=1.0_r8/dc(0)
663 tl_cff1=-cff1*cff1*tl_dc(0)
664 tl_cff2=tl_cf(0)*cff1+cf(0)*tl_cff1
665# ifdef MASKING
666 tl_cff2=tl_cff2*umask(i,j)
667# endif
668 boundary(ng)%tl_ubar_east(j)=tl_cff2
669 END DO
670 END IF
671
674 &
domain(ng)%Southern_Edge(tile))
THEN
676 DO i=istr,iend
677 dc(0)=0.0_r8
678 tl_dc(0)=0.0_r8
679 cf(0)=0.0_r8
680 tl_cf(0)=0.0_r8
682 dc(k)=0.5_r8*(hz_bry(i-1,k,
isouth)+ &
684 tl_dc(k)=0.5_r8*(tl_hz_bry(i-1,k,
isouth)+ &
686 dc(0)=dc(0)+dc(k)
687 tl_dc(0)=tl_dc(0)+tl_dc(k)
688 cf(0)=cf(0)+dc(k)*
boundary(ng)%u_south(i,k)
689 tl_cf(0)=tl_cf(0)+ &
690 & tl_dc(k)*
boundary(ng)%u_south(i,k)+ &
691 & dc(k)*
boundary(ng)%tl_u_south(i,k)
692 END DO
693 cff1=1.0_r8/dc(0)
694 tl_cff1=-cff1*cff1*tl_dc(0)
695 tl_cff2=tl_cf(0)*cff1+cf(0)*tl_cff1
696# ifdef MASKING
697 tl_cff2=tl_cff2*umask(i,j)
698# endif
699 boundary(ng)%tl_ubar_south(i)=tl_cff2
700 END DO
701 END IF
702
705 &
domain(ng)%Northern_Edge(tile))
THEN
707 DO i=istr,iend
708 dc(0)=0.0_r8
709 tl_dc(0)=0.0_r8
710 cf(0)=0.0_r8
711 tl_cf(0)=0.0_r8
713 dc(k)=0.5_r8*(hz_bry(i-1,k,
inorth)+ &
715 tl_dc(k)=0.5_r8*(tl_hz_bry(i-1,k,
inorth)+ &
717 dc(0)=dc(0)+dc(k)
718 tl_dc(0)=tl_dc(0)+tl_dc(k)
719 cf(0)=cf(0)+dc(k)*
boundary(ng)%u_north(i,k)
720 tl_cf(0)=tl_cf(0)+ &
721 & tl_dc(k)*
boundary(ng)%u_north(i,k)+ &
722 & dc(k)*
boundary(ng)%tl_u_north(i,k)
723 END DO
724 cff1=1.0_r8/dc(0)
725 tl_cff1=-cff1*cff1*tl_dc(0)
726 tl_cff2=tl_cf(0)*cff1+cf(0)*tl_cff1
727# ifdef MASKING
728 tl_cff2=tl_cff2*umask(i,j)
729# endif
730 boundary(ng)%tl_ubar_north(i)=tl_cff2
731 END DO
732 END IF
733
734
735
736
739 &
domain(ng)%Western_Edge(tile))
THEN
741 DO j=jstrv,jend
742 dc(0)=0.0_r8
743 tl_dc(0)=0.0_r8
744 cf(0)=0.0_r8
745 tl_cf(0)=0.0_r8
747 dc(k)=0.5_r8*(hz_bry(j-1,k,
iwest)+ &
748 & hz_bry(j ,k,
iwest))
749 tl_dc(k)=0.5_r8*(tl_hz_bry(j-1,k,
iwest)+ &
750 & tl_hz_bry(j ,k,
iwest))
751 dc(0)=dc(0)+dc(k)
752 tl_dc(0)=tl_dc(0)+tl_dc(k)
753 cf(0)=cf(0)+dc(k)*
boundary(ng)%v_west(j,k)
754 tl_cf(0)=tl_cf(0)+ &
755 & tl_dc(k)*
boundary(ng)%v_west(j,k)+ &
757 END DO
758 cff1=1.0_r8/dc(0)
759 tl_cff1=-cff1*cff1*tl_dc(0)
760 tl_cff2=tl_cf(0)*cff1+cf(0)*tl_cff1
761# ifdef MASKING
762 tl_cff2=tl_cff2*vmask(i,j)
763# endif
764 boundary(ng)%tl_vbar_west(j)=tl_cff2
765 END DO
766 END IF
767
770 &
domain(ng)%Eastern_Edge(tile))
THEN
772 DO j=jstrv,jend
773 dc(0)=0.0_r8
774 tl_dc(0)=0.0_r8
775 cf(0)=0.0_r8
776 tl_cf(0)=0.0_r8
778 dc(k)=0.5_r8*(hz_bry(j-1,k,
ieast)+ &
779 & hz_bry(j ,k,
ieast))
780 tl_dc(k)=0.5_r8*(tl_hz_bry(j-1,k,
ieast)+ &
781 & tl_hz_bry(j ,k,
ieast))
782 dc(0)=dc(0)+dc(k)
783 tl_dc(0)=tl_dc(0)+tl_dc(k)
784 cf(0)=cf(0)+dc(k)*
boundary(ng)%v_east(j,k)
785 tl_cf(0)=tl_cf(0)+ &
786 & tl_dc(k)*
boundary(ng)%v_east(j,k)+ &
788 END DO
789 cff1=1.0_r8/dc(0)
790 tl_cff1=-cff1*cff1*tl_dc(0)
791 tl_cff2=tl_cf(0)*cff1+cf(0)*tl_cff1
792# ifdef MASKING
793 tl_cff2=tl_cff2*vmask(i,j)
794# endif
795 boundary(ng)%tl_vbar_east(j)=tl_cff2
796 END DO
797 END IF
798
801 &
domain(ng)%Southern_Edge(tile))
THEN
803 DO i=istr,iend
804 dc(0)=0.0_r8
805 tl_dc(0)=0.0_r8
806 cf(0)=0.0_r8
807 tl_cf(0)=0.0_r8
809 dc(k)=0.5_r8*(hz_bry(i,k,
isouth)+ &
810 & hz(i+1,j,k))
811 tl_dc(k)=0.5_r8*(tl_hz_bry(i,k,
isouth)+ &
812 & tl_hz(i+1,j,k))
813 dc(0)=dc(0)+dc(k)
814 tl_dc(0)=tl_dc(0)+tl_dc(k)
815 cf(0)=cf(0)+dc(k)*
boundary(ng)%v_south(i,k)
816 tl_cf(0)=tl_cf(0)+ &
817 & tl_dc(k)*
boundary(ng)%v_south(i,k)+ &
818 & dc(k)*
boundary(ng)%tl_v_south(i,k)
819 END DO
820 cff1=1.0_r8/dc(0)
821 tl_cff1=-cff1*cff1*tl_dc(0)
822 tl_cff2=tl_cf(0)*cff1+cf(0)*tl_cff1
823# ifdef MASKING
824 tl_cff2=tl_cff2*vmask(i,j)
825# endif
826 boundary(ng)%tl_vbar_south(i)=tl_cff2
827 END DO
828 END IF
829
832 &
domain(ng)%Northern_Edge(tile))
THEN
834 DO i=istr,iend
835 dc(0)=0.0_r8
836 tl_dc(0)=0.0_r8
837 cf(0)=0.0_r8
838 tl_cf(0)=0.0_r8
840 dc(k)=0.5_r8*(hz(i,j-1,k)+ &
842 tl_dc(k)=0.5_r8*(tl_hz(i,j-1,k)+ &
844 dc(0)=dc(0)+dc(k)
845 tl_dc(0)=tl_dc(0)+tl_dc(k)
846 cf(0)=cf(0)+dc(k)*
boundary(ng)%v_north(i,k)
847 tl_cf(0)=tl_cf(0)+ &
848 & tl_dc(k)*
boundary(ng)%v_north(i,k)+ &
849 & dc(k)*
boundary(ng)%tl_v_north(i,k)
850 END DO
851 cff1=1.0_r8/dc(0)
852 tl_cff1=-cff1*cff1*tl_dc(0)
853 tl_cff2=tl_cf(0)*cff1+cf(0)*tl_cff1
854# ifdef MASKING
855 tl_cff2=tl_cff2*vmask(i,j)
856# endif
857 boundary(ng)%tl_vbar_north(i)=tl_cff2
858 END DO
859 END IF
860
861 RETURN
type(t_boundary), dimension(:), allocatable boundary
integer, dimension(:), allocatable n
type(t_bounds), dimension(:), allocatable bounds
type(t_lbc), dimension(:,:,:), allocatable tl_lbc
type(t_domain), dimension(:), allocatable domain
integer, parameter r2dvar
integer, dimension(:), allocatable iic
real(dp), dimension(:), allocatable dt
integer, dimension(:), allocatable nobc
logical, dimension(:,:,:), allocatable lobc
real(dp), dimension(:,:), allocatable obc_time
integer, parameter isouth
real(dp), dimension(:), allocatable time
integer, dimension(:), allocatable ntstart
integer, parameter inorth
integer, dimension(:), allocatable nbrec