/home/uryu/Cocal_svn_checkinout/Cocal/code/Subroutine/hydrostatic_eq_WL_peos.f90

Go to the documentation of this file.

subroutine hydrostatic_eq_WL_peos(emd)
  use phys_constant, only  : long
  use grid_parameter
!!!  use def_matter, only : rs
  use def_matter_parameter, only : ome, ber
  use def_matter, only : utf
  use def_metric_on_SFC_WL
  use coordinate_grav_r, only : rg
  use trigonometry_grav_theta, only : sinthg, costhg
  use trigonometry_grav_phi, only   : sinphig, cosphig
  use def_vector_phi, only : vec_phif
  use make_array_3d
  use interface_interpo_gr2fl
  implicit none
  real(long), pointer :: emd(:,:,:)
  real(long) :: vphif(3)
  real(long) :: ovufc(3), ovdfc(3)
  real(long) :: ovocf
  real(long) :: hh, ut, pre, rho, ene, qq
  real(long) :: gmxxdf, gmxydf, gmxzdf, gmyxdf, gmyydf, gmyzdf, 
               gmzxdf, gmzydf, gmzzdf, ovovf
  integer    :: irf, itf, ipf
!
  do ipf = 0, npf
    do itf = 0, ntf
      do irf = 0, nrf
        vphif(1) = vec_phif(irf,itf,ipf,1)
        vphif(2) = vec_phif(irf,itf,ipf,2)
        vphif(3) = vec_phif(irf,itf,ipf,3)
        gmxxdf = 1.0d0 + hxxdf(irf,itf,ipf)
        gmxydf =         hxydf(irf,itf,ipf)
        gmxzdf =         hxzdf(irf,itf,ipf)
        gmyydf = 1.0d0 + hyydf(irf,itf,ipf)
        gmyzdf =         hyzdf(irf,itf,ipf)
        gmzzdf = 1.0d0 + hzzdf(irf,itf,ipf)
        gmyxdf = gmxydf
        gmzxdf = gmxzdf
        gmzydf = gmyzdf
        ovufc(1) = bvxuf(irf,itf,ipf) + ome*vphif(1)
        ovufc(2) = bvyuf(irf,itf,ipf) + ome*vphif(2)
        ovufc(3) = bvzuf(irf,itf,ipf) + ome*vphif(3)
        ovdfc(1) = bvxdf(irf,itf,ipf) &
        &        + gmxxdf*ome*vphif(1) + gmxydf*ome*vphif(2) &
        &        + gmxzdf*ome*vphif(3)
        ovdfc(2) = bvydf(irf,itf,ipf) &
        &        + gmyxdf*ome*vphif(1) + gmyydf*ome*vphif(2) &
        &        + gmyzdf*ome*vphif(3)
        ovdfc(3) = bvzdf(irf,itf,ipf) &
        &        + gmzxdf*ome*vphif(1) + gmzydf*ome*vphif(2) &
        &        + gmzzdf*ome*vphif(3)
        ovovf = ovdfc(1)*ovufc(1) + ovdfc(2)*ovufc(2) + ovdfc(3)*ovufc(3)
        ut = 1.0d0/sqrt(alphf(irf,itf,ipf)**2 & 
      &                - psif(irf,itf,ipf)**4*ovovf)
        hh = ber*ut
        call peos_h2qprho(hh, qq, pre, rho, ene)
        emd(irf,itf,ipf) = qq
        utf(irf,itf,ipf) = ut
      end do
    end do
  end do
!
end subroutine hydrostatic_eq_WL_peos

---