00001 subroutine interpolation_fillup_cartesian_parity(fnc,fncca,par)
00002   use phys_constant, only : long
00003   use grid_parameter_cartesian, only : nx, ny, nz, nx_mid
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   implicit none
00008   real(long), pointer :: fnc(:,:,:)
00009   real(long), pointer :: fncca(:,:,:)
00010   real(long) :: xc, yc, zc, cfn, R, par
00011   integer :: ix, iy, iz
00012 
00013   do iz = 1, nz
00014     zc = z(iz)
00015     do iy = 1, ny
00016       yc = y(iy)
00017       do ix = 1, nx
00018         xc = x(ix)
00019         call interpo_gr2cgr_4th(fnc,cfn,xc,yc,zc)
00020         fncca(ix,iy,iz) = cfn
00021       end do
00022     end do
00023   end do
00024 
00025   do iz = 1, nz
00026     zc = z(iz)
00027     do iy = 1, ny
00028       yc = y(iy)
00029       do ix = 1, nx
00030         xc = x(ix)
00031         R = sqrt((xc-ex_rgmid)**2 + yc**2 + zc**2)
00032         if (R <= ex_radius*1.2d0) then
00033           call interpo_gr2cgr_4th(fnc,cfn,-xc+ex_rgmid,-yc,zc)
00034           fncca(ix,iy,iz) = par*cfn
00035         endif
00036       end do
00037     end do
00038   end do
00039 end subroutine interpolation_fillup_cartesian_parity