00001 subroutine interpolation_fillup_cartesian_mpt(fnc, fncca, impt, impt_ex)
00002 use phys_constant, only : long
00003 use grid_parameter_cartesian, only : nx, ny, nz
00004 use grid_parameter_binary_excision, only : ex_rgmid, ex_radius
00005 use coordinate_grav_xyz, only : x, y, z
00006 use def_binary_parameter, only : dis
00007 use interface_modules_cartesian
00008 implicit none
00009 real(long), pointer :: fnc(:,:,:)
00010 real(long), pointer :: fncca(:,:,:)
00011 real(long) :: xc, yc, zc, cfn, R
00012 integer :: ix, iy, iz, impt, impt_ex
00013
00014 do iz = 1, nz
00015 zc = z(iz)
00016 do iy = 1, ny
00017 yc = y(iy)
00018 do ix = 1, nx
00019 xc = x(ix)
00020 call interpo_gr2cgr_4th(fnc,cfn,xc,yc,zc)
00021 fncca(ix,iy,iz) = cfn
00022 end do
00023 end do
00024 end do
00025
00026 call copy_from_mpatch_interpolation_utility(impt_ex)
00027 call copy_poisson_solver_test_from_mpt(impt_ex)
00028 do iz = 1, nz
00029 zc = z(iz)
00030 do iy = 1, ny
00031 yc = - y(iy)
00032 do ix = 1, nx
00033 xc = x(ix)
00034 R = sqrt((xc-ex_rgmid)**2+ yc**2 + zc**2)
00035 if (R <= ex_radius*1.45d0.and.xc >= dis) then
00036 call interpo_gr2cgr_4th(fnc,cfn,-xc+ex_rgmid,-yc,zc)
00037 fncca(ix,iy,iz) = cfn
00038 endif
00039 end do
00040 end do
00041 end do
00042 call copy_from_mpatch_interpolation_utility(impt)
00043 call copy_poisson_solver_test_from_mpt(impt)
00044 end subroutine interpolation_fillup_cartesian_mpt