00001 subroutine helmholtz_solver_binary_bhex_homosol(fnc,sou,pot)
00002   use phys_constant,  only : long
00003   use grid_parameter, only : nrg, npg, ntg
00004   use def_matter_parameter, only : ome
00005   use make_array_2d
00006   use make_array_3d
00007   use interface_sourceterm_exsurf_eqm_binary
00008   use interface_sourceterm_surface_int
00009   use interface_sourceterm_surface_int_homosol
00010   use interface_helmholtz_solver_binary_vol_int
00011   use interface_helmholtz_solver_binary_surf_int
00012   use interface_helmholtz_solver_outer_surf_int
00013   use interface_helmholtz_solver_bhex_surf_int
00014   implicit none
00015   real(long), pointer :: pot(:,:,:), sou(:,:,:), fnc(:,:,:)
00016   real(long), pointer :: sou_exsurf(:,:), dsou_exsurf(:,:)
00017   real(long), pointer :: sou_insurf(:,:), dsou_insurf(:,:)
00018   real(long), pointer :: sou_outsurf(:,:), dsou_outsurf(:,:)
00019   real(long), pointer :: pot_vol(:,:,:), pot_exsurf(:,:,:)
00020   real(long), pointer :: pot_insurf(:,:,:), pot_outsurf(:,:,:)
00021   real(long), pointer :: pot_integrals(:,:,:)
00022 
00023   call alloc_array2d(sou_exsurf,0,ntg,0,npg)
00024   call alloc_array2d(dsou_exsurf,0,ntg,0,npg)
00025   call alloc_array2d(sou_insurf,0,ntg,0,npg)
00026   call alloc_array2d(dsou_insurf,0,ntg,0,npg)
00027   call alloc_array2d(sou_outsurf,0,ntg,0,npg)
00028   call alloc_array2d(dsou_outsurf,0,ntg,0,npg)
00029 
00030   call alloc_array3d(pot_vol,0,nrg,0,ntg,0,npg)
00031   call alloc_array3d(pot_exsurf,0,nrg,0,ntg,0,npg)
00032   call alloc_array3d(pot_insurf,0,nrg,0,ntg,0,npg)
00033   call alloc_array3d(pot_outsurf,0,nrg,0,ntg,0,npg)
00034   call alloc_array3d(pot_integrals,0,nrg,0,ntg,0,npg)
00035 
00036   call sourceterm_exsurf_eqm_binary(fnc,sou_exsurf,dsou_exsurf)
00037   call sourceterm_surface_int(fnc,0,sou_insurf,dsou_insurf)
00038   call sourceterm_surface_int(fnc,nrg,sou_outsurf,dsou_outsurf)
00039 
00040   call calc_radial_green_fn_hrethadv(ome)
00041   call helmholtz_solver_binary_vol_int(sou,pot_vol)
00042   call helmholtz_solver_binary_surf_int(sou_exsurf,dsou_exsurf,pot_exsurf)
00043   call helmholtz_solver_outer_surf_int(sou_outsurf,dsou_outsurf,pot_outsurf)
00044   pot_intgrals(0:nrg,0:ntg,0:npg) = pot_vol(0:nrg,0:ntg,0:npg)    &
00045                                 & + pot_exsurf(0:nrg,0:ntg,0:npg) &
00046                                 & + pot_outsurf(0:nrg,0:ntg,0:npg)
00047 
00048   call sourceterm_surface_int_homosol(pot_integrals,0,sou_insurf,dsou_insurf)
00049 
00050   call helmholtz_solver_surf_int(sou_insurf,dsou_insurf,pot_insurf)
00051   pot(0:nrg,0:ntg,0:npg) = pot_integrals(0:nrg,0:ntg,0:npg)  &
00052   &                      + pot_insurf(0:nrg,0:ntg,0:npg)
00053 
00054   deallocate(sou_exsurf)
00055   deallocate(dsou_exsurf)
00056   deallocate(sou_insurf)
00057   deallocate(dsou_insurf)
00058   deallocate(sou_outsurf)
00059   deallocate(dsou_outsurf)
00060 
00061   deallocate(pot_vol)
00062   deallocate(pot_exsurf)
00063   deallocate(pot_insurf)
00064   deallocate(pot_outsurf)
00065   deallocate(pot_integrals)
00066 
00067 end subroutine helmholtz_solver_binary_bhex_homosol