00001 subroutine iteration_poisson_bbh_2pot_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, alph
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
00019 use interface_sourceterm_2pot_test
00020 use interface_poisson_solver_binary_bhex_homosol
00021
00022
00023 use interface_bh_boundary_nh_psi_test
00024 use interface_bh_boundary_nh_alph_test
00025 use interface_interpolation_fillup_binary
00026
00027 implicit none
00028 real(long), pointer :: sou(:,:,:)
00029 real(long), pointer :: pot(:,:,:), psi_bak(:,:,:), alph_bak(:,:,:)
00030 real(long), pointer :: sou_exsurf(:,:), dsou_exsurf(:,:)
00031 real(long), pointer :: sou_bhsurf(:,:), dsou_bhsurf(:,:)
00032 real(long), pointer :: sou_outsurf(:,:), dsou_outsurf(:,:)
00033 real(long) :: error_psi, count, error_alph
00034 integer :: iter_count, flag_psi = 0, flag_alph = 0
00035
00036 call alloc_array3d(sou,0,nrg,0,ntg,0,npg)
00037 call alloc_array3d(pot,0,nrg,0,ntg,0,npg)
00038 call alloc_array3d(psi_bak,0,nrg,0,ntg,0,npg)
00039 call alloc_array3d(alph_bak,0,nrg,0,ntg,0,npg)
00040 call alloc_array2d(sou_exsurf,0,ntg,0,npg)
00041 call alloc_array2d(dsou_exsurf,0,ntg,0,npg)
00042 call alloc_array2d(sou_bhsurf,0,ntg,0,npg)
00043 call alloc_array2d(dsou_bhsurf,0,ntg,0,npg)
00044 call alloc_array2d(sou_outsurf,0,ntg,0,npg)
00045 call alloc_array2d(dsou_outsurf,0,ntg,0,npg)
00046
00047 iter_count = 0
00048 do
00049 iter_count = iter_count + 1
00050 count = dble(iter_count)
00051 conv_gra = dmin1(conv0_gra,conv_ini*count)
00052 conv_den = dmin1(conv0_den,conv_ini*count)
00053
00054 call calc_vector_x_grav(1)
00055
00056 call calc_vector_phi_grav(1)
00057
00058
00059
00060
00061
00062
00063 sou(0:nrg,0:ntg,0:npg) = 0.0d0
00064 call reset_bh_boundary('n')
00065 call sourceterm_exsurf_eqm_binary(psi,sou_exsurf,dsou_exsurf)
00066 call sourceterm_surface_int(psi,0,sou_bhsurf,dsou_bhsurf)
00067 call sourceterm_surface_int(psi,nrg,sou_outsurf,dsou_outsurf)
00068
00069 call bh_boundary_nh_psi_test(dsou_bhsurf)
00070 call poisson_solver_binary_bhex_homosol('nd',sou, &
00071 & sou_exsurf,dsou_exsurf, &
00072 & sou_bhsurf,dsou_bhsurf, &
00073 & sou_outsurf,dsou_outsurf,pot)
00074 psi_bak = psi
00075 call update_grfield(pot,psi,conv_gra)
00076 call interpolation_fillup_binary(psi)
00077 call error_metric_type0(psi,psi_bak,error_psi,flag_psi,'bh')
00078 call printout_error_metric(iter_count,error_psi)
00079 call reset_bh_boundary('n')
00080
00081
00082
00083
00084
00085 sou(0:nrg,0:ntg,0:npg) = 0.0d0
00086
00087 call sourceterm_2pot_test(sou)
00088 call sourceterm_exsurf_eqm_binary(alph,sou_exsurf,dsou_exsurf)
00089 call sourceterm_surface_int(alph,0,sou_bhsurf,dsou_bhsurf)
00090 call sourceterm_surface_int(alph,nrg,sou_outsurf,dsou_outsurf)
00091
00092 call bh_boundary_nh_alph_test(dsou_bhsurf)
00093 call poisson_solver_binary_bhex_homosol('nd',sou, &
00094 & sou_exsurf,dsou_exsurf, &
00095 & sou_bhsurf,dsou_bhsurf, &
00096 & sou_outsurf,dsou_outsurf,pot)
00097 alph_bak = alph
00098 call update_grfield(pot,alph,conv_gra)
00099 call interpolation_fillup_binary(alph)
00100 call error_metric_type0(alph,alph_bak,error_alph,flag_alph,'bh')
00101 call printout_error_metric(iter_count,error_alph)
00102 call reset_bh_boundary('n')
00103
00104 if ((flag_psi==0).and.(flag_alph==0)) exit
00105 if (iter_count >= iter_max) exit
00106 if (iter_count >= 50 .and. error_psi > 1.5d0) exit
00107 if (iter_count >= 50 .and. error_alph > 1.5d0) exit
00108 flag_psi = 0
00109 flag_alph = 0
00110 end do
00111
00112 deallocate(sou)
00113 deallocate(pot)
00114 deallocate(psi_bak)
00115 deallocate(alph_bak)
00116 deallocate(sou_exsurf)
00117 deallocate(dsou_exsurf)
00118 deallocate(sou_bhsurf)
00119 deallocate(dsou_bhsurf)
00120 deallocate(sou_outsurf)
00121 deallocate(dsou_outsurf)
00122 end subroutine iteration_poisson_bbh_2pot_test