00001 subroutine calc_vector_x_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, costhg, hcosthg
00006 use trigonometry_grav_phi, only : sinphig, cosphig, hsinphig, hcosphig
00007 use def_vector_x, only : vec_xg, hvec_xg
00008 use def_binary_parameter, only : dis
00009 use interface_interpo_linear_type0_2Dsurf
00010 implicit none
00011 real(long) :: rrgg, sth, cth, 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 cth = costhg(itg)
00023 sphi = sinphig(ipg)
00024 cphi = cosphig(ipg)
00025 vec_xg(irg,itg,ipg,1) = - dis_bin + rrgg*sth*cphi
00026 vec_xg(irg,itg,ipg,2) = rrgg*sth*sphi
00027 vec_xg(irg,itg,ipg,3) = rrgg*cth
00028 if (irg.eq.0.or.itg.eq.0.or.ipg.eq.0) cycle
00029 rrgg = hrg(irg)
00030 sth = hsinthg(itg)
00031 cth = hcosthg(itg)
00032 sphi = hsinphig(ipg)
00033 cphi = hcosphig(ipg)
00034 hvec_xg(irg,itg,ipg,1) = - dis_bin + rrgg*sth*cphi
00035 hvec_xg(irg,itg,ipg,2) = rrgg*sth*sphi
00036 hvec_xg(irg,itg,ipg,3) = rrgg*cth
00037 end do
00038 end do
00039 end do
00040 end subroutine calc_vector_x_grav