/home/uryu/Cocal_svn_checkinout/Cocal/code/Subroutine/sourceterm_trG_CF.f90

Go to the documentation of this file.

subroutine sourceterm_trG_CF(sou)
  use phys_constant, only : long
  use grid_parameter, only : nrg, ntg, npg
  use def_metric, only : psi, alph, bvxu, bvyu, bvzu, &
  &                      tfkijkij, trk
!!!  use def_metric_rotshift, only : ovxu, ovyu, ovzu
  use def_metric_excurve_grid, only : trk_grid
  use interface_interpo_linear_type0
  use interface_grgrad_midpoint_type0
  implicit none
  real(long), pointer :: sou(:,:,:)
  real(long) :: psigc, alpgc, bxugc, byugc, bzugc, aijaij
  real(long) :: oxugc, oyugc, ozugc
  real(long) :: traceK, dKdx, dKdy, dKdz, LiebeK, LieomeK, fac512
  integer    :: irg, itg, ipg
!
! --- Source term of the spatial trace of Einstein eq 
! --- for computing alpha*psi.
!
  fac512 = 5.0d0/12.0d0
  do ipg = 1, npg
    do itg = 1, ntg
      do irg = 1, nrg
        call interpo_linear_type0(psigc,psi,irg,itg,ipg)
        call interpo_linear_type0(alpgc,alph,irg,itg,ipg)
        call interpo_linear_type0(bxugc,bvxu,irg,itg,ipg)
        call interpo_linear_type0(byugc,bvyu,irg,itg,ipg)
        call interpo_linear_type0(bzugc,bvzu,irg,itg,ipg)
!!!        call interpo_linear_type0(oxugc,ovxu,irg,itg,ipg)
!!!        call interpo_linear_type0(oyugc,ovyu,irg,itg,ipg)
!!!        call interpo_linear_type0(ozugc,ovzu,irg,itg,ipg)
        call grgrad_midpoint_type0(trk_grid,dKdx,dKdy,dKdz,irg,itg,ipg)
        aijaij = tfkijkij(irg,itg,ipg)
        traceK = trk(irg,itg,ipg)
! -- Should be rotating shift for Helical Symmetry.
        LiebeK = bxugc*dKdx + byugc*dKdy + bzugc*dKdz
!!!        LieomeK = oxugc*dKdx + oyugc*dKdy + ozugc*dKdz
!
        sou(irg,itg,ipg) = alpgc*psigc**5*(0.875d0*aijaij + fac512*traceK**2) &
        &                + psigc**5*LiebeK
!!!        &                + psigc**5*LieomeK
      end do
    end do
  end do
!
end subroutine sourceterm_trG_CF

---