00001 subroutine calc_virial_WL
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, W_gravene, &
00006   &                          ToverW, PoverW, Virial
00007   use make_array_3d
00008   use interface_source_virial_WL
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(:,:,:), sou_Wgra(:,:,:)
00014 
00015   call alloc_array3d(sou_Tkin, 0, nrf, 0, ntf, 0, npf)
00016   call alloc_array3d(sou_Pint, 0, nrf, 0, ntf, 0, npf)
00017   call alloc_array3d(sou_Wgra, 0, nrg, 0, ntg, 0, npg)
00018 
00019   call source_virial_WL(sou_Tkin,sou_Pint,sou_Wgra)
00020 
00021   call vol_int_fluid(sou_Tkin,volf)
00022   T_kinene = radi**3*volf
00023 
00024   call vol_int_fluid(sou_Pint,volf)
00025   P_intene = radi**3*volf
00026 
00027   call vol_int_grav(sou_Wgra,volg)
00028   W_gravene= radi*volg
00029 
00030   ToverW = T_kinene/dabs(W_gravene)
00031   PoverW = P_intene/dabs(W_gravene)
00032   Virial = (2.0d0*T_kinene + 3.0d0*P_intene + W_gravene)/W_gravene
00033   Virial = dabs(Virial)
00034 
00035 
00036   deallocate(sou_Tkin)
00037   deallocate(sou_Pint)
00038   deallocate(sou_Wgra)
00039 
00040 end subroutine calc_virial_WL