00001 subroutine peos_q2hprho(q,h,pre,rho,ened)
00002
00003 use def_peos_parameter
00004 implicit none
00005
00006 real(8), intent(inout) :: q
00007 real(8), intent(out) :: h, pre, rho, ened
00008 real(8) :: hin, qin, abin, abct, fac1, fac2, fack, small
00009 integer :: iphase
00010
00011 call peos_lookup(q, qi, iphase)
00012 hin = hi(iphase)
00013 qin = qi(iphase)
00014 abin = abi(iphase)
00015 abct = abc(iphase)
00016
00017 fac1 = 1.0d0/(abin - 1.0d0)
00018 fac2 = abin/(abin - 1.0d0)
00019 fack = abct**(-fac1)
00020
00021 small = 1.0d-60
00022 if (q <= small) q = small
00023 h = hin + fac2*(q - qin)
00024 if (h <= 1.0d0) h = 1.0d0
00025 pre = fack*q**fac2
00026 rho = fack*q**fac1
00027 ened = rho*h - pre
00028
00029 end subroutine peos_q2hprho
