00001 subroutine interpolation_fillup_cartesian_bh_all
00002 use phys_constant, only : long
00003 use def_metric
00004 use def_metric_cartesian
00005 use grid_parameter_cartesian, only : nx, ny, nz
00006 use grid_parameter_binary_excision, only : ex_rgmid, ex_radius
00007 use coordinate_grav_xyz, only : x, y, z
00008 use interface_modules_cartesian
00009 use grid_parameter, only : rgin
00010 implicit none
00011 real(long) :: xc, yc, zc, cfn, R
00012 integer :: ix, iy, iz
00013 real(long) :: r1,r2, cpsi,calph,cbvxd,cbvyd,cbvzd
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(psi,cpsi,xc,yc,zc)
00025 call interpo_gr2cgr_4th(alph,calph,xc,yc,zc)
00026 call interpo_gr2cgr_4th(bvxd,cbvxd,xc,yc,zc)
00027 call interpo_gr2cgr_4th(bvyd,cbvyd,xc,yc,zc)
00028 call interpo_gr2cgr_4th(bvzd,cbvzd,xc,yc,zc)
00029 psica(ix,iy,iz) = cpsi
00030 alphca(ix,iy,iz) = calph
00031 bvxdca(ix,iy,iz) = cbvxd
00032 bvydca(ix,iy,iz) = cbvyd
00033 bvzdca(ix,iy,iz) = cbvzd
00034 else
00035 psica(ix,iy,iz) = 0.0d0
00036 alphca(ix,iy,iz) = 0.0d0
00037 bvxdca(ix,iy,iz) = 0.0d0
00038 bvydca(ix,iy,iz) = 0.0d0
00039 bvzdca(ix,iy,iz) = 0.0d0
00040 endif
00041 end do
00042 end do
00043 end do
00044
00045 do iz = 1, nz
00046 zc = z(iz)
00047 do iy = 1, ny
00048 yc = y(iy)
00049 do ix = 1, nx
00050 xc = x(ix)
00051 R = sqrt((xc-ex_rgmid)**2 + yc**2 + zc**2)
00052 if ((R <= ex_radius*1.2d0).and.(R>=rgin)) then
00053 call interpo_gr2cgr_4th(psi ,cpsi ,-xc+ex_rgmid,-yc,zc)
00054 call interpo_gr2cgr_4th(alph,calph,-xc+ex_rgmid,-yc,zc)
00055 call interpo_gr2cgr_4th(bvxd,cbvxd,-xc+ex_rgmid,-yc,zc)
00056 call interpo_gr2cgr_4th(bvyd,cbvyd,-xc+ex_rgmid,-yc,zc)
00057 call interpo_gr2cgr_4th(bvzd,cbvzd,-xc+ex_rgmid,-yc,zc)
00058 psica(ix,iy,iz) = cpsi
00059 alphca(ix,iy,iz) = calph
00060 bvxdca(ix,iy,iz) = -cbvxd
00061 bvydca(ix,iy,iz) = -cbvyd
00062 bvzdca(ix,iy,iz) = +cbvzd
00063 endif
00064 end do
00065 end do
00066 end do
00067 end subroutine interpolation_fillup_cartesian_bh_all
