00001 subroutine sourceterm_HaC_CF(sou)
00002 use phys_constant, only : long
00003 use grid_parameter, only : nrg, ntg, npg, ntgeq, npgxzp
00004 use coordinate_grav_r, only : hrg
00005 use def_metric, only : psi, tfkijkij
00006 use interface_interpo_linear_type0
00007 implicit none
00008 real(long), pointer :: sou(:,:,:)
00009 real(long) :: psigc, aijaij
00010 integer :: irg, itg, ipg
00011
00012
00013
00014
00015 do ipg = 1, npg
00016 do itg = 1, ntg
00017 do irg = 1, nrg
00018 call interpo_linear_type0(psigc,psi,irg,itg,ipg)
00019 aijaij = tfkijkij(irg,itg,ipg)
00020
00021 sou(irg,itg,ipg) = - 0.125d0*psigc**5*aijaij
00022 end do
00023 end do
00024 end do
00025
00026 end subroutine sourceterm_HaC_CF