00001 subroutine peos_h2qprho_tidal(h,q,pre,rho,ened,dpde)
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, dpde
00008 real(8) :: qq, hin, qin, abin, abct
00009 real(8) :: fac1, fac2, fack, small = 1.0d-16
00010 integer :: iphase
00011 real(8) :: fac3, dpdq, drhodq
00012
00013 call peos_lookup(h, hi, iphase)
00014 hin = hi(iphase)
00015 qin = qi(iphase)
00016 abin = abi(iphase)
00017 abct = abc(iphase)
00018
00019 fac1 = 1.0d0/(abin - 1.0d0)
00020 fac2 = abin/(abin - 1.0d0)
00021 fack = abct**(-fac1)
00022
00023 q = (h - hin)/fac2 + qin
00024 qq = q
00025 if (h <= 1.0d0) qq = small/fac2
00026 pre = fack*qq**fac2
00027 rho = fack*qq**fac1
00028 ened = rho*h - pre
00029
00030 fac3 = (2.0d0 - abin)/(abin - 1.0d0)
00031 dpdq = fack*fac2*qq**fac1
00032 drhodq = fack*fac1*qq**fac3
00033 dpde = dpdq/(drhodq*h + fac2*rho - dpdq)
00034
00035 end subroutine peos_h2qprho_tidal
