00001 subroutine calc_mass_WL_MHD
00002 use phys_constant, only : long, pi
00003 use grid_parameter, only : nrg, ntg, npg, nrf, ntf, npf
00004 use def_matter_parameter, only : radi
00005 use make_array_3d
00006 use def_quantities, only : admmass, komarmass, komarmass_nc
00007 use interface_source_adm_mass_WL
00008 use interface_source_adm_mass_WL_EMF
00009 use interface_source_komar_mass_peos
00010 use interface_source_komar_mass_peos_EMF
00011 use interface_source_komar_mass_compact_WL
00012 use interface_source_komar_mass_compact_WL_EMF
00013 use interface_vol_int_grav
00014 use interface_vol_int_fluid
00015 implicit none
00016 real(long) :: fac2pi, fac4pi
00017 real(long) :: volg, volf
00018 real(long), pointer :: soug(:,:,:), souf(:,:,:), soug_EMF(:,:,:)
00019
00020
00021 call alloc_array3d(soug, 0, nrg, 0, ntg, 0, npg)
00022 call alloc_array3d(soug_EMF, 0, nrg, 0, ntg, 0, npg)
00023 call alloc_array3d(souf, 0, nrf, 0, ntf, 0, npf)
00024
00025 call source_adm_mass_WL(soug,souf)
00026 call source_adm_mass_WL_EMF(soug_EMF)
00027 soug(0:nrg,0:ntg,0:npg) = soug(0:nrg,0:ntg,0:npg) &
00028 & + soug_EMF(0:nrg,0:ntg,0:npg)
00029 call vol_int_grav(soug,volg)
00030 call vol_int_fluid(souf,volf)
00031
00032 fac2pi = 0.5d0/pi
00033 admmass = fac2pi*(radi*volg + radi**3*volf)
00034
00035 call source_komar_mass_peos(soug,souf)
00036 call source_komar_mass_peos_EMF(soug_EMF)
00037 soug(0:nrg,0:ntg,0:npg) = soug(0:nrg,0:ntg,0:npg) &
00038 & + soug_EMF(0:nrg,0:ntg,0:npg)
00039 call vol_int_grav(soug,volg)
00040 call vol_int_fluid(souf,volf)
00041
00042 fac4pi = 0.25d0/pi
00043 komarmass_nc = fac4pi*(radi*volg + radi**3*volf)
00044
00045 call source_komar_mass_compact_WL(souf)
00046 call source_komar_mass_compact_WL_EMF(soug)
00047 call vol_int_grav(soug,volg)
00048 call vol_int_fluid(souf,volf)
00049
00050 komarmass = radi*volg + radi**3*volf
00051
00052 write (6,'(a20,1p,e14.6)') ' ADM mass = ', admmass
00053 write (6,'(a20,1p,e14.6)') ' Komar mass compact=', komarmass
00054 write (6,'(a20,1p,e14.6)') ' Komar mass noncomp=', komarmass_nc
00055
00056 deallocate(soug)
00057 deallocate(soug_EMF)
00058 deallocate(souf)
00059 end subroutine calc_mass_WL_MHD