00001 subroutine test_analytic_BHNS_solution_mpt(impt)
00002 use phys_constant, only : long, pi
00003 use grid_parameter, only : nrg, ntg, npg, nrf
00004 use def_metric, only : bvxd
00005 use coordinate_grav_r, only : rg
00006 use grid_points_binary_excision, only : rb
00007 implicit none
00008 integer :: irg, itg, ipg, impt
00009 real(long) :: zfac, small = 1.0d-15
00010
00011 do ipg = 0, npg
00012 do itg = 0, ntg
00013 do irg = 0, nrg
00014 if(impt.eq.1) then
00015 bvxd(irg,itg,ipg) = -(8.0d0*pi/3.0d0)*1.0d0/rg(irg) &
00016 & -(4.0d0*pi/3.0d0)*1.0d0/rb(irg,itg,ipg)
00017 end if
00018 if(impt.eq.2) then
00019 if(irg.lt.nrf) &
00020 & bvxd(irg,itg,ipg) = - 2.0d0*pi/3.0d0*(3.0d0-rg(irg)**2) &
00021 & -(8.0d0*pi/3.0d0)*1.0d0/rb(irg,itg,ipg)
00022 if(irg.ge.nrf) &
00023 & bvxd(irg,itg,ipg) = -(4.0d0*pi/3.0d0)*1.0d0/rg(irg) &
00024 & -(8.0d0*pi/3.0d0)*1.0d0/rb(irg,itg,ipg)
00025 end if
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036 end do
00037 end do
00038 end do
00039
00040 end subroutine test_analytic_BHNS_solution_mpt