00001 subroutine hydrostatic_eq_WL_peos(emd)
00002 use phys_constant, only : long
00003 use grid_parameter
00004 use def_matter, only : utf, omef, jomef, jomef_int
00005 use def_matter_parameter, only : ome, ber
00006 use def_metric_on_SFC_CF
00007 use def_metric_on_SFC_WL
00008 use coordinate_grav_r, only : rg
00009 use def_vector_phi, only : vec_phif
00010 use make_array_3d
00011 use interface_interpo_gr2fl
00012 implicit none
00013 real(long), pointer :: emd(:,:,:)
00014 real(long) :: vphif(3)
00015 real(long) :: ovufc(3), ovdfc(3)
00016 real(long) :: omefc, jomef_intfc
00017 real(long) :: hh, ut, pre, rho, ene, qq
00018 real(long) :: gmxxdf, gmxydf, gmxzdf, gmyxdf, gmyydf, gmyzdf,
00019 gmzxdf, gmzydf, gmzzdf, ovovf
00020 integer :: irf, itf, ipf
00021
00022 do ipf = 0, npf
00023 do itf = 0, ntf
00024 do irf = 0, nrf
00025 vphif(1) = vec_phif(irf,itf,ipf,1)
00026 vphif(2) = vec_phif(irf,itf,ipf,2)
00027 vphif(3) = vec_phif(irf,itf,ipf,3)
00028 omefc = omef(irf,itf,ipf)
00029 gmxxdf = 1.0d0 + hxxdf(irf,itf,ipf)
00030 gmxydf = hxydf(irf,itf,ipf)
00031 gmxzdf = hxzdf(irf,itf,ipf)
00032 gmyydf = 1.0d0 + hyydf(irf,itf,ipf)
00033 gmyzdf = hyzdf(irf,itf,ipf)
00034 gmzzdf = 1.0d0 + hzzdf(irf,itf,ipf)
00035 gmyxdf = gmxydf
00036 gmzxdf = gmxzdf
00037 gmzydf = gmyzdf
00038 ovufc(1) = bvxuf(irf,itf,ipf) + omefc*vphif(1)
00039 ovufc(2) = bvyuf(irf,itf,ipf) + omefc*vphif(2)
00040 ovufc(3) = bvzuf(irf,itf,ipf) + omefc*vphif(3)
00041 ovdfc(1) = bvxdf(irf,itf,ipf) &
00042 & + gmxxdf*omefc*vphif(1) + gmxydf*omefc*vphif(2) &
00043 & + gmxzdf*omefc*vphif(3)
00044 ovdfc(2) = bvydf(irf,itf,ipf) &
00045 & + gmyxdf*omefc*vphif(1) + gmyydf*omefc*vphif(2) &
00046 & + gmyzdf*omefc*vphif(3)
00047 ovdfc(3) = bvzdf(irf,itf,ipf) &
00048 & + gmzxdf*omefc*vphif(1) + gmzydf*omefc*vphif(2) &
00049 & + gmzzdf*omefc*vphif(3)
00050 ovovf = ovdfc(1)*ovufc(1) + ovdfc(2)*ovufc(2) + ovdfc(3)*ovufc(3)
00051 ut = 1.0d0/sqrt(alphf(irf,itf,ipf)**2 &
00052 & - psif(irf,itf,ipf)**4*ovovf)
00053 jomef_intfc = jomef_int(irf,itf,ipf)
00054 hh = ber*ut*dexp(-jomef_intfc)
00055 call peos_h2qprho(hh, qq, pre, rho, ene)
00056 emd(irf,itf,ipf) = qq
00057 utf(irf,itf,ipf) = ut
00058 end do
00059 end do
00060 end do
00061
00062 end subroutine hydrostatic_eq_WL_peos
