00001 subroutine sourceterm_MWtemp_current(sou)
00002   use phys_constant, only : long, pi
00003   use grid_parameter, only : nrg, ntg, npg
00004   use def_metric, only : psi, alph
00005   use def_matter, only : emdg
00006   use def_matter_parameter, only : radi
00007   use def_emfield, only : jtu
00008   use interface_interpo_linear_type0
00009   implicit none
00010   real(long), pointer :: sou(:,:,:)
00011   real(long) :: emdgc, rhoSc, zfac
00012   real(long) :: psigc, alphgc, jtugc
00013   integer    :: irg, itg, ipg
00014 
00015 
00016 
00017 
00018   do ipg = 1, npg
00019     do itg = 1, ntg
00020       do irg = 1, nrg
00021         call interpo_linear_type0(emdgc,emdg,irg,itg,ipg)
00022         call interpo_linear_type0(jtugc,jtu,irg,itg,ipg)
00023         call interpo_linear_type0(psigc,psi,irg,itg,ipg)
00024         call interpo_linear_type0(alphgc,alph,irg,itg,ipg)
00025         zfac = 1.0d0
00026         if (emdgc <= 1.0d-15) then 
00027           emdgc = 1.0d-15
00028           zfac  = 0.0d0
00029         end if
00030         rhoSc = alphgc*jtugc
00031         sou(irg,itg,ipg) = - radi**2*4.0d0*pi*alphgc*psigc**4*rhoSc*zfac
00032       end do
00033     end do
00034   end do
00035 end subroutine sourceterm_MWtemp_current
00036