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

Go to the documentation of this file.

subroutine calc_ang_mom_WL_MHD
!
  use phys_constant, only  :   long, pi
  use grid_parameter, only :   nrg, ntg, npg, nrf, ntf, npf, ntgeq
  use coordinate_grav_r, only :   hrg
  use def_matter_parameter, only : radi
  use def_quantities, only : angmom
  use make_array_3d
  use interface_source_ang_mom_WL
  use interface_source_ang_mom_EMF
  use interface_vol_int_grav
  use interface_vol_int_fluid
  implicit none
  real(long)          :: volf, volg, pi8inv
  real(long), pointer :: soug(:,:,:), souf(:,:,:), soug_EMF(:,:,:)
  integer :: irg, itg, ipg
!
  call alloc_array3d(soug, 0, nrg, 0, ntg, 0, npg)
  call alloc_array3d(soug_EMF, 0, nrg, 0, ntg, 0, npg)
  call alloc_array3d(souf,0, nrf,0, ntf,0, npf)
!
  call source_ang_mom_WL(soug,souf)
  call source_ang_mom_EMF(soug_EMF)
!
  pi8inv = 0.125d0/pi
!testtest                                                                      
!       itg = ntgeq-2; ipg = 2
!!       itg = ntgeq; ipg = 2
!       open(15,file='test_vec_ang',status='unknown')
!       do irg = 1, nrg
!         write(15,'(1p,9e20.12)')  hrg(irg), pi8inv*soug(irg,itg,ipg) &
!               &                           , pi8inv*soug_EMF(irg,itg,ipg)
!       end do
!       close(15)
!       open(16,file='test_vec_angf',status='unknown')
!       do irg = 1, nrf
!         write(16,'(1p,9e20.12)')  hrg(irg), radi**2*souf(irg,itg,ipg)
!       end do
!       close(16)
!testtest
!
  soug(0:nrg,0:ntg,0:npg) = soug(0:nrg,0:ntg,0:npg)   &
  &                       + soug_EMF(0:nrg,0:ntg,0:npg)
  call vol_int_grav(soug,volg)
  call vol_int_fluid(souf,volf)
!
  angmom = radi**4*volf + pi8inv*radi**2*volg
!
!  write (6,'(a20,1p,e14.6)') ' Angular momentum = ', angmom
!
  deallocate(soug)
  deallocate(soug_EMF)
  deallocate(souf)
!
end subroutine calc_ang_mom_WL_MHD

---