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