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