00001 subroutine test_current
00002 use phys_constant, only : long, pi
00003 use grid_parameter, only : nrg, ntg, npg
00004 use def_emfield, only : jtu, jxu, jyu, jzu
00005 use def_vector_x, only : vec_xg
00006 use def_vector_phi, only : vec_phig
00007 implicit none
00008 real(long) :: ome_cur, dis_cur, sigma, charge
00009 real(long) :: xx, yy, zz, phix, phiy, phiz, rminusR, factor
00010 integer :: irg, itg, ipg
00011
00012
00013
00014
00015 ome_cur = 0.3d0
00016 dis_cur = 0.5d0
00017 sigma = 0.3d0
00018 charge = 0.003d0
00019
00020 do ipg = 0, npg
00021 do itg = 0, ntg
00022 do irg = 0, nrg
00023
00024 xx = vec_xg(irg,itg,ipg,1)
00025 yy = vec_xg(irg,itg,ipg,2)
00026 zz = vec_xg(irg,itg,ipg,3)
00027 phix = vec_phig(irg,itg,ipg,1)
00028 phiy = vec_phig(irg,itg,ipg,2)
00029 phiz = vec_phig(irg,itg,ipg,3)
00030
00031 rminusR = (sqrt(xx**2+yy**2) - dis_cur)**2 + zz**2
00032 factor = charge/(sqrt(2.0d0*pi)*sigma)**2 &
00033 & * exp(-rminusR /(2.0d0*sigma**2))
00034
00035 jtu(irg,itg,ipg) = factor
00036 jxu(irg,itg,ipg) = factor*ome_cur*phix
00037 jyu(irg,itg,ipg) = factor*ome_cur*phiy
00038 jzu(irg,itg,ipg) = 0.0d0
00039
00040 end do
00041 end do
00042 end do
00043
00044 end subroutine test_current
00045