00001 subroutine interpolation_fillup_binary_COCP(impt,fnchar,char,fnc)
00002 use phys_constant, only : long
00003 use grid_parameter_interpo, only : nrg_itp, ntg_itp, npg_itp
00004 use interface_interpolation_fillup_binary_parity_mpt
00005 use def_metric_mpt, only : psi_, alph_, bvxd_, bvyd_, bvzd_
00006 use copy_array_4dto3d_mpt
00007 use make_array_3d
00008 implicit none
00009 real(long), pointer :: fnc_itp(:,:,:), fnc(:,:,:)
00010 integer :: impt, impt_ex, irg
00011 character(len=4) :: fnchar
00012 character(len=2) :: char
00013
00014 if (impt.eq.1) impt_ex = 2
00015 if (impt.eq.2) impt_ex = 1
00016 call copy_grid_parameter_interpo_from_mpt(impt_ex)
00017 call copy_grid_parameter_binary_excision_interpo_from_mpt(impt_ex)
00018 call copy_coordinate_grav_extended_interpo_from_mpt(impt_ex)
00019 call alloc_array3d(fnc_itp,0,nrg_itp,0,ntg_itp,0,npg_itp)
00020 if (fnchar.eq.'psi ') call copy_array4dto3d_mpt(impt_ex,psi_,fnc_itp, &
00021 & 0,nrg_itp,0,ntg_itp,0,npg_itp)
00022 if (fnchar.eq.'alph') call copy_array4dto3d_mpt(impt_ex,alph_,fnc_itp, &
00023 & 0,nrg_itp,0,ntg_itp,0,npg_itp)
00024 if (fnchar.eq.'bvxd') call copy_array4dto3d_mpt(impt_ex,bvxd_,fnc_itp, &
00025 & 0,nrg_itp,0,ntg_itp,0,npg_itp)
00026 if (fnchar.eq.'bvyd') call copy_array4dto3d_mpt(impt_ex,bvyd_,fnc_itp, &
00027 & 0,nrg_itp,0,ntg_itp,0,npg_itp)
00028 if (fnchar.eq.'bvzd') call copy_array4dto3d_mpt(impt_ex,bvzd_,fnc_itp, &
00029 & 0,nrg_itp,0,ntg_itp,0,npg_itp)
00030 call interpolation_fillup_binary_parity_mpt(fnc,fnc_itp,char)
00031
00032 deallocate(fnc_itp)
00033
00034 end subroutine interpolation_fillup_binary_COCP
