559
560
565
566
567
568 integer, intent(in) :: ng, tile
569 integer, intent(in) :: LBi, UBi, LBj, UBj, LBij, UBij
570 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
571 integer, intent(in) :: Linp
572
573# ifdef ASSUMED_SHAPE
574# ifdef MASKING
575 real(r8), intent(in) :: umask(LBi:,LBj:)
576 real(r8), intent(in) :: vmask(LBi:,LBj:)
577# endif
578 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
579 real(r8), intent(in) :: Hz_bry(LBij:,:,:)
580 real(r8), intent(in) :: tl_Hz(LBi:,LBj:,:)
581 real(r8), intent(in) :: tl_Hz_bry(LBij:,:,:)
582
583# else
584
585# ifdef MASKING
586 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
587 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
588# endif
589 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
590 real(r8), intent(in) :: Hz_bry(LBij:UBij,N(ng),4)
591 real(r8), intent(in) :: tl_Hz(LBi:UBi,LBj:UBj,N(ng))
592 real(r8), intent(in) :: tl_Hz_bry(LBij:UBij,N(ng),4)
593# endif
594
595
596
597 integer :: i, it1, it2, j, k
598
599 real(r8) :: fac, fac1, fac2
600 real(r8) :: cff1, cff2, cff3, tl_cff1, tl_cff2
601
602 real(r8), dimension(0:N(ng)) :: CF
603 real(r8), dimension(0:N(ng)) :: DC
604
605 real(r8), dimension(0:N(ng)) :: tl_CF
606 real(r8), dimension(0:N(ng)) :: tl_DC
607
608# include "set_bounds.h"
609
610
611
612
613
614
615
616 IF (
nbrec(ng).eq.1)
THEN
617 it1=1
618 it2=1
619 fac1=1.0_r8
620 fac2=0.0_r8
621 ELSE
622# ifdef GENERIC_DSTART
624# else
625 it1=max(0,(
iic(ng)-1)/
nobc(ng))+1
626# endif
627 it2=min(it1+1,
nbrec(ng))
630 fac=1.0_r8/(fac1+fac2)
631 fac1=fac*fac1
632 fac2=fac*fac2
633 END IF
634
635
636
637
640 &
domain(ng)%Western_Edge(tile))
THEN
642 DO j=jstr,jend
643 dc(0)=0.0_r8
644 tl_dc(0)=0.0_r8
645 cf(0)=0.0_r8
646 tl_cf(0)=0.0_r8
650 dc(k)=0.5_r8*(hz_bry(j,k,
iwest)+ &
651 & hz(i+1,j,k))
652 tl_dc(k)=0.5_r8*(tl_hz_bry(j,k,
iwest)+ &
653 & tl_hz(i+1,j,k))
654 dc(0)=dc(0)+dc(k)
655 tl_dc(0)=tl_dc(0)+tl_dc(k)
656 cf(0)=cf(0)+dc(k)*
boundary(ng)%u_west(j,k)
657 tl_cf(0)=tl_cf(0)+ &
658 & tl_dc(k)*
boundary(ng)%u_west(j,k)+ &
659 & dc(k)*cff3
660 END DO
661 cff1=1.0_r8/dc(0)
662 tl_cff1=-cff1*cff1*tl_dc(0)
663 tl_cff2=tl_cf(0)*cff1+cf(0)*tl_cff1
664# ifdef MASKING
665 tl_cff2=tl_cff2*umask(i,j)
666# endif
668 & tl_cff2
669 END DO
670 END IF
671
674 &
domain(ng)%Eastern_Edge(tile))
THEN
676 DO j=jstr,jend
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
684 dc(k)=0.5_r8*(hz(i-1,j,k)+ &
686 tl_dc(k)=0.5_r8*(tl_hz(i-1,j,k)+ &
687 & tl_hz_bry(j,k,
ieast))
688 dc(0)=dc(0)+dc(k)
689 tl_dc(0)=tl_dc(0)+tl_dc(k)
690 cf(0)=cf(0)+dc(k)*
boundary(ng)%u_east(j,k)
691 tl_cf(0)=tl_cf(0)+ &
692 & tl_dc(k)*
boundary(ng)%u_east(j,k)+ &
693 & dc(k)*cff3
694 END DO
695 cff1=1.0_r8/dc(0)
696 tl_cff1=-cff1*cff1*tl_dc(0)
697 tl_cff2=tl_cf(0)*cff1+cf(0)*tl_cff1
698# ifdef MASKING
699 tl_cff2=tl_cff2*umask(i,j)
700# endif
702 & tl_cff2
703 END DO
704 END IF
705
708 &
domain(ng)%Southern_Edge(tile))
THEN
710 DO i=istr,iend
711 dc(0)=0.0_r8
712 tl_dc(0)=0.0_r8
713 cf(0)=0.0_r8
714 tl_cf(0)=0.0_r8
718 dc(k)=0.5_r8*(hz_bry(i-1,k,
isouth)+ &
720 tl_dc(k)=0.5_r8*(tl_hz_bry(i-1,k,
isouth)+ &
722 dc(0)=dc(0)+dc(k)
723 tl_dc(0)=tl_dc(0)+tl_dc(k)
724 cf(0)=cf(0)+dc(k)*
boundary(ng)%u_south(i,k)
725 tl_cf(0)=tl_cf(0)+ &
726 & tl_dc(k)*
boundary(ng)%u_south(i,k)+ &
727 & dc(k)*cff3
728 END DO
729 cff1=1.0_r8/dc(0)
730 tl_cff1=-cff1*cff1*tl_dc(0)
731 tl_cff2=tl_cf(0)*cff1+cf(0)*tl_cff1
732# ifdef MASKING
733 tl_cff2=tl_cff2*umask(i,j)
734# endif
736 & tl_cff2
737 END DO
738 END IF
739
742 &
domain(ng)%Northern_Edge(tile))
THEN
744 DO i=istr,iend
745 dc(0)=0.0_r8
746 tl_dc(0)=0.0_r8
747 cf(0)=0.0_r8
748 tl_cf(0)=0.0_r8
752 dc(k)=0.5_r8*(hz_bry(i-1,k,
inorth)+ &
754 tl_dc(k)=0.5_r8*(tl_hz_bry(i-1,k,
inorth)+ &
756 dc(0)=dc(0)+dc(k)
757 tl_dc(0)=tl_dc(0)+tl_dc(k)
758 cf(0)=cf(0)+dc(k)*
boundary(ng)%u_north(i,k)
759 tl_cf(0)=tl_cf(0)+ &
760 & tl_dc(k)*
boundary(ng)%u_north(i,k)+ &
761 & dc(k)*cff3
762 END DO
763 cff1=1.0_r8/dc(0)
764 tl_cff1=-cff1*cff1*tl_dc(0)
765 tl_cff2=tl_cf(0)*cff1+cf(0)*tl_cff1
766# ifdef MASKING
767 tl_cff2=tl_cff2*umask(i,j)
768# endif
770 & tl_cff2
771 END DO
772 END IF
773
774
775
776
779 &
domain(ng)%Western_Edge(tile))
THEN
781 DO j=jstrv,jend
782 dc(0)=0.0_r8
783 tl_dc(0)=0.0_r8
784 cf(0)=0.0_r8
785 tl_cf(0)=0.0_r8
789 dc(k)=0.5_r8*(hz_bry(j-1,k,
iwest)+ &
790 & hz_bry(j ,k,
iwest))
791 tl_dc(k)=0.5_r8*(tl_hz_bry(j-1,k,
iwest)+ &
792 & tl_hz_bry(j ,k,
iwest))
793 dc(0)=dc(0)+dc(k)
794 tl_dc(0)=tl_dc(0)+tl_dc(k)
795 cf(0)=cf(0)+dc(k)*
boundary(ng)%v_west(j,k)
796 tl_cf(0)=tl_cf(0)+ &
797 & tl_dc(k)*
boundary(ng)%v_west(j,k)+ &
798 & dc(k)*cff3
799 END DO
800 cff1=1.0_r8/dc(0)
801 tl_cff1=-cff1*cff1*tl_dc(0)
802 tl_cff2=tl_cf(0)*cff1+cf(0)*tl_cff1
803# ifdef MASKING
804 tl_cff2=tl_cff2*vmask(i,j)
805# endif
807 & tl_cff2
808 END DO
809 END IF
810
813 &
domain(ng)%Eastern_Edge(tile))
THEN
815 DO j=jstrv,jend
816 dc(0)=0.0_r8
817 tl_dc(0)=0.0_r8
818 cf(0)=0.0_r8
819 tl_cf(0)=0.0_r8
823 dc(k)=0.5_r8*(hz_bry(j-1,k,
ieast)+ &
824 & hz_bry(j ,k,
ieast))
825 tl_dc(k)=0.5_r8*(tl_hz_bry(j-1,k,
ieast)+ &
826 & tl_hz_bry(j ,k,
ieast))
827 dc(0)=dc(0)+dc(k)
828 tl_dc(0)=tl_dc(0)+tl_dc(k)
829 cf(0)=cf(0)+dc(k)*
boundary(ng)%v_east(j,k)
830 tl_cf(0)=tl_cf(0)+ &
831 & tl_dc(k)*
boundary(ng)%v_east(j,k)+ &
832 & dc(k)*cff3
833 END DO
834 cff1=1.0_r8/dc(0)
835 tl_cff1=-cff1*cff1*tl_dc(0)
836 tl_cff2=tl_cf(0)*cff1+cf(0)*tl_cff1
837# ifdef MASKING
838 tl_cff2=tl_cff2*vmask(i,j)
839# endif
841 & tl_cff2
842 END DO
843 END IF
844
847 &
domain(ng)%Southern_Edge(tile))
THEN
849 DO i=istr,iend
850 dc(0)=0.0_r8
851 tl_dc(0)=0.0_r8
852 cf(0)=0.0_r8
853 tl_cf(0)=0.0_r8
857 dc(k)=0.5_r8*(hz_bry(i,k,
isouth)+ &
858 & hz(i+1,j,k))
859 tl_dc(k)=0.5_r8*(tl_hz_bry(i,k,
isouth)+ &
860 & tl_hz(i+1,j,k))
861 dc(0)=dc(0)+dc(k)
862 tl_dc(0)=tl_dc(0)+tl_dc(k)
863 cf(0)=cf(0)+dc(k)*
boundary(ng)%v_south(i,k)
864 tl_cf(0)=tl_cf(0)+ &
865 & tl_dc(k)*
boundary(ng)%v_south(i,k)+ &
866 & dc(k)*cff3
867 END DO
868 cff1=1.0_r8/dc(0)
869 tl_cff1=-cff1*cff1*tl_dc(0)
870 tl_cff2=tl_cf(0)*cff1+cf(0)*tl_cff1
871# ifdef MASKING
872 tl_cff2=tl_cff2*vmask(i,j)
873# endif
875 & tl_cff2
876 END DO
877 END IF
878
881 &
domain(ng)%Northern_Edge(tile))
THEN
883 DO i=istr,iend
884 dc(0)=0.0_r8
885 tl_dc(0)=0.0_r8
886 cf(0)=0.0_r8
887 tl_cf(0)=0.0_r8
891 dc(k)=0.5_r8*(hz(i,j-1,k)+ &
893 tl_dc(k)=0.5_r8*(tl_hz(i,j-1,k)+ &
895 dc(0)=dc(0)+dc(k)
896 tl_dc(0)=tl_dc(0)+tl_dc(k)
897 cf(0)=cf(0)+dc(k)*
boundary(ng)%v_north(i,k)
898 tl_cf(0)=tl_cf(0)+ &
899 & tl_dc(k)*
boundary(ng)%v_north(i,k)+ &
900 & dc(k)*cff3
901 END DO
902 cff1=1.0_r8/dc(0)
903 tl_cff1=-cff1*cff1*tl_dc(0)
904 tl_cff2=tl_cf(0)*cff1+cf(0)*tl_cff1
905# ifdef MASKING
906 tl_cff2=tl_cff2*vmask(i,j)
907# endif
909 & tl_cff2
910 END DO
911 END IF
912
913 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