00001 subroutine interpolation_fillup_binary_parity_mpt(fnc,fnc_ex,parchar)
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   real(long) :: pari
00014   integer :: irg, itg, ipg, nrg_exin, nrg_exout
00015   character(len=2) :: parchar
00016 
00017   if (parchar.eq.'ev') pari = + 1.0d0
00018   if (parchar.eq.'od') pari = - 1.0d0
00019 
00020 
00021 
00022   do ipg = 0, npg
00023     do itg = 0, ntg
00024       nrg_exin  = irg_exin(itg,ipg)  + 1
00025       nrg_exout = irg_exout(itg,ipg) - 1
00026       if (nrg_exin.eq.0) cycle
00027       do irg = nrg_exin, nrg_exout
00028         rc = rb(irg,itg,ipg)
00029         thc = thb(irg,itg,ipg)
00030         phic = dmod(phib(irg,itg,ipg)+pi,2.0d0*pi)
00031         call interpo_gr2gr_4th_mpt(fnc_ex,cfn,rc,thc,phic)
00032         fnc(irg,itg,ipg) = cfn*pari
00033       end do
00034     end do
00035   end do
00036 
00037 end subroutine interpolation_fillup_binary_parity_mpt