00001 subroutine calc_virial_WL_MHD
00002 use phys_constant, only : long, pi
00003 use grid_parameter, only : nrg, ntg, npg, nrf, ntf, npf
00004 use def_matter_parameter, only : radi
00005 use def_quantities, only : T_kinene, P_intene, M_emfene, W_gravene, &
00006 & ToverW, PoverW, MoverW, Virial
00007 use make_array_3d
00008 use interface_source_virial_WL_MHD
00009 use interface_vol_int_grav
00010 use interface_vol_int_fluid
00011 implicit none
00012 real(long) :: volf, volg, fac8pi
00013 real(long), pointer :: sou_Tkin(:,:,:), sou_Pint(:,:,:),
00014 sou_Memf(:,:,:), sou_Wgra(:,:,:)
00015
00016 call alloc_array3d(sou_Tkin, 0, nrf, 0, ntf, 0, npf)
00017 call alloc_array3d(sou_Pint, 0, nrf, 0, ntf, 0, npf)
00018 call alloc_array3d(sou_Memf, 0, nrg, 0, ntg, 0, npg)
00019 call alloc_array3d(sou_Wgra, 0, nrg, 0, ntg, 0, npg)
00020
00021 call source_virial_WL_MHD(sou_Tkin,sou_Pint,sou_Memf,sou_Wgra)
00022
00023 call vol_int_fluid(sou_Tkin,volf)
00024 T_kinene = radi**3*volf
00025
00026 call vol_int_fluid(sou_Pint,volf)
00027 P_intene = radi**3*volf
00028
00029 call vol_int_grav(sou_Memf,volg)
00030 M_emfene = radi*volg
00031
00032 call vol_int_grav(sou_Wgra,volg)
00033 W_gravene= radi*volg
00034
00035 ToverW = T_kinene/dabs(W_gravene)
00036 PoverW = P_intene/dabs(W_gravene)
00037 MoverW = M_emfene/dabs(W_gravene)
00038 Virial = (2.0d0*T_kinene + 3.0d0*P_intene + M_emfene + W_gravene)/W_gravene
00039 Virial = dabs(Virial)
00040
00041
00042 deallocate(sou_Tkin)
00043 deallocate(sou_Pint)
00044 deallocate(sou_Memf)
00045 deallocate(sou_Wgra)
00046
00047 end subroutine calc_virial_WL_MHD