00001 subroutine interpolation_fillup_cartesian_bh(fnc,fncca)
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 interface_modules_cartesian
00007 use grid_parameter, only : rgin
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
00013 real(long) :: r1,r2
00014
00015 do iz = 1, nz
00016 zc = z(iz)
00017 do iy = 1, ny
00018 yc = y(iy)
00019 do ix = 1, nx
00020 xc = x(ix)
00021 r1 = sqrt(xc**2 + yc**2 + zc**2)
00022 r2 = sqrt((xc-ex_rgmid)**2 + yc**2 + zc**2)
00023 if((r1.ge.rgin).and.(r2.ge.rgin)) then
00024 call interpo_gr2cgr_4th(fnc,cfn,xc,yc,zc)
00025 fncca(ix,iy,iz) = cfn
00026 else
00027 fncca(ix,iy,iz) = 0.0d0
00028 endif
00029 end do
00030 end do
00031 end do
00032
00033 do iz = 1, nz
00034 zc = z(iz)
00035 do iy = 1, ny
00036 yc = y(iy)
00037 do ix = 1, nx
00038 xc = x(ix)
00039 R = sqrt((xc-ex_rgmid)**2 + yc**2 + zc**2)
00040 if (R <= ex_radius*1.2d0) then
00041 call interpo_gr2cgr_4th(fnc,cfn,-xc+ex_rgmid,-yc,zc)
00042 fncca(ix,iy,iz) = cfn
00043 endif
00044 end do
00045 end do
00046 end do
00047 end subroutine interpolation_fillup_cartesian_bh