00001 subroutine interpolation_fillup_binary_mpt(fnc,fnc_ex)
00002 use phys_constant, only : long, pi
00003 use grid_parameter, only : ntg, npg, rgin
00004 use grid_parameter_binary_excision, only : ex_rgmid, ex_radius
00005 use grid_points_binary_excision, only : rb, thb, phib, irg_exin, irg_exout
00006 use coordinate_grav_r, only : rg
00007 use coordinate_grav_theta, only : thg
00008 use coordinate_grav_phi, only : phig
00009 use interface_interpo_gr2gr_4th_mpt
00010 implicit none
00011 real(long), pointer :: fnc(:,:,:), fnc_ex(:,:,:)
00012 real(long) :: rc, thc, phic, cfn
00013 integer :: irg, itg, ipg, nrg_exin, nrg_exout
00014
00015
00016
00017 do ipg = 0, npg
00018 do itg = 0, ntg
00019 nrg_exin = irg_exin(itg,ipg) + 1
00020 nrg_exout = irg_exout(itg,ipg) - 1
00021 if (nrg_exin.eq.0) cycle
00022 do irg = nrg_exin, nrg_exout
00023 rc = rb(irg,itg,ipg)
00024 thc = thb(irg,itg,ipg)
00025 phic = dmod(phib(irg,itg,ipg)+pi,2.0d0*pi)
00026 call interpo_gr2gr_4th_mpt(fnc_ex,cfn,rc,thc,phic)
00027 fnc(irg,itg,ipg) = cfn
00028 end do
00029 end do
00030 end do
00031
00032 end subroutine interpolation_fillup_binary_mpt