1C
2C
3C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
4C EQRELV
5C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
6 SUBROUTINE EQRELV(TL,T,PL,P,DL,D,BETA,AMU,EMU,ETA,QDT,QDP,QCP,
7C 1 DELA,QDTT,QDTP,QAT,QAP,QCPT,QCPP,X) ! KC 2025-05-31
8 1 1 DELA,QDTT,QDTP,QAT,QAP,QCPT,QCPP)
9C 10/14/26 MHP via Claude
10C code changed to convert COMMON/DEBHU/ into DEBHU_MOD.
11 USE DEBHU_MOD
12C 10/14/26 MHP via Claude
13C code changed to convert COMMON/CCR/ into CCR_MOD.
14 USE CCR_MOD
15C 10/14/26 MHP via Claude
16C code changed to convert COMMON/NMLPAR/ into NMLPAR_MOD.
17 USE NMLPAR_MOD
18C 10/14/26 MHP via Claude
19C code changed to convert COMMON/CONSTANTS/ into CONSTANTS_MOD.
20 USE CONSTANTS_MOD
21C 10/14/26 MHP via Claude
22C code changed to convert COMMON/IOUNITS/ into IOUNITS_MOD.
23 USE IOUNITS_MOD
24C 10/20/26 MHP via Claude
25C code changed to replace implicit typing with IMPLICIT NONE and
26C explicit declarations.
27 IMPLICIT NONE
28 REAL*8 ACP,ALMIX,AMU,BCP,BETA,BETA1,CDEN1,CDEN2,CDEN3,CL1,CL2,CL3,
29 * * CMFDH,CMFDH0,CMFDH1,CORR,D,D8,DCL1,DCL2,DCL3,DELA,DF1,DF2,
30 * * DL,DL8,DML,DPEL1,DPEL2,DX1,DX2,DX3,EMU,EMUL,EMUL8,ETA,FACT,
31 * * FACTL,FACTOR,FF,FFE,P,PA,PD,PDH,PDHP,PDT,PDU,PE,PEL,PEQ,
32 * * PINV,PL,PL8,PR,PR1,PR2,PR3,PR4,PR5,PR6,PR7,PR8,PR8L,PR9,
33 * * PR9L,PT,PTL,QAP,QAT,QCP,QCPI,QCPP,QCPT,QDP,QDPP,QDT,QDTP,
34 * * QDTT,QPD,QPED,QPEQD,QPEQT,QPT,QQPDD,QQPDT,QQPEDD,QQPTT,
35 * * QQUDT,QQUTT,QUDT,QUEQT,QUTD,QUTP,RAMU,RAMUT,SLOPE,T,T0,T1,
36 * * TL,TL8,TTCU,TTDCU,TTUD,U,UA,UDH,UDHU,UE,UEQ,UI,UR,XX
37 INTEGER ID,ID1,ID1P,ID2,ID3,II,JT1,JT2,JT3,KK,NDEN,NN
38
39C QDTT,QDTP = NAT-LOG DERIVATIVES OF QDT=D(LOG D )/D(LOG T )
40C QAT,QAP = NAT-LOG DERIVATIVES OF THE ADIABATIC DERIVATIVE
41C DBG 7/92 MODIFIED TO INCLUDE DEBYE-HUCKEL CORRECTION.
42C CORRECTION IS APPLIED TO PRESSURE AND ALL THERMODYNAMIC VARIABLES.
43C TREATMENT IS ALSO VALID FOR ELECTRON DEGENERACY. A RAMP FUNCTION
44C BETWEEN THE NONDEGENERATE AND DEGERNATE ELECTRON GAS CASES OF THE
45C D.H. CORRECTION IS USED (THIS IS NOT CORRECT BUT, HOPEFULLY IS
46C CLOSE ENOUGH. CONSTANT TERM CDH IS CALCULATED IN SETUPS.
47
48
49C 9/25/26 MHP via Claude
50C code changed to consolidate all I/O logical unit numbers, previously
51C scattered across COMMON/LUOUT/, COMMON/LUNUM/, COMMON/ALEX06/,
52C COMMON/ACDPTH/, COMMON/NEWOPAC/, COMMON/LOPAL95/, COMMON/ATMOS2/,
53C COMMON/ALATM03/, COMMON/OPALEOS/, and COMMON/SCV2/, into a single
54C COMMON/IOUNITS/
55C 9/25/26 MHP via Claude
56C code changed to merge COMMON/CONST/, COMMON/CONST1/, COMMON/CONST2/,
57C and COMMON/CONST3/ into a single COMMON/CONSTANTS/
58C 9/24/26 MHP via Claude
59C code changed to remove dead CMIXL from COMMON/CONST3/; it is now
60C passed as an explicit argument where actually used
61C DBG 7/92 CDH IS CONSTANT TERM DEFINED IN SETUPS
62C RAMP FUNCTION BETWEEN NO ELECTRON DEGENERACY ETA .LT. ETADH0
63C AND FULL ELECTRON DEGENERACY ETA .GT. ETADH1 VERSION OF D.H.
64C CORRECTION.
65C IF LDH = .TRUE. THEN APPLY D.H. CORRECTION.
66C ZDH IS ARRAY OF RELATIVE MASS FRACTIONS OF LAOL METAL MIXTURE
67C SUMMED TO 1.0.
68C DBG 7/92 COMMON BLOCK ADDED TO COMPUTE DEBYE-HUCKEL CORRECTION.
69C 10/12/26 MHP via Claude
70C code changed to extend COMMON/NMLPAR/ to 234 members, adding the
71C namelist variables that the physics routines read from 27 COMMON
72C blocks which also held derived or working members. Those blocks keep
73C only their non-namelist members; five of them -- NEWMX, VMULT,
74C PMMWIND, CCOUT1 and ENVGEN -- had nothing left and are gone.
75C Derivation-only namelist variables from the same blocks went to
76C COMMON/NMLBYPASS/ instead, not here.
77C
78C Declared identically in all 121 files that hold any of these members.
79C Generated from one member list, so every copy is byte-identical; the
80C linker's 'size of symbol changed' warning is the check that they are.
81 DIMENSION DF1(5,3),DF2(5,3),FF(5,3),FFE(5)
82 SAVE
83
84C THE ELECTRON PRESSURE (TABULATED IN FERMI TABLE) FOR A GIVEN (RHO,T)
85C IS FOUND HERE; THE DENSITY IS ADJUSTED SO THAT THE RESULTING TOTAL
86C PRESSURE (PE + PA + PR) EQUALS THE INITIAL P. FOR DETAILS
87C CONSULT PRATHER'S THESIS.
88C SUFFIX E=ELECTRON;R=RADIATION;A=NUCLEON;I.E.PA=PRESSURE DUE TO NUCLEI
89 PINV = 1.0D0/P
90 BETA1 = 1.0D0 - BETA
91 TL8 = TL
92 PL8 = PL
93 PR = BETA1*P
94 RAMU = CGAS*AMU
95 RAMUT = RAMU*T
96 EMUL = DLOG10(EMU)
97 EMUL8 = EMUL
98C PE IS TABULATED AS A FUNCTION OF X(=LOG D - LOG MUE - 3/2LOG T) AND
99C Y(= LOG T). FIND INDEX(JT1,JT2,JT3) FOR 3 PT INTERPOLATION IN Y.
100C MHP 10/02 CORRECTED MIXED TYPE
101 JT1 = INT(5.0D0*(TL - 5.0D0))
102 JT1 = MAX0(1,MIN0(JT1,18)) ! Force jt1 to be in the table
103 JT2 = JT1 + 1
104 JT3 = JT1 + 2
105 TTUD = 5.0D0*(TL8 - (5.0D0 + 0.20D0*DFLOAT(JT1)))
106 TTCU = 0.50D0*TTUD*(TTUD - 1.0D0)
107 TTDCU = TTUD - 0.50D0
108 DML = DL + EMUL
109 NDEN = 1
110 ID1P = -100
111C DBG 7/92 CALCULATE D.H. TERMS: ALPHA-MIXTURE, MASS-FRAC0, MASS-FRAC1
112 IF (LDH) THEN
113 ALMIX = 0.0D0
114 DO II=1,18
115 ALMIX = ALMIX + DHNUE(II)*ZDH(II)
116 END DO
117 CMFDH0 = 2.0D0*XXDH+1.5D0*YYDH+0.5D0*(ZZDH+ALMIX)
118 CMFDH1 = XXDH+YYDH+0.5D0*ALMIX
119 END IF
120 10 10 CONTINUE
121C BEGIN ITERATION LOOP FOR CORRECT DENSITY
122C FIND INDEX (ID1,ID2,ID3) FOR 3-PT INTERPOLATION IN X
123 XX = DML - 1.50D0*TL8
124 PR6= 20.0D0*(XX - DVAL(1)) + 1.0D0
125C MHP 10/02 CORRECTED MIXED TYPE
126 KK = INT(PR6)
127C KK = PR6
128 KK = MIN0(261,MAX0(1,KK))
129 ID1 = IDEN(KK)
130C IF INDEX UNCHANGED FROM PREVIOUS LOOP,SKIP THIS SECTION
131 IF (ID1.EQ.ID1P) GO TO 30
132 ID1P = ID1
133 ID2 = ID1 + 1
134 ID3 = ID1 + 2
135 PR9 = 1.0D0/( DVAL(ID3) - DVAL(ID2) )
136 PR8 = 1.0D0/( DVAL(ID2) - DVAL(ID1) )
137 PR7 = 1.0D0/( DVAL(ID1) - DVAL(ID3) )
138 CDEN1 = -PR7*PR8
139 CDEN2 = -PR8*PR9
140 CDEN3 = -PR9*PR7
141C INTERPOLATION IN Y IS NEWTONIAN(EQUAL SPACING IN Y)
142 DO 20 NN = 1,3
143 ID = ID1 + NN - 1
144 DF1(1,NN) = DTABLE(1,ID,JT2) - DTABLE(1,ID,JT1)
145 DF2(1,NN) = DTABLE(1,ID,JT3)-DTABLE(1,ID,JT2)-DF1(1,NN)
146 FF(1,NN) = DTABLE(1,ID,JT1) + TTUD*DF1(1,NN) + TTCU*DF2(1,NN)
147 20 20 CONTINUE
148 DPEL2 = 2.0D0*(FF(1,1)*CDEN1 + FF(1,2)*CDEN2 + FF(1,3)*CDEN3)
149 30 30 DX1 = XX - DVAL(ID1)
150 DX2 = XX - DVAL(ID2)
151 DX3 = XX - DVAL(ID3)
152C INTERPOLATION IN X IS LAGRANGIAN(UNEQUAL TABLE SPACING IN X)
153 CL1 = DX2*DX3*CDEN1
154 CL2 = DX3*DX1*CDEN2
155 CL3 = DX1*DX2*CDEN3
156 DCL1 = (DX2 + DX3)*CDEN1
157 DCL2 = (DX3 + DX1)*CDEN2
158 DCL3 = (DX1 + DX2)*CDEN3
159 IF (LDH) THEN
160 ETA = CL1*ETAT8(ID1) + CL2*ETAT8(ID2) + CL3*ETAT8(ID3)
161 IF (ETA .LT. ETADH0) THEN
162 CMFDH = CMFDH0*SQRT(CMFDH0)
163 ELSE IF (ETA .GT. ETADH1) THEN
164 CMFDH = CMFDH0*SQRT(CMFDH1)
165 ELSE
166 T0 = CMFDH0*SQRT(CMFDH0)
167 T1 = CMFDH0*SQRT(CMFDH1)
168 SLOPE = (T1-T0)/(ETADH1-ETADH0)
169 CMFDH = T0+(ETA-ETADH0)*SLOPE
170 END IF
171 END IF
172C NOW FIND PE AND ITS 1ST AND 2ND DERIVS.W/R/T DENSITY
173 PEL = CL1*FF(1,1) + CL2*FF(1,2) + CL3*FF(1,3)
174 DPEL1 = DCL1*FF(1,1) + DCL2*FF(1,2) + DCL3*FF(1,3)
175 DL8 = DML - EMUL8
176 D8 = DEXP(CLN*DL8)
177 PA = RAMUT*D8
178 PE = DEXP(CLN*PEL)
179 IF (LDH) THEN
180 PDH = CDH*CMFDH*SQRT(D8/T)*D8
181 END IF
182 PT = PA + PE + PR
183 IF (LDH) THEN
184 PT = PT + PDH
185 PDHP = PDH/PT
186 END IF
187 PTL = DLOG10(PT)
188 PR7 = (PA + PE*DPEL1)/PT
189 IF (LDH) THEN
190 PR7 = PR7 + 1.5D0*PDHP
191 END IF
192 PR8 = (PTL - PL8)/PR7
193 PR9 = CLN*( (PA + PE*(DPEL1**2+DPEL2/CLN))/(PT*PR7) - PR7 )
194 IF (LDH) THEN
195 PR9 = PR9 + 2.25D0*PDHP/PR7
196 END IF
197C FACTOR IS THE DIFFERENCE BETWEEN THE P PREDICTED FROM THE GIVEN RHO
198C AND THE TRUE P; IF TOO LARGE INCREMENT RHO AND TRY AGAIN.
199 FACTOR=DABS(PR8)
200 IF(factor .lt. 1D-15) factor = 1D-15
201 PR8L=DLOG10(FACTOR)
202 PR9L=DLOG10(DABS(PR9))
203 FACTL=DLOG10(0.5D0)+PR9L+2.D0*PR8L
204 FACT=DEXP(CLN*FACTL)
205 FACT=DSIGN(FACT,PR9)
206 CORR=-PR8-FACT
207c limit range of changes in density to a factor of 10**4 llp 1/31/07
208 if(corr .gt. 4D0) corr = 4d0
209 if(corr .lt. -4D0) corr = -4D0
210 IF(DABS(CORR).GE.1.0D-08) THEN
211 DML = DML + CORR
212 NDEN = NDEN + 1
213 IF(NDEN.LE.20) GO TO 10
214 WRITE(ISHORT,40) TL,PL,PTL,DML,CORR
215 40 40 FORMAT('EQRELV: Did not Converge: T,P,Pcalc,Dcalc,CORR',
216 * * 4F10.6,F20.12)
217c PAUSE
218 RETURN
219c STOP 'ERRELV failed'
220 ENDIF
221 DL = DL8
222 D = D8
223 DO 60 KK = 2,5
224 DO 50 NN = 1,3
225 ID = ID1 + NN - 1
226 DF1(KK,NN) = DTABLE(KK,ID,JT2) - DTABLE(KK,ID,JT1)
227 DF2(KK,NN)=(DTABLE(KK,ID,JT3)-DTABLE(KK,ID,JT2))-DF1(KK,NN)
228 FF(KK,NN)=DTABLE(KK,ID,JT1)+TTUD*DF1(KK,NN)+TTCU*DF2(KK,NN)
229 50 50 CONTINUE
230 FFE(KK) = CL1*FF(KK,1) + CL2*FF(KK,2) + CL3*FF(KK,3)
231 60 60 CONTINUE
232C DERIVATIVES OF P
233 PEQ = DEXP(CLN*FFE(3))
234 QPED = FFE(4)
235 QQPEDD =(DCL1*FF(4,1) + DCL2*FF(4,2) + DCL3*FF(4,3))*CLNI
236 PR1 = DF1(3,1)+TTDCU*DF2(3,1)
237 PR2 = DF1(3,2)+TTDCU*DF2(3,2)
238 PR3 = DF1(3,3)+TTDCU*DF2(3,3)
239 PR4 = DCL1*FF(3,1) + DCL2*FF(3,2) + DCL3*FF(3,3)
240 PR5 = 5.0D0*(CL1*PR1 + CL2*PR2 + CL3*PR3)
241 QPEQD = PEQ*PR4
242 QPEQT = PEQ*(PR5 - 1.50D0*PR4)
243 QPT = (PA + PEQ)*PINV + 4.0D0*BETA1
244 IF (LDH) THEN
245 QPT = QPT - 0.5D0*PDHP
246 END IF
247 QPD = (PA + PE*QPED)*PINV
248 IF (LDH) THEN
249 QPD = QPD + 1.5D0*PDHP
250 END IF
251 QQPTT = (PA + QPEQT)*PINV + 16.0D0*BETA1 - QPT**2
252 IF (LDH) THEN
253 QQPTT = QQPTT+(0.5D0*QPT+0.25D0)*PDHP
254 END IF
255 QQPDT = (PA + QPEQD)*PINV - QPT*QPD
256 IF (LDH) THEN
257 QQPDT = QQPDT+(0.5D0*QPT-0.75D0)*PDHP
258 END IF
259 QQPDD = (PA + PE*(QPED**2 + QQPEDD))*PINV - QPD**2
260 IF (LDH) THEN
261 QQPDD = QQPDD + (-1.5D0*QPD+2.25D0)*PDHP
262 END IF
263C DERIVATIVES OF DENSITY
264 QDP = 1.0D0/QPD
265 QDT = -QPT*QDP
266 PR1 = QDP**2
267 QDPP = -QQPDD*QDP*PR1
268 QDTP = -QPT*QDPP - QQPDT*PR1
269 QDTT = -QPT*QDTP - QDP*(QQPTT + QDT*QQPDT)
270C INTERNAL ENERGY TERM(U) AND ITS DERIVATIVES
271 UE = DEXP(CLN*(FFE(2) + EMUL))
272 UEQ = DEXP(CLN*(FFE(5) + EMUL))
273 PR1 = DF1(5,1)+TTDCU*DF2(5,1)
274 PR2 = DF1(5,2)+TTDCU*DF2(5,2)
275 PR3 = DF1(5,3)+TTDCU*DF2(5,3)
276 PR4 = DCL1*FF(5,1) + DCL2*FF(5,2) + DCL3*FF(5,3)
277 PR5 = 5.0D0*(CL1*PR1 + CL2*PR2 + CL3*PR3)
278 QUEQT = UEQ*(PR5 - 1.50D0*PR4)
279 PD = P/D
280 PDT = PD/T
281 UA = 1.50D0*RAMUT
282 UR = 3.0D0*BETA1*PD
283 IF (LDH) THEN
284 UDH = 3.0D0*PDH/D8
285 END IF
286 U = UA + UE + UR
287 IF (LDH) THEN
288 U = U + UDH
289 UDHU = UDH/U
290 END IF
291 UI = 1.0D0/U
292 PDU = PD*UI
293 QUTD = (UA + UEQ + 4.0D0*UR)*UI
294 IF(LDH) THEN
295 QUTD = QUTD -0.5D0*UDHU
296 END IF
297 QUDT = PDU*(1.0D0 - QPT)
298 IF (LDH) THEN
299 QUDT = QUDT + 0.5D0*UDHU
300 END IF
301 QUTP = QUTD + QDT*QUDT
302 QQUTT = (UA + QUEQT + 16.0D0*UR)*UI - QUTD**2
303 IF (LDH) THEN
304 QQUTT = QQUTT + (0.5D0*QUTD+0.25D0)*UDHU
305 END IF
306 QQUDT = QUDT*(QPT - QUTD) - PDU*QQPTT
307 IF (LDH) THEN
308 QQUDT = QQUDT + (0.5D0*QUDT-0.25D0)*UDHU
309 END IF
310C SPECIFIC HEAT(QCP) AND ITS DERIVATIVES
311 PR1 =-PDT*QDT
312 PR2 = U/T
313 PR3 = -(1.0D0 + QDT) + QDTT/QDT
314 PR4 = (1.0D0 - QDP) + QDTP/QDT
315 ACP = PR1*QPT
316 BCP = PR2*QUTD
317 QCP = ACP + BCP
318 QCPI = 1.0D0/QCP
319 QCPT = ACP*PR3 + PR1*(QQPTT + QDT*QQPDT) +
320 1 1 BCP*(QUTP - 1.0D0) + PR2*(QQUTT + QDT*QQUDT)
321 QCPP = ACP*PR4 + QDP*(PR1*QQPDT + BCP*QUDT + PR2*QQUDT)
322 QCPT = QCPT*QCPI
323 QCPP = QCPP*QCPI
324C ADIABATIC GRADIENT(DELA) AND DERIVATIVES ( ALL DERIVS ARE LN(DELA)/LN(
325 DELA = PR1*QCPI
326 QAT = PR3 - QCPT
327 QAP = PR4 - QCPP
328 ETA = CL1*ETAT8(ID1) + CL2*ETAT8(ID2) + CL3*ETAT8(ID3)
329
330 RETURN
331 END1"""Python version of eqrelv.f (YREC 7be4133): the equation of state for
2fully ionized gas with partially degenerate, possibly relativistic
3electrons."""
4
5import math
6
7import numpy as np
8
9from pyrec import ccr_mod
10from pyrec import constants_mod
11from pyrec import debhu_mod
12from pyrec import iounits_mod
13from pyrec import nmlpar_mod
14
15
16def eqrelv(tl: float, t: float, pl: float, p: float, dl: float, d: float, beta: float, amu: float, emu: float,
17 eta: float, qdt: float, qdp: float, qcp: float, dela: float, qdtt: float, qdtp: float, qat: float,
18 qap: float, qcpt: float, qcpp: float) -> tuple[float, float, float, float, float, float, float, float, float,
19 float, float, float, float]:
20 """Find the density at which ions, electrons (from the Fermi table) and
21 radiation, plus an optional Debye-Hueckel term, give the pressure p,
22 then the thermodynamic derivatives the structure equations need.
23
24 Translates: eqrelv.f#EQRELV (7be4133)
25
26 Arguments: tl, t (log10 T and T); pl, p (log10 P and P); dl, the
27 starting guess of log10 rho; d; beta (P_gas/P); amu, emu (ions and
28 electrons per unit mass, in units of 1/m_H); eta, qdt, qdp, qcp, dela,
29 qdtt, qdtp, qat, qap, qcpt, qcpp (set only).
30
31 Returns (dl, d, eta, qdt, qdp, qcp, dela, qdtt, qdtp, qat, qap, qcpt,
32 qcpp): the density and its log, the electron degeneracy, d ln rho /
33 d ln T and / d ln P, c_P, nabla_ad, and their logarithmic derivatives.
34 If the iteration does not converge, a message is written and the
35 arguments come back as they were passed (eta possibly set).
36
37 """
38
39 c = constants_mod
40 dval = ccr_mod.dval
41 etat8 = ccr_mod.etat8
42 dtable = ccr_mod.dtable
43 iden = ccr_mod.iden
44 ldh = nmlpar_mod.ldh
45 etadh0 = nmlpar_mod.etadh0
46 etadh1 = nmlpar_mod.etadh1
47 df1 = np.zeros((5 + 1, 3 + 1))
48 df2 = np.zeros((5 + 1, 3 + 1))
49 ff = np.zeros((5 + 1, 3 + 1))
50 ffe = np.zeros(5 + 1)
51
52 # Fortran lines 89–97.
53 pinv = 1.0 / p
54 beta1 = 1.0 - beta
55 tl8 = tl
56 pl8 = pl
57 pr = beta1 * p
58 ramu = c.cgas * amu
59 ramut = ramu * t
60 emul = math.log10(emu)
61 emul8 = emul
62
63 # Newton interpolation in log T: three columns from jt1 (Fortran lines
64 # 101–110).
65 # Question (see the page): forced into the table, extrapolating silently.
66 jt1 = int(5.0 * (tl - 5.0))
67 jt1 = max(1, min(jt1, 18))
68 jt2 = jt1 + 1
69 jt3 = jt1 + 2
70 ttud = 5.0 * (tl8 - (5.0 + 0.20 * float(jt1)))
71 ttcu = 0.50 * ttud * (ttud - 1.0)
72 ttdcu = ttud - 0.50
73 dml = dl + emul
74 nden = 1
75 id1p = -100
76
77 # Debye-Hueckel composition terms (Fortran lines 112–119).
78 if ldh:
79 almix = 0.0
80 for ii in range(1, 19):
81 almix = almix + debhu_mod.dhnue[ii] * debhu_mod.zdh[ii]
82 cmfdh0 = (2.0 * debhu_mod.xxdh + 1.5 * debhu_mod.yydh
83 + 0.5 * (debhu_mod.zzdh + almix))
84 cmfdh1 = debhu_mod.xxdh + debhu_mod.yydh + 0.5 * almix
85
86 # Newton iteration on log rho for the pressure balance (Fortran lines
87 # 120–220).
88 while True: # label 10
89 # The three table rows around x (Fortran lines 123–148).
90 xx = dml - 1.50 * tl8
91 pr6 = 20.0 * (xx - dval[1]) + 1.0
92 kk = int(pr6)
93 kk = min(261, max(1, kk))
94 id1 = iden[kk]
95 if id1 != id1p: # else GO TO 30: same three table rows
96 id1p = id1
97 id2 = id1 + 1
98 id3 = id1 + 2
99 pr9 = 1.0 / (dval[id3] - dval[id2])
100 pr8 = 1.0 / (dval[id2] - dval[id1])
101 pr7 = 1.0 / (dval[id1] - dval[id3])
102 cden1 = -pr7 * pr8
103 cden2 = -pr8 * pr9
104 cden3 = -pr9 * pr7
105 for nn in range(1, 4): # label 20
106 id_ = id1 + nn - 1
107 df1[1, nn] = dtable[1, id_, jt2] - dtable[1, id_, jt1]
108 df2[1, nn] = dtable[1, id_, jt3] - dtable[1, id_, jt2] - df1[1, nn]
109 ff[1, nn] = dtable[1, id_, jt1] + ttud * df1[1, nn] + ttcu * df2[1, nn]
110 dpel2 = 2.0 * (ff[1, 1] * cden1 + ff[1, 2] * cden2 + ff[1, 3] * cden3)
111
112 # label 30: Lagrange interpolation in x (Fortran lines 149–171).
113 dx1 = xx - dval[id1]
114 dx2 = xx - dval[id2]
115 dx3 = xx - dval[id3]
116 cl1 = dx2 * dx3 * cden1
117 cl2 = dx3 * dx1 * cden2
118 cl3 = dx1 * dx2 * cden3
119 dcl1 = (dx2 + dx3) * cden1
120 dcl2 = (dx3 + dx1) * cden2
121 dcl3 = (dx1 + dx2) * cden3
122 if ldh:
123 # Debye-Hueckel composition factor, ramped in eta.
124 eta = cl1 * etat8[id1] + cl2 * etat8[id2] + cl3 * etat8[id3]
125 if eta < etadh0:
126 cmfdh = cmfdh0 * math.sqrt(cmfdh0)
127 elif eta > etadh1:
128 cmfdh = cmfdh0 * math.sqrt(cmfdh1)
129 else:
130 t0 = cmfdh0 * math.sqrt(cmfdh0)
131 t1 = cmfdh0 * math.sqrt(cmfdh1)
132 slope = (t1 - t0) / (etadh1 - etadh0)
133 cmfdh = t0 + (eta - etadh0) * slope
134
135 # The total pressure and its derivatives in log rho (Fortran lines
136 # 173–196).
137 pel = cl1 * ff[1, 1] + cl2 * ff[1, 2] + cl3 * ff[1, 3]
138 dpel1 = dcl1 * ff[1, 1] + dcl2 * ff[1, 2] + dcl3 * ff[1, 3]
139 dl8 = dml - emul8
140 d8 = math.exp(c.cln * dl8)
141 pa = ramut * d8
142 pe = math.exp(c.cln * pel)
143 if ldh:
144 pdh = debhu_mod.cdh * cmfdh * math.sqrt(d8 / t) * d8
145 pt = pa + pe + pr
146 if ldh:
147 pt = pt + pdh
148 pdhp = pdh / pt
149 ptl = math.log10(pt)
150 pr7 = (pa + pe * dpel1) / pt
151 if ldh:
152 pr7 = pr7 + 1.5 * pdhp
153 pr8 = (ptl - pl8) / pr7
154 pr9 = c.cln * ((pa + pe * (dpel1**2 + dpel2 / c.cln)) / (pt * pr7) - pr7)
155 if ldh:
156 pr9 = pr9 + 2.25 * pdhp / pr7
157
158 # Second-order correction 0.5*pr9*pr8**2, formed through logs
159 # (Fortran lines 199–220).
160 factor = abs(pr8)
161 if factor < 1e-15:
162 factor = 1e-15
163 pr8l = math.log10(factor)
164 pr9l = math.log10(abs(pr9))
165 factl = math.log10(0.5) + pr9l + 2.0 * pr8l
166 fact = math.exp(c.cln * factl)
167 fact = math.copysign(fact, pr9)
168 corr = -pr8 - fact
169 if corr > 4.0:
170 corr = 4.0
171 if corr < -4.0:
172 corr = -4.0
173 if abs(corr) >= 1.0e-08:
174 dml = dml + corr
175 nden = nden + 1
176 if nden <= 20:
177 continue
178 # Question (see the page): returns unconverged, with dl, d and
179 # the derivatives as the caller passed them.
180 iounits_mod.write(
181 iounits_mod.ishort,
182 f"EQRELV: Did not Converge: T,P,Pcalc,Dcalc,CORR"
183 f"{tl:10.6f}{pl:10.6f}{ptl:10.6f}{dml:10.6f}{corr:20.12f}")
184 return (dl, d, eta, qdt, qdp, qcp, dela, qdtt, qdtp, qat, qap,
185 qcpt, qcpp)
186 break
187
188 dl = dl8
189 d = d8
190
191 # The other table columns: log U_e, and the derivatives (Fortran lines
192 # 221–231).
193 for kk in range(2, 6): # label 60
194 for nn in range(1, 4): # label 50
195 id_ = id1 + nn - 1
196 df1[kk, nn] = dtable[kk, id_, jt2] - dtable[kk, id_, jt1]
197 df2[kk, nn] = (dtable[kk, id_, jt3] - dtable[kk, id_, jt2]) - df1[kk, nn]
198 ff[kk, nn] = dtable[kk, id_, jt1] + ttud * df1[kk, nn] + ttcu * df2[kk, nn]
199 ffe[kk] = cl1 * ff[kk, 1] + cl2 * ff[kk, 2] + cl3 * ff[kk, 3]
200
201 # Pressure derivatives (Fortran lines 233–262).
202 peq = math.exp(c.cln * ffe[3])
203 qped = ffe[4]
204 qqpedd = (dcl1 * ff[4, 1] + dcl2 * ff[4, 2] + dcl3 * ff[4, 3]) * c.clni
205 pr1 = df1[3, 1] + ttdcu * df2[3, 1]
206 pr2 = df1[3, 2] + ttdcu * df2[3, 2]
207 pr3 = df1[3, 3] + ttdcu * df2[3, 3]
208 pr4 = dcl1 * ff[3, 1] + dcl2 * ff[3, 2] + dcl3 * ff[3, 3]
209 pr5 = 5.0 * (cl1 * pr1 + cl2 * pr2 + cl3 * pr3)
210 qpeqd = peq * pr4
211 qpeqt = peq * (pr5 - 1.50 * pr4)
212 qpt = (pa + peq) * pinv + 4.0 * beta1
213 if ldh:
214 qpt = qpt - 0.5 * pdhp
215 qpd = (pa + pe * qped) * pinv
216 if ldh:
217 qpd = qpd + 1.5 * pdhp
218 qqptt = (pa + qpeqt) * pinv + 16.0 * beta1 - qpt**2
219 if ldh:
220 qqptt = qqptt + (0.5 * qpt + 0.25) * pdhp
221 qqpdt = (pa + qpeqd) * pinv - qpt * qpd
222 if ldh:
223 qqpdt = qqpdt + (0.5 * qpt - 0.75) * pdhp
224 qqpdd = (pa + pe * (qped**2 + qqpedd)) * pinv - qpd**2
225 if ldh:
226 qqpdd = qqpdd + (-1.5 * qpd + 2.25) * pdhp
227
228 # Density derivatives, by inversion (Fortran lines 264–269).
229 qdp = 1.0 / qpd
230 qdt = -qpt * qdp
231 pr1 = qdp**2
232 qdpp = -qqpdd * qdp * pr1
233 qdtp = -qpt * qdpp - qqpdt * pr1
234 qdtt = -qpt * qdtp - qdp * (qqptt + qdt * qqpdt)
235
236 # Internal energy and its derivatives (Fortran lines 271–309).
237 ue = math.exp(c.cln * (ffe[2] + emul))
238 ueq = math.exp(c.cln * (ffe[5] + emul))
239 pr1 = df1[5, 1] + ttdcu * df2[5, 1]
240 pr2 = df1[5, 2] + ttdcu * df2[5, 2]
241 pr3 = df1[5, 3] + ttdcu * df2[5, 3]
242 pr4 = dcl1 * ff[5, 1] + dcl2 * ff[5, 2] + dcl3 * ff[5, 3]
243 pr5 = 5.0 * (cl1 * pr1 + cl2 * pr2 + cl3 * pr3)
244 queqt = ueq * (pr5 - 1.50 * pr4)
245 pd = p / d
246 pdt = pd / t
247 ua = 1.50 * ramut
248 ur = 3.0 * beta1 * pd
249 if ldh:
250 udh = 3.0 * pdh / d8
251 u = ua + ue + ur
252 if ldh:
253 u = u + udh
254 udhu = udh / u
255 ui = 1.0 / u
256 pdu = pd * ui
257 qutd = (ua + ueq + 4.0 * ur) * ui
258 if ldh:
259 qutd = qutd - 0.5 * udhu
260 qudt = pdu * (1.0 - qpt)
261 if ldh:
262 qudt = qudt + 0.5 * udhu
263 qutp = qutd + qdt * qudt
264 qqutt = (ua + queqt + 16.0 * ur) * ui - qutd**2
265 if ldh:
266 qqutt = qqutt + (0.5 * qutd + 0.25) * udhu
267 qqudt = qudt * (qpt - qutd) - pdu * qqptt
268 if ldh:
269 qqudt = qqudt + (0.5 * qudt - 0.25) * udhu
270
271 # c_P, nabla_ad and their derivatives (Fortran lines 311–328).
272 pr1 = -pdt * qdt
273 pr2 = u / t
274 pr3 = -(1.0 + qdt) + qdtt / qdt
275 pr4 = (1.0 - qdp) + qdtp / qdt
276 acp = pr1 * qpt
277 bcp = pr2 * qutd
278 qcp = acp + bcp
279 qcpi = 1.0 / qcp
280 qcpt = (acp * pr3 + pr1 * (qqptt + qdt * qqpdt)
281 + bcp * (qutp - 1.0) + pr2 * (qqutt + qdt * qqudt))
282 qcpp = acp * pr4 + qdp * (pr1 * qqpdt + bcp * qudt + pr2 * qqudt)
283 qcpt = qcpt * qcpi
284 qcpp = qcpp * qcpi
285 dela = pr1 * qcpi
286 qat = pr3 - qcpt
287 qap = pr4 - qcpp
288 eta = cl1 * etat8[id1] + cl2 * etat8[id2] + cl3 * etat8[id3]
289
290 return (dl, d, eta, qdt, qdp, qcp, dela, qdtt, qdtp, qat, qap, qcpt,
291 qcpp)