00001 subroutine iteration_poisson_bbh_test(iter_count)
00002 use phys_constant, only : long, nnrg, nntg, nnpg
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 make_array_2d
00010 use make_array_3d
00011 use interface_poisson_solver
00012 use interface_update_grfield
00013 use interface_error_metric_type0
00014 use interface_interpo_fl2gr
00015 use interface_sourceterm_poisson_solver_test
00016 use interface_sourceterm_exsurf_eqm_binary
00017 use interface_sourceterm_surface_int
00018 use interface_poisson_solver_binary_bhex_homosol
00019
00020 use interface_bh_boundary_test
00021 implicit none
00022 real(long), pointer :: sou(:,:,:), pot(:,:,:), psi_bak(:,:,:)
00023 real(long), pointer :: sou_exsurf(:,:), dsou_exsurf(:,:)
00024 real(long), pointer :: sou_bhsurf(:,:), dsou_bhsurf(:,:)
00025 real(long), pointer :: sou_outsurf(:,:), dsou_outsurf(:,:)
00026 real(long) :: error_psi, count
00027 integer :: iter_count, flag = 0
00028
00029 call alloc_array3d(sou,0,nrg,0,ntg,0,npg)
00030 call alloc_array3d(pot,0,nrg,0,ntg,0,npg)
00031 call alloc_array3d(psi_bak,0,nrg,0,ntg,0,npg)
00032 call alloc_array2d(sou_exsurf,0,ntg,0,npg)
00033 call alloc_array2d(dsou_exsurf,0,ntg,0,npg)
00034 call alloc_array2d(sou_bhsurf,0,ntg,0,npg)
00035 call alloc_array2d(dsou_bhsurf,0,ntg,0,npg)
00036 call alloc_array2d(sou_outsurf,0,ntg,0,npg)
00037 call alloc_array2d(dsou_outsurf,0,ntg,0,npg)
00038
00039 iter_count = 0
00040 do
00041 iter_count = iter_count + 1
00042 count = dble(iter_count)
00043 conv_gra = dmin1(conv0_gra,conv_ini*count)
00044 conv_den = dmin1(conv0_den,conv_ini*count)
00045
00046 call calc_vector_x_grav(1)
00047
00048 call calc_vector_phi_grav(1)
00049
00050
00051 sou(0:nrg,0:ntg,0:npg) = 0.0d0
00052 call reset_bh_boundary('d')
00053 call sourceterm_exsurf_eqm_binary(psi,sou_exsurf,dsou_exsurf)
00054 call sourceterm_surface_int(psi,0,sou_bhsurf,dsou_bhsurf)
00055 call sourceterm_surface_int(psi,nrg,sou_outsurf,dsou_outsurf)
00056
00057
00058
00059
00060
00061
00062
00063 call bh_boundary_test('dh',sou_bhsurf,dsou_bhsurf)
00064 call poisson_solver_binary_bhex_homosol('dh',sou,sou_exsurf,dsou_exsurf, &
00065 & sou_bhsurf,dsou_bhsurf, &
00066 & sou_outsurf,dsou_outsurf,pot)
00067 psi_bak = psi
00068 call update_grfield(pot,psi,conv_gra)
00069 call error_metric_type0(psi,psi_bak,error_psi,flag,'bh')
00070 call printout_error_metric(iter_count,error_psi)
00071 call reset_bh_boundary('d')
00072
00073 if (flag == 0) exit
00074 if (iter_count >= iter_max) exit
00075 if (iter_count >= 10 .and. error_psi > 1.5d0) exit
00076 flag = 0
00077 end do
00078
00079 deallocate(sou)
00080 deallocate(pot)
00081 deallocate(psi_bak)
00082 deallocate(sou_exsurf)
00083 deallocate(dsou_exsurf)
00084 deallocate(sou_bhsurf)
00085 deallocate(dsou_bhsurf)
00086 deallocate(sou_outsurf)
00087 deallocate(dsou_outsurf)
00088 end subroutine iteration_poisson_bbh_test