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