!---------------------------------------------------------------------
!     Copyright (C) GFD Dennou Club, 2006. All rights reserved.
!---------------------------------------------------------------------

module phys_vfilter_shapiro_mod
  !
  != $BJ*M}2aDx(B $B1tD>%U%#%k%?!<(B(Shapiro $B7?(B)$B%b%8%e!<%k(B
  !
  !== $B35MW(B
  !
  ! $B1tD>J}8~$K%U%#%k%?!<$1$1$k(B.
  ! Shapiro $B7?$N%U%#%k%?!<(B
  !
  !== HISTORY
  ! * 2006-12-14 M. Ishiwatari agcm5 $B@PEOHG$N(B p2zflt.F $B$h$j(Bimport
  !
  use type_mod,    only : REKIND, DBKIND, INTKIND, TOKEN, STRING

  implicit none

  private
  public :: phys_vfilter_shapiro
contains

  subroutine phys_vfilter_shapiro( 
    & xyz_VelLon , & !intent(inout)
    & xyz_VelLat , & !intent(inout)
    & xyz_Temp  , & !intent(inout)
    & GTUZF, & !intent(out)
    & GTVZF, & !intent(out)
    & GTTZF, & !intent(out)
    & DelTimePhy, & !intent(in)
    & xyr_Press  ) !intent(in)
    !
    != $B1tD>%U%#%k%?!<(B 3 $BE@%H%j%*$GJ]B8$5$;$kHG(B
    !
    !== $B35MW(B
    !
    ! $B1tD>J}8~$K%U%#%k%?!<$r$+$1$k(B. Shapiro (1971)
    !
    !== HISTORY
    ! * 2006-12-14  M.Ishiwatari AGCM5 $B@PEO%P!<%8%g%s$N(B p2zflt.F $B$h$j0\?"(B
    !
    use type_mod,      only: REKIND, DBKIND, INTKIND, TOKEN, STRING
    use grid_3d_mod,   only: im, jm, km

    real(DBKIND), intent(inout) :: xyz_Temp ( im,jm,km )  ! $B29EY(B   $B#T(B
    real(DBKIND), intent(inout) :: xyz_VelLon ( im,jm,km )  ! $BEl@>Iw(B $B#U(B
    real(DBKIND), intent(inout) :: xyz_VelLat ( im,jm,km )  ! $BFnKLIw(B $B#V(B

    real(DBKIND), intent(in) :: xyr_Press ( im,jm,km+1 )  !  ($B%@%_!<(B)
    real(DBKIND), intent(in) :: DelTimePhy ! 2 $B&$(Bt ($B$GNI$$$s$@$h$M(B?)

    real(DBKIND) :: SH                   ! $B%U%#%k%?78?t(B
    real(DBKIND) :: SM                   ! $B%U%#%k%?78?t(B

    DATA    SH / 0.5 /
    DATA    SM / 0.5 /

    ! $B$H$j$"$($:(B NAMELIST $B$K$h$k%Q%i%a!<%?F~NO$N<BAu$O%5%\$k(B
    !NAMELIST  /NMZFLT/ SH,SM
    !SAVE

    character(STRING),  parameter:: subname = "phys_vfilter_shapiro"
    integer(INTKIND) :: i
    integer(INTKIND) :: j
    integer(INTKIND) :: k

    real(DBKIND), intent(out) :: GTTZF (im,jm,km) ! $B%U%#%k%?#TJQ2=N((B
    real(DBKIND), intent(out) :: GTUZF (im,jm,km) ! $B%U%#%k%?#UJQ2=N((B
    real(DBKIND), intent(out) :: GTVZF (im,jm,km) ! $B%U%#%k%?#VJQ2=N((B

    ! $B$H$j$"$($:(B NAMELIST $B$K$h$k%Q%i%a!<%?F~NO$N<BAu$O%5%\$k(B

    ! $B3+;O=hM}(B
    call BeginSub(subname)

    GTTZF = 0.0d0 
    GTUZF = 0.0d0 
    GTVZF = 0.0d0 

    do j=1,jm
      do i=1,im
        GTTZF(i,j,1) = SH/2.0d0*(xyz_Temp(i,j,2)-xyz_Temp(i,j,1)) &
          &            /DelTimePhy
        GTUZF(i,j,1) = SM/2.0d0*(xyz_VelLon(i,j,2)-xyz_VelLon(i,j,1)) &
          &            /DelTimePhy
        GTVZF(i,j,1) = SM/2.0d0*(xyz_VelLat(i,j,2)-xyz_VelLat(i,j,1)) &
          &            /DelTimePhy
        do K=2, km-1
          GTTZF(I,J,K) &
            & = SH/2.0d0*( xyz_Temp(I,J,K-1)-2.0d0*xyz_Temp(I,J,K) &
            &           + xyz_Temp(I,J,K+1)) / DelTimePhy
          GTUZF(i,j,k) &
            & = SM/2.0d0*(  xyz_VelLon(i,j,k-1)-2.0d0*xyz_VelLon(i,j,k) &
            &             + xyz_VelLon(i,j,k+1)) / DelTimePhy
          GTVZF(i,j,k) &
            & = SM/2.0d0*(  xyz_VelLat(i,j,k-1)-2.0d0*xyz_VelLat(i,j,k) &
            &             + xyz_VelLat(i,j,k+1)) / DelTimePhy
        enddo
        GTTZF(i,j,km) & 
          & = SH/2.0d0*(xyz_Temp(i,j,km-1)-xyz_Temp(i,j,km))/DelTimePhy
        GTUZF(i,j,km) &
          & = SM/2.0d0*(xyz_VelLon(i,j,km-1)-xyz_VelLon(i,j,km))/DelTimePhy
        GTVZF(I,J,km) &
          & = SM/2.0d0*(xyz_VelLat(i,j,km-1)-xyz_VelLat(i,j,km))/DelTimePhy
      enddo
    enddo

    do i = 1, im
      do j = 1, jm
        do k=1,km
          xyz_Temp(i,j,k) = xyz_Temp(i,j,k) + GTTZF(i,j,k)*DelTimePhy
          xyz_VelLon(i,j,k) = xyz_VelLon(i,j,k) + GTUZF(i,j,k)*DelTimePhy
          xyz_VelLat(i,j,k) = xyz_VelLat(i,j,k) + GTVZF(i,j,k)*DelTimePhy
        enddo
      enddo
    enddo

  end subroutine phys_vfilter_shapiro
end module phys_vfilter_shapiro_mod


