00001 subroutine bh_boundary_d_bvyd(sou_surf)
00002   use phys_constant, only  : long, pi
00003   use grid_parameter, only : nrg, ntg, npg, rgin
00004   use trigonometry_grav_theta, only : hsinthg, hcosthg
00005   use trigonometry_grav_phi,   only : hsinphig, hcosphig
00006   use def_binary_parameter,    only : sepa
00007   implicit none
00008   real(long), pointer :: sou_surf(:,:)
00009   real(long) :: st, ct, sp, cp, xa,ya,za, rcm2, xycm2, rcm, tcm, pcm
00010   integer    :: itg, ipg
00011 
00012   do ipg = 1, npg
00013     do itg = 1, ntg
00014       st = hsinthg(itg)
00015       ct = hcosthg(itg)
00016       sp = hsinphig(ipg)
00017       cp = hcosphig(ipg)
00018 
00019       xa = rgin*st*cp
00020       ya = rgin*st*sp
00021       za = rgin*ct
00022 
00023       rcm2 = (xa-0.5d0*sepa)**2 + ya**2 + za**2
00024       xycm2= (xa-0.5d0*sepa)**2 + ya**2
00025 
00026       rcm = sqrt(rcm2)
00027       tcm = atan2(sqrt(xycm2),za)
00028       pcm = dmod(2.0d0*pi+datan2(ya,xa-0.5d0*sepa),2.0d0*pi)
00029 
00030       sou_surf(itg,ipg) = -0.08d0*(+rcm*sin(tcm)*cos(pcm))
00031     end do
00032   end do
00033 
00034 end subroutine bh_boundary_d_bvyd