00001 subroutine iteration_poisson_bbh_2pot_test_mpt(iter_count)
00002 use phys_constant, only : long, nnrg, nntg, nnpg, nmpt
00003 use grid_parameter
00004 use grid_parameter_interpo, only : nrg_itp, ntg_itp, npg_itp
00005 use coordinate_grav_r
00006 use coordinate_grav_phi
00007 use coordinate_grav_theta
00008 use weight_midpoint_grav
00009 use def_metric, only : psi, alph
00010 use def_metric_mpt, only : psi_, alph_
00011 use copy_array_4dto3d_mpt
00012 use make_array_2d
00013 use make_array_3d
00014 use interface_poisson_solver
00015 use interface_update_grfield
00016 use interface_error_metric
00017 use interface_error_metric_type0
00018 use interface_interpo_fl2gr
00019 use interface_sourceterm_poisson_solver_test
00020 use interface_sourceterm_exsurf_eqm_binary
00021 use interface_sourceterm_surface_int
00022
00023 use interface_sourceterm_2pot_test
00024 use interface_poisson_solver_binary_bhex_homosol
00025 use interface_bh_boundary_test_mpt
00026 use interface_bh_boundary_psi_test_mpt
00027 use interface_bh_boundary_alph_test_mpt
00028 use interface_bh_boundary_nh_psi_test
00029 use interface_bh_boundary_nh_alph_test
00030 use interface_interpolation_fillup_binary_mpt
00031
00032 use interface_bh_boundary_test
00033 implicit none
00034 real(long), pointer :: sou(:,:,:)
00035 real(long), pointer :: pot(:,:,:), psi_bak(:,:,:), alph_bak(:,:,:)
00036 real(long), pointer :: sou_exsurf(:,:), dsou_exsurf(:,:)
00037 real(long), pointer :: sou_bhsurf(:,:), dsou_bhsurf(:,:)
00038 real(long), pointer :: sou_outsurf(:,:), dsou_outsurf(:,:)
00039 real(long), pointer :: fnc_itp(:,:,:)
00040 real(long) :: error_psi =0.0d0, error_alph =0.0d0, error_tmp =0.0d0, count
00041 integer :: iter_count, flag_psi = 0, flag_alph = 0, flag_tmp = 0
00042 integer :: irf, itf, ipf, irg, itg, ipg, ihy, impt, impt_ex
00043
00044 call set_allocate_size_mpt
00045 call alloc_array3d(sou,0,nrg,0,ntg,0,npg)
00046 call alloc_array3d(pot,0,nrg,0,ntg,0,npg)
00047 call alloc_array3d(psi_bak,0,nrg,0,ntg,0,npg)
00048 call alloc_array3d(alph_bak,0,nrg,0,ntg,0,npg)
00049 call alloc_array3d(fnc_itp,0,nrg,0,ntg,0,npg)
00050 call alloc_array2d(sou_exsurf,0,ntg,0,npg)
00051 call alloc_array2d(dsou_exsurf,0,ntg,0,npg)
00052 call alloc_array2d(sou_bhsurf,0,ntg,0,npg)
00053 call alloc_array2d(dsou_bhsurf,0,ntg,0,npg)
00054 call alloc_array2d(sou_outsurf,0,ntg,0,npg)
00055 call alloc_array2d(dsou_outsurf,0,ntg,0,npg)
00056
00057 iter_count = 0
00058 do
00059 iter_count = iter_count + 1
00060 count = dble(iter_count)
00061
00062 do impt = 1, nmpt
00063 call copy_grid_parameter_from_mpt(impt)
00064 conv_gra = dmin1(conv0_gra,conv_ini*count)
00065 conv_den = dmin1(conv0_den,conv_ini*count)
00066 call copy_grid_parameter_to_mpt(impt)
00067
00068 call copy_from_mpatch_all_test(impt)
00069 call calc_vector_x_grav(0)
00070 call calc_vector_x_matter(0)
00071 call calc_vector_phi_grav(0)
00072 call calc_vector_phi_matter(0)
00073 call copy_to_mpatch_all_test(impt)
00074
00075
00076 sou(0:nrg,0:ntg,0:npg) = 0.0d0
00077 sou_exsurf(0:ntg,0:npg) = 0.0d0 ; dsou_exsurf(0:ntg,0:npg) = 0.0d0
00078 sou_bhsurf(0:ntg,0:npg) = 0.0d0 ; dsou_bhsurf(0:ntg,0:npg) = 0.0d0
00079 sou_outsurf(0:ntg,0:npg)= 0.0d0 ; dsou_outsurf(0:ntg,0:npg)= 0.0d0
00080
00081 if(impt.eq.1) impt_ex = 2
00082 if(impt.eq.2) impt_ex = 1
00083 call copy_from_mpatch_all_test(impt_ex)
00084 call copy_metric_and_matter_BHNS_test_from_mpt(impt_ex)
00085 call sourceterm_exsurf_eqm_binary(psi,sou_exsurf,dsou_exsurf)
00086 call copy_from_mpatch_all_test(impt)
00087 call copy_metric_and_matter_BHNS_test_from_mpt(impt)
00088
00089
00090
00091 call sourceterm_surface_int(psi,nrg,sou_outsurf,dsou_outsurf)
00092
00093
00094
00095
00096
00097 call bh_boundary_psi_test_mpt(impt,'n',sou_bhsurf,dsou_bhsurf)
00098 call poisson_solver_binary_bhex_homosol('nd',sou, &
00099 & sou_exsurf,dsou_exsurf, &
00100 & sou_bhsurf,dsou_bhsurf, &
00101 & sou_outsurf,dsou_outsurf,pot)
00102
00103 psi_bak(0:nrg,0:ntg,0:npg) = psi(0:nrg,0:ntg,0:npg)
00104 call update_grfield(pot,psi,conv_gra)
00105
00106 call copy_grid_parameter_interpo_from_mpt(impt_ex)
00107 call copy_grid_parameter_binary_excision_interpo_from_mpt(impt_ex)
00108 call copy_coordinate_grav_extended_interpo_from_mpt(impt_ex)
00109 call copy_array4dto3d_mpt(impt_ex,psi_,fnc_itp, &
00110 & 0,nrg_itp,0,ntg_itp,0,npg_itp)
00111 call interpolation_fillup_binary_mpt(psi,fnc_itp)
00112
00113 call error_metric_type0(psi,psi_bak,error_tmp,flag_tmp,'bh')
00114 flag_psi = max(flag_psi,flag_tmp)
00115 error_psi = dmax1(error_psi,error_tmp)
00116 call printout_error_metric(iter_count,error_psi)
00117 call reset_bh_boundary('n')
00118 call copy_to_mpatch_all_test(impt)
00119 call copy_metric_and_matter_BHNS_test_to_mpt(impt)
00120
00121
00122
00123 sou(0:nrg,0:ntg,0:npg) = 0.0d0
00124 sou_exsurf(0:ntg,0:npg) = 0.0d0 ; dsou_exsurf(0:ntg,0:npg) = 0.0d0
00125 sou_bhsurf(0:ntg,0:npg) = 0.0d0 ; dsou_bhsurf(0:ntg,0:npg) = 0.0d0
00126 sou_outsurf(0:ntg,0:npg)= 0.0d0 ; dsou_outsurf(0:ntg,0:npg)= 0.0d0
00127
00128 if(impt.eq.1) impt_ex = 2
00129 if(impt.eq.2) impt_ex = 1
00130 call copy_from_mpatch_all_test(impt_ex)
00131 call copy_metric_and_matter_BHNS_test_from_mpt(impt_ex)
00132 call sourceterm_exsurf_eqm_binary(alph,sou_exsurf,dsou_exsurf)
00133 call copy_from_mpatch_all_test(impt)
00134 call copy_metric_and_matter_BHNS_test_from_mpt(impt)
00135
00136
00137
00138
00139
00140 call sourceterm_surface_int(alph,nrg,sou_outsurf,dsou_outsurf)
00141
00142 call bh_boundary_alph_test_mpt(impt,'n',sou_bhsurf,dsou_bhsurf)
00143
00144 call sourceterm_2pot_test(sou)
00145
00146 call poisson_solver_binary_bhex_homosol('nd',sou, &
00147 & sou_exsurf,dsou_exsurf, &
00148 & sou_bhsurf,dsou_bhsurf, &
00149 & sou_outsurf,dsou_outsurf,pot)
00150 alph_bak(0:nrg,0:ntg,0:npg) = alph(0:nrg,0:ntg,0:npg)
00151 call update_grfield(pot,alph,conv_gra)
00152
00153 call copy_grid_parameter_interpo_from_mpt(impt_ex)
00154 call copy_grid_parameter_binary_excision_interpo_from_mpt(impt_ex)
00155 call copy_coordinate_grav_extended_interpo_from_mpt(impt_ex)
00156 call copy_array4dto3d_mpt(impt_ex,alph_,fnc_itp, &
00157 & 0,nrg_itp,0,ntg_itp,0,npg_itp)
00158 call interpolation_fillup_binary_mpt(alph,fnc_itp)
00159
00160 call error_metric_type0(alph,alph_bak,error_tmp,flag_tmp,'bh')
00161 flag_alph = max(flag_alph,flag_tmp)
00162 error_alph = dmax1(error_alph,error_tmp)
00163 call printout_error_metric(iter_count,error_alph)
00164 call reset_bh_boundary('n')
00165 call copy_to_mpatch_all_test(impt)
00166 call copy_metric_and_matter_BHNS_test_to_mpt(impt)
00167 end do
00168
00169 if ((flag_psi==0).and.(flag_alph==0)) exit
00170 if (iter_count >= iter_max) exit
00171 if (iter_count >= 150 .and. error_psi > 1.5d0) exit
00172 if (iter_count >= 150 .and. error_alph > 1.5d0) exit
00173 flag_psi = 0
00174 flag_alph = 0
00175 error_psi = 0.0d0
00176 error_alph = 0.0d0
00177 end do
00178
00179 deallocate(sou)
00180 deallocate(pot)
00181 deallocate(psi_bak)
00182 deallocate(alph_bak)
00183 deallocate(fnc_itp)
00184 deallocate(sou_exsurf)
00185 deallocate(dsou_exsurf)
00186 deallocate(sou_bhsurf)
00187 deallocate(dsou_bhsurf)
00188 deallocate(sou_outsurf)
00189 deallocate(dsou_outsurf)
00190 end subroutine iteration_poisson_bbh_2pot_test_mpt
