00001 subroutine peos_q2hprho_tidal(q,h,pre,rho,ened,dpde)
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, dpde
00008 real(8) :: hin, qin, abin, abct, fac1, fac2, fack, small
00009 integer :: iphase
00010 real(8) :: fac3, dpdq, drhodq
00011
00012 call peos_lookup(q, qi, 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 small = 1.0d-60
00023 if (q <= small) q = small
00024 h = hin + fac2*(q - qin)
00025 if (h <= 1.0d0) h = 1.0d0
00026 pre = fack*q**fac2
00027 rho = fack*q**fac1
00028 ened = rho*h - pre
00029
00030 fac3 = (2.0d0 - abin)/(abin - 1.0d0)
00031 dpdq = fack*fac2*q**fac1
00032 drhodq = fack*fac1*q**fac3
00033 dpde = dpdq/(drhodq*h + fac2*rho - dpdq)
00034
00035 end subroutine peos_q2hprho_tidal
