00001 subroutine iteration_helmholtz_solver_binary_test(iter_count)
00002 use phys_constant, only : long, nnrg, nntg, nnpg, nmpt
00003 use grid_parameter
00004 use coordinate_grav_r
00005 use coordinate_grav_phi
00006 use coordinate_grav_theta
00007 use weight_midpoint_grav
00008 use def_metric, only : psi
00009 use def_matter, only : emd, emdg
00010 use make_array_2d
00011 use make_array_3d
00012 use interface_update_grfield
00013 use interface_error_metric_type0
00014 use interface_interpo_fl2gr
00015 use interface_sourceterm_insurf_asymptotic_patch
00016 use interface_sourceterm_helmholtz_solver_test
00017 use interface_helmholtz_solver_binary
00018 use interface_helmholtz_solver_asymptotic_patch_homosol
00019 implicit none
00020 real(long), pointer :: sou(:,:,:), pot(:,:,:), psi_bak(:,:,:)
00021 real(long), pointer :: sou_insurf(:,:), dsou_insurf(:,:)
00022 real(long) :: error_psi, count
00023 integer :: iter_count, flag = 0, flag0 = 0, impt, impt_bin
00024 integer :: irf, itf, ipf, irg, itg, ipg, ihy
00025
00026 call set_allocate_size_mpt
00027
00028 call alloc_array2d(sou_insurf,0,ntg,0,npg)
00029 call alloc_array2d(dsou_insurf,0,ntg,0,npg)
00030 call alloc_array3d(sou,0,nrg,0,ntg,0,npg)
00031 call alloc_array3d(pot,0,nrg,0,ntg,0,npg)
00032 call alloc_array3d(psi_bak,0,nrg,0,ntg,0,npg)
00033
00034 iter_count = 0
00035 do
00036 iter_count = iter_count + 1
00037 count = dble(iter_count)
00038
00039 do impt = 1, nmpt
00040 call copy_grid_parameter_from_mpt(impt)
00041 conv_gra = dmin1(conv0_gra,conv_ini*count)
00042 conv_den = dmin1(conv0_den,conv_ini*count)
00043 call copy_grid_parameter_to_mpt(impt)
00044
00045 call copy_from_mpatch_helmholtz_test(impt)
00046 call calc_vector_x_grav(0)
00047 call calc_vector_x_matter(0)
00048 call calc_vector_phi_grav(0)
00049 call calc_vector_phi_matter(0)
00050 call copy_to_mpatch_helmholtz_test(impt)
00051
00052 call copy_from_mpatch_helmholtz_test(impt)
00053 call copy_metric_and_matter_BHNS_test_from_mpt(impt)
00054 if (impt.eq.1) then
00055 call sourceterm_helmholtz_solver_test(sou)
00056 call helmholtz_solver_binary(psi,sou,pot)
00057 end if
00058 if (impt.eq.2) then
00059 sou = 0.0d0
00060 impt_bin = 1
00061 call copy_from_mpatch_helmholtz_test(impt_bin)
00062 call copy_metric_and_matter_BHNS_test_from_mpt(impt_bin)
00063 call sourceterm_insurf_asymptotic_patch(impt_bin,impt,psi, &
00064 & sou_insurf,dsou_insurf)
00065 call copy_from_mpatch_helmholtz_test(impt)
00066 call copy_metric_and_matter_BHNS_test_from_mpt(impt)
00067 call helmholtz_solver_asymptotic_patch_homosol(psi,sou,&
00068 & sou_insurf,dsou_insurf,pot)
00069 end if
00070
00071 psi_bak(0:nrg,0:ntg,0:npg) = psi(0:nrg,0:ntg,0:npg)
00072 call update_grfield(pot,psi,conv_gra)
00073 if (impt.eq.1) call error_metric_type0(psi,psi_bak,error_psi,flag0,'ns')
00074 if (impt.eq.2) call error_metric_type0(psi,psi_bak,error_psi,flag0,'bh')
00075 flag = flag + flag0
00076 call printout_error_metric(iter_count,error_psi)
00077 call copy_to_mpatch_helmholtz_test(impt)
00078 call copy_metric_and_matter_BHNS_test_to_mpt(impt)
00079 end do
00080
00081 if (flag == 0) exit
00082 if (iter_count >= iter_max) exit
00083 if (iter_count >= 20 .and. error_psi > 1.5d0) exit
00084 flag = 0
00085 flag0 = 0
00086 end do
00087
00088 deallocate(sou)
00089 deallocate(sou_insurf)
00090 deallocate(dsou_insurf)
00091 deallocate(pot)
00092 deallocate(psi_bak)
00093 end subroutine iteration_helmholtz_solver_binary_test
