00001 subroutine calc_vector_phi_grav(sb)
00002   use phys_constant, only : long
00003   use grid_parameter, only : nrf, ntf, npf, nrg, ntg, npg
00004   use coordinate_grav_r, only : rg, hrg
00005   use trigonometry_grav_theta, only : sinthg, hsinthg
00006   use trigonometry_grav_phi, only : sinphig, cosphig, hsinphig, hcosphig
00007   use def_vector_phi, only : vec_phig, hvec_phig
00008   use def_binary_parameter, only : dis
00009   use interface_interpo_linear_type0_2Dsurf
00010   implicit none
00011   real(long) :: rrgg, sth, sphi, cphi, dis_bin
00012   integer :: irg, itg, ipg, sb
00013 
00014   dis_bin = dis
00015   if(sb.eq.1) dis_bin = 0.0d0   
00016 
00017   do ipg = 0, npg
00018     do itg = 0, ntg
00019       do irg = 0, nrg
00020         rrgg = rg(irg)
00021         sth  = sinthg(itg)
00022         sphi = sinphig(ipg)
00023         cphi = cosphig(ipg)
00024         vec_phig(irg,itg,ipg,1) =           - rrgg*sth*sphi
00025         vec_phig(irg,itg,ipg,2) = - dis_bin + rrgg*sth*cphi
00026         vec_phig(irg,itg,ipg,3) = 0.0d0
00027         if (irg.eq.0.or.itg.eq.0.or.ipg.eq.0) cycle
00028         rrgg = hrg(irg)
00029         sth  = hsinthg(itg)
00030         sphi = hsinphig(ipg)
00031         cphi = hcosphig(ipg)
00032         hvec_phig(irg,itg,ipg,1) =           - rrgg*sth*sphi
00033         hvec_phig(irg,itg,ipg,2) = - dis_bin + rrgg*sth*cphi
00034         hvec_phig(irg,itg,ipg,3) = 0.0d0
00035       end do
00036     end do
00037   end do
00038 end subroutine calc_vector_phi_grav