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