00001 subroutine poisson_solver_binary_star_homosol(char_bc,sou, &
00002            &                                      sou_exsurf,dsou_exsurf, &
00003            &                                     sou_outsurf,dsou_outsurf,pot)
00004   use phys_constant,  only : long
00005   use grid_parameter, only : nrg, npg, ntg, npgxzm, npgxzp, ntgeq
00006   use make_array_3d
00007   use interface_poisson_solver_binary_vol_int
00008   use interface_poisson_solver_binary_surf_int
00009   use interface_poisson_solver_bhex_surf_int
00010   use interface_sourceterm_surface_int_homosol
00011   use interface_copy_to_hgfn_and_gfnsf
00012   use radial_green_fn_grav_bhex_sd
00013   use radial_green_fn_grav_bhex_nb
00014   implicit none
00015 
00016   real(long), pointer :: pot(:,:,:), sou(:,:,:)
00017   real(long), pointer :: sou_exsurf(:,:), dsou_exsurf(:,:)
00018   real(long), pointer :: sou_outsurf(:,:), dsou_outsurf(:,:)
00019   real(long), pointer :: sou_iosurf(:,:,:)
00020   real(long), pointer :: pot_vol(:,:,:), pot_exsurf(:,:,:)
00021   real(long), pointer :: pot_outsurf(:,:,:)
00022   real(long), pointer :: pot_integrals(:,:,:)
00023   character(len=2)    :: char_bc
00024   integer :: irg
00025 
00026   call alloc_array3d(pot_vol,0,nrg,0,ntg,0,npg)
00027   call alloc_array3d(pot_exsurf,0,nrg,0,ntg,0,npg)
00028   call alloc_array3d(pot_outsurf,0,nrg,0,ntg,0,npg)
00029   call alloc_array3d(pot_integrals,0,nrg,0,ntg,0,npg)
00030   call alloc_array3d(sou_iosurf,0,ntg,0,npg,1,4)
00031 
00032   call calc_hgfn_bhex_nb
00033   call copy_to_hgfn_and_gfnsf(hgfn_nb,gfnsf_nb)
00034   call poisson_solver_binary_vol_int(sou,pot_vol)
00035 
00036   call poisson_solver_binary_surf_int(sou_exsurf,dsou_exsurf,pot_exsurf)
00037 
00038   pot_integrals(0:nrg,0:ntg,0:npg) = pot_vol(0:nrg,0:ntg,0:npg) &
00039                                  & + pot_exsurf(0:nrg,0:ntg,0:npg)
00040 
00041   if (char_bc.eq.'sd') then
00042     call calc_hgfn_bhex_sd
00043     call copy_to_hgfn_and_gfnsf(hgfn_sd,gfnsf_sd)
00044   end if
00045 
00046   call sourceterm_surface_int_homosol(pot_integrals,nrg,sou_outsurf, &
00047   &                                                    dsou_outsurf)
00048   sou_iosurf(1:ntg,1:npg,3) = dsou_outsurf(1:ntg,1:npg)
00049   sou_iosurf(1:ntg,1:npg,4) = sou_outsurf(1:ntg,1:npg)
00050   call poisson_solver_bhex_surf_int('ou',sou_iosurf,pot_outsurf)
00051 
00052   pot(0:nrg,0:ntg,0:npg) = pot_integrals(0:nrg,0:ntg,0:npg) &
00053                        & + pot_outsurf(0:nrg,0:ntg,0:npg)
00054 
00055   deallocate(pot_vol)
00056   deallocate(pot_exsurf)
00057   deallocate(pot_outsurf)
00058   deallocate(pot_integrals)
00059   deallocate(sou_iosurf)
00060 
00061 end subroutine poisson_solver_binary_star_homosol