00001 subroutine test_source_helical
00002   use phys_constant, only     : long, pi
00003   use coordinate_grav_r, only : rg
00004   use grid_parameter, only    : nrg, ntg, npg
00005   use def_matter, only        : emdg, rs
00006   use def_matter_parameter, only : ome
00007   use def_vector_x, only      :vec_xg
00008   implicit none
00009   integer     ::   irg, itg, ipg
00010   real(long)  ::   zfac, small = 1.0d-15
00011   real(long), parameter ::   a = 1.0d0, q = 1.0d0, sigma = 0.5d0
00012   real(long)  ::   xx, yy, zz, rplusR, rminusR
00013 
00014 
00015   ome = 0.3d0
00016   call calc_vector_x_grav(1)
00017   do ipg = 0, npg
00018     do itg = 0, ntg
00019     rs(itg,ipg) = 1.0d0
00020       do irg = 0, nrg
00021         xx = vec_xg(irg,itg,ipg,1)
00022         yy = vec_xg(irg,itg,ipg,2)
00023         zz = vec_xg(irg,itg,ipg,3)
00024         rplusR  = (xx + a)**2 + yy**2 + zz**2
00025         rminusR = (xx - a)**2 + yy**2 + zz**2
00026         emdg(irg,itg,ipg) = q/((sqrt(2.0d0*pi)*sigma)**3) &
00027         &                 * ( exp(-rplusR /(2.0d0*sigma**2)) &
00028         &                   + exp(-rminusR/(2.0d0*sigma**2)) )
00029       end do
00030     end do
00031   end do
00032 
00033 
00034 end subroutine test_source_helical