00001 subroutine hydrostatic_eq(emd)
00002 use phys_constant, only : long
00003 use grid_parameter
00004 use def_matter, only : rs
00005 use def_matter_parameter, only : pinx, ome, ber
00006 use def_metric, only : alph, psi, bvxd, bvyd, bvzd
00007 use coordinate_grav_r, only : rg
00008 use trigonometry_grav_theta, only : sinthg, costhg
00009 use trigonometry_grav_phi, only : sinphig, cosphig
00010 use def_vector_phi, only : vec_phif
00011 use make_array_3d
00012 use interface_interpo_gr2fl
00013 implicit none
00014 real(long), pointer :: emd(:,:,:)
00015 real(long), pointer :: alphf(:,:,:), psif(:,:,:)
00016 real(long), pointer :: bvxdf(:,:,:), bvydf(:,:,:), bvzdf(:,:,:)
00017 real(long) :: vphif(3)
00018 real(long) :: ovufc(3)
00019 real(long) :: ovufc2
00020 real(long) :: hh, ut
00021 integer :: irf, itf, ipf
00022 call alloc_array3d(psif, 0, nrf, 0, ntf, 0, npf)
00023 call alloc_array3d(alphf, 0, nrf, 0, ntf, 0, npf)
00024 call alloc_array3d(bvxdf, 0, nrf, 0, ntf, 0, npf)
00025 call alloc_array3d(bvydf, 0, nrf, 0, ntf, 0, npf)
00026 call alloc_array3d(bvzdf, 0, nrf, 0, ntf, 0, npf)
00027 call interpo_gr2fl(alph, alphf)
00028 call interpo_gr2fl(psi, psif)
00029 call interpo_gr2fl(bvxd, bvxdf)
00030 call interpo_gr2fl(bvyd, bvydf)
00031 call interpo_gr2fl(bvzd, bvzdf)
00032
00033 do ipf = 0, npf
00034 do itf = 0, ntf
00035 do irf = 0, nrf
00036 vphif(1) = vec_phif(irf,itf,ipf,1)
00037 vphif(2) = vec_phif(irf,itf,ipf,2)
00038 vphif(3) = vec_phif(irf,itf,ipf,3)
00039 ovufc(1) = bvxdf(irf,itf,ipf) + ome*vphif(1)
00040 ovufc(2) = bvydf(irf,itf,ipf) + ome*vphif(2)
00041 ovufc(3) = bvzdf(irf,itf,ipf) + ome*vphif(3)
00042 ovufc2 = ovufc(1)**2 + ovufc(2)**2 + ovufc(3)**2
00043 ut = 1.0d0/sqrt(alphf(irf,itf,ipf)**2 &
00044 & - psif(irf,itf,ipf)**4*ovufc2)
00045 hh = ber*ut
00046 emd(irf,itf,ipf) = 1.0d0/(pinx+1.0d0)*(hh-1.0d0)
00047 end do
00048 end do
00049 end do
00050
00051 deallocate(alphf)
00052 deallocate(psif)
00053 deallocate(bvxdf)
00054 deallocate(bvydf)
00055 deallocate(bvzdf)
00056 end subroutine hydrostatic_eq
