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

Go to the documentation of this file.

subroutine calc_mass_WL_MHD
  use phys_constant, only  :   long, pi
  use grid_parameter, only :   nrg, ntg, npg, nrf, ntf, npf, ntgeq
  use coordinate_grav_r, only :   hrg
  use def_matter_parameter, only : radi
  use make_array_3d
  use def_quantities, only : admmass, komarmass, komarmass_nc
  use interface_source_adm_mass_WL
  use interface_source_adm_mass_WL_EMF
  use interface_source_komar_mass_peos
  use interface_source_komar_mass_peos_EMF
  use interface_source_komar_mass_compact_WL
  use interface_source_komar_mass_compact_WL_EMF
  use interface_vol_int_grav
  use interface_vol_int_fluid
  implicit none
  real(long)          :: fac2pi, fac4pi
  real(long)          :: volg, volf
  real(long), pointer :: soug(:,:,:), souf(:,:,:), soug_EMF(:,:,:)
  integer :: irg, itg, ipg
!
!
  call alloc_array3d(soug, 0, nrg, 0, ntg, 0, npg)
  call alloc_array3d(soug_EMF, 0, nrg, 0, ntg, 0, npg)
  call alloc_array3d(souf, 0, nrf, 0, ntf, 0, npf)
!      
  call source_adm_mass_WL(soug,souf)
  call source_adm_mass_WL_EMF(soug_EMF)
!!testtest
!       itg = ntgeq-2; ipg = 2
!!       itg = ntgeq; ipg = 2
!       fac2pi = 0.5d0/pi
!       open(15,file='test_vec_adm',status='unknown')
!       do irg = 1, nrg
!         write(15,'(1p,9e20.12)')  hrg(irg), fac2pi*radi*soug(irg,itg,ipg) &
!               &                           , fac2pi*radi*soug_EMF(irg,itg,ipg)
!       end do
!       close(15)
!!testtest
  soug(0:nrg,0:ntg,0:npg) = soug(0:nrg,0:ntg,0:npg)   &
  &                       + soug_EMF(0:nrg,0:ntg,0:npg)
  call vol_int_grav(soug,volg)
  call vol_int_fluid(souf,volf)
!
  fac2pi = 0.5d0/pi
  admmass = fac2pi*(radi*volg + radi**3*volf)
!
!testtest                                                                      
       open(16,file='test_vec_admf',status='unknown')
       do irg = 1, nrf
         write(16,'(1p,9e20.12)')  hrg(irg), fac2pi*radi**3*souf(irg,itg,ipg)
       end do
       close(16)
!testtest
!
  call source_komar_mass_peos(soug,souf)
  call source_komar_mass_peos_EMF(soug_EMF)
  soug(0:nrg,0:ntg,0:npg) = soug(0:nrg,0:ntg,0:npg)   &
  &                       + soug_EMF(0:nrg,0:ntg,0:npg)
  call vol_int_grav(soug,volg) 
  call vol_int_fluid(souf,volf)
!
  fac4pi = 0.25d0/pi
  komarmass_nc = fac4pi*(radi*volg + radi**3*volf)
!
  call source_komar_mass_compact_WL(souf)
  call source_komar_mass_compact_WL_EMF(soug)
  call vol_int_grav(soug,volg) 
  call vol_int_fluid(souf,volf)
!
  komarmass = radi*volg + radi**3*volf
!
  write (6,'(a20,1p,e14.6)') ' ADM   mass =       ', admmass
  write (6,'(a20,1p,e14.6)') ' Komar mass compact=', komarmass
  write (6,'(a20,1p,e14.6)') ' Komar mass noncomp=', komarmass_nc
!
  deallocate(soug)
  deallocate(soug_EMF)
  deallocate(souf)
end subroutine calc_mass_WL_MHD

---