From 70554a3bdd064ace5674147c6c9468d06a4c02fa Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 07:00:40 -0700 Subject: [PATCH 01/70] Initial check-in of eos17.f --- EOS/pc/eos17.f | 2315 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 2315 insertions(+) create mode 100755 EOS/pc/eos17.f diff --git a/EOS/pc/eos17.f b/EOS/pc/eos17.f new file mode 100755 index 0000000000..8add04da4c --- /dev/null +++ b/EOS/pc/eos17.f @@ -0,0 +1,2315 @@ +** Equation of state for fully ionized electron-ion plasmas (EOS EIP) +* A.Y.Potekhin & G.Chabrier, Contrib. Plasma Phys., 50 (2010) 82, +* and references therein +* Please communicate comments/suggestions to Alexander Potekhin: +* palex@astro.ioffe.ru +* Previously distributed versions (obsolete): +* eos2000, eos2002, eos2004, eos2006, eos2007, eos2009, eos10, eos11, +* eos13, and eos14. +* Last update: 04.03.21. All updates since 2008 are listed below. +** L I S T O F S U B R O U T I N E S : +* MAIN (normally commented-out) - example driving routine. +* MELANGE9 - for arbitrary ionic mixture, renders total (ion+electron) +* pressure, internal energy, entropy, heat capacity (all +* normalized to the ionic ideal-gas values), logarithmic +* derivatives of pressure over temperature and density. +* EOSFI8 - nonideal (ion-ion + ion-electron + electron-electron) +* contributions to the free and internal energies, pressure, +* entropy, heat capacity, derivatives of pressure over +* logarithm of temperature and over logarithm of density (all +* normalized to the ionic ideal-gas values) for one ionic +* component in a mixture. +* FITION9 - ion-ion interaction contributions to the free and internal +* energies, pressure, entropy, heat capacity, derivatives of +* pressure over logarithms of temperature and density. +* FSCRliq8 - ion-electron (screening) contributions to the free and +* internal energies, pressure, entropy, heat capacity, +* derivatives of pressure over logarithms of temperature and +* density in the liquid phase for one ionic component in a +* mixture. +* FSCRsol8 - ion-electron (screening) contributions to the free and +* internal energies, pressure, entropy, heat capacity, +* derivatives of pressure over logarithms of temperature and +* density for monoionic solid. +* FHARM12 - harmonic (including static-lattice and zero-point) +* contributions to the free and internal energies, pressure, +* entropy, heat capacity, derivatives of pressure over +* logarithms of temperature and density for solid OCP. +* HLfit12 - the same as FHARM12, but only for thermal contributions +* ANHARM8 - anharmonic contributions to the free and internal energies, +* pressure, entropy, heat capacity, derivatives of pressure +* over logarithms of temperature and density for solid OCP. +* CORMIX - correction to the linear mixing rule for the Coulomb +* contributions to the thermodynamic functions in the liquid. +* ELECT11 - for an ideal electron gas of arbitrary degeneracy and +* relativity at given temperature and electron chemical +* potential, renders number density (in atomic units), free +* energy, pressure, internal energy, entropy, heat capacity +* (normalized to the electron ideal-gas values), logarithmic +* derivatives of pressure over temperature and density. +* EXCOR7 - electron-electron (exchange-correlation) contributions to +* the free and internal energies, pressure, entropy, heat +* capacity, derivatives of pressure over logarithm of +* temperature and over logarithm of density (all normalized +* to the classical electron ideal-gas values). +* FERINV7 - inverse non-relativistic Fermi integrals of orders -1/2, +* 1/2, 3/2, 5/2, and their first and second derivatives. +* BLIN9 - relativistic Fermi-Dirac integrals of orders 1/2, 3/2, 5/2, +* and their first, second, and some third derivatives. +* CHEMFIT7 - electron chemical potential at given density and +* temperature, and its first derivatives over density and +* temperature and the second derivative over temperature. +** I M P R O V E M E N T S S I N C E 2 0 0 8 : +* FHARM8 uses a fit HLfit8 to the thermal free energy of the harmonic +* Coulomb lattice, which is more accurate than its predecessor FHARM7. +* Resulting corrections amount up to 20% for the ion heat capacity. +* Accordingly, S/R D3fit and FthCHA7 deleted (not used anymore). +* BLIN7 upgraded to BLIN8: +* - cleaned (a never-reached if-else branch deleted); +* - Sommerfeld (high-\chi) expansion improved; +* - some third derivatives added. +* CORMIX added (and MELANGE7 upgraded to MELANGE8 accordingly). +* ANHARM7 upgraded to ANHARM8, more consistent with Wigner-Kirkwood. +* Since the T- and rho-dependences of individual Z values in a mixture +* are not considered, the corresponding inputs (AYLR, AYLT) are +* excluded from MELANGE8 (and EOSFI7 changed to EOSFI8 accordingly). +* ELECT7 upgraded to ELECT9 (high-degeneracy behaviour is improved) +** P O S T - P U B L I C A T I O N (2 0 1 0 +) IMPROVEMENTS : +* ELECT9 upgraded (smooth match of two fits at chi >> 1) +* BLIN8 replaced by BLIN9 - smooth fit interfaces at chi=0.6 and 14. +* MELANGE8 replaced by MELANGE9 - slightly modified input/output +* 08.08.11 - corrected mistake (unlikely to have an effect) in CHEMFIT7 +* 16.11.11 - ELECT9 upgraded to ELECT11 (additional output) +* 20.04.12 - FHARM8 and HLfit8 upgraded to FHARM12 and HLfit12: +* output of HLfit12 does not include zero-point vibr., but provides U1 +* 22.12.12 - MELANGE9 now includes a correction to the linear mixing +* rule (LMR) for the Madelung energy in the random bcc multi-ion +* lattice. +* 14.05.13 - an accidental error in programming the newly introduced +* correction to the LMR is fixed. +* 20.05.13 - calculation of the Wigner-Kirkwood quantum diffraction term +* for the liquid plasma is moved from EOSFI8 into MELANGE9. +* 10.12.14 - slight cleaning of the text (no effect on the results) +* 28.05.15 - an accidental error in Wigner-Kirkwood entropy correction +* is fixed (it was in the line "Stot=Stot+FWK*DENSI" since 20.05.13) +* 29.08.15 - eliminated underflow of exp(-THETA) in CHEMFIT7 +* 10.08.16 - modified criteria to avoid accuracy loss (round-off errors) +* 07.02.17 - included possibility to switch off the WK (Wigner) terms +* 27.05.17 - safeguard against Zion < 1 is added in FSCRsol8; +* safeguard against huge (-CHI) values is added in ELECT11. +* 27.01.19 - safeguard against X1=0 in CORMIX. +* 18.04.20 - corrected Wigner-Kirkwood term for heat capacity. +* 04.03.21 - corrected SUBFERMJ: defined parameter EPS (was undefined). +************************************************************************ +* MAIN program: Version 02.06.09 +* This driving routine allows one to compile and run this code "as is". +* In practice, however, one usually needs to link subroutines from this +* file to another (external) code, therefore the MAIN program is +* normally commented-out. +C%C implicit double precision (A-H), double precision (O-Z) +C%C parameter(MAXY=10,UN_T6=.3157746,EPS=1.d-7) +C%C dimension AY(MAXY),AZion(MAXY),ACMI(MAXY) +C%C write(*,'('' Introduce the chemical composition (up to'',I3, +C%C * '' ion species):''/ +C%C * '' charge number Z_i, atomic weight A_i,'', +C%C * '' partial number density x_i, derivatives d x_i / d ln T'', +C%C * '' and d x_i / d ln rho''/ +C%C / '' (non-positive Z, A, or x=1 terminates the input)'')') MAXY +C%C NMIX=0 +C%C 3 continue +C%C XSUM=0. +C%C do IX=1,MAXY +C%C write(*,'(''Z, A ('',I2,''): ''$)') IX +C%C read*,AZion(IX),ACMI(IX) +C%C if (AZion(IX).le.0..or.ACMI(IX).le.0.) goto 2 +C%C write(*,'(''x ('',I2,''): ''$)') IX +C%C read*,AY(IX) +C%C XSUM=XSUM+AY(IX) +C%C if (AY(IX).le.0.) goto 2 +C%C NMIX=IX +C%C if (dabs(XSUM-1.d0).lt.EPS) goto 2 +C%C enddo +C%C 2 continue +C%C if (NMIX.eq.0) then +C%C print*,'There must be at least one set of positive (x,Z,A).' +C%C goto 3 +C%C endif +C%C write(*,114) +C%C do IX=1,NMIX +C%C write(*,113) IX,AZion(IX),ACMI(IX),AY(IX) +C%C enddo +C%C 9 continue +C%C write(*,'('' Input T (K) (<0 to stop): ''$)') +C%C read*,T +C%C if (T.le.0.) stop +C%C 10 continue +C%C write(*,'('' Input RHO [g/cc] (<0 to new T): ''$)') +C%C read*,RHO +C%C if (RHO.le.0.) goto 9 +C%C RHOlg=dlog10(RHO) +C%C Tlg=dlog10(T) +C%C T6=10.d0**(Tlg-6.d0) +C%C RHO=10.d0**RHOlg +C%C write(*,112) +C%C 1 continue +C%C TEMP=T6/UN_T6 ! T [au] +C%C call MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP, ! input +C%C * PRADnkT, ! additional output - radiative pressure +C%C * DENS,Zmean,CMImean,Z2mean,GAMI,CHI,TPT,LIQSOL, ! output param. +C%C * PnkT,UNkT,SNk,CV,CHIR,CHIT) ! output dimensionless TD functions +C%C Tnk=8.31447d13/CMImean*RHO*T6 ! n_i kT [erg/cc] +C%C P=PnkT*Tnk/1.d12 ! P [Mbar] +C%C TEGRAD=CHIT/(CHIT**2+CHIR*CV/PnkT) ! from Maxwell relat. +* -------------------- OUTPUT -------------------------------- * +* Here in the output we have: +* RHO - mass density in g/cc +* P - total pressure in Mbar (i.e. in 1.e12 dyn/cm^2) +* PnkT=P/nkT, where n is the number density of ions, T temperature +* CV - heat capacity at constant volume, divided by number of ions, /k +* CHIT - logarithmic derivative of pressure \chi_T +* CHIR - logarithmic derivative of pressure \chi_\rho +* UNkT - internal energy divided by NkT, N being the number of ions +* SNk - entropy divided by number of ions, /k +* GAMI - ionic Coulomb coupling parameter +* TPT=T_p/T, where T_p is the ion plasma temperature +* CHI - electron chemical potential, divided by kT +* LIQSOL = 0 in the liquid state, = 1 in the solid state +C%C write(*,111) RHO,T6,P,PnkT,CV,CHIT,CHIR,UNkT,SNk,GAMI,TPT,CHI, +C%C * LIQSOL +C%C goto 10 +C%C 112 format(/ +C%C * ' rho [g/cc] T6 [K] P [Mbar] P/(n_i kT) Cv/(N k)', +C%C * ' chi_T chi_r U/(N k T) S/(N k) Gamma_i', +C%C * ' T_p/T chi_e liq/sol') +C%C 111 format(1P,12E12.3,I2) +C%C 113 format(I3,2F8.3,1PE12.4) +C%C 114 format(' Z CMI x_j') +C%C end + + subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, + * DENS,Zmean,CMImean,Z2mean,GAMImean,CHI,TPT,LIQSOL, + * PnkT,UNkT,SNk,CV,CHIR,CHIT) +* Version 18.04.20 +* Difference from v.10.12.14: included switch-off of WK correction +* Stems from MELANGE8 v.26.12.09. +* Difference: output PRADnkT instead of input KRAD +* + EOS of fully ionized electron-ion plasma mixture. +* Limitations: +* (a) inapplicable in the regimes of +* (1) bound-state formation, +* (2) quantum liquid, +* (3) presence of positrons; +* (b) for the case of a composition gradually depending on RHO or TEMP, +* second-order functions (CV,CHIR,CHIT in output) should not be trusted +* Choice of the liquid or solid regime - criterion GAMI [because the +* choice based on comparison of total (non-OCP) free energies can be +* sometimes dangerous because of the fit uncertainties ("Local field +* correction" in solid and quantum effects in liquid are unknown)]. +* Input: NMIX - number of different elements; +* AY - their partial number densities, +* AZion and ACMI - their charge and mass numbers, +* RHO - total mass density [g/cc] +* TEMP - temperature [in a.u.=2Ryd=3.1577e5 K]. +* NB: instead of RHO, a true input is CHI, defined below +* Hence, disagreement between RHO and DENS is the fit error (<0.4%) +* Output: +* AY - rescaled so that to sum up to 1 and resorted (by AZion) +* AZion - resorted in ascending order +* ACMI - resorted in agreement with AZion +* DENS - electron number density [in a.u.=6.7483346e24 cm^{-3}] +* Zmean=, CMImean= - mean ion charge and mass numbers, +* Z2mean= - mean-square ion charge number +* GAMImean - effective ion-ion Coulomb coupling constant +* CHI = mu_e/kT, where mu_e is the electron chem.potential +* TPT - effective ionic quantum parameter (T_p/T) +* LIQSOL=0/1 for liquid/solid +* SNk - dimensionless entropy per 1 ion +* UNkT - internal energy per kT per ion +* PnkT - pressure / n_i kT, where n_i is the ion number density +* PRADnkT - radiative pressure / n_i kT +* CV - heat capacity per ion, div. by Boltzmann const. +* CHIR - inverse compressibility -(d ln P / d ln V)_T ("\chi_r") +* CHIT = (d ln P / d ln T)_V ("\chi_T") + implicit double precision (A-H), double precision (O-Z) + character CHWK + save + parameter(TINY=1.d-7) + dimension AY(*),AZion(*),ACMI(*) + parameter (PI=3.141592653d0,C53=5.d0/3.d0,C13=1.d0/3.d0, + * AUM=1822.888d0, ! a.m.u./m_e + * GAMIMELT=175., ! OCP value of Gamma_i for melting + * RSIMELT=140., ! ion density parameter of quantum melting + * RAD=2.554d-7) ! Radiation constant (=4\sigma/c) (in a.u.) + data KRUN/0/ + if (RHO.lt.1.e-19.or.RHO.gt.1.e15) stop'MELANGE: RHO out of range' + if (KRUN.ne.12345) then + write(*,'('' To include Wigner corrections? (N/Y) ''$)') + read(*,'(A)') CHWK + CWK=0. + if (CHWK.eq.'y'.or.CHWK.eq.'Y') CWK=1.d0 + KRUN=12345 + endif + Y=0. + do IX=1,NMIX + Y=Y+AY(IX) + enddo + if (dabs(Y-1.d0).gt.TINY) then + do IX=1,NMIX + AY(IX)=AY(IX)/Y + enddo + print*,'MELANGE9: partial densities (and derivatives)', + * ' are rescaled by factor',1./Y + endif +* Sort the elements in ascending order in Z_j: + KSORT=0 + do I=2,NMIX + J=I + Z=AZion(J) + CMI=ACMI(J) + Y=AY(J) + 1 if (J.le.1.or.AZion(J-1).le.Z) goto 2 + AZion(J)=AZion(J-1) + ACMI(J)=ACMI(J-1) + AY(J)=AY(J-1) + J=J-1 + KSORT=1 + goto 1 + 2 AZion(J)=Z + ACMI(J)=CMI + AY(J)=Y + enddo + if (KSORT.eq.1) write(*,'('' Ions are resorted as follows:''/ + * '' i Z_i A_i x_i''/(0P,I3,'':'',1P,3E10.3))') + * (J,AZion(J),ACMI(J),AY(J),J=1,NMIX) +* Calculation of average values: + Zmean=0. + Z2mean=0. + Z52=0. + Z53=0. + Z73=0. + Z321=0. ! corr.26.12.09 + CMImean=0. + do IX=1,NMIX + Zmean=Zmean+AY(IX)*AZion(IX) + Z2mean=Z2mean+AY(IX)*AZion(IX)**2 + Z13=AZion(IX)**C13 + Z53=Z53+AY(IX)*Z13**5 + Z73=Z73+AY(IX)*Z13**7 + Z52=Z52+AY(IX)*dsqrt(AZion(IX))**5 + Z321=Z321+AY(IX)*AZion(IX)*dsqrt(AZion(IX)+1.d0)**3 ! 26.12.09 + CMImean=CMImean+AY(IX)*ACMI(IX) + enddo +* (0) Photons: + UINTRAD=RAD*TEMP**4 + PRESSRAD=UINTRAD/3. +C CVRAD=4.*UINTRAD/TEMP +* (1) ideal electron gas (including relativity and degeneracy) ----- * + DENS=RHO/11.20587*Zmean/CMImean ! number density of electrons [au] + call CHEMFIT(DENS,TEMP,CHI) +* NB: CHI can be used as true input instead of RHO or DENS + call ELECT11(TEMP,CHI, + * DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, + * DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) +* NB: at this point DENS is redefined (the difference can be ~0.1%) + DTE=DENS*TEMP + PRESSE=PEid*DTE ! P_e [a.u.] + UINTE=UEid*DTE ! U_e / V [a.u.] +* (2) non-ideal Coulomb EIP ---------------------------------------- * + RS=(.75d0/PI/DENS)**C13 ! r_s - electron density parameter + RSI=RS*CMImean*Z73*AUM ! R_S - ion density parameter + GAME=1.d0/RS/TEMP ! electron Coulomb parameter Gamma_e + GAMImean=Z53*GAME ! effective Gamma_i - ion Coulomb parameter + if (GAMImean.lt.GAMIMELT.or.RSI.lt.RSIMELT) then + LIQSOL=0 ! liquid regime + else + LIQSOL=1 ! solid regime + endif +* Calculate partial thermodynamic quantities and combine them together: + UINT=UINTE + PRESS=PRESSE + CVtot=CVE*DENS + Stot=SEid*DENS + PDLT=PRESSE*CHITE ! d P_e[a.u.] / d ln T + PDLR=PRESSE*CHIRE ! d P_e[a.u.] / d ln\rho + DENSI=DENS/Zmean ! number density of all ions + PRESSI=DENSI*TEMP ! ideal-ions total pressure (normalization) + TPT2=0. + CTP=4.d0*PI/AUM/TEMP**2 ! common coefficient for TPT2.10.12.14 +* Add Coulomb+xc nonideal contributions, and ideal free energy: + do IX=1,NMIX + if (AY(IX).lt.TINY) goto 10 ! skip this species + Zion=AZion(IX) + CMI=ACMI(IX) + GAMI=Zion**C53*GAME ! Gamma_i for given ion species + DNI=DENSI*AY(IX) ! number density of ions of given type + PRI=DNI*TEMP ! = ideal-ions partial pressure (normalization) + call EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, + * FC1,UC1,PC1,SC1,CV1,PDT1,PDR1, + * FC2,UC2,PC2,SC2,CV2,PDT2,PDR2) +* First-order TD functions: + UINT=UINT+UC2*PRI ! internal energy density (e+i+Coul.) + Stot=Stot+DNI*(SC2-dlog(AY(IX))) !entropy per unit volume[a.u.] + PRESS=PRESS+PC2*PRI ! pressure (e+i+Coul.) [a.u.] +* Second-order functions (they take into account compositional changes): + CVtot=CVtot+DNI*CV2 ! C_V (e+i+Coul.)/ V (optim.10.12.14) + PDLT=PDLT+PRI*PDT2 ! d P / d ln T + PDLR=PDLR+PRI*PDR2 ! d P / d ln\rho + TPT2=TPT2+CTP*DNI/ACMI(IX)*AZion(IX)**2 ! opt.10.12.14 + 10 continue + enddo ! next IX +* Wigner-Kirkwood perturbative correction for liquid: + TPT=dsqrt(TPT2) ! effective T_p/T - ion quantum parameter +* (in the case of a mixture, this estimate is crude) + if (LIQSOL.eq.0) then + FWK=TPT2/24.d0*CWK ! Wigner-Kirkwood (quantum diffr.) term + if (FWK.gt..7.and.CWK.gt.0.) then + print*,'MELANGE9: strong quantum effects in liquid!' + read(*,'(A)') + endif + UWK=2.d0*FWK + UINT=UINT+UWK*PRESSI + Stot=Stot+FWK*DENSI ! corrected 28.05.15 + PRESS=PRESS+FWK*PRESSI + CVtot=CVtot-UWK*DENSI ! corrected 18.04.20 + PDLT=PDLT-FWK*PRESSI + PDLR=PDLR+UWK*PRESSI + endif +* Corrections to the linear mixing rule: + if (LIQSOL.eq.0) then ! liquid phase + call CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, + * FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) + else ! solid phase (only Madelung contribution) [22.12.12] + FMIX=0. + do I=1,NMIX + do J=I+1,NMIX + RZ=AZion(J)/AZion(I) + X2=AY(J)/(AY(I)+AY(J)) + X1=dim(1.d0,X2) + if (X1.lt.TINY) goto 11 ! 27.01.19 + if (X2.lt.TINY) goto 11 + X=X2/RZ+(1.d0-1.d0/RZ)*X2**RZ + GAMI=AZion(I)**C53*GAME ! Gamma_i corrected 14.05.13 + DeltaG=.012*(1.d0-1.d0/RZ**2)*(X1+X2*RZ**C53) + DeltaG=DeltaG*X/X2*dim(1.d0,X)/X1 + FMIX=FMIX+AY(I)*AY(J)*GAMI*DeltaG + 11 continue + enddo + enddo + UMIX=FMIX + PMIX=FMIX/3.d0 + CVMIX=0. + PDTMIX=0. + PDRMIX=FMIX/2.25d0 + endif + UINT=UINT+UMIX*PRESSI + Stot=Stot+DENSI*(UMIX-FMIX) + PRESS=PRESS+PMIX*PRESSI + CVtot=CVtot+DENSI*CVMIX + PDLT=PDLT+PRESSI*PDTMIX + PDLR=PDLR+PRESSI*PDRMIX +* First-order: + PRADnkT=PRESSRAD/PRESSI ! radiative pressure / n_i k T +C CVtot=CVtot+CVRAD +C Stot=Stot+CVRAD/3. + PnkT=PRESS/PRESSI ! P / n_i k T + UNkT=UINT/PRESSI ! U / N_i k T +C UNkT=UNkT+UINTRAD/PRESSI + SNk=Stot/DENSI ! S / N_i k +* Second-order: + CV=CVtot/DENSI ! C_V per ion + CHIR=PDLR/PRESS ! d ln P / d ln\rho + CHIT=PDLT/PRESS ! d ln P / d ln T +C CHIT=CHIT+4.*PRESSRAD/PRESS ! d ln P / d ln T + return + end + + subroutine EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, + * FC1,UC1,PC1,SC1,CV1,PDT1,PDR1, + * FC2,UC2,PC2,SC2,CV2,PDT2,PDR2) +* Version 16.09.08 +* call FHARM8 has been replaced by call FHARM12 27.04.12 +* Wigner-Kirkwood correction excluded 20.05.13 +* slight cleaning 10.12.14 +* Non-ideal parts of thermodynamic functions in the fully ionized plasma +* Stems from EOSFI5 and EOSFI05 v.04.10.05 +* Input: LIQSOL=0/1(liquid/solid), +* Zion,CMI - ion charge and mass numbers, +* RS=r_s (electronic density parameter), +* GAMI=Gamma_i (ion coupling), +* Output: FC1 and UC1 - non-ideal "ii+ie+ee" contribution to the +* free and internal energies (per ion per kT), +* PC1 - analogous contribution to pressure divided by (n_i kT), +* CV1 - "ii+ie+ee" heat capacity per ion [units of k] +* PDT1=(1/n_i kT)*(d P_C/d ln T)_V +* PDR1=(1/n_i kT)*(d P_C/d ln\rho)_T +* FC2,UC2,PC2,SC2,CV2 - analogous to FC1,UC1,PC1,SC1,CV1, but including +* the part corresponding to the ideal ion gas. This is useful for +* preventing accuracy loss in some cases (e.g., when SC2 << SC1). +* FC2 does not take into account the entropy of mixing S_{mix}: in a +* mixture, S_{mix}/(N_i k) has to be added externally (see MELANGE9). +* FC2 does not take into account the ion spin degeneracy either. +* When needed, the spin term must be added to the entropy externally. + implicit double precision (A-H), double precision (O-Z) + save + parameter(C53=5.d0/3.d0,C76=7.d0/6.d0) ! TINY excl.10.12.14 + parameter (AUM=1822.888d0) ! a.m.u/m_e + if (LIQSOL.ne.1.and.LIQSOL.ne.0) stop'EOSFI8: invalid LIQSOL' + if (CMI.le..1) stop'EOSFI8: too small CMI' + if (Zion.le..1) stop'EOSFI8: too small Zion' + if (RS.le..0) stop'EOSFI8: invalid RS' + if (GAMI.le..0) stop'EOSFI8: invalid GAMI' + GAME=GAMI/Zion**C53 + call EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) ! "ee"("xc") +* Calculate "ii" part: + COTPT=dsqrt(3.d0/AUM/CMI)/Zion**C76 ! auxiliary coefficient + TPT=GAMI/dsqrt(RS)*COTPT ! = T_p/T in the OCP + FidION=1.5*dlog(TPT**2/GAMI)-1.323515 +* 1.3235=1+0.5*ln(6/pi); FidION = F_{id.ion gas}/(N_i kT), but without +* the term x_i ln x_i = -S_{mix}/(N_i k). + if (LIQSOL.eq.0) then ! liquid + call FITION9(GAMI, + * FION,UION,PION,CVii,PDTii,PDRii) + FItot=FION+FidION + UItot=UION+1.5 + PItot=PION+1.d0 + CVItot=CVii+1.5d0 + SCItot=UItot-FItot + PDTi=PDTii+1.d0 + PDRi=PDRii+1.d0 + else ! solid + call FHARM12(GAMI,TPT, + * Fharm,Uharm,Pharm,CVharm,Sharm,PDTharm,PDRharm) ! harm."ii" + call ANHARM8(GAMI,TPT,Fah,Uah,Pah,CVah,PDTah,PDRah) ! anharm. + FItot=Fharm+Fah + FION=FItot-FidION + UItot=Uharm+Uah + UION=UItot-1.5d0 ! minus 1.5=ideal-gas, in order to get "ii" + PItot=Pharm+Pah + PION=PItot-1.d0 ! minus 1=ideal-gas + PDTi=PDTharm+PDTah + PDRi=PDRharm+PDRah + PDTii=PDTi-1.d0 ! minus 1=ideal-gas + PDRii=PDRi-1.d0 ! minus 1=ideal-gas + CVItot=CVharm+CVah + SCItot=Sharm+Uah-Fah + CVii=CVItot-1.5d0 ! minus 1.5=ideal-gas + endif +* Calculate "ie" part: + if (LIQSOL.eq.1) then + call FSCRsol8(RS,GAMI,Zion,TPT, + * FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR) + else + call FSCRliq8(RS,GAME,Zion, + * FSCR,USCR,PSCR,CVSCR,PDTSCR,PDRSCR) + S_SCR=USCR-FSCR + endif +* Total excess quantities ("ii"+"ie"+"ee", per ion): + FC0=FSCR+Zion*FXC + UC0=USCR+Zion*UXC + PC0=PSCR+Zion*PXC + SC0=S_SCR+Zion*SXC + CV0=CVSCR+Zion*CVXC + PDT0=PDTSCR+Zion*PDTXC + PDR0=PDRSCR+Zion*PDRXC + FC1=FION+FC0 + UC1=UION+UC0 + PC1=PION+PC0 + SC1=(UION-FION)+SC0 + CV1=CVii+CV0 + PDT1=PDTii+PDT0 + PDR1=PDRii+PDR0 +* Total excess + ideal-ion quantities + FC2=FItot+FC0 + UC2=UItot+UC0 + PC2=PItot+PC0 + SC2=SCItot+SC0 + CV2=CVItot+CV0 + PDT2=PDTi+PDT0 + PDR2=PDRi+PDR0 + return + end + +* ================== ELECTRON-ION COULOMB LIQUID =================== * + subroutine FITION9(GAMI,FION,UION,PION,CVii,PDTii,PDRii) +* Version 11.09.08 +* Dummy argument Zion is deleted in 2009. +* Non-ideal contributions to thermodynamic functions of classical OCP. +* Stems from FITION00 v.24.05.00. +* Input: GAMI - ion coupling parameter +* Output: FION - ii free energy / N_i kT +* UION - ii internal energy / N_i kT +* PION - ii pressure / n_i kT +* CVii - ii heat capacity / N_i k +* PDTii = PION + d(PION)/d ln T = (1/N_i kT)*(d P_{ii}/d ln T) +* PDRii = PION + d(PION)/d ln\rho +* Parameters adjusted to Caillol (1999). + implicit double precision (A-H),double precision (O-Z) + save + parameter (A1=-.907347d0,A2=.62849d0,C1=.004500d0,G1=170.0, + * C2=-8.4d-5,G2=.0037,SQ32=.8660254038d0) ! SQ32=sqrt(3)/2 + A3=-SQ32-A1/dsqrt(A2) + F0=A1*(dsqrt(GAMI*(A2+GAMI))- + - A2*dlog(dsqrt(GAMI/A2)+dsqrt(1.+GAMI/A2)))+ + + 2.*A3*(dsqrt(GAMI)-datan(dsqrt(GAMI))) + U0=dsqrt(GAMI)**3*(A1/dsqrt(A2+GAMI)+A3/(1.d0+GAMI)) +* This is the zeroth approximation. Correction: + UION=U0+C1*GAMI**2/(G1+GAMI)+C2*GAMI**2/(G2+GAMI**2) + FION=F0+C1*(GAMI-G1*dlog(1.d0+GAMI/G1))+ + + C2/2.*dlog(1.d0+GAMI**2/G2) + CVii=-0.5*dsqrt(GAMI)**3*(A1*A2/dsqrt(A2+GAMI)**3+ + + A3*(1.d0-GAMI)/(1.d0+GAMI)**2) - + - GAMI**2*(C1*G1/(G1+GAMI)**2+C2*(G2-GAMI**2)/(G2+GAMI**2)**2) + PION=UION/3. + PDRii=(4.*UION-CVii)/9. ! p_{ii} + d p_{ii} / d ln\rho + PDTii=CVii/3. ! p_{ii} + d p_{ii} / d ln T + return + end + + subroutine FSCRliq8(RS,GAME,Zion, + * FSCR,USCR,PSCR,CVSCR,PDTSCR,PDRSCR) ! fit to the el.-ion scr. +* Version 11.09.08 +* cleaned 16.06.09 +* Stems from FSCRliq7 v. 09.06.07. Included a check for RS=0. +* INPUT: RS - density parameter, GAME - electron Coulomb parameter, +* Zion - ion charge number, +* OUTPUT: FSCR - screening (e-i) free energy per kT per 1 ion, +* USCR - internal energy per kT per 1 ion (screen.contrib.) +* PSCR - pressure divided by (n_i kT) (screen.contrib.) +* CVSCR - heat capacity per 1 ion (screen.contrib.) +* PDTSCR,PDRSCR = PSCR + d PSCR / d ln(T,\rho) + implicit double precision(A-H),double precision(O-Z) + save + parameter(XRS=.0140047,TINY=1.d-19) + if (RS.lt.0.) stop'FSCRliq8: RS < 0' + if (RS.lt.TINY) then + FSCR=0. + USCR=0. + PSCR=0. + CVSCR=0. + PDTSCR=0. + PDRSCR=0. + return + endif + SQG=sqrt(GAME) + SQR=sqrt(RS) + SQZ1=dsqrt(1.+Zion) + SQZ=dsqrt(Zion) + CDH0=Zion/1.73205 ! 1.73205=sqrt(3.) + CDH=CDH0*(SQZ1**3-SQZ**3-1.) + SQG=sqrt(GAME) + ZLN=dlog(Zion) + Z13=exp(ZLN/3.) ! Zion**(1./3.) + X=XRS/RS ! relativity parameter + CTF=Zion**2*.2513*(Z13-1.+.2/sqrt(Z13)) +* Thomas-Fermi constant; .2513=(18/175)(12/\pi)^{2/3} + P01=1.11*exp(.475*ZLN) + P03=0.2+0.078*ZLN**2 + PTX=1.16+.08*ZLN + TX=GAME**PTX + TXDG=PTX*TX/GAME + TXDGG=(PTX-1.)*TXDG/GAME + TY1=1./(1.d-3*Zion**2+2.*GAME) + TY1DG=-2.*TY1**2 + TY1DGG=-4.*TY1*TY1DG + TY2=1.+6.*RS**2 + TY2DX=-12.*RS**2/X + TY2DXX=-3.*TY2DX/X + TY=RS**3/TY2*(1.+TY1) + TYX=3./X+TY2DX/TY2 + TYDX=-TY*TYX + TYDG=RS**3*TY1DG/TY2 + P1=(Zion-1.)/9. + COR1=1.+P1*TY + COR1DX=P1*TYDX + COR1DG=P1*TYDG + COR1DXX=P1*(TY*(3./X**2+(TY2DX/TY2)**2-TY2DXX/TY2)-TYDX*TYX) + COR1DGG=P1*RS**3*TY1DGG/TY2 + COR1DXG=-P1*TYDG*TYX + U0=.78*sqrt(GAME/Zion)*RS**3 + U0DX=-3.*U0/X + U0DG=.5*U0/GAME + U0DXX=-4.*U0DX/X + U0DGG=-.5*U0DG/GAME + U0DXG=-3.*U0DG/X + D0DG=Zion**3 + D0=GAME*D0DG+21.*RS**3 + D0DX=-63.*RS**3/X + D0DXX=252.*RS**3/X**2 + COR0=1.+U0/D0 + COR0DX=(U0DX-U0*D0DX/D0)/D0 + COR0DG=(U0DG-U0*D0DG/D0)/D0 + COR0DXX=(U0DXX-(2.*U0DX*D0DX+U0*D0DXX)/D0+2.*(D0DX/D0)**2)/D0 + COR0DGG=(U0DGG-2.*U0DG*D0DG/D0+2.*U0*(D0DG/D0)**2)/D0 + COR0DXG=(U0DXG-(U0DX*D0DG+U0DG*D0DX)/D0+2.*U0*D0DX*D0DG/D0**2)/D0 +* Relativism: + RELE=dsqrt(1.d0+X**2) + Q1=.18/dsqrt(dsqrt(Zion)) + Q2=.2+.37/dsqrt(Zion) + H1U=1.+X**2/5. + H1D=1.+Q1*X+Q2*X**2 + H1=H1U/H1D + H1X=.4*X/H1U-(Q1+2.*Q2*X)/H1D + H1DX=H1*H1X + H1DXX=H1DX*H1X+ + + H1*(.4/H1U-(.4*X/H1U)**2-2.*Q2/H1D+((Q1+2.*Q2*X)/H1D)**2) + UP=CDH*SQG+P01*CTF*TX*COR0*H1 + UPDX=P01*CTF*TX*(COR0DX*H1+COR0*H1DX) + UPDG=.5*CDH/SQG+P01*CTF*(TXDG*COR0+TX*COR0DG)*H1 + UPDXX=P01*CTF*TX*(COR0DXX*H1+2.*COR0DX*H1DX+COR0*H1DXX) + UPDGG=-.25*CDH/(SQG*GAME)+ + + P01*CTF*(TXDGG*COR0+2.*TXDG*COR0DG+TX*COR0DGG)*H1 + UPDXG=P01*CTF*(TXDG*(COR0DX*H1+COR0*H1DX)+ + + TX*(COR0DXG*H1+COR0DG*H1DX)) + DN1=P03*SQG+P01/RS*TX*COR1 + DN1DX=P01*TX*(COR1/XRS+COR1DX/RS) + DN1DG=.5*P03/SQG+P01/RS*(TXDG*COR1+TX*COR1DG) + DN1DXX=P01*TX/XRS*(2.*COR1DX+X*COR1DXX) + DN1DGG=-.25*P03/(GAME*SQG)+ + + P01/RS*(TXDGG*COR1+2.*TXDG*COR1DG+TX*COR1DGG) + DN1DXG=P01*(TXDG*(COR1/XRS+COR1DX/RS)+TX*(COR1DG/XRS+COR1DXG/RS)) + DN=1.+DN1/RELE + DNDX=DN1DX/RELE-X*DN1/RELE**3 + DNDXX=(DN1DXX-((2.*X*DN1DX+DN1)-3.*X**2*DN1/RELE**2)/RELE**2)/RELE + DNDG=DN1DG/RELE + DNDGG=DN1DGG/RELE + DNDXG=DN1DXG/RELE-X*DN1DG/RELE**3 + FSCR=-UP/DN*GAME + FX=(UP*DNDX/DN-UPDX)/DN + FXDG=((UPDG*DNDX+UPDX*DNDG+UP*DNDXG-2.*UP*DNDX*DNDG/DN)/DN- + - UPDXG)/DN + FDX=FX*GAME + FG=(UP*DNDG/DN-UPDG)/DN + FDG=FG*GAME-UP/DN + FDGDH=SQG*DNDG/DN**2 ! d FDG / d CDH + FDXX=((UP*DNDXX+2.*(UPDX*DNDX-UP*DNDX**2/DN))/DN-UPDXX)/DN*GAME + FDGG=2.*FG+GAME*((2.*DNDG*(UPDG-UP*DNDG/DN)+UP*DNDGG)/DN-UPDGG)/DN + FDXG=FX+GAME*FXDG + USCR=GAME*FDG + CVSCR=-GAME**2*FDGG + PSCR=(X*FDX+GAME*FDG)/3. + PDTSCR=-GAME**2*(X*FXDG+FDGG)/3. + PDRSCR=(12.*PSCR+X**2*FDXX+2.*X*GAME*FDXG+GAME**2*FDGG)/9. + return + end + +* ============== SUBROUTINES FOR THE SOLID STATE ================= * + subroutine FSCRsol8(RS,GAMI,ZNUCL,TPT, + * FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR) +* Version 28.05.08 +* undefined zero variable Q1DXG is wiped out 21.06.10 +* accuracy-loss safeguard added 10.08.16 +* safequard against Zion < 1 added 27.05.17 +* Fit to the el.-ion screening in bcc or fcc Coulomb solid +* Stems from FSCRsol8 v.09.06.07. Included a check for RS=0. +* INPUT: RS - el. density parameter, GAMI - ion coupling parameter, +* ZNUCL - ion charge, TPT=T_p/T - ion quantum parameter +* OUTPUT: FSCR - screening (e-i) free energy per kT per 1 ion, +* USCR - internal energy per kT per 1 ion (screen.contrib.) +* PSCR - pressure divided by (n_i kT) (screen.contrib.) +* S_SCR - screening entropy contribution / (N_i k) +* CVSCR - heat capacity per 1 ion (screen.contrib.) +* PDTSCR,PDRSCR = PSCR + d PSCR / d ln(T,\rho) + implicit double precision(A-H),double precision(O-Z) + save + dimension AP(4) ! parameters of the fit + parameter (C13=1.d0/3.d0,ENAT=2.7182818285d0,TINY=1.d-19) + data AP/1.1866,.684,17.9,41.5/,PX/.205/ ! for bcc lattice +cc data AP/1.1857,.663,17.1,40./,PX/.212/ ! for fcc lattice + if (RS.lt.0.) stop'FSCRliq8: RS < 0' + if (RS.lt.TINY) then + FSCR=0. + USCR=0. + PSCR=0. + S_SCR=0. + CVSCR=0. + PDTSCR=0. + PDRSCR=0. + return + endif + Zion=ZNUCL + if (Zion.lt.1.d0) then ! 27.05.17 + print*,'FSCRsol8 WARNING: Z =',Zion,' < 1.' + Zion=1.d0 + endif + XSR=.0140047/RS ! relativity parameter + Z13=Zion**C13 + P1=.00352*(1.-AP(1)/Zion**.267+.27/Zion) + P2=1.d0+2.25/Z13* + *(1.+AP(2)*Zion**5+.222*Zion**6)/(1.+.222*Zion**6) + ZLN=dlog(Zion) + Finf=sqrt(P2/XSR**2+1.)*Z13**2*P1 ! The TF limit + FinfX=-P2/((P2+XSR**2)*XSR) + FinfDX=Finf*FinfX + FinfDXX=FinfDX*FinfX-FinfDX*(P2+3.*XSR**2)/((P2+XSR**2)*XSR) + R1=AP(4)/(1.+ZLN) + R2=.395*ZLN+.347/Zion/sqrt(Zion) + R3=1.d0/(1.d0+ZLN*sqrt(ZLN)*.01+.097/Zion**2) + Q1U=R1+AP(3)*XSR**2 + Q1D=1.d0+R2*XSR**2 + Q1=Q1U/Q1D + Q1X=2.*XSR*(AP(3)/Q1U-R2/Q1D) + Q1XDX=Q1X/XSR+4.*XSR**2*((R2/Q1D)**2-(AP(3)/Q1U)**2) + Q1DX=Q1*Q1X + Q1DXX=Q1DX*Q1X+Q1*Q1XDX +* New quantum factor, in order to suppress CVSCR at TPT >> 1 + if (TPT.lt.6./PX) then + Y0=(PX*TPT)**2 + Y0DX=Y0/XSR + Y0DG=2.*Y0/GAMI + Y0DXX=0. + Y0DGG=Y0DG/GAMI + Y0DXG=Y0DG/XSR + Y1=dexp(Y0) + Y1DX=Y1*Y0DX + Y1DG=Y1*Y0DG + Y1DXX=Y1*(Y0DX**2+Y0DXX) + Y1DGG=Y1*(Y0DG**2+Y0DGG) + Y1DXG=Y1*(Y0DX*Y0DG+Y0DXG) + SA=1.d0+Y1 + SUPA=dlog(SA) + SUPADX=Y1DX/SA + SUPADG=Y1DG/SA + SUPADXX=(Y1DXX-Y1DX**2/SA)/SA + SUPADGG=(Y1DGG-Y1DG**2/SA)/SA + SUPADXG=(Y1DXG-Y1DX*Y1DG/SA)/SA + EM2=ENAT-2.d0 + SB=ENAT-EM2/Y1 + SUPB=dlog(SB) + EM2Y1=EM2/(Y1**2*SB) + SUPBDX=EM2Y1*Y1DX + SUPBDG=EM2Y1*Y1DG + SUPBDXX=EM2Y1*(Y1DXX-2.d0*Y1DX**2/Y1-Y1DX*SUPBDX) + SUPBDGG=EM2Y1*(Y1DGG-2.d0*Y1DG**2/Y1-Y1DG*SUPBDG) + SUPBDXG=EM2Y1*(Y1DXG-2.d0*Y1DX*Y1DG/Y1-Y1DG*SUPBDX) + SUP=dsqrt(SUPA/SUPB) + SUPX=.5d0*(SUPADX/SUPA-SUPBDX/SUPB) + SUPDX=SUP*SUPX + SUPG=.5d0*(SUPADG/SUPA-SUPBDG/SUPB) + SUPDG=SUP*SUPG + SUPDXX=SUPDX*SUPX+ + + SUP*.5d0*(SUPADXX/SUPA-(SUPADX/SUPA)**2- + - SUPBDXX/SUPB+(SUPBDX/SUPB)**2) + SUPDGG=SUPDG*SUPG+ + + SUP*.5d0*(SUPADGG/SUPA-(SUPADG/SUPA)**2- + - SUPBDGG/SUPB+(SUPBDG/SUPB)**2) + SUPDXG=SUPDX*SUPG+ + + SUP*.5d0*((SUPADXG-SUPADX*SUPADG/SUPA)/SUPA- + - (SUPBDXG-SUPBDX*SUPBDG/SUPB)/SUPB) + else + SUP=PX*TPT + SUPDX=.5d0*PX*TPT/XSR + SUPDG=PX*TPT/GAMI + SUPDXX=-.5d0*SUPDX/XSR + SUPDGG=0. + SUPDXG=SUPDX/GAMI + endif + GR3=(GAMI/SUP)**R3 + GR3X=-R3*SUPDX/SUP + GR3DX=GR3*GR3X + GR3DXX=GR3DX*GR3X-R3*GR3*(SUPDXX/SUP-(SUPDX/SUP)**2) + GR3G=R3*(1.d0/GAMI-SUPDG/SUP) + GR3DG=GR3*GR3G + GR3DGG=GR3DG*GR3G+GR3*R3*((SUPDG/SUP)**2-SUPDGG/SUP-1.d0/GAMI**2) + GR3DXG=GR3DG*GR3X+GR3*R3*(SUPDX*SUPDG/SUP**2-SUPDXG/SUP) + W=1.d0+Q1/GR3 + WDX=Q1DX/GR3-Q1*GR3DX/GR3**2 + WDG=-Q1*GR3DG/GR3**2 + WDXX=Q1DXX/GR3- + - (2.d0*Q1DX*GR3DX+Q1*(GR3DXX-2.d0*GR3DX**2/GR3))/GR3**2 + WDGG=Q1*(2.d0*GR3DG**2/GR3-GR3DGG)/GR3**2 + WDXG=-(Q1DX*GR3DG+Q1*(GR3DXG-2.d0*GR3DX*GR3DG/GR3))/GR3**2 + FSCR=-GAMI*Finf*W + FDX=-GAMI*(FinfDX*W+Finf*WDX) + FDXX=-GAMI*(FinfDXX*W+2.d0*FinfDX*WDX+Finf*WDXX) + FDG=-Finf*W-GAMI*Finf*WDG + FDGG=-2.d0*Finf*WDG-GAMI*Finf*WDGG + if (dabs(FDGG).lt.TINY) FDGG=0. ! 10.08.16: roundoff err.safeguard + FDXG=-FinfDX*W-Finf*WDX-GAMI*(FinfDX*WDG+Finf*WDXG) + S_SCR=-GAMI**2*Finf*WDG + USCR=S_SCR+FSCR + CVSCR=-GAMI**2*FDGG + PSCR=(XSR*FDX+GAMI*FDG)/3.d0 + PDTSCR=GAMI**2*(XSR*Finf*(FinfX*WDG+WDXG)-FDGG)/3.d0 + PDRSCR=(12.d0*PSCR+XSR**2*FDXX+2.d0*XSR*GAMI*FDXG+ + + GAMI**2*FDGG)/9.d0 + return + end + + subroutine ANHARM8(GAMI,TPT,Fah,Uah,Pah,CVah,PDTah,PDRah) +* ANHARMONIC free energy Version 27.07.07 +* cleaned 16.06.09 +* Stems from ANHARM8b. Difference: AC=0., B1=.12 (.1217 - over accuracy) +* Input: GAMI - ionic Gamma, TPT=Tp/T - ionic quantum parameter +* Output: anharm.free en. Fah=F_{AH}/(N_i kT), internal energy Uah, +* pressure Pah=P_{AH}/(n_i kT), specific heat CVah = C_{V,AH}/(N_i k), +* PDTah = Pah + d Pah / d ln T, PDRah = Pah + d Pah / d ln\rho + implicit double precision (A-H), double precision (O-Z) + save + parameter(NM=3) + dimension AA(NM) + data AA/10.9,247.,1.765d5/ ! Farouki & Hamaguchi'93 + data B1/.12/ ! coeff.at \eta^2/\Gamma at T=0 + CK=B1/AA(1) ! fit coefficient + TPT2=TPT**2 + TPT4=TPT2**2 + TQ=B1*TPT2/GAMI ! quantum dependence + TK2=CK*TPT2 + SUP=dexp(-TK2) ! suppress.factor of class.anharmonicity + Fah=0. + Uah=0. + Pah=0. + CVah=0. + PDTah=0. + PDRah=0. + SUPGN=SUP + do N=1,NM + CN=N + SUPGN=SUPGN/GAMI ! SUP/Gamma^n + ACN=AA(N) + Fah=Fah-ACN/CN*SUPGN + Uah=Uah+(ACN*(1.+2.*TK2/CN))*SUPGN + PN=AA(N)/3.+TK2*AA(N)/CN + Pah=Pah+PN*SUPGN + CVah=CVah+((CN+1.)*AA(N)+(4.-2./CN)*AA(N)*TK2+ + + 4.*AA(N)*CK**2/CN*TPT4)*SUPGN + PDTah=PDTah+(PN*(1.+CN+2.*TK2)-2./CN*AA(N)*TK2)*SUPGN + PDRah=PDRah+(PN*(1.-CN/3.-TK2)+AA(N)/CN*TK2)*SUPGN + enddo + Fah=Fah-TQ + Uah=Uah-TQ + Pah=Pah-TQ/1.5 + PDRah=PDRah-TQ/4.5 + return + end + + subroutine FHARM12(GAMI,TPT, + * Fharm,Uharm,Pharm,CVth,Sth,PDTharm,PDRharm) +* Thermodynamic functions of a harmonic crystal, incl.stat.Coul.lattice +* +* Version 27.04.12 +* Stems from FHARM8 v.15.02.08 +* Replaced HLfit8 with HLfit12: rearranged output. +* Input: GAMI - ionic Gamma, TPT=T_{p,i}/T +* Output: Fharm=F/(N_i T), Uharm=U/(N_i T), Pharm=P/(n_i T), +* CVth=C_V/N_i, Sharm=S/N_i +* PDTharm = Pharm + d Pharm / d ln T, PDRharm = Pharm + d Pharm/d ln\rho + implicit double precision (A-H), double precision (O-Z) + save + parameter(CM=.895929256d0) ! Madelung + call HLfit12(TPT,F,U,CVth,Sth,U1,CW,1) + U0=-CM*GAMI ! perfect lattice + E0=1.5d0*U1*TPT ! zero-point energy + Uth=U+E0 + Fth=F+E0 + Uharm=U0+Uth + Fharm=U0+Fth + Pharm=U0/3.d0+Uth/2.d0 + PDTharm=.5d0*CVth + PDRharm=U0/2.25d0+.75d0*Uth-.25d0*CVth + return + end + + subroutine HLfit12(eta,F,U,CV,S,U1,CW,LATTICE) +* Version 24.04.12 +* Stems from HLfit8 v.03.12.08; +* differences: E0 excluded from U and F; +* U1 and d(CV)/d\ln(T) are added on the output. +* Fit to thermal part of the thermodynamic functions. +* Baiko, Potekhin, & Yakovlev (2001). +* Zero-point lattice quantum energy 1.5u_1\eta EXCLUDED (unlike HLfit8). +* Input: eta=Tp/T, LATTICE=1 for bcc, 2 for fcc +* Output: F and U (normalized to NkT) - due to phonon excitations, +* CV and S (normalized to Nk) in the HL model, +* U1 - the 1st phonon moment, +* CW=d(CV)/d\ln(T) + implicit double precision (A-H), double precision (O-Z) + save + parameter(EPS=1.d-5,TINY=1.d-99) + if (LATTICE.eq.1) then ! bcc lattice + CLM=-2.49389d0 ! 3*ln<\omega/\omega_p> + U1=.5113875d0 + ALPHA=.265764d0 + BETA=.334547d0 + GAMMA=.932446d0 + A1=.1839d0 + A2=.593586d0 + A3=.0054814d0 + A4=5.01813d-4 + A6=3.9247d-7 + A8=5.8356d-11 + B0=261.66d0 + B2=7.07997d0 + B4=.0409484d0 + B5=.000397355d0 + B6=5.11148d-5 + B7=2.19749d-6 + C9=.004757014d0 + C11=.0047770935d0 + elseif (LATTICE.eq.2) then ! fcc lattice + CLM=-2.45373d0 + U1=.513194d0 + ALPHA=.257591d0 + BETA=.365284d0 + GAMMA=.9167070d0 + A1=.0 + A2=.532535d0 + A3=.0 + A4=3.76545d-4 + A6=2.63013d-7 + A8=6.6318d-11 + B0=303.20d0 + B2=7.7255d0 + B4=.0439597d0 + B5=.000114295d0 + B6=5.63434d-5 + B7=1.36488d-6 + C9=.00492387d0 + C11=.00437506d0 + else + stop'HLfit: unknown lattice type' + endif + if (eta.gt.1./EPS) then ! asymptote of Eq.(13) of BPY'01 + U=3./(C11*eta**3) + F=-U/3. + CV=4.*U + goto 50 + elseif (eta.lt.EPS) then ! Eq.(17) of BPY'01 + if (eta.lt.TINY) stop'HLfit: eta is too small' + F=3.*dlog(eta)+CLM-1.5*U1*eta+eta**2/24. + U=3.-1.5*U1*eta+eta**2/12. + CV=3.-eta**2/12. + goto 50 + endif + eta2=eta**2 + eta3=eta2*eta + eta4=eta3*eta + eta5=eta4*eta + eta6=eta5*eta + eta7=eta6*eta + eta8=eta7*eta + B9=A6*C9 + B11=A8*C11 + UP=1.+A1*eta+A2*eta2+A3*eta3+A4*eta4+A6*eta6+A8*eta8 + DN=B0+B2*eta2+B4*eta4+B5*eta5+B6*eta6+ + + B7*eta7+eta8*(B9*eta+B11*eta3) + EA=dexp(-ALPHA*eta) + EB=dexp(-BETA*eta) + EG=dexp(-GAMMA*eta) + F=dlog(1.d0-EA)+dlog(1.d0-EB)+dlog(1.-EG)-UP/DN ! F_{thermal}/NT + UP1=A1+ + + 2.*A2*eta+3.*A3*eta2+4.*A4*eta3+6.*A6*eta5+8.*A8*eta7 + UP2=2.*A2+6.*A3*eta+12.*A4*eta2+30.*A6*eta4+56.*A8*eta6 + UP3=6.*A3+24.*A4*eta+120.*A6*eta3+336*A8*eta5 + DN1=2.*B2*eta+4.*B4*eta3+5.*B5*eta4+6.*B6*eta5+ + + 7.*B7*eta6+eta8*(9.*B9+11.*B11*eta2) + DN2=2.*B2+12.*B4*eta2+20.*B5*eta3+30.*B6*eta4+ + + 42.*B7*eta5+72.*B9*eta7+110.*B11*eta8*eta + DN3=24.*B4*eta+60.*B5*eta2+120.*B6*eta3+ + + 210.*B7*eta4+504.*B9*eta6+990.*B11*eta8 + DF1=ALPHA*EA/(1.d0-EA)+BETA*EB/(1.d0-EB)+GAMMA*EG/(1.d0-EG)- + - (UP1*DN-DN1*UP)/DN**2 ! int.en./NT/eta = df/d\eta + DF2=ALPHA**2*EA/(1.d0-EA)**2+BETA**2*EB/(1.d0-EB)**2+ + + GAMMA**2*EG/(1.d0-EG)**2+ + + ((UP2*DN-DN2*UP)*DN-2.*(UP1*DN-DN1*UP)*DN1)/DN**3 ! -d2f/d\eta^2 + U=DF1*eta + CV=DF2*eta2 + DF3=-ALPHA**3*EA/(1.d0-EA)**3*(1.+EA)- + - BETA**3*EB/(1.d0-EB)**3*(1.+EB)- + - GAMMA**3*EG/(1.d0-EG)**3*(1.+EG)+ + + UP3/DN-(3.*UP2*DN1+3.*UP1*DN2+UP*DN3)/DN**2+ + + 6.*DN1*(UP1*DN1+UP*DN2)/DN**3-6.*UP*DN1**3/DN**4 ! -d3f/d\eta^3 + CW=-2.*CV-eta3*DF3 + 50 continue + S=U-F + return + end + + subroutine CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, + * FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) +* Version 02.07.09 +* Correction to the linear mixing rule for moderate to small Gamma +* Input: RS=r_s (if RS=0, then OCP, otherwise EIP) +* GAME=\Gamma_e +* Zmean= (average Z of all ions, without electrons) +* Z2mean=, Z52=, Z53=, Z321= +* Output: FMIX=\Delta f - corr.to the reduced free energy f=F/N_{ion}kT +* UMIX=\Delta u - corr.to the reduced internal energy u +* PMIX=\Delta u - corr.to the reduced pressure P=P/n_{ion}kT +* CVMIX=\Delta c - corr.to the reduced heat capacity c_V +* PDTMIX=(1/n_{ion}kT)d\Delta P / d ln T +* = \Delta p + d \Delta p / d ln T +* PDRMIX=(1/n_{ion}kT)d\Delta P / d ln n_e +* (composition is assumed fixed: Zmean,Z2mean,Z52,Z53=constant) + implicit double precision (A-H), double precision (O-Z) + parameter (TINY=1.d-9) + GAMImean=GAME*Z53 + if (RS.lt.TINY) then ! OCP + Dif0=Z52-dsqrt(Z2mean**3/Zmean) + else + Dif0=Z321-dsqrt((Z2mean+Zmean)**3/Zmean) + endif + DifR=Dif0/Z52 + DifFDH=Dif0*GAME*sqrt(GAME/3.) ! F_DH - F_LM(DH) + D=Z2mean/Zmean**2 + if (dabs(D-1.d0).lt.TINY) then ! no correction + FMIX=0. + UMIX=0. + PMIX=0. + CVMIX=0. + PDTMIX=0. + PDRMIX=0. + return + endif + P3=D**(-0.2) + D0=(2.6*DifR+14.*DifR**3)/(1.d0-P3) + GP=D0*GAMImean**P3 + FMIX0=DifFDH/(1.+GP) + Q=D**2*.0117 + R=1.5/P3-1. + GQ=Q*GP + FMIX=FMIX0/(1.+GQ)**R + G=1.5-P3*GP/(1.+GP)-R*P3*GQ/(1.+GQ) + UMIX=FMIX*G + PMIX=UMIX/3.d0 + GDG=-P3**2*(GP/(1.d0+GP)**2+R*GQ/(1.d0+GQ)**2) ! d G /d ln Gamma + UDG=UMIX*G+FMIX*GDG ! d u_mix /d ln Gamma + CVMIX=UMIX-UDG + PDTMIX=PMIX-UDG/3. + PDRMIX=PMIX+UDG/9. + return + end + +* =================== IDEAL ELECTRON GAS =========================== * + subroutine ELECT11(TEMP,CHI, + * DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, + * DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) +* Version 17.11.11 +* safeguard against huge (-CHI) values is added 27.05.17 +* ELECT9 v.04.03.09 + smooth match of two fits at chi >> 1 + add.outputs +* Compared to ELECTRON v.06.07.00, this S/R is completely rewritten: +* numerical differentiation is avoided now. +* Compared to ELECT7 v.06.06.07, +* - call BLIN7 is changed to call BLIN9, +* - Sommerfeld expansion is used at chi >~ 28 i.o. 1.e4 +* - Sommerfeld expansion is corrected: introduced DeltaEF, D1 and D2. +* Ideal electron-gas EOS. +* Input: TEMP - T [a.u.], CHI=\mu/T +* Output: DENS - electron number density n_e [a.u.], +* FEid - free energy / N_e kT, UEid - internal energy / N_e kT, +* PEid - pressure (P_e) / n_e kT, SEid - entropy / N_e k, +* CVE - heat capacity / N_e k, +* CHITE=(d ln P_e/d ln T)_V, CHIRE=(d ln P_e/d ln n_e)_T +* DlnDH=(d ln n_e/d CHI)_T = (T/n_e) (d n_e/d\mu)_T +* DlnDT=(d ln n_e/d ln T)_CHI +* DlnDHH=(d^2 ln n_e/d CHI^2)_T +* DlnDTT=(d^2 ln n_e/d (ln T)^2)_CHI +* DlnDHT=d^2 ln n_e/d (ln T) d CHI + implicit double precision (A-H), double precision (O-Z) + save + parameter (CHI2=28.d0,XMAX=20.d0) + parameter (DCHI2=CHI2-1.d0) + parameter (XSCAL2=XMAX/DCHI2) + if (CHI.lt.-1.d2) stop'ELECT11: too large negative CHI' ! 27.05.17 + X2=(CHI-CHI2)*XSCAL2 + if (X2.lt.-XMAX) then + call ELECT11a(TEMP,CHI, + * DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, + * DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) + elseif (X2.gt.XMAX) then + call ELECT11b(TEMP,CHI, + * DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, + * DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) + else + call FERMI10(X2,XMAX,FP,FM) + call ELECT11a(TEMP,CHI, + * DENSa,FEida,PEida,UEida,SEida,CVEa,CHITEa,CHIREa, + * DlnDHa,DlnDTa,DlnDHHa,DlnDTTa,DlnDHTa) + call ELECT11b(TEMP,CHI, + * DENSb,FEidb,PEidb,UEidb,SEidb,CVEb,CHITEb,CHIREb, + * DlnDHb,DlnDTb,DlnDHHb,DlnDTTb,DlnDHTb) + DENS=DENSa*FP+DENSb*FM + FEid=FEida*FP+FEidb*FM + PEid=PEida*FP+PEidb*FM + UEid=UEida*FP+UEidb*FM + SEid=SEida*FP+SEidb*FM + CVE=CVEa*FP+CVEb*FM + CHITE=CHITEa*FP+CHITEb*FM + CHIRE=CHIREa*FP+CHIREb*FM + DlnDH=DlnDHa*FP+DlnDHb*FM + DlnDT=DlnDTa*FP+DlnDTb*FM + DlnDHH=DlnDHHa*FP+DlnDHHb*FM + DlnDHT=DlnDHTa*FP+DlnDHTb*FM + DlnDTT=DlnDTTa*FP+DlnDTTb*FM + endif + return + end + + subroutine ELECT11a(TEMP,CHI, + * DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, + * DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) +* Version 16.11.11 +* This is THE FIRST PART of ELECT9 v.04.03.09. + implicit double precision (A-H), double precision (O-Z) + save + parameter (BOHR=137.036,PI=3.141592653d0) + parameter (PI2=PI**2,BOHR2=BOHR**2,BOHR3=BOHR2*BOHR) !cleaned 15/6 + TEMR=TEMP/BOHR2 ! T in rel.units (=T/mc^2) + call BLIN9(TEMR,CHI, + * W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, + * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, + * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, + * W0XXX,W0XTT,W0XXT) + TPI=TEMR*dsqrt(2.d0*TEMR)/PI2 ! common pre-factor + DENR=TPI*(W1*TEMR+W0) + PR=TEMR*TPI/3.*(W2*TEMR+2.*W1) + U=TEMR*TPI*(W2*TEMR+W1) +* (these are density, pressure, and internal energy in the rel.units) + PEid=PR/(DENR*TEMR) + UEid=U/(DENR*TEMR) + FEid=CHI-PEid + DENS=DENR*BOHR3 ! converts from rel.units to a.u. + SEid=UEid-FEid +* derivatives over T at constant chi: + dndT=TPI*(1.5*W0/TEMR+2.5*W1+W0DT+TEMR*W1DT) ! (d n_e/dT)_\chi + dPdT=TPI/3.*(5.*W1+2.*TEMR*W1DT+3.5*TEMR*W2+TEMR**2*W2DT)!dP/dT + dUdT=TPI*(2.5*W1+TEMR*W1DT+3.5*TEMR*W2+TEMR**2*W2DT)!dU/dT_\chi +* derivatives over chi at constant T and second derivatives: + dndH=TPI*(W0DX+TEMR*W1DX) ! (d n_e/d\chi)_T + dndHH=TPI*(W0DXX+TEMR*W1DXX) ! (d^2 n_e/d\chi)_T + dndTT=TPI*(.75*W0/TEMR**2+3.*W0DT/TEMR+W0DTT+ + + 3.75*W1/TEMR+5.*W1DT+TEMR*W1DTT) + dndHT=TPI*(1.5*W0DX/TEMR+W0DXT+2.5*W1DX+TEMR*W1DXT) + DlnDH=dndH/DENR ! (d ln n_e/d\chi)_T + DlnDT=dndT*TEMR/DENR ! (d ln n_e/d ln T)_\chi + DlnDHH=dndHH/DENR-DlnDH**2 ! (d^2 ln n_e/d\chi^2)_T + DlnDTT=TEMR**2/DENR*dndTT+DlnDT-DlnDT**2 ! d^2 ln n_e/d ln T^2 + DlnDHT=TEMR/DENR*(dndHT-dndT*DlnDH) ! d^2 ln n_e/d\chi d ln T + dPdH=TPI/3.*TEMR*(2.*W1DX+TEMR*W2DX) ! (d P_e/d\chi)_T + dUdH=TPI*TEMR*(W1DX+TEMR*W2DX) ! (d U_e/d\chi)_T + CVE=(dUdT-dUdH*dndT/dndH)/DENR + CHITE=TEMR/PR*(dPdT-dPdH*dndT/dndH) + CHIRE=DENR/PR*dPdH/dndH ! (dndH*TEMR*PEid) ! DENS/PRE*dPdH/dndH + return + end + + subroutine ELECT11b(TEMP,CHI, + * DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, + * DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) +* Version 17.11.11 +* Stems from ELECT9b v.19.01.10, Diff. - additional output. +* Sommerfeld expansion at very large CHI. + implicit double precision (A-H), double precision (O-Z) + save + parameter (BOHR=137.036,PI=3.141592653d0) + parameter (PI2=PI**2,BOHR2=BOHR**2,BOHR3=BOHR2*BOHR) !cleaned 15/6 + TEMR=TEMP/BOHR2 ! T in rel.units (=T/mc^2) + EF=CHI*TEMR ! Fermi energy in mc^2 - zeroth aprox. = CMU1 + DeltaEF=PI2*TEMR**2/6.d0*(1.d0+2.d0*EF*(2.d0+EF))/ + / (EF*(1.d0+EF)*(2.d0+EF)) ! corr. [p.125, equiv.Eq.(6) of PC'10] + EF=EF+DeltaEF ! corrected Fermi energy (14.02.09) + G=1.d0+EF ! electron Lorentz-factor + if (EF.gt.1.d-5) then ! relativistic expansion (Yak.&Shal.'89) + PF=dsqrt(G**2-1.d0) ! Fermi momentum [rel.un.=mc] + F=(PF*(1.+2.d0*PF**2)*G-PF**3/.375d0-dlog(PF+G))/8.d0/PI2!F/V + DF=-TEMR**2*PF*G/6.d0 ! thermal correction to F/V + P=(PF*G*(PF**2/1.5d0-1.d0)+dlog(PF+G))/8.d0/PI2 ! P(T=0) + DP=TEMR**2*PF*(PF**2+2.d0)/G/18.d0 ! thermal correction to P + CVE=PI2*TEMR*G/PF**2 + else ! nonrelativistic limit + PF=dsqrt(2.d0*EF) + F=PF**5*0.1d0/PI2 + DF=-TEMR**2*PF/6.d0 + P=F/1.5d0 + DP=TEMR**2*PF/9.d0 + CVE=PI2*TEMR/EF/2.d0 + endif + F=F+DF + P=P+DP + S=-2.d0*DF ! entropy per unit volume [rel.un.] + U=F+S + CHIRE=PF**5/(9.d0*PI2*P*G) + CHITE=2.d0*DP/P + DENR=PF**3/3.d0/PI2 ! n_e [rel.un.=\Compton^{-3}] + DENS=DENR*BOHR3 ! conversion to a.u.(=\Bohr_radius^{-3}) +* derivatives over chi at constant T and T at constant chi: + TPI=TEMR*dsqrt(2.d0*TEMR)/PI2 ! common pre-factor + call SOMMERF(TEMR,CHI, + * W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, + * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, + * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, + * W0XXX,W0XTT,W0XXT) + dndH=TPI*(W0DX+TEMR*W1DX) ! (d n_e/d\chi)_T + dndT=TPI*(1.5*W0/TEMR+2.5*W1+W0DT+TEMR*W1DT) ! (d n_e/dT)_\chi + dndHH=TPI*(W0DXX+TEMR*W1DXX) ! (d^2 n_e/d\chi)_T + dndTT=TPI*(.75*W0/TEMR**2+3.*W0DT/TEMR+W0DTT+ + + 3.75*W1/TEMR+5.*W1DT+TEMR*W1DTT) + dndHT=TPI*(1.5*W0DX/TEMR+W0DXT+2.5*W1DX+TEMR*W1DXT) + DlnDH=dndH/DENR ! (d ln n_e/d\chi)_T + DlnDT=dndT*TEMR/DENR ! (d ln n_e/d ln T)_\chi + DlnDHH=dndHH/DENR-DlnDH**2 ! (d^2 ln n_e/d\chi^2)_T + DlnDTT=TEMR**2/DENR*dndTT+DlnDT-DlnDT**2 ! d^2 ln n_e/d ln T^2 + DlnDHT=TEMR/DENR*(dndHT-dndT*DlnDH) ! d^2 ln n_e/d\chi d ln T + DT=DENR*TEMR + PEid=P/DT + UEid=U/DT + FEid=F/DT + SEid=S/DT +* Empirical corrections of 16.02.09: + D1=DeltaEF/EF + D2=D1*(4.d0-2.d0*(PF/G)) + CVE=CVE/(1.d0+D2) + SEid=SEid/(1.d0+D1) + CHITE=CHITE/(1.d0+D2) + return + end + + subroutine SOMMERF(TEMR,CHI, + * W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, + * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, + * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, + * W0XXX,W0XTT,W0XXT) +* Version 17.11.11 +* Sommerfeld expansion for the Fermi-Dirac integrals +* Input: TEMR=T/mc^2; CHI=(\mu-mc^2)/T +* Output: Wk - Fermi-Dirac integral of the order k+1/2 +* WkDX=dWk/dCHI, WkDT = dWk/dT, WkDXX=d^2 Wk / d CHI^2, +* WkDTT=d^2 Wk / d T^2, WkDXT=d^2 Wk /dCHIdT, +* W0XXX=d^3 W0 / d CHI^3, W0XTT=d^3 W0 /(d CHI d^2 T), +* W0XXT=d^3 W0 /dCHI^2 dT +* [Draft source: yellow book pages 124-127] + implicit double precision (A-H), double precision (O-Z) + save + parameter(PI=3.141592653d0) + parameter(PI2=PI**2) + if (CHI.lt..5d0) stop'SOMMERF: non-degenerate (small CHI)' + if (TEMR.le.0.d0) stop'SOMMERF: T < 0' + CMU1=CHI*TEMR ! chemical potential in rel.units + CMU=1.d0+CMU1 + call SUBFERMJ(CMU1, + * CJ00,CJ10,CJ20, + * CJ01,CJ11,CJ21, + * CJ02,CJ12,CJ22, + * CJ03,CJ13,CJ23, + * CJ04,CJ14,CJ24,CJ05) + PIT26=(PI*TEMR)**2/6.d0 +CCC PITAU4=PIT26**2*0.7d0 + CN0=dsqrt(.5d0/TEMR)/TEMR + CN1=CN0/TEMR + CN2=CN1/TEMR + W0=CN0*(CJ00+PIT26*CJ02) ! +CN0*PITAU4*CJ04 + W1=CN1*(CJ10+PIT26*CJ12) ! +CN1*PITAU4*CJ14 + W2=CN2*(CJ20+PIT26*CJ22) ! +CN2*PITAU4*CJ24 + W0DX=CN0*TEMR*(CJ01+PIT26*CJ03) ! +CN0*PITAU4*CJ05 + W1DX=CN0*(CJ11+PIT26*CJ13) + W2DX=CN1*(CJ21+PIT26*CJ23) + W0DT=CN1*(CMU1*CJ01-1.5d0*CJ00+PIT26*(CMU1*CJ03+.5d0*CJ02)) +CCC + CN1*PITAU4*(CMU1*CJ05+2.5d0*CJ04) + W1DT=CN2*(CMU1*CJ11-2.5d0*CJ10+PIT26*(CMU1*CJ13-.5d0*CJ12)) + W2DT=CN2/TEMR*(CMU1*CJ21-3.5d0*CJ20+PIT26*(CMU1*CJ23-1.5d0*CJ22)) + W0DXX=CN0*TEMR**2*(CJ02+PIT26*CJ04) + W1DXX=CN0*TEMR*(CJ12+PIT26*CJ14) + W2DXX=CN0*(CJ22+PIT26*CJ24) + W0DXT=CN0*(CMU1*CJ02-.5d0*CJ01+PIT26*(CMU1*CJ04+1.5d0*CJ03)) + W1DXT=CN1*(CMU1*CJ12-1.5d0*CJ11+PIT26*(CMU1*CJ14+.5d0*CJ13)) + W2DXT=CN2*(CMU1*CJ22-2.5d0*CJ21+PIT26*(CMU1*CJ24-.5d0*CJ23)) + W0DTT=CN2*(3.75d0*CJ00-3.d0*CMU1*CJ01+CMU1**2*CJ02+ + + PIT26*(-.25d0*CJ02+CMU1*CJ03+CMU1**2*CJ04)) + W1DTT=CN2/TEMR*(8.75d0*CJ10-5.d0*CMU1*CJ11+CMU1**2*CJ12+ + + PIT26*(.75d0*CJ12-CMU1*CJ13+CMU1**2*CJ14)) + W2DTT=CN2/TEMR**2*(15.75d0*CJ20-7.d0*CMU1*CJ21+CMU1**2*CJ22+ + + PIT26*(3.75d0*CJ22-3.d0*CMU1*CJ23+CMU1**2*CJ24)) + W0XXX=CN0*TEMR**3*(CJ03+PIT26*CJ05) + W0XXT=CN0*TEMR*(CMU1*CJ03+.5d0*CJ02+PIT26*(CMU1*CJ05+2.5d0*CJ04)) + W0XTT=CN1*(.75d0*CJ01-CMU1*CJ02+CMU1**2*CJ03+ + + PIT26*(.75d0*CJ03+3.d0*CMU1*CJ04+CMU1**2*CJ05)) + return + end + + subroutine SUBFERMJ(CMU1, + * CJ00,CJ10,CJ20, + * CJ01,CJ11,CJ21, + * CJ02,CJ12,CJ22, + * CJ03,CJ13,CJ23, + * CJ04,CJ14,CJ24,CJ05) +* Version 17.11.11 +* corrected 04.03.21 +* Supplement to SOMMERF + implicit double precision (A-H), double precision (O-Z) + save + parameter(EPS=1.d-4) ! inserted 04.03.21 + if (CMU1.le.0.d0) stop'SUBFERMJ: small CHI' + CMU=1.d0+CMU1 + X0=dsqrt(CMU1*(2.d0+CMU1)) + X3=X0**3 + X5=X0**5 + if (X0.lt.EPS) then + CJ00=X3/3.d0 + CJ10=.1d0*X5 + CJ20=X0**7/28.d0 + else + CL=dlog(X0+CMU) + CJ00=.5d0*(X0*CMU-CL) ! J_{1/2}^0 + CJ10=X3/3.d0-CJ00 ! J_{3/2}^0 + CJ20=(.75d0*CMU-2.d0)/3.d0*X3+1.25d0*CJ00 ! J_{5/2}^0 + endif + CJ01=X0 ! J_{1/2}^1 + CJ11=CJ01*CMU1 ! J_{3/2}^1 + CJ21=CJ11*CMU1 ! J_{5/2}^1 + CJ02=CMU/X0 ! J_{1/2}^2 + CJ12=CMU1/X0*(3.d0+2.d0*CMU1) ! J_{3/2}^2 + CJ22=CMU1**2/X0*(5.d0+3.d0*CMU1) ! J_{5/2}^2 + CJ03=-1.d0/X3 ! J_{1/2}^3 + CJ13=CMU1/X3*(2.d0*CMU1**2+6.d0*CMU1+3.d0) + CJ23=CMU1**2/X3*(6.d0*CMU1**2+2.d1*CMU1+1.5d1) + CJ04=3.d0*CMU/X5 + CJ14=-3.d0*CMU1/X5 + CJ24=CMU1**2/X5*(6.d0*CMU1**3+3.d1*CMU1**2+45.d0*CMU1+15.d0) + CJ05=(-12.d0*CMU1**2-24.d0*CMU1-15.d0)/(X5*X0**2) + return + end + + subroutine FERMI10(X,XMAX,FP,FM) +* Version 20.01.10 +* Fermi distribution function and its 3 derivatives +* Input: X - argument f(x) +* XMAX - max|X| where it is assumed that 0 < f(x) < 1. +* Output: FP = f(x) +* FM = 1-f(x) + implicit double precision (A-H), double precision (O-Z) + save + if (XMAX.lt.3.d0) stop'FERMI10: XMAX' + if (X.gt.XMAX) then + FP=0.d0 + FM=1.d0 + elseif (X.lt.-XMAX) then + FP=1.d0 + FM=0.d0 + else + FP=1.d0/(dexp(X)+1.d0) + FM=1.d0-FP + endif + return + end + +* ============== ELECTRON EXCHANGE AND CORRELATION ================ * + subroutine EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) +* Version 09.06.07 +* Accuracy-loss cut-off modified on 10.08.16 +* Exchange-correlation contribution for the electron gas +* Stems from TANAKA1 v.03.03.96. Added derivatives. +* Input: RS - electron density parameter =electron-sphere radius in a.u. +* GAME - electron Coulomb coupling parameter +* Output: FXC - excess free energy of e-liquid per kT per one electron +* according to Tanaka & Ichimaru 85-87 and Ichimaru 93 +* UXC - internal energy contr.[per 1 electron, kT] +* PXC - pressure contribution divided by (n_e kT) +* CVXC - heat capacity divided by N_e k +* SXC - entropy divided by N_e k +* PDTXC,PDRXC = PXC + d PXC / d ln(T,\rho) + implicit double precision(A-H),double precision(O-Z) + save + parameter(EPS=1.d-8) ! 10.08.16 + THETA=.543*RS/GAME ! non-relativistic degeneracy parameter + SQTH=dsqrt(THETA) + THETA2=THETA**2 + THETA3=THETA2*THETA + THETA4=THETA3*THETA + if (THETA.gt..005) then + CHT1=dcosh(1.d0/THETA) + SHT1=dsinh(1.d0/THETA) + CHT2=dcosh(1.d0/SQTH) + SHT2=dsinh(1.d0/SQTH) + T1=SHT1/CHT1 ! dtanh(1.d0/THETA) + T2=SHT2/CHT2 ! dtanh(1./dsqrt(THETA)) + T1DH=-1./(THETA*CHT1)**2 ! d T1 / d\theta + T1DHH=2./(THETA*CHT1)**3*(CHT1-SHT1/THETA) + T2DH=-.5*SQTH/(THETA*CHT2)**2 + T2DHH=(.75*SQTH*CHT2-.5*SHT2)/(THETA*CHT2)**3 + else + T1=1. + T2=1. + T1DH=0. + T2DH=0. + T1DHH=0. + T2DHH=0. + endif + A0=.75+3.04363*THETA2-.09227*THETA3+1.7035*THETA4 + A0DH=6.08726*THETA-.27681*THETA2+6.814*THETA3 + A0DHH=6.08726-.55362*THETA+20.442*THETA2 + A1=1.+8.31051*THETA2+5.1105*THETA4 + A1DH=16.62102*THETA+20.442*THETA3 + A1DHH=16.62102+61.326*THETA2 + A=.610887*A0/A1*T1 ! HF fit of Perrot and Dharma-wardana + AH=A0DH/A0-A1DH/A1+T1DH/T1 + ADH=A*AH + ADHH=ADH*AH+A*(A0DHH/A0-(A0DH/A0)**2-A1DHH/A1+(A1DH/A1)**2+ + + T1DHH/T1-(T1DH/T1)**2) + B0=.341308+12.070873d0*THETA2+1.148889d0*THETA4 + B0DH=24.141746d0*THETA+4.595556d0*THETA3 + B0DHH=24.141746d0+13.786668d0*THETA2 + B1=1.+10.495346d0*THETA2+1.326623*THETA4 + B1DH=20.990692d0*THETA+5.306492*THETA3 + B1DHH=20.990692d0+15.919476d0*THETA2 + B=SQTH*T2*B0/B1 + BH=.5/THETA+T2DH/T2+B0DH/B0-B1DH/B1 + BDH=B*BH + BDHH=BDH*BH+B*(-.5/THETA2+T2DHH/T2-(T2DH/T2)**2+ + + B0DHH/B0-(B0DH/B0)**2-B1DHH/B1+(B1DH/B1)**2) + D0=.614925+16.996055d0*THETA2+1.489056*THETA4 + D0DH=33.99211d0*THETA+5.956224d0*THETA3 + D0DHH=33.99211d0+17.868672d0*THETA2 + D1=1.+10.10935*THETA2+1.22184*THETA4 + D1DH=20.2187*THETA+4.88736*THETA3 + D1DHH=20.2187+14.66208*THETA2 + D=SQTH*T2*D0/D1 + DH=.5/THETA+T2DH/T2+D0DH/D0-D1DH/D1 + DDH=D*DH + DDHH=DDH*DH+D*(-.5/THETA2+T2DHH/T2-(T2DH/T2)**2+ + + D0DHH/D0-(D0DH/D0)**2-D1DHH/D1+(D1DH/D1)**2) + E0=.539409+2.522206*THETA2+.178484*THETA4 + E0DH=5.044412*THETA+.713936*THETA3 + E0DHH=5.044412+2.141808*THETA2 + E1=1.+2.555501*THETA2+.146319*THETA4 + E1DH=5.111002*THETA+.585276*THETA3 + E1DHH=5.111002+1.755828*THETA2 + E=THETA*T1*E0/E1 + EH=1./THETA+T1DH/T1+E0DH/E0-E1DH/E1 + EDH=E*EH + EDHH=EDH*EH+E*(T1DHH/T1-(T1DH/T1)**2+E0DHH/E0-(E0DH/E0)**2- + - E1DHH/E1+(E1DH/E1)**2-1./THETA2) + EXP1TH=dexp(-1./THETA) + C=(.872496+.025248*EXP1TH)*E + CDH=.025248*EXP1TH/THETA2*E+C*EDH/E + CDHH=.025248*EXP1TH/THETA2*(EDH+(1.-2.*THETA)/THETA2*E)+ + + CDH*EDH/E+C*EDHH/E-C*(EDH/E)**2 + DISCR=dsqrt(4.*E-D**2) + DIDH=.5/DISCR*(4.*EDH-2.*D*DDH) + DIDHH=(-((2.*EDH-D*DDH)/DISCR)**2+2.*EDHH-DDH**2-D*DDHH)/DISCR + S1=-C/E*GAME + S1H=CDH/C-EDH/E + S1DH=S1*S1H + S1DHH=S1DH*S1H+S1*(CDHH/C-(CDH/C)**2-EDHH/E+(EDH/E)**2) + S1DG=-C/E ! => S1DGG=0 + S1DHG=S1DG*(CDH/C-EDH/E) + B2=B-C*D/E + B2DH=BDH-(CDH*D+C*DDH)/E+C*D*EDH/E**2 + B2DHH=BDHH-(CDHH*D+2.*CDH*DDH+C*DDHH)/E+ + + (2.*(CDH*D+C*DDH-C*D*EDH/E)*EDH+C*D*EDHH)/E**2 + SQGE=dsqrt(GAME) + S2=-2./E*B2*SQGE + S2H=B2DH/B2-EDH/E + S2DH=S2*S2H + S2DHH=S2DH*S2H+S2*(B2DHH/B2-(B2DH/B2)**2-EDHH/E+(EDH/E)**2) + S2DG=.5*S2/GAME + S2DGG=-.5*S2DG/GAME + S2DHG=.5*S2DH/GAME + R3=E*GAME+D*SQGE+1. + R3DH=EDH*GAME+DDH*SQGE + R3DHH=EDHH*GAME+DDHH*SQGE + R3DG=E+.5*D/SQGE + R3DGG=-.25*D/(GAME*SQGE) + R3DHG=EDH+.5*DDH/SQGE + B3=A-C/E + B3DH=ADH-CDH/E+C*EDH/E**2 + B3DHH=ADHH-CDHH/E+(2.*CDH*EDH+C*EDHH)/E**2-2.*C*EDH**2/E**3 + C3=(D/E*B2-B3)/E ! =D*B2/E**2-B3/E + C3DH=(DDH*B2+D*B2DH+B3*EDH)/E**2-2.*D*B2*EDH/E**3-B3DH/E + C3DHH=(-B3DHH+ + + (DDHH*B2+2.*DDH*B2DH+D*B2DHH+B3DH*EDH+B3*EDHH+B3DH*EDH)/E- + - 2.*((DDH*B2+D*B2DH+B3*EDH+DDH*B2+D*B2DH)*EDH+D*B2*EDHH)/E**2+ + + 6.*D*B2*EDH**2/E**3)/E + S3=C3*dlog(R3) + S3DH=S3*C3DH/C3+C3*R3DH/R3 + S3DHH=(S3DH*C3DH+S3*C3DHH)/C3-S3*(C3DH/C3)**2+ + + (C3DH*R3DH+C3*R3DHH)/R3-C3*(R3DH/R3)**2 + S3DG=C3*R3DG/R3 + S3DGG=C3*(R3DGG/R3-(R3DG/R3)**2) + S3DHG=(C3DH*R3DG+C3*R3DHG)/R3-C3*R3DG*R3DH/R3**2 + B4=2.-D**2/E + B4DH=EDH*(D/E)**2-2.*D*DDH/E + B4DHH=EDHH*(D/E)**2+2.*EDH*(D/E)**2*(DDH/D-EDH/E)- + - 2.*(DDH**2+D*DDHH)/E+2.*D*DDH*EDH/E**2 + C4=2.*E*SQGE+D + C4DH=2.*EDH*SQGE+DDH + C4DHH=2.*EDHH*SQGE+DDHH + C4DG=E/SQGE + C4DGG=-.5*E/(GAME*SQGE) + C4DHG=EDH/SQGE + S4A=2./E/DISCR + S4AH=EDH/E+DIDH/DISCR + S4ADH=-S4A*S4AH + S4ADHH=-S4ADH*S4AH- + - S4A*(EDHH/E-(EDH/E)**2+DIDHH/DISCR-(DIDH/DISCR)**2) + S4B=D*B3+B4*B2 + S4BDH=DDH*B3+D*B3DH+B4DH*B2+B4*B2DH + S4BDHH=DDHH*B3+2.*DDH*B3DH+D*B3DHH+B4DHH*B2+2.*B4DH*B2DH+B4*B2DHH + S4C=datan(C4/DISCR)-datan(D/DISCR) + UP1=C4DH*DISCR-C4*DIDH + DN1=DISCR**2+C4**2 + UP2=DDH*DISCR-D*DIDH + DN2=DISCR**2+D**2 + S4CDH=UP1/DN1-UP2/DN2 + S4CDHH=(C4DHH*DISCR-C4*DIDHH)/DN1- + - UP1*2.*(DISCR*DIDH+C4*C4DH)/DN1**2- + - (DDHH*DISCR-D*DIDHH)/DN2+UP2*2.*(DISCR*DIDH+D*DDH)/DN2**2 + S4CDG=C4DG*DISCR/DN1 + S4CDGG=C4DGG*DISCR/DN1-2.*C4*DISCR*(C4DG/DN1)**2 + S4CDHG=(C4DHG*DISCR+C4DG*DIDH- + - C4DG*DISCR/DN1*2.*(DISCR*DIDH+C4*C4DH))/DN1 + S4=S4A*S4B*S4C + S4DH=S4ADH*S4B*S4C+S4A*S4BDH*S4C+S4A*S4B*S4CDH + S4DHH=S4ADHH*S4B*S4C+S4A*S4BDHH*S4C+S4A*S4B*S4CDHH+ + + 2.*(S4ADH*S4BDH*S4C+S4ADH*S4B*S4CDH+S4A*S4BDH*S4CDH) + S4DG=S4A*S4B*S4CDG + S4DGG=S4A*S4B*S4CDGG + S4DHG=S4A*S4B*S4CDHG+S4CDG*(S4ADH*S4B+S4A*S4BDH) + FXC=S1+S2+S3+S4 + FXCDH=S1DH+S2DH+S3DH+S4DH + FXCDG=S1DG+S2DG+S3DG+S4DG + FXCDHH=S1DHH+S2DHH+S3DHH+S4DHH + FXCDGG=S2DGG+S3DGG+S4DGG + FXCDHG=S1DHG+S2DHG+S3DHG+S4DHG + PXC=(GAME*FXCDG-2.*THETA*FXCDH)/3. + UXC=GAME*FXCDG-THETA*FXCDH + SXC=(GAME*S2DG-S2+GAME*S3DG-S3+S4A*S4B*(GAME*S4CDG-S4C))- + - THETA*FXCDH + if (dabs(SXC).lt.EPS*dabs(THETA*FXCDH)) SXC=0. ! accuracy loss + CVXC=2.*THETA*(GAME*FXCDHG-FXCDH)-THETA**2*FXCDHH-GAME**2*FXCDGG + if (dabs(CVXC).lt.EPS*dabs(GAME**2*FXCDGG)) CVXC=0. ! accuracy + PDLH=THETA*(GAME*FXCDHG-2.*FXCDH-2.*THETA*FXCDHH)/3. + PDLG=GAME*(FXCDG+GAME*FXCDGG-2.*THETA*FXCDHG)/3. + PDRXC=PXC+(PDLG-2.*PDLH)/3. + PDTXC=GAME*(THETA*FXCDHG-GAME*FXCDGG/3.)- + - THETA*(FXCDH/.75+THETA*FXCDHH/1.5) + return + end + +* ====================== AUXILIARY SUBROUTINES ==================== * + subroutine FERINV7(F,N,X,XDF,XDFF) ! Inverse Fermi intergals +* Version 24.05.07 +* X_q(f)=F^{-1}_q(f) : H.M.Antia 93 ApJS 84, 101 +* q=N-1/2=-1/2,1/2,3/2,5/2 (N=0,1,2,3) +* Input: F - argument, N=q+1/2 +* Output: X=X_q, XDF=dX/df, XDFF=d^2 X / df^2 +* Relative error: N = 0 1 2 3 +* for X: 3.e-9, 4.2e-9, 2.3e-9, 6.2e-9 +* jump at f=4: +* for XDF: 6.e-7, 5.4e-7, 9.6e-8, 3.1e-7 +* for XDFF: 4.7e-5, 4.8e-5, 2.3e-6, 1.5e-6 + implicit double precision (A-H), double precision (O-Z) + save + dimension A(0:5,0:3),B(0:6,0:3),C(0:6,0:3),D(0:6,0:3), + * LA(0:3),LB(0:3),LD(0:3) + data A/-1.570044577033d4,1.001958278442d4,-2.805343454951d3, + * 4.121170498099d2,-3.174780572961d1,1.d0, ! X_{-1/2} + * 1.999266880833d4,5.702479099336d3,6.610132843877d2, + * 3.818838129486d1,1.d0,0., ! X_{1/2} + * 1.715627994191d2,1.125926232897d2,2.056296753055d1,1.d0,0.,0., + * 2.138969250409d2,3.539903493971d1,1.d0,0.,0.,0./, ! X_{5/2} + * B/-2.782831558471d4,2.886114034012d4,-1.274243093149d4, + * 3.063252215963d3,-4.225615045074d2,3.168918168284d1, + * -1.008561571363d0, ! X_{-1/2} + * 1.771804140488d4,-2.014785161019d3,9.130355392717d1, + * -1.670718177489d0,0.,0.,0., ! X_{1/2} + * 2.280653583157d2,1.193456203021d2,1.16774311354d1, + * -3.226808804038d-1,3.519268762788d-3,0.,0., ! X_{3/2} + * 7.10854551271d2,9.873746988121d1,1.067755522895d0, + * -1.182798726503d-2,0.,0.,0./, ! X_{5/2} + * C/2.206779160034d-8,-1.437701234283d-6,6.103116850636d-5, + * -1.169411057416d-3,1.814141021608d-2,-9.588603457639d-2,1.d0, + * -1.277060388085d-2,7.187946804945d-2,-4.262314235106d-1, + * 4.997559426872d-1,-1.285579118012d0,-3.930805454272d-1,1.d0, + * -6.321828169799d-3,-2.183147266896d-2,-1.05756279932d-1, + * -4.657944387545d-1,-5.951932864088d-1,3.6844711771d-1,1.d0, + * -3.312041011227d-2,1.315763372315d-1,-4.820942898296d-1, + * 5.099038074944d-1,5.49561349863d-1,-1.498867562255d0,1.d0/, + * D/8.827116613576d-8,-5.750804196059d-6,2.429627688357d-4, + * -4.601959491394d-3,6.932122275919d-2,-3.217372489776d-1, + * 3.124344749296d0, ! X_{-1/2} + * -9.745794806288d-3,5.485432756838d-2,-3.29946624326d-1, + * 4.077841975923d-1,-1.145531476975d0,-6.067091689181d-2,0., + * -4.381942605018d-3,-1.5132365041d-2,-7.850001283886d-2, + * -3.407561772612d-1,-5.074812565486d-1,-1.387107009074d-1,0., + * -2.315515517515d-2,9.198776585252d-2,-3.835879295548d-1, + * 5.415026856351d-1,-3.847241692193d-1,3.739781456585d-2, + * -3.008504449098d-2/, ! X_{5/2} + * LA/5,4,3,2/,LB/6,3,4,3/,LD/6,5,5,6/ + if (N.lt.0.or.N.gt.3) stop'FERINV7: Invalid subscript' + if (F.le.0.) stop'FERINV7: Non-positive argument' + if (F.lt.4.) then + T=F + UP=0. + UP1=0. + UP2=0. + DOWN=0. + DOWN1=0. + DOWN2=0. + do I=LA(N),0,-1 + UP=UP*T+A(I,N) + if (I.ge.1) UP1=UP1*T+A(I,N)*I + if (I.ge.2) UP2=UP2*T+A(I,N)*I*(I-1) + enddo + do I=LB(N),0,-1 + DOWN=DOWN*T+B(I,N) + if (I.ge.1) DOWN1=DOWN1*T+B(I,N)*I + if (I.ge.2) DOWN2=DOWN2*T+B(I,N)*I*(I-1) + enddo + X=dlog(T*UP/DOWN) + XDF=1.d0/T+UP1/UP-DOWN1/DOWN + XDFF=-1.d0/T**2+UP2/UP-(UP1/UP)**2-DOWN2/DOWN+(DOWN1/DOWN)**2 + else + P=-1./(.5+N) ! = -1/(1+\nu) = power index + T=F**P ! t - argument of the rational fraction + T1=P*T/F ! dt/df + T2=P*(P-1.)*T/F**2 ! d^2 t / df^2 + UP=0. + UP1=0. + UP2=0. + DOWN=0. + DOWN1=0. + DOWN2=0. + do I=6,0,-1 + UP=UP*T+C(I,N) + if (I.ge.1) UP1=UP1*T+C(I,N)*I + if (I.ge.2) UP2=UP2*T+C(I,N)*I*(I-1) + enddo + do I=LD(N),0,-1 + DOWN=DOWN*T+D(I,N) + if (I.ge.1) DOWN1=DOWN1*T+D(I,N)*I + if (I.ge.2) DOWN2=DOWN2*T+D(I,N)*I*(I-1) + enddo + R=UP/DOWN + R1=(UP1-UP*DOWN1/DOWN)/DOWN ! dR/dt + R2=(UP2-(2.*UP1*DOWN1+UP*DOWN2)/DOWN+2.*UP*(DOWN1/DOWN)**2)/ + / DOWN + X=R/T + RT=(R1-R/T)/T + XDF=T1*RT + XDFF=T2*RT+T1**2*(R2-2.*RT)/T + endif + return + end + + subroutine BLIN9(TEMP,CHI, + * W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, + * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, + * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, + * W0XXX,W0XTT,W0XXT) +* Version 21.01.10 +* Stems from BLIN8 v.24.12.08 +* Difference - smooth matching of different CHI ranges +* Input: TEMP=T/mc^2; CHI=(\mu-mc^2)/T +* Output: Wk - Fermi-Dirac integral of the order k+1/2 +* WkDX=dWk/dCHI, WkDT = dWk/dT, WkDXX=d^2 Wk / d CHI^2, +* WkDTT=d^2 Wk / d T^2, WkDXT=d^2 Wk /dCHIdT, +* W0XXX=d^3 W0 / d CHI^3, W0XTT=d^3 W0 /(d CHI d^2 T), +* W0XXT=d^3 W0 /dCHI^2 dT + implicit double precision (A-H), double precision (O-Z) + save + parameter (CHI1=0.6d0,CHI2=14.d0,XMAX=30.d0) + parameter (DCHI1=.1d0,DCHI2=CHI2-CHI1-DCHI1) + parameter (XSCAL1=XMAX/DCHI1,XSCAL2=XMAX/DCHI2) + X1=(CHI-CHI1)*XSCAL1 + X2=(CHI-CHI2)*XSCAL2 + if (X1.lt.-XMAX) then + call BLIN9a(TEMP,CHI, + * W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, + * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, + * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, + * W0XXX,W0XTT,W0XXT) + elseif (X2.lt.XMAX) then ! match two fits + if (X1.lt.XMAX) then ! match fits "a" and "b" + call FERMI10(X1,XMAX,FP,FM) + call BLIN9a(TEMP,CHI, + * W0a,W0DXa,W0DTa,W0DXXa,W0DTTa,W0DXTa, + * W1a,W1DXa,W1DTa,W1DXXa,W1DTTa,W1DXTa, + * W2a,W2DXa,W2DTa,W2DXXa,W2DTTa,W2DXTa, + * W0XXXa,W0XTTa,W0XXTa) + call BLIN9b(TEMP,CHI, + * W0b,W0DXb,W0DTb,W0DXXb,W0DTTb,W0DXTb, + * W1b,W1DXb,W1DTb,W1DXXb,W1DTTb,W1DXTb, + * W2b,W2DXb,W2DTb,W2DXXb,W2DTTb,W2DXTb, + * W0XXXb,W0XTTb,W0XXTb) + else ! match fits "b" and "c" + call FERMI10(X2,XMAX,FP,FM) + call BLIN9b(TEMP,CHI, + * W0a,W0DXa,W0DTa,W0DXXa,W0DTTa,W0DXTa, + * W1a,W1DXa,W1DTa,W1DXXa,W1DTTa,W1DXTa, + * W2a,W2DXa,W2DTa,W2DXXa,W2DTTa,W2DXTa, + * W0XXXa,W0XTTa,W0XXTa) + call BLIN9c(TEMP,CHI, + * W0b,W0DXb,W0DTb,W0DXXb,W0DTTb,W0DXTb, + * W1b,W1DXb,W1DTb,W1DXXb,W1DTTb,W1DXTb, + * W2b,W2DXb,W2DTb,W2DXXb,W2DTTb,W2DXTb, + * W0XXXb,W0XTTb,W0XXTb) + endif + W0=W0a*FP+W0b*FM + W0DX=W0DXa*FP+W0DXb*FM !! +(W0a-W0b)*F1 + W0DT=W0DTa*FP+W0DTb*FM + W0DXX=W0DXXa*FP+W0DXXb*FM !! +2.d0*(W0DXa-W0DXb)*F1+(W0a-W0b)*F2 + W0DTT=W0DTTa*FP+W0DTTb*FM + W0DXT=W0DXTa*FP+W0DXTb*FM !! +(W0DTa-W0DTb)*F1 + W0XXX=W0XXXa*FP+W0XXXb*FM !! +3.d0*(W0DXXa-W0DXXb)*F1+3.d0*(W0DXa-W0DXb)*F2+(W0a-W0b)*F3 + W0XTT=W0XTTa*FP+W0XTTb*FM !! +(W0DTTa-W0DTTb)*F1 + W0XXT=W0XXTa*FP+W0XXTb*FM !! +2.d0*(W0DXTa-W0DXTb)*F1+(W0DTa-W0DTb)*F2 + W1=W1a*FP+W1b*FM + W1DX=W1DXa*FP+W1DXb*FM !! +(W1a-W1b)*F1 + W1DT=W1DTa*FP+W1DTb*FM + W1DXX=W1DXXa*FP+W1DXXb*FM !! +2.d0*(W1DXa-W1DXb)*F1+(W1a-W1b)*F2 + W1DTT=W1DTTa*FP+W1DTTb*FM + W1DXT=W1DXTa*FP+W1DXTb*FM !! +(W1DTa-W1DTb)*F1 + W2=W2a*FP+W2b*FM + W2DX=W2DXa*FP+W2DXb*FM !! +(W2a-W2b)*F1 + W2DT=W2DTa*FP+W2DTb*FM + W2DXX=W2DXXa*FP+W2DXXb*FM !! +2.d0*(W2DXa-W2DXb)*F1+(W2a-W2b)*F2 + W2DTT=W2DTTa*FP+W2DTTb*FM + W2DXT=W2DXTa*FP+W2DXTb*FM !! + else + call BLIN9c(TEMP,CHI, + * W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, + * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, + * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, + * W0XXX,W0XTT,W0XXT) + endif + return + end + + subroutine BLIN9a(TEMP,CHI, + * W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, + * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, + * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, + * W0XXX,W0XTT,W0XXT) +* Version 19.01.10 +* First part of BILN9: small CHI. Stems from BLIN9 v.24.12.08 + implicit double precision (A-H), double precision (O-Z) + save + dimension AC(5,0:2),AU(5,0:2),AA(5,0:2) + data AC/.37045057 d0, .41258437 d0, + & 9.777982 d-2, 5.3734153 d-3, 3.8746281 d-5, ! c_i^0 + & .39603109 d0, .69468795 d0, + & .22322760 d0, 1.5262934 d-2, 1.3081939 d-4, ! c_i^1 + & .76934619 d0, 1.7891437 d0, + & .70754974 d0, 5.6755672 d-2, 5.5571480 d-4/ ! c_i^2 + data AU/.43139881 d0, 1.7597537 d0, + & 4.1044654 d0, 7.7467038 d0, 13.457678 d0, ! \chi_i^0 + & .81763176 d0, 2.4723339 d0, + & 5.1160061 d0, 9.0441465 d0, 15.049882 d0, ! \chi_i^1 + & 1.2558461 d0, 3.2070406 d0, + & 6.1239082 d0, 10.316126 d0, 16.597079 d0/ ! \chi_i^2 + data KRUN/0/ + KRUN=KRUN+1 + if (KRUN.eq.1) then ! initialize + do J=0,2 + do I=1,5 + AA(I,J)=dexp(-AU(I,J)) + enddo + enddo + endif + do K=0,2 + W=0. + WDX=0. + WDT=0. + WDXX=0. + WDTT=0. + WDXT=0. + WDXXX=0. + WDXTT=0. + WDXXT=0. + ECHI=dexp(-CHI) + do I=1,5 + SQ=dsqrt(1.d0+AU(I,K)*TEMP/2.) + DN=AA(I,K)+ECHI ! e^{-\chi_i}+e^{-\chi}) + W=W+AC(I,K)*SQ/DN + WDX=WDX+AC(I,K)*SQ/DN**2 + WDT=WDT+AC(I,K)*AU(I,K)/(SQ*DN) + WDXX=WDXX+AC(I,K)*SQ*(ECHI-AA(I,K))/DN**3 + WDTT=WDTT-AC(I,K)*AU(I,K)**2/(DN*SQ**3) + WDXT=WDXT+AC(I,K)*AU(I,K)/(SQ*DN**2) + WDXXX=WDXXX+AC(I,K)*SQ* + * (ECHI**2-4.*ECHI*AA(I,K)+AA(I,K)**2)/DN**4 + WDXTT=WDXTT-AC(I,K)*AU(I,K)**2/(DN**2*SQ**3) + WDXXT=WDXXT+AC(I,K)*AU(I,K)*(ECHI-AA(I,K))/(SQ*DN**3) + enddo + WDX=WDX*ECHI + WDT=WDT/4. + WDXX=WDXX*ECHI + WDTT=WDTT/16. + WDXT=WDXT/4.*ECHI + WDXXX=WDXXX*ECHI + WDXTT=WDXTT*ECHI/16. + WDXXT=WDXXT/4.*ECHI + if (K.eq.0) then + W0=W + W0DX=WDX + W0DT=WDT + W0DXX=WDXX + W0DTT=WDTT + W0DXT=WDXT + W0XXX=WDXXX + W0XTT=WDXTT + W0XXT=WDXXT + elseif (K.eq.1) then + W1=W + W1DX=WDX + W1DT=WDT + W1DXX=WDXX + W1DTT=WDTT + W1DXT=WDXT + else + W2=W + W2DX=WDX + W2DT=WDT + W2DXX=WDXX + W2DTT=WDTT + W2DXT=WDXT + endif + enddo ! next K + return + end + + subroutine BLIN9b(TEMP,CHI, + * W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, + * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, + * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, + * W0XXX,W0XTT,W0XXT) +* Version 19.01.10 +* Small syntax fix 15.03.13 +* Second part of BILN9: intermediate CHI. Stems from BLIN8 v.24.12.08 + implicit double precision (A-H), double precision (O-Z) + save + dimension AX(5),AXI(5),AH(5),AV(5) + parameter (EPS=1.d-3) + data AX/7.265351 d-2, .2694608 d0, + & .533122 d0, .7868801 d0, .9569313 d0/ ! x_i + data AXI/.26356032 d0, 1.4134031 d0, + & 3.5964258 d0, 7.0858100 d0, 12.640801 d0/ ! \xi_i + data AH/3.818735 d-2, .1256732 d0, + & .1986308 d0, .1976334 d0, .1065420 d0/ ! H_i + data AV/.29505869 d0, .32064856 d0, 7.3915570 d-2, + & 3.6087389 d-3, 2.3369894 d-5/ ! \bar{V}_i + if (CHI.lt.EPS) stop'BLIN9b: CHI is too small' + do K=0,2 + W=0. + WDX=0. + WDT=0. + WDXX=0. + WDTT=0. + WDXT=0. + WDXXX=0. + WDXTT=0. + WDXXT=0. + SQCHI=dsqrt(CHI) + do I=1,5 + CE=AX(I)-1.d0 + ECHI=dexp(CE*CHI) + DE=1.d0+ECHI + D=1.d0+AX(I)*CHI*TEMP/2. + H=CHI**(K+1)*SQCHI*dsqrt(D)/DE + HX=(K+1.5)/CHI+.25*AX(I)*TEMP/D-ECHI*CE/DE + HDX=H*HX + HXX=(K+1.5)/CHI**2+.125*(AX(I)*TEMP/D)**2+ECHI*(CE/DE)**2 + HDXX=HDX*HX-H*HXX + HT=.25*AX(I)*CHI/D + HDT=H*HT + HDTT=-H*HT**2 + HTX=1./CHI-.5*AX(I)*TEMP/D + HDXT=HDX*HT+HDT*HTX + HDXXT=HDXX*HT+HDX*HT*HTX+HDXT*HTX+ + + HDT*(.25*(AX(I)*TEMP/D)**2-1./CHI**2) + HDXTT=HDXT*HT-HDX*.125*(AX(I)*CHI/D)**2+HDTT*HTX+ + + HDT*.5*AX(I)*(TEMP*.5*AX(I)*CHI/D**2-1./D) + HXXX=(2*K+3)/CHI**3+.125*(AX(I)*TEMP/D)**3- + - ECHI*(1.d0-ECHI)*(CE/DE)**3 + HDXXX=HDXX*HX-2.*HDX*HXX+H*HXXX + XICHI=AXI(I)+CHI + DXI=1.d0+XICHI*TEMP/2. + V=XICHI**K*dsqrt(XICHI*DXI) + VX=(K+.5)/XICHI+.25*TEMP/DXI + VDX=V*VX + VT=.25*XICHI/DXI + VDT=V*VT + VXX=(K+.5)/XICHI**2+.125*(TEMP/DXI)**2 + VDXX=VDX*VX-V*VXX + VDXXX=VDXX*VX-2.*VDX*VXX+ + + V*((2*K+1)/XICHI**3+.125*(TEMP/DXI)**3) + VXXT=(1.-.5*TEMP*XICHI/DXI)/DXI + VDTT=-V*VT**2 + VXT=1./XICHI-.5*TEMP/DXI + VDXT=VDT*VXT+VDX*VT + VDXXT=VDXT*VX+VDX*.25*VXXT-VDT*VXX-V*.25*TEMP/DXI*VXXT + VDXTT=VDTT*VXT-VDT*.5*VXXT+VDXT*VT- + - VDX*.125*(XICHI/DXI)**2 + W=W+AH(I)*AX(I)**K*H+AV(I)*V + WDX=WDX+AH(I)*AX(I)**K*HDX+AV(I)*VDX + WDT=WDT+AH(I)*AX(I)**K*HDT+AV(I)*VDT + WDXX=WDXX+AH(I)*AX(I)**K*HDXX+AV(I)*VDXX + WDTT=WDTT+AH(I)*AX(I)**K*HDTT+AV(I)*VDTT + WDXT=WDXT+AH(I)*AX(I)**K*HDXT+AV(I)*VDXT + WDXXX=WDXXX+AH(I)*AX(I)**K*HDXXX+AV(I)*VDXXX + WDXTT=WDXTT+AH(I)*AX(I)**K*HDXTT+AV(I)*VDXTT + WDXXT=WDXXT+AH(I)*AX(I)**K*HDXXT+AV(I)*VDXXT + enddo + if (K.eq.0) then + W0=W + W0DX=WDX + W0DT=WDT + W0DXX=WDXX + W0DTT=WDTT + W0DXT=WDXT + W0XXX=WDXXX + W0XTT=WDXTT + W0XXT=WDXXT + elseif (K.eq.1) then + W1=W + W1DX=WDX + W1DT=WDT + W1DXX=WDXX + W1DTT=WDTT + W1DXT=WDXT + else + W2=W + W2DX=WDX + W2DT=WDT + W2DXX=WDXX + W2DTT=WDTT + W2DXT=WDXT + endif + enddo ! next K + return + end + + subroutine BLIN9c(TEMP,CHI, + * W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, + * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, + * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, + * W0XXX,W0XTT,W0XXT) +* Version 19.01.10 +* Third part of BILN9: large CHI. Stems from BLIN8 v.24.12.08 + implicit double precision (A-H), double precision (O-Z) + save + parameter (PI=3.141592653d0,PI26=PI*PI/6.) + dimension AM(0:2),AMDX(0:2),AMDT(0:2), + * AMDXX(0:2),AMDTT(0:2),AMDXT(0:2) + if (CHI*TEMP.lt..1) then + do K=0,2 + W=0. + WDX=0. + WDT=0. + WDXX=0. + WDTT=0. + WDXT=0. + WDXXX=0. + WDXTT=0. + WDXXT=0. + do J=0,4 ! for nonrel.Fermi integrals from k+1/2 to k+4.5 + CNU=K+J+.5 ! nonrelativistic Fermi integral index \nu + CHINU=CHI**(K+J)*dsqrt(CHI) ! \chi^\nu + F=CHINU*(CHI/(CNU+1.)+PI26*CNU/CHI+ ! nonrel.Fermi + + .7*PI26**2*CNU*(CNU-1.)*(CNU-2.)/CHI**3) + FDX=CHINU*(1.+PI26*CNU*(CNU-1.)/CHI**2+ + + .7*PI26**2*CNU*(CNU-1.)*(CNU-2.)*(CNU-3.)/CHI**4) + FDXX=CHINU/CHI*CNU*(1.+PI26*(CNU-1.)*(CNU-2.)/CHI**2+ + + .7*PI26**2*(CNU-1.)*(CNU-2.)*(CNU-3.)*(CNU-4.)/CHI**4) + FDXXX=CHINU/CHI**2*CNU*(CNU-1.)* + * (1.+PI26*(CNU-2.)*(CNU-3.)/CHI**2+ + + .7*PI26**2*(CNU-2.)*(CNU-3.)*(CNU-4.)*(CNU-5.)/CHI**4) + if (J.eq.0) then + W=F + WDX=FDX + WDXX=FDXX + WDXXX=FDXXX + elseif (J.eq.1) then + C=.25*TEMP + W=W+C*F ! Fermi-Dirac, expressed through Fermi + WDX=WDX+C*FDX + WDXX=WDXX+C*FDXX + WDT=F/4. + WDXT=FDX/4. + WDTT=0. + WDXXX=WDXXX+C*FDXXX + WDXXT=FDXX/4. + WDXTT=0. + else + C=-C/J*(2*J-3)/4.*TEMP + W=W+C*F + WDX=WDX+C*FDX + WDT=WDT+C*J/TEMP*F + WDXX=WDXX+C*FDXX + WDTT=WDTT+C*J*(J-1)/TEMP**2*F + WDXT=WDXT+C*J/TEMP*FDX + WDXXX=WDXXX+C*FDXXX + WDXTT=WDXTT+C*J*(J-1)/TEMP**2*FDX + WDXXT=WDXXT+C*J/TEMP*FDXX + endif + enddo ! next J + if (K.eq.0) then + W0=W + W0DX=WDX + W0DT=WDT + W0DXX=WDXX + W0DTT=WDTT + W0DXT=WDXT + W0XXX=WDXXX + W0XTT=WDXTT + W0XXT=WDXXT + elseif (K.eq.1) then + W1=W + W1DX=WDX + W1DT=WDT + W1DXX=WDXX + W1DTT=WDTT + W1DXT=WDXT + else + W2=W + W2DX=WDX + W2DT=WDT + W2DXX=WDXX + W2DTT=WDTT + W2DXT=WDXT + endif + enddo ! next K +* ---------------------------------------------------------------- * + else ! CHI > 14, CHI*TEMP > 0.1: general high-\chi expansion + D=1.d0+CHI*TEMP/2.d0 + R=dsqrt(CHI*D) + RX=.5d0/CHI+.25d0*TEMP/D + RDX=R*RX + RDT=.25d0*CHI**2/R + RXX=-.5d0/CHI**2-.125d0*(TEMP/D)**2 + RDXX=RDX*RX+R*RXX + RDTT=-.25d0*RDT*CHI/D + RXT=.25d0/D-.125d0*CHI*TEMP/D**2 + RDXT=RDT*RX+R*RXT + RXXX=1.d0/CHI**3+.125d0*(TEMP/D)**3 + RDXXX=RDXX*RX+2.d0*RDX*RXX+R*RXXX + RXTT=-.25d0/D**2*CHI+.125d0*CHI**2*TEMP/D**3 + RDXTT=RDTT*RX+2.d0*RDT*RXT+R*RXTT + RXXT=-RXT*TEMP/D + RDXXT=RDXT*RX+RDX*RXT+RDT*RXX+R*RXXT + do K=0,2 + DM=K+.5d0+(K+1.d0)*CHI*TEMP/2.d0 + AM(K)=CHI**K*DM/R + FMX1=.5d0*(K+1.)*TEMP/DM + FMX2=.25d0*TEMP/D + FMX=(K-.5d0)/CHI+FMX1-FMX2 + AMDX(K)=AM(K)*FMX + CKM=.5d0*(K+1.d0)/DM + FMT1=CKM*CHI + FMT2=.25d0*CHI/D + FMT=FMT1-FMT2 + AMDT(K)=AM(K)*FMT + FMXX=-(K-.5d0)/CHI**2-FMX1**2+2.d0*FMX2**2 + AMDXX(K)=AMDX(K)*FMX+AM(K)*FMXX + FMTT=2.d0*FMT2**2-FMT1**2 + AMDTT(K)=AMDT(K)*FMT+AM(K)*FMTT + AMDXT(K)=AMDX(K)*FMT+AM(K)*(CKM*(1.d0-CKM*CHI*TEMP)- + - .25d0/D+.125d0*CHI*TEMP/D**2) + if (K.eq.0) then + FMXXX=(2*K-1)/CHI**3+2.d0*FMX1**3-8.d0*FMX2**3 + AMDXXX=AMDXX(K)*FMX+2.d0*AMDX(K)*FMXX+AM(K)*FMXXX + FMT1DX=CKM-TEMP*CHI*CKM**2 + FMT2DX=(.25d0-CHI*TEMP*.125d0/D)/D + FMXT=FMT1DX-FMT2DX + FMTTX=4.d0*FMT2*FMT2DX-2.d0*FMT1*FMT1DX + AMDXTT=AMDXT(K)*FMT+AMDT(K)*FMXT+AMDX(K)*FMTT+AM(K)*FMTTX + FMX1DT=CKM-CHI*TEMP*CKM**2 + FMX2DT=.25d0/D*(1.d0-.5d0*CHI*TEMP/D) + FMXXT=4.d0*FMX2*FMX2DT-2.d0*FMX1*FMX1DT + AMDXXT=AMDXT(K)*FMX+AMDX(K)*FMXT+AMDT(K)*FMXX+AM(K)*FMXXT + endif + enddo + SQ2T=dsqrt(2.d0*TEMP) + A=1.d0+CHI*TEMP+SQ2T*R + ADX=TEMP+SQ2T*RDX + ADT=CHI+R/SQ2T+SQ2T*RDT + ADXX=SQ2T*RDXX + ADTT=-R/SQ2T**3+2.d0/SQ2T*RDT+SQ2T*RDTT + ADXT=1.d0+RDX/SQ2T+SQ2T*RDXT + ADXTT=-RDX/SQ2T**3+2.d0/SQ2T*RDXT+SQ2T*RDXTT + ADXXT=RDXX/SQ2T+SQ2T*RDXXT + XT1=CHI+1.d0/TEMP + Aln=dlog(A) + FJ0=.5d0*XT1*R-Aln/SQ2T**3 + ASQ3=A*SQ2T**3 + ASQ3DX=ADX*SQ2T**3 + FJ0DX=.5d0*(R+XT1*RDX)-ADX/ASQ3 + FJ0DT=.5d0*(XT1*RDT-R/TEMP**2)-ADT/ASQ3+ + + .75d0/(TEMP**2*SQ2T)*Aln + FJ0DXX=RDX+.5d0*XT1*RDXX+(ADX/A)**2/SQ2T**3-ADXX/ASQ3 + FJ0DTT=R/TEMP**3-RDT/TEMP**2+.5d0*XT1*RDTT+ + + 3.d0/(ASQ3*TEMP)*ADT+ + + (ADT/A)**2/SQ2T**3-ADTT/ASQ3-1.875d0/(TEMP**3*SQ2T)*Aln + BXT=1.5d0/TEMP*ADX+ADX*ADT/A-ADXT + BXXT=1.5d0/TEMP*ADXX+(ADXX*ADT+ADX*ADXT)/A- + - (ADX/A)**2*ADT-ADXXT + FJ0DXT=.5d0*(RDT-RDX/TEMP**2+XT1*RDXT)+BXT/ASQ3 + FJ0XXX=RDXX*1.5d0+.5d0*XT1*RDXXX+ + + (2.d0*ADX*(ADXX/A-(ADX/A)**2)- + - SQ2T*RDXXX+ADXX/ASQ3*ASQ3DX)/ASQ3 + FJ0XTT=RDX/TEMP**3-RDXT/TEMP**2+.5d0*(RDTT+XT1*RDXTT)+ + + 3.d0/TEMP*(ADXT-ADT/ASQ3*ASQ3DX)/ASQ3+ + + (2.d0*ADT*(ADXT/A-ADT*ADX/A**2)- + - ADXTT+ADTT*ASQ3DX/ASQ3)/ASQ3-1.875d0/(TEMP**3*SQ2T)*ADX/A + FJ0XXT=.5d0*(RDXT-RDXX/TEMP**2+RDXT+XT1*RDXXT)+ + + (BXXT-BXT*ASQ3DX/ASQ3)/ASQ3 + W0=FJ0+PI26*AM(0) + W0DX=FJ0DX+PI26*AMDX(0) + W0DT=FJ0DT+PI26*AMDT(0) + W0DXX=FJ0DXX+PI26*AMDXX(0) + W0DTT=FJ0DTT+PI26*AMDTT(0) + W0DXT=FJ0DXT+PI26*AMDXT(0) + W0XXX=FJ0XXX+PI26*AMDXXX + W0XTT=FJ0XTT+PI26*AMDXTT + W0XXT=FJ0XXT+PI26*AMDXXT + FJ1=(R**3/1.5d0-FJ0)/TEMP + FJ1DX=(2.d0*R**2*RDX-FJ0DX)/TEMP + FJ1DT=(2.d0*R**2*RDT-FJ0DT-FJ1)/TEMP + FJ1DXX=(4.d0*R*RDX**2+2.d0*R**2*RDXX-FJ0DXX)/TEMP + FJ1DTT=(4.d0*R*RDT**2+2.d0*R**2*RDTT-FJ0DTT-2.d0*FJ1DT)/TEMP + FJ1DXT=(4.d0*R*RDX*RDT+2.d0*R**2*RDXT-FJ0DXT-FJ1DX)/TEMP + W1=FJ1+PI26*AM(1) + W1DX=FJ1DX+PI26*AMDX(1) + W1DT=FJ1DT+PI26*AMDT(1) + W1DXX=FJ1DXX+PI26*AMDXX(1) + W1DTT=FJ1DTT+PI26*AMDTT(1) + W1DXT=FJ1DXT+PI26*AMDXT(1) + FJ2=(.5d0*CHI*R**3-1.25d0*FJ1)/TEMP + FJ2DX=(.5d0*R**3+1.5d0*CHI*R**2*RDX-1.25d0*FJ1DX)/TEMP + FJ2DT=(1.5d0*CHI*R**2*RDT-1.25d0*FJ1DT-FJ2)/TEMP + FJ2DXX=(3.d0*R*RDX*(R+CHI*RDX)+1.5d0*CHI*R**2*RDXX- + - 1.25d0*FJ1DXX)/TEMP + FJ2DTT=(3.d0*CHI*R*(RDT**2+.5d0*R*RDTT)- + - 1.25d0*FJ1DTT-2.d0*FJ2DT)/TEMP + FJ2DXT=(1.5d0*R*RDT*(R+2.d0*CHI*RDX)+1.5d0*CHI*R**2*RDXT- + - 1.25d0*FJ1DXT-FJ2DX)/TEMP + W2=FJ2+PI26*AM(2) + W2DX=FJ2DX+PI26*AMDX(2) + W2DT=FJ2DT+PI26*AMDT(2) + W2DXX=FJ2DXX+PI26*AMDXX(2) + W2DTT=FJ2DTT+PI26*AMDTT(2) + W2DXT=FJ2DXT+PI26*AMDXT(2) + endif + return + end + + subroutine CHEMFIT(DENS,TEMP,CHI) +* Version 07.06.07 +* This is merely an interface to CHEMFIT7 for compatibility purposes. +* Input: DENS - electron density [a.u.=6.7483346e24 cm^{-3}], +* TEMP - temperature [a.u.=2Ryd=3.1577e5 K] +* Output: CHI=\mu/TEMP, where \mu - electron chem.pot.w/o rest-energy + implicit double precision (A-H), double precision (O-Z) + save + DENR=DENS/2.5733806d6 ! n_e in rel.un.=\lambda_{Compton}^{-3} + TEMR=TEMP/1.8778865d4 ! T in rel.un.=(mc^2/k)=5.93e9 K + call CHEMFIT7(DENR,TEMR,CHI,CMU1,0,CMUDENR,CMUDT,CMUDTT) + return + end + + subroutine CHEMFIT7(DENR,TEMR,CHI,CMU1,KDERIV, + * CMUDENR,CMUDT,CMUDTT) +* Version 29.08.15 +* Fit to the chemical potential of free electron gas described in: +* G.Chabrier & A.Y.Potekhin, Phys.Rev.E 58, 4941 (1998) +* Stems from CHEMFIT v.10.10.96. The main difference - derivatives. +* All quantities are by default in relativistic units +* Input: DENR - electron density, TEMR - temperature +* KDERIV=0 if the derivatives are not required +* Output: CHI=CMU1/TEMR, where CMU1 = \mu-1 - chem.pot.w/o rest-energy +* CMUDENR = (d\mu/d n_e)_T +* CMUDT = (d\mu/dT)_V +* CMUDTT = (d^2\mu/dT^2)_V +* CMUDENR,CMUDT, and CMUDTT =0 on output, if KREDIV=0 + implicit double precision (A-H), double precision (O-Z) + save + parameter (C13=1.d0/3.d0,PARA=1.612d0,PARB=6.192d0,PARC=.0944d0, + * PARF=5.535d0,PARG=.698d0) + parameter(XEPST=228.d0) ! the largest argument of e^{-X} + PF0=(29.6088132d0*DENR)**C13 ! Classical Fermi momentum + if (PF0.gt.1.d-4) then + TF=dsqrt(1.d0+PF0**2)-1.d0 ! Fermi temperature + else + TF=.5d0*PF0**2 + endif + THETA=TEMR/TF + THETA32=THETA*dsqrt(THETA) + Q2=12.d0+8.d0/THETA32 + T1=0. + if (THETA.lt.XEPST) T1=dexp(-THETA) + U3=T1**2+PARA + THETAC=THETA**PARC + THETAG=THETA**PARG + D3=PARB*THETAC*T1**2+PARF*THETAG + Q3=1.365568127d0-U3/D3 ! 1.365...=2/\pi^{1/3} + if (THETA.gt.1.d-5) then + Q1=1.5d0*T1/(1.d0-T1) + else + Q1=1.5d0/THETA + endif + SQT=dsqrt(TEMR) + G=(1.d0+Q2*TEMR*Q3+Q1*SQT)*TEMR + H=(1.d0+.5d0*TEMR/THETA)*(1.d0+Q2*TEMR) + CT=1.d0+G/H + F=2.d0*C13/THETA32 + call FERINV7(F,1,X,XDF,XDFF) + CHI=X ! non-relativistic result + - - 1.5d0*dlog(CT) ! Relativistic fit + CMU1=TEMR*CHI ! Fit to chemical potential w/o mc^2 + if (KDERIV.eq.0) then ! DISMISS DERIVATIVES + CMUDENR=0. + CMUDT=0. + CMUDTT=0. + return + endif +* CALCULATE DERIVATIVES: +* 1: derivatives of CHI over THETA and T +* (a): Non-relativistic result: + THETA52=THETA32*THETA + CHIDY=-XDF/THETA52 ! d\chi/d\theta + CHIDYY=(XDFF/THETA**4-2.5d0*CHIDY)/THETA ! d^2\chi/d\theta^2 +* (b): Relativistic corrections: + if (THETA.gt.1.d-5) then + Q1D=-Q1/(1.d0-T1) + Q1DD=-Q1D*(1.d0+T1)/(1.d0-T1) + else + Q1D=-1.5d0/THETA**2 + Q1DD=-2.d0*Q1D/THETA ! sign corrected 08.08.11 + endif + Q2D=-12.d0/THETA52 ! d q_2 / d \theta + Q2DD=30.d0/(THETA52*THETA) ! d^2 q_2 / d \theta^2 + U3D=-2.d0*T1**2 + D3D=PARF*PARG*THETAG/THETA+PARB*T1**2*THETAC*(PARC/THETA-2.d0) + D3DD=PARF*PARG*(PARG-1.d0)*THETAG/THETA**2+ + +PARB*T1**2*THETAC*(PARC*(PARC-1.d0)/THETA**2-4.d0*PARC/THETA+4.d0) + Q3D=(D3D*U3/D3-U3D)/D3 + Q3DD=(2.d0*U3D+(2.d0*U3D*D3D+U3*D3DD)/D3-2.d0*U3*(D3D/D3)**2)/D3 + GDY=TEMR*(Q1D*SQT+(Q2D*Q3+Q2*Q3D)*TEMR) ! dG/d\theta + GDT=1.d0+1.5d0*Q1*SQT+2.d0*Q2*Q3*TEMR + GDYY=TEMR*(Q1DD*SQT+(Q2DD*Q3+2.d0*Q2D*Q3D+Q2*Q3DD)*TEMR) + GDTT=.75d0*Q1/SQT+2.d0*Q2*Q3 + GDYT=1.5d0*Q1D*SQT+2.d0*(Q2D*Q3+Q2*Q3D)*TEMR + HDY=(-.5d0/THETA**2+Q2D+.5d0*(Q2D-Q2/THETA)/THETA*TEMR)*TEMR + HDT=(.5d0+Q2*TEMR)/THETA+Q2 + HDYY=TEMR/THETA**3+Q2DD*TEMR+ + + TEMR**2*(.5d0*Q2DD-Q2D/THETA+Q2/THETA**2)/THETA + HDTT=Q2/THETA + HDYT=Q2D*(1.d0+TEMR/THETA)-(.5d0+Q2*TEMR)/THETA**2 + CTY=GDY/G-HDY/H + CTT=GDT/G-HDT/H + GH=G/H + CTDY=GH*CTY + CTDT=GH*CTT + CTDYY=CTDY*CTY+GH*(GDYY/G-(GDY/G)**2-HDYY/H+(HDY/H)**2) + CTDTT=CTDT*CTT+GH*(GDTT/G-(GDT/G)**2-HDTT/H+(HDT/H)**2) + CTDYT=CTDT*CTY+GH*(GDYT/G-GDY*GDT/G**2-HDYT/H+HDY*HDT/H**2) + CHIDY=CHIDY-1.5d0*CTDY/CT + CHIDT=-1.5d0*CTDT/CT + CHIDYY=CHIDYY+1.5d0*((CTDY/CT)**2-CTDYY/CT) + CHIDTT=1.5d0*((CTDT/CT)**2-CTDTT/CT) + CHIDYT=1.5d0*(CTDY*CTDT/CT**2-CTDYT/CT) + CMUDENR=-(THETA*PF0)**2/(3.d0*DENR*(1.d0+TF))*CHIDY + CMUDT=CHI+THETA*CHIDY+TEMR*CHIDT + CMUDTT=2.d0*(CHIDY/TF+CHIDT+THETA*CHIDYT)+ + + THETA/TF*CHIDYY+TEMR*CHIDTT + return + end From 5e7a1eebeb4746847a72354afa45d481f2169d06 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 07:15:50 -0700 Subject: [PATCH 02/70] Turn on main program --- EOS/pc/eos17.f | 131 +++++++++++++++++++++++++------------------------ 1 file changed, 66 insertions(+), 65 deletions(-) diff --git a/EOS/pc/eos17.f b/EOS/pc/eos17.f index 8add04da4c..06690fe1cb 100755 --- a/EOS/pc/eos17.f +++ b/EOS/pc/eos17.f @@ -106,60 +106,61 @@ * In practice, however, one usually needs to link subroutines from this * file to another (external) code, therefore the MAIN program is * normally commented-out. -C%C implicit double precision (A-H), double precision (O-Z) -C%C parameter(MAXY=10,UN_T6=.3157746,EPS=1.d-7) -C%C dimension AY(MAXY),AZion(MAXY),ACMI(MAXY) -C%C write(*,'('' Introduce the chemical composition (up to'',I3, -C%C * '' ion species):''/ -C%C * '' charge number Z_i, atomic weight A_i,'', -C%C * '' partial number density x_i, derivatives d x_i / d ln T'', -C%C * '' and d x_i / d ln rho''/ -C%C / '' (non-positive Z, A, or x=1 terminates the input)'')') MAXY -C%C NMIX=0 -C%C 3 continue -C%C XSUM=0. -C%C do IX=1,MAXY -C%C write(*,'(''Z, A ('',I2,''): ''$)') IX -C%C read*,AZion(IX),ACMI(IX) -C%C if (AZion(IX).le.0..or.ACMI(IX).le.0.) goto 2 -C%C write(*,'(''x ('',I2,''): ''$)') IX -C%C read*,AY(IX) -C%C XSUM=XSUM+AY(IX) -C%C if (AY(IX).le.0.) goto 2 -C%C NMIX=IX -C%C if (dabs(XSUM-1.d0).lt.EPS) goto 2 -C%C enddo -C%C 2 continue -C%C if (NMIX.eq.0) then -C%C print*,'There must be at least one set of positive (x,Z,A).' -C%C goto 3 -C%C endif -C%C write(*,114) -C%C do IX=1,NMIX -C%C write(*,113) IX,AZion(IX),ACMI(IX),AY(IX) -C%C enddo -C%C 9 continue -C%C write(*,'('' Input T (K) (<0 to stop): ''$)') -C%C read*,T -C%C if (T.le.0.) stop -C%C 10 continue -C%C write(*,'('' Input RHO [g/cc] (<0 to new T): ''$)') -C%C read*,RHO -C%C if (RHO.le.0.) goto 9 -C%C RHOlg=dlog10(RHO) -C%C Tlg=dlog10(T) -C%C T6=10.d0**(Tlg-6.d0) -C%C RHO=10.d0**RHOlg -C%C write(*,112) -C%C 1 continue -C%C TEMP=T6/UN_T6 ! T [au] -C%C call MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP, ! input -C%C * PRADnkT, ! additional output - radiative pressure -C%C * DENS,Zmean,CMImean,Z2mean,GAMI,CHI,TPT,LIQSOL, ! output param. -C%C * PnkT,UNkT,SNk,CV,CHIR,CHIT) ! output dimensionless TD functions -C%C Tnk=8.31447d13/CMImean*RHO*T6 ! n_i kT [erg/cc] -C%C P=PnkT*Tnk/1.d12 ! P [Mbar] -C%C TEGRAD=CHIT/(CHIT**2+CHIR*CV/PnkT) ! from Maxwell relat. + program main + implicit double precision (A-H), double precision (O-Z) + parameter(MAXY=10,UN_T6=.3157746,EPS=1.d-7) + dimension AY(MAXY),AZion(MAXY),ACMI(MAXY) + write(*,'('' Introduce the chemical composition (up to'',I3, + * '' ion species):''/ + * '' charge number Z_i, atomic weight A_i,'', + * '' partial number density x_i, derivatives d x_i / d ln T'', + * '' and d x_i / d ln rho''/ + / '' (non-positive Z, A, or x=1 terminates the input)'')') MAXY + NMIX=0 + 3 continue + XSUM=0. + do IX=1,MAXY + write(*,'(''Z, A ('',I2,''): ''$)') IX + read*,AZion(IX),ACMI(IX) + if (AZion(IX).le.0..or.ACMI(IX).le.0.) goto 2 + write(*,'(''x ('',I2,''): ''$)') IX + read*,AY(IX) + XSUM=XSUM+AY(IX) + if (AY(IX).le.0.) goto 2 + NMIX=IX + if (dabs(XSUM-1.d0).lt.EPS) goto 2 + enddo + 2 continue + if (NMIX.eq.0) then + print*,'There must be at least one set of positive (x,Z,A).' + goto 3 + endif + write(*,114) + do IX=1,NMIX + write(*,113) IX,AZion(IX),ACMI(IX),AY(IX) + enddo + 9 continue + write(*,'('' Input T (K) (<0 to stop): ''$)') + read*,T + if (T.le.0.) stop + 10 continue + write(*,'('' Input RHO [g/cc] (<0 to new T): ''$)') + read*,RHO + if (RHO.le.0.) goto 9 + RHOlg=dlog10(RHO) + Tlg=dlog10(T) + T6=10.d0**(Tlg-6.d0) + RHO=10.d0**RHOlg + write(*,112) + 1 continue + TEMP=T6/UN_T6 ! T [au] + call MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP, ! input + * PRADnkT, ! additional output - radiative pressure + * DENS,Zmean,CMImean,Z2mean,GAMI,CHI,TPT,LIQSOL, ! output param. + * PnkT,UNkT,SNk,CV,CHIR,CHIT) ! output dimensionless TD functions + Tnk=8.31447d13/CMImean*RHO*T6 ! n_i kT [erg/cc] + P=PnkT*Tnk/1.d12 ! P [Mbar] + TEGRAD=CHIT/(CHIT**2+CHIR*CV/PnkT) ! from Maxwell relat. * -------------------- OUTPUT -------------------------------- * * Here in the output we have: * RHO - mass density in g/cc @@ -174,17 +175,17 @@ * TPT=T_p/T, where T_p is the ion plasma temperature * CHI - electron chemical potential, divided by kT * LIQSOL = 0 in the liquid state, = 1 in the solid state -C%C write(*,111) RHO,T6,P,PnkT,CV,CHIT,CHIR,UNkT,SNk,GAMI,TPT,CHI, -C%C * LIQSOL -C%C goto 10 -C%C 112 format(/ -C%C * ' rho [g/cc] T6 [K] P [Mbar] P/(n_i kT) Cv/(N k)', -C%C * ' chi_T chi_r U/(N k T) S/(N k) Gamma_i', -C%C * ' T_p/T chi_e liq/sol') -C%C 111 format(1P,12E12.3,I2) -C%C 113 format(I3,2F8.3,1PE12.4) -C%C 114 format(' Z CMI x_j') -C%C end + write(*,111) RHO,T6,P,PnkT,CV,CHIT,CHIR,UNkT,SNk,GAMI,TPT,CHI, + * LIQSOL + goto 10 + 112 format(/ + * ' rho [g/cc] T6 [K] P [Mbar] P/(n_i kT) Cv/(N k)', + * ' chi_T chi_r U/(N k T) S/(N k) Gamma_i', + * ' T_p/T chi_e liq/sol') + 111 format(1P,12E12.3,I2) + 113 format(I3,2F8.3,1PE12.4) + 114 format(' Z CMI x_j') + end program main subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, * DENS,Zmean,CMImean,Z2mean,GAMImean,CHI,TPT,LIQSOL, From b67a13386d0a34a28f8d2743c19a3dd93b7784d4 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 07:17:21 -0700 Subject: [PATCH 03/70] Turn on Wigner corrections by default --- EOS/pc/eos17.f | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/EOS/pc/eos17.f b/EOS/pc/eos17.f index 06690fe1cb..af4cb9c46b 100755 --- a/EOS/pc/eos17.f +++ b/EOS/pc/eos17.f @@ -241,15 +241,8 @@ subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, * GAMIMELT=175., ! OCP value of Gamma_i for melting * RSIMELT=140., ! ion density parameter of quantum melting * RAD=2.554d-7) ! Radiation constant (=4\sigma/c) (in a.u.) - data KRUN/0/ if (RHO.lt.1.e-19.or.RHO.gt.1.e15) stop'MELANGE: RHO out of range' - if (KRUN.ne.12345) then - write(*,'('' To include Wigner corrections? (N/Y) ''$)') - read(*,'(A)') CHWK - CWK=0. - if (CHWK.eq.'y'.or.CHWK.eq.'Y') CWK=1.d0 - KRUN=12345 - endif + CWK=1.d0 Y=0. do IX=1,NMIX Y=Y+AY(IX) From da2ce057c69af1458ad9baadc856d2f87ea44799 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 07:22:41 -0700 Subject: [PATCH 04/70] Hardcode a 60/40 C/O mix --- EOS/pc/eos17.f | 51 +++++++++++--------------------------------------- 1 file changed, 11 insertions(+), 40 deletions(-) diff --git a/EOS/pc/eos17.f b/EOS/pc/eos17.f index af4cb9c46b..4d4ecb5756 100755 --- a/EOS/pc/eos17.f +++ b/EOS/pc/eos17.f @@ -108,51 +108,25 @@ * normally commented-out. program main implicit double precision (A-H), double precision (O-Z) - parameter(MAXY=10,UN_T6=.3157746,EPS=1.d-7) + parameter(MAXY=2,UN_T6=.3157746,EPS=1.d-7) dimension AY(MAXY),AZion(MAXY),ACMI(MAXY) - write(*,'('' Introduce the chemical composition (up to'',I3, - * '' ion species):''/ - * '' charge number Z_i, atomic weight A_i,'', - * '' partial number density x_i, derivatives d x_i / d ln T'', - * '' and d x_i / d ln rho''/ - / '' (non-positive Z, A, or x=1 terminates the input)'')') MAXY NMIX=0 - 3 continue XSUM=0. - do IX=1,MAXY - write(*,'(''Z, A ('',I2,''): ''$)') IX - read*,AZion(IX),ACMI(IX) - if (AZion(IX).le.0..or.ACMI(IX).le.0.) goto 2 - write(*,'(''x ('',I2,''): ''$)') IX - read*,AY(IX) - XSUM=XSUM+AY(IX) - if (AY(IX).le.0.) goto 2 - NMIX=IX - if (dabs(XSUM-1.d0).lt.EPS) goto 2 - enddo - 2 continue - if (NMIX.eq.0) then - print*,'There must be at least one set of positive (x,Z,A).' - goto 3 - endif - write(*,114) - do IX=1,NMIX - write(*,113) IX,AZion(IX),ACMI(IX),AY(IX) - enddo - 9 continue - write(*,'('' Input T (K) (<0 to stop): ''$)') - read*,T - if (T.le.0.) stop - 10 continue - write(*,'('' Input RHO [g/cc] (<0 to new T): ''$)') - read*,RHO - if (RHO.le.0.) goto 9 + AZion(1) = 6.0d0 + AZion(2) = 8.0d0 + ACMI(1) = 12.0d0 + ACMI(2) = 16.0d0 + AY(1) = 0.6d0 + AY(2) = 0.4d0 + XSUM = 1.0d0 + NMIX = 2 + T = 1.d9 + RHO = 1.d7 RHOlg=dlog10(RHO) Tlg=dlog10(T) T6=10.d0**(Tlg-6.d0) RHO=10.d0**RHOlg write(*,112) - 1 continue TEMP=T6/UN_T6 ! T [au] call MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP, ! input * PRADnkT, ! additional output - radiative pressure @@ -177,14 +151,11 @@ program main * LIQSOL = 0 in the liquid state, = 1 in the solid state write(*,111) RHO,T6,P,PnkT,CV,CHIT,CHIR,UNkT,SNk,GAMI,TPT,CHI, * LIQSOL - goto 10 112 format(/ * ' rho [g/cc] T6 [K] P [Mbar] P/(n_i kT) Cv/(N k)', * ' chi_T chi_r U/(N k T) S/(N k) Gamma_i', * ' T_p/T chi_e liq/sol') 111 format(1P,12E12.3,I2) - 113 format(I3,2F8.3,1PE12.4) - 114 format(' Z CMI x_j') end program main subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, From 556c7faed7851b257bcbc2992e2d01e1e3c1c0d4 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 07:29:40 -0700 Subject: [PATCH 05/70] Implicit none in main --- EOS/pc/eos17.f | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/EOS/pc/eos17.f b/EOS/pc/eos17.f index 4d4ecb5756..651eadd9bd 100755 --- a/EOS/pc/eos17.f +++ b/EOS/pc/eos17.f @@ -107,19 +107,20 @@ * file to another (external) code, therefore the MAIN program is * normally commented-out. program main - implicit double precision (A-H), double precision (O-Z) - parameter(MAXY=2,UN_T6=.3157746,EPS=1.d-7) - dimension AY(MAXY),AZion(MAXY),ACMI(MAXY) - NMIX=0 - XSUM=0. + implicit none + double precision, parameter :: UN_T6 = .3157746 + double precision :: AY(2), AZion(2), ACMI(2) + double precision :: RHO, RHOlg, T, Tlg, T6, Tnk, TEMP, DENS + double precision :: Zmean, CMImean, Z2mean, GAMI, P + double precision :: CHI, TPT, TEGRAD, PRADnkT + double precision :: PnkT, UNkT, SNk, CV, CHIR, CHIT + integer :: LIQSOL AZion(1) = 6.0d0 AZion(2) = 8.0d0 ACMI(1) = 12.0d0 ACMI(2) = 16.0d0 AY(1) = 0.6d0 AY(2) = 0.4d0 - XSUM = 1.0d0 - NMIX = 2 T = 1.d9 RHO = 1.d7 RHOlg=dlog10(RHO) @@ -128,7 +129,7 @@ program main RHO=10.d0**RHOlg write(*,112) TEMP=T6/UN_T6 ! T [au] - call MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP, ! input + call MELANGE9(2,AY,AZion,ACMI,RHO,TEMP, ! input * PRADnkT, ! additional output - radiative pressure * DENS,Zmean,CMImean,Z2mean,GAMI,CHI,TPT,LIQSOL, ! output param. * PnkT,UNkT,SNk,CV,CHIR,CHIT) ! output dimensionless TD functions From 5abec181c8424ef11f40726bfb26dc73c3840ca6 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 07:36:05 -0700 Subject: [PATCH 06/70] Replace comment syntax --- EOS/pc/eos17.f | 810 ++++++++++++++++++++++++------------------------- 1 file changed, 405 insertions(+), 405 deletions(-) diff --git a/EOS/pc/eos17.f b/EOS/pc/eos17.f index 651eadd9bd..79f829afba 100755 --- a/EOS/pc/eos17.f +++ b/EOS/pc/eos17.f @@ -1,111 +1,111 @@ -** Equation of state for fully ionized electron-ion plasmas (EOS EIP) -* A.Y.Potekhin & G.Chabrier, Contrib. Plasma Phys., 50 (2010) 82, -* and references therein -* Please communicate comments/suggestions to Alexander Potekhin: -* palex@astro.ioffe.ru -* Previously distributed versions (obsolete): -* eos2000, eos2002, eos2004, eos2006, eos2007, eos2009, eos10, eos11, -* eos13, and eos14. -* Last update: 04.03.21. All updates since 2008 are listed below. -** L I S T O F S U B R O U T I N E S : -* MAIN (normally commented-out) - example driving routine. -* MELANGE9 - for arbitrary ionic mixture, renders total (ion+electron) -* pressure, internal energy, entropy, heat capacity (all -* normalized to the ionic ideal-gas values), logarithmic -* derivatives of pressure over temperature and density. -* EOSFI8 - nonideal (ion-ion + ion-electron + electron-electron) -* contributions to the free and internal energies, pressure, -* entropy, heat capacity, derivatives of pressure over -* logarithm of temperature and over logarithm of density (all -* normalized to the ionic ideal-gas values) for one ionic -* component in a mixture. -* FITION9 - ion-ion interaction contributions to the free and internal -* energies, pressure, entropy, heat capacity, derivatives of -* pressure over logarithms of temperature and density. -* FSCRliq8 - ion-electron (screening) contributions to the free and -* internal energies, pressure, entropy, heat capacity, -* derivatives of pressure over logarithms of temperature and -* density in the liquid phase for one ionic component in a -* mixture. -* FSCRsol8 - ion-electron (screening) contributions to the free and -* internal energies, pressure, entropy, heat capacity, -* derivatives of pressure over logarithms of temperature and -* density for monoionic solid. -* FHARM12 - harmonic (including static-lattice and zero-point) -* contributions to the free and internal energies, pressure, -* entropy, heat capacity, derivatives of pressure over -* logarithms of temperature and density for solid OCP. -* HLfit12 - the same as FHARM12, but only for thermal contributions -* ANHARM8 - anharmonic contributions to the free and internal energies, -* pressure, entropy, heat capacity, derivatives of pressure -* over logarithms of temperature and density for solid OCP. -* CORMIX - correction to the linear mixing rule for the Coulomb -* contributions to the thermodynamic functions in the liquid. -* ELECT11 - for an ideal electron gas of arbitrary degeneracy and -* relativity at given temperature and electron chemical -* potential, renders number density (in atomic units), free -* energy, pressure, internal energy, entropy, heat capacity -* (normalized to the electron ideal-gas values), logarithmic -* derivatives of pressure over temperature and density. -* EXCOR7 - electron-electron (exchange-correlation) contributions to -* the free and internal energies, pressure, entropy, heat -* capacity, derivatives of pressure over logarithm of -* temperature and over logarithm of density (all normalized -* to the classical electron ideal-gas values). -* FERINV7 - inverse non-relativistic Fermi integrals of orders -1/2, -* 1/2, 3/2, 5/2, and their first and second derivatives. -* BLIN9 - relativistic Fermi-Dirac integrals of orders 1/2, 3/2, 5/2, -* and their first, second, and some third derivatives. -* CHEMFIT7 - electron chemical potential at given density and -* temperature, and its first derivatives over density and -* temperature and the second derivative over temperature. -** I M P R O V E M E N T S S I N C E 2 0 0 8 : -* FHARM8 uses a fit HLfit8 to the thermal free energy of the harmonic -* Coulomb lattice, which is more accurate than its predecessor FHARM7. -* Resulting corrections amount up to 20% for the ion heat capacity. -* Accordingly, S/R D3fit and FthCHA7 deleted (not used anymore). -* BLIN7 upgraded to BLIN8: -* - cleaned (a never-reached if-else branch deleted); -* - Sommerfeld (high-\chi) expansion improved; -* - some third derivatives added. -* CORMIX added (and MELANGE7 upgraded to MELANGE8 accordingly). -* ANHARM7 upgraded to ANHARM8, more consistent with Wigner-Kirkwood. -* Since the T- and rho-dependences of individual Z values in a mixture -* are not considered, the corresponding inputs (AYLR, AYLT) are -* excluded from MELANGE8 (and EOSFI7 changed to EOSFI8 accordingly). -* ELECT7 upgraded to ELECT9 (high-degeneracy behaviour is improved) -** P O S T - P U B L I C A T I O N (2 0 1 0 +) IMPROVEMENTS : -* ELECT9 upgraded (smooth match of two fits at chi >> 1) -* BLIN8 replaced by BLIN9 - smooth fit interfaces at chi=0.6 and 14. -* MELANGE8 replaced by MELANGE9 - slightly modified input/output -* 08.08.11 - corrected mistake (unlikely to have an effect) in CHEMFIT7 -* 16.11.11 - ELECT9 upgraded to ELECT11 (additional output) -* 20.04.12 - FHARM8 and HLfit8 upgraded to FHARM12 and HLfit12: -* output of HLfit12 does not include zero-point vibr., but provides U1 -* 22.12.12 - MELANGE9 now includes a correction to the linear mixing -* rule (LMR) for the Madelung energy in the random bcc multi-ion -* lattice. -* 14.05.13 - an accidental error in programming the newly introduced -* correction to the LMR is fixed. -* 20.05.13 - calculation of the Wigner-Kirkwood quantum diffraction term -* for the liquid plasma is moved from EOSFI8 into MELANGE9. -* 10.12.14 - slight cleaning of the text (no effect on the results) -* 28.05.15 - an accidental error in Wigner-Kirkwood entropy correction -* is fixed (it was in the line "Stot=Stot+FWK*DENSI" since 20.05.13) -* 29.08.15 - eliminated underflow of exp(-THETA) in CHEMFIT7 -* 10.08.16 - modified criteria to avoid accuracy loss (round-off errors) -* 07.02.17 - included possibility to switch off the WK (Wigner) terms -* 27.05.17 - safeguard against Zion < 1 is added in FSCRsol8; -* safeguard against huge (-CHI) values is added in ELECT11. -* 27.01.19 - safeguard against X1=0 in CORMIX. -* 18.04.20 - corrected Wigner-Kirkwood term for heat capacity. -* 04.03.21 - corrected SUBFERMJ: defined parameter EPS (was undefined). -************************************************************************ -* MAIN program: Version 02.06.09 -* This driving routine allows one to compile and run this code "as is". -* In practice, however, one usually needs to link subroutines from this -* file to another (external) code, therefore the MAIN program is -* normally commented-out. +!! Equation of state for fully ionized electron-ion plasmas (EOS EIP) +! A.Y.Potekhin & G.Chabrier, Contrib. Plasma Phys., 50 (2010) 82, +! and references therein +! Please communicate comments/suggestions to Alexander Potekhin: +! palex@astro.ioffe.ru +! Previously distributed versions (obsolete): +! eos2000, eos2002, eos2004, eos2006, eos2007, eos2009, eos10, eos11, +! eos13, and eos14. +! Last update: 04.03.21. All updates since 2008 are listed below. +!! L I S T O F S U B R O U T I N E S : +! MAIN (normally commented-out) - example driving routine. +! MELANGE9 - for arbitrary ionic mixture, renders total (ion+electron) +! pressure, internal energy, entropy, heat capacity (all +! normalized to the ionic ideal-gas values), logarithmic +! derivatives of pressure over temperature and density. +! EOSFI8 - nonideal (ion-ion + ion-electron + electron-electron) +! contributions to the free and internal energies, pressure, +! entropy, heat capacity, derivatives of pressure over +! logarithm of temperature and over logarithm of density (all +! normalized to the ionic ideal-gas values) for one ionic +! component in a mixture. +! FITION9 - ion-ion interaction contributions to the free and internal +! energies, pressure, entropy, heat capacity, derivatives of +! pressure over logarithms of temperature and density. +! FSCRliq8 - ion-electron (screening) contributions to the free and +! internal energies, pressure, entropy, heat capacity, +! derivatives of pressure over logarithms of temperature and +! density in the liquid phase for one ionic component in a +! mixture. +! FSCRsol8 - ion-electron (screening) contributions to the free and +! internal energies, pressure, entropy, heat capacity, +! derivatives of pressure over logarithms of temperature and +! density for monoionic solid. +! FHARM12 - harmonic (including static-lattice and zero-point) +! contributions to the free and internal energies, pressure, +! entropy, heat capacity, derivatives of pressure over +! logarithms of temperature and density for solid OCP. +! HLfit12 - the same as FHARM12, but only for thermal contributions +! ANHARM8 - anharmonic contributions to the free and internal energies, +! pressure, entropy, heat capacity, derivatives of pressure +! over logarithms of temperature and density for solid OCP. +! CORMIX - correction to the linear mixing rule for the Coulomb +! contributions to the thermodynamic functions in the liquid. +! ELECT11 - for an ideal electron gas of arbitrary degeneracy and +! relativity at given temperature and electron chemical +! potential, renders number density (in atomic units), free +! energy, pressure, internal energy, entropy, heat capacity +! (normalized to the electron ideal-gas values), logarithmic +! derivatives of pressure over temperature and density. +! EXCOR7 - electron-electron (exchange-correlation) contributions to +! the free and internal energies, pressure, entropy, heat +! capacity, derivatives of pressure over logarithm of +! temperature and over logarithm of density (all normalized +! to the classical electron ideal-gas values). +! FERINV7 - inverse non-relativistic Fermi integrals of orders -1/2, +! 1/2, 3/2, 5/2, and their first and second derivatives. +! BLIN9 - relativistic Fermi-Dirac integrals of orders 1/2, 3/2, 5/2, +! and their first, second, and some third derivatives. +! CHEMFIT7 - electron chemical potential at given density and +! temperature, and its first derivatives over density and +! temperature and the second derivative over temperature. +!! I M P R O V E M E N T S S I N C E 2 0 0 8 : +! FHARM8 uses a fit HLfit8 to the thermal free energy of the harmonic +! Coulomb lattice, which is more accurate than its predecessor FHARM7. +! Resulting corrections amount up to 20% for the ion heat capacity. +! Accordingly, S/R D3fit and FthCHA7 deleted (not used anymore). +! BLIN7 upgraded to BLIN8: +! - cleaned (a never-reached if-else branch deleted); +! - Sommerfeld (high-\chi) expansion improved; +! - some third derivatives added. +! CORMIX added (and MELANGE7 upgraded to MELANGE8 accordingly). +! ANHARM7 upgraded to ANHARM8, more consistent with Wigner-Kirkwood. +! Since the T- and rho-dependences of individual Z values in a mixture +! are not considered, the corresponding inputs (AYLR, AYLT) are +! excluded from MELANGE8 (and EOSFI7 changed to EOSFI8 accordingly). +! ELECT7 upgraded to ELECT9 (high-degeneracy behaviour is improved) +!! P O S T - P U B L I C A T I O N (2 0 1 0 +) IMPROVEMENTS : +! ELECT9 upgraded (smooth match of two fits at chi >> 1) +! BLIN8 replaced by BLIN9 - smooth fit interfaces at chi=0.6 and 14. +! MELANGE8 replaced by MELANGE9 - slightly modified input/output +! 08.08.11 - corrected mistake (unlikely to have an effect) in CHEMFIT7 +! 16.11.11 - ELECT9 upgraded to ELECT11 (additional output) +! 20.04.12 - FHARM8 and HLfit8 upgraded to FHARM12 and HLfit12: +! output of HLfit12 does not include zero-point vibr., but provides U1 +! 22.12.12 - MELANGE9 now includes a correction to the linear mixing +! rule (LMR) for the Madelung energy in the random bcc multi-ion +! lattice. +! 14.05.13 - an accidental error in programming the newly introduced +! correction to the LMR is fixed. +! 20.05.13 - calculation of the Wigner-Kirkwood quantum diffraction term +! for the liquid plasma is moved from EOSFI8 into MELANGE9. +! 10.12.14 - slight cleaning of the text (no effect on the results) +! 28.05.15 - an accidental error in Wigner-Kirkwood entropy correction +! is fixed (it was in the line "Stot=Stot+FWK*DENSI" since 20.05.13) +! 29.08.15 - eliminated underflow of exp(-THETA) in CHEMFIT7 +! 10.08.16 - modified criteria to avoid accuracy loss (round-off errors) +! 07.02.17 - included possibility to switch off the WK (Wigner) terms +! 27.05.17 - safeguard against Zion < 1 is added in FSCRsol8; +! safeguard against huge (-CHI) values is added in ELECT11. +! 27.01.19 - safeguard against X1=0 in CORMIX. +! 18.04.20 - corrected Wigner-Kirkwood term for heat capacity. +! 04.03.21 - corrected SUBFERMJ: defined parameter EPS (was undefined). +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! MAIN program: Version 02.06.09 +! This driving routine allows one to compile and run this code "as is". +! In practice, however, one usually needs to link subroutines from this +! file to another (external) code, therefore the MAIN program is +! normally commented-out. program main implicit none double precision, parameter :: UN_T6 = .3157746 @@ -136,20 +136,20 @@ program main Tnk=8.31447d13/CMImean*RHO*T6 ! n_i kT [erg/cc] P=PnkT*Tnk/1.d12 ! P [Mbar] TEGRAD=CHIT/(CHIT**2+CHIR*CV/PnkT) ! from Maxwell relat. -* -------------------- OUTPUT -------------------------------- * -* Here in the output we have: -* RHO - mass density in g/cc -* P - total pressure in Mbar (i.e. in 1.e12 dyn/cm^2) -* PnkT=P/nkT, where n is the number density of ions, T temperature -* CV - heat capacity at constant volume, divided by number of ions, /k -* CHIT - logarithmic derivative of pressure \chi_T -* CHIR - logarithmic derivative of pressure \chi_\rho -* UNkT - internal energy divided by NkT, N being the number of ions -* SNk - entropy divided by number of ions, /k -* GAMI - ionic Coulomb coupling parameter -* TPT=T_p/T, where T_p is the ion plasma temperature -* CHI - electron chemical potential, divided by kT -* LIQSOL = 0 in the liquid state, = 1 in the solid state +! -------------------- OUTPUT -------------------------------- * +! Here in the output we have: +! RHO - mass density in g/cc +! P - total pressure in Mbar (i.e. in 1.e12 dyn/cm^2) +! PnkT=P/nkT, where n is the number density of ions, T temperature +! CV - heat capacity at constant volume, divided by number of ions, /k +! CHIT - logarithmic derivative of pressure \chi_T +! CHIR - logarithmic derivative of pressure \chi_\rho +! UNkT - internal energy divided by NkT, N being the number of ions +! SNk - entropy divided by number of ions, /k +! GAMI - ionic Coulomb coupling parameter +! TPT=T_p/T, where T_p is the ion plasma temperature +! CHI - electron chemical potential, divided by kT +! LIQSOL = 0 in the liquid state, = 1 in the solid state write(*,111) RHO,T6,P,PnkT,CV,CHIT,CHIR,UNkT,SNk,GAMI,TPT,CHI, * LIQSOL 112 format(/ @@ -162,47 +162,47 @@ end program main subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, * DENS,Zmean,CMImean,Z2mean,GAMImean,CHI,TPT,LIQSOL, * PnkT,UNkT,SNk,CV,CHIR,CHIT) -* Version 18.04.20 -* Difference from v.10.12.14: included switch-off of WK correction -* Stems from MELANGE8 v.26.12.09. -* Difference: output PRADnkT instead of input KRAD -* + EOS of fully ionized electron-ion plasma mixture. -* Limitations: -* (a) inapplicable in the regimes of -* (1) bound-state formation, -* (2) quantum liquid, -* (3) presence of positrons; -* (b) for the case of a composition gradually depending on RHO or TEMP, -* second-order functions (CV,CHIR,CHIT in output) should not be trusted -* Choice of the liquid or solid regime - criterion GAMI [because the -* choice based on comparison of total (non-OCP) free energies can be -* sometimes dangerous because of the fit uncertainties ("Local field -* correction" in solid and quantum effects in liquid are unknown)]. -* Input: NMIX - number of different elements; -* AY - their partial number densities, -* AZion and ACMI - their charge and mass numbers, -* RHO - total mass density [g/cc] -* TEMP - temperature [in a.u.=2Ryd=3.1577e5 K]. -* NB: instead of RHO, a true input is CHI, defined below -* Hence, disagreement between RHO and DENS is the fit error (<0.4%) -* Output: -* AY - rescaled so that to sum up to 1 and resorted (by AZion) -* AZion - resorted in ascending order -* ACMI - resorted in agreement with AZion -* DENS - electron number density [in a.u.=6.7483346e24 cm^{-3}] -* Zmean=, CMImean= - mean ion charge and mass numbers, -* Z2mean= - mean-square ion charge number -* GAMImean - effective ion-ion Coulomb coupling constant -* CHI = mu_e/kT, where mu_e is the electron chem.potential -* TPT - effective ionic quantum parameter (T_p/T) -* LIQSOL=0/1 for liquid/solid -* SNk - dimensionless entropy per 1 ion -* UNkT - internal energy per kT per ion -* PnkT - pressure / n_i kT, where n_i is the ion number density -* PRADnkT - radiative pressure / n_i kT -* CV - heat capacity per ion, div. by Boltzmann const. -* CHIR - inverse compressibility -(d ln P / d ln V)_T ("\chi_r") -* CHIT = (d ln P / d ln T)_V ("\chi_T") +! Version 18.04.20 +! Difference from v.10.12.14: included switch-off of WK correction +! Stems from MELANGE8 v.26.12.09. +! Difference: output PRADnkT instead of input KRAD +! + EOS of fully ionized electron-ion plasma mixture. +! Limitations: +! (a) inapplicable in the regimes of +! (1) bound-state formation, +! (2) quantum liquid, +! (3) presence of positrons; +! (b) for the case of a composition gradually depending on RHO or TEMP, +! second-order functions (CV,CHIR,CHIT in output) should not be trusted +! Choice of the liquid or solid regime - criterion GAMI [because the +! choice based on comparison of total (non-OCP) free energies can be +! sometimes dangerous because of the fit uncertainties ("Local field +! correction" in solid and quantum effects in liquid are unknown)]. +! Input: NMIX - number of different elements; +! AY - their partial number densities, +! AZion and ACMI - their charge and mass numbers, +! RHO - total mass density [g/cc] +! TEMP - temperature [in a.u.=2Ryd=3.1577e5 K]. +! NB: instead of RHO, a true input is CHI, defined below +! Hence, disagreement between RHO and DENS is the fit error (<0.4%) +! Output: +! AY - rescaled so that to sum up to 1 and resorted (by AZion) +! AZion - resorted in ascending order +! ACMI - resorted in agreement with AZion +! DENS - electron number density [in a.u.=6.7483346e24 cm^{-3}] +! Zmean=, CMImean= - mean ion charge and mass numbers, +! Z2mean= - mean-square ion charge number +! GAMImean - effective ion-ion Coulomb coupling constant +! CHI = mu_e/kT, where mu_e is the electron chem.potential +! TPT - effective ionic quantum parameter (T_p/T) +! LIQSOL=0/1 for liquid/solid +! SNk - dimensionless entropy per 1 ion +! UNkT - internal energy per kT per ion +! PnkT - pressure / n_i kT, where n_i is the ion number density +! PRADnkT - radiative pressure / n_i kT +! CV - heat capacity per ion, div. by Boltzmann const. +! CHIR - inverse compressibility -(d ln P / d ln V)_T ("\chi_r") +! CHIT = (d ln P / d ln T)_V ("\chi_T") implicit double precision (A-H), double precision (O-Z) character CHWK save @@ -226,7 +226,7 @@ subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, print*,'MELANGE9: partial densities (and derivatives)', * ' are rescaled by factor',1./Y endif -* Sort the elements in ascending order in Z_j: +! Sort the elements in ascending order in Z_j: KSORT=0 do I=2,NMIX J=I @@ -247,7 +247,7 @@ subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, if (KSORT.eq.1) write(*,'('' Ions are resorted as follows:''/ * '' i Z_i A_i x_i''/(0P,I3,'':'',1P,3E10.3))') * (J,AZion(J),ACMI(J),AY(J),J=1,NMIX) -* Calculation of average values: +! Calculation of average values: Zmean=0. Z2mean=0. Z52=0. @@ -265,22 +265,22 @@ subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, Z321=Z321+AY(IX)*AZion(IX)*dsqrt(AZion(IX)+1.d0)**3 ! 26.12.09 CMImean=CMImean+AY(IX)*ACMI(IX) enddo -* (0) Photons: +! (0) Photons: UINTRAD=RAD*TEMP**4 PRESSRAD=UINTRAD/3. C CVRAD=4.*UINTRAD/TEMP -* (1) ideal electron gas (including relativity and degeneracy) ----- * +! (1) ideal electron gas (including relativity and degeneracy) ----- * DENS=RHO/11.20587*Zmean/CMImean ! number density of electrons [au] call CHEMFIT(DENS,TEMP,CHI) -* NB: CHI can be used as true input instead of RHO or DENS +! NB: CHI can be used as true input instead of RHO or DENS call ELECT11(TEMP,CHI, * DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, * DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) -* NB: at this point DENS is redefined (the difference can be ~0.1%) +! NB: at this point DENS is redefined (the difference can be ~0.1%) DTE=DENS*TEMP PRESSE=PEid*DTE ! P_e [a.u.] UINTE=UEid*DTE ! U_e / V [a.u.] -* (2) non-ideal Coulomb EIP ---------------------------------------- * +! (2) non-ideal Coulomb EIP ---------------------------------------- * RS=(.75d0/PI/DENS)**C13 ! r_s - electron density parameter RSI=RS*CMImean*Z73*AUM ! R_S - ion density parameter GAME=1.d0/RS/TEMP ! electron Coulomb parameter Gamma_e @@ -290,7 +290,7 @@ subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, else LIQSOL=1 ! solid regime endif -* Calculate partial thermodynamic quantities and combine them together: +! Calculate partial thermodynamic quantities and combine them together: UINT=UINTE PRESS=PRESSE CVtot=CVE*DENS @@ -301,7 +301,7 @@ subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, PRESSI=DENSI*TEMP ! ideal-ions total pressure (normalization) TPT2=0. CTP=4.d0*PI/AUM/TEMP**2 ! common coefficient for TPT2.10.12.14 -* Add Coulomb+xc nonideal contributions, and ideal free energy: +! Add Coulomb+xc nonideal contributions, and ideal free energy: do IX=1,NMIX if (AY(IX).lt.TINY) goto 10 ! skip this species Zion=AZion(IX) @@ -312,20 +312,20 @@ subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, call EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, * FC1,UC1,PC1,SC1,CV1,PDT1,PDR1, * FC2,UC2,PC2,SC2,CV2,PDT2,PDR2) -* First-order TD functions: +! First-order TD functions: UINT=UINT+UC2*PRI ! internal energy density (e+i+Coul.) Stot=Stot+DNI*(SC2-dlog(AY(IX))) !entropy per unit volume[a.u.] PRESS=PRESS+PC2*PRI ! pressure (e+i+Coul.) [a.u.] -* Second-order functions (they take into account compositional changes): +! Second-order functions (they take into account compositional changes): CVtot=CVtot+DNI*CV2 ! C_V (e+i+Coul.)/ V (optim.10.12.14) PDLT=PDLT+PRI*PDT2 ! d P / d ln T PDLR=PDLR+PRI*PDR2 ! d P / d ln\rho TPT2=TPT2+CTP*DNI/ACMI(IX)*AZion(IX)**2 ! opt.10.12.14 10 continue enddo ! next IX -* Wigner-Kirkwood perturbative correction for liquid: +! Wigner-Kirkwood perturbative correction for liquid: TPT=dsqrt(TPT2) ! effective T_p/T - ion quantum parameter -* (in the case of a mixture, this estimate is crude) +! (in the case of a mixture, this estimate is crude) if (LIQSOL.eq.0) then FWK=TPT2/24.d0*CWK ! Wigner-Kirkwood (quantum diffr.) term if (FWK.gt..7.and.CWK.gt.0.) then @@ -340,7 +340,7 @@ subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, PDLT=PDLT-FWK*PRESSI PDLR=PDLR+UWK*PRESSI endif -* Corrections to the linear mixing rule: +! Corrections to the linear mixing rule: if (LIQSOL.eq.0) then ! liquid phase call CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, * FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) @@ -373,7 +373,7 @@ subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, CVtot=CVtot+DENSI*CVMIX PDLT=PDLT+PRESSI*PDTMIX PDLR=PDLR+PRESSI*PDRMIX -* First-order: +! First-order: PRADnkT=PRESSRAD/PRESSI ! radiative pressure / n_i k T C CVtot=CVtot+CVRAD C Stot=Stot+CVRAD/3. @@ -381,7 +381,7 @@ subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, UNkT=UINT/PRESSI ! U / N_i k T C UNkT=UNkT+UINTRAD/PRESSI SNk=Stot/DENSI ! S / N_i k -* Second-order: +! Second-order: CV=CVtot/DENSI ! C_V per ion CHIR=PDLR/PRESS ! d ln P / d ln\rho CHIT=PDLT/PRESS ! d ln P / d ln T @@ -392,29 +392,29 @@ subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, subroutine EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, * FC1,UC1,PC1,SC1,CV1,PDT1,PDR1, * FC2,UC2,PC2,SC2,CV2,PDT2,PDR2) -* Version 16.09.08 -* call FHARM8 has been replaced by call FHARM12 27.04.12 -* Wigner-Kirkwood correction excluded 20.05.13 -* slight cleaning 10.12.14 -* Non-ideal parts of thermodynamic functions in the fully ionized plasma -* Stems from EOSFI5 and EOSFI05 v.04.10.05 -* Input: LIQSOL=0/1(liquid/solid), -* Zion,CMI - ion charge and mass numbers, -* RS=r_s (electronic density parameter), -* GAMI=Gamma_i (ion coupling), -* Output: FC1 and UC1 - non-ideal "ii+ie+ee" contribution to the -* free and internal energies (per ion per kT), -* PC1 - analogous contribution to pressure divided by (n_i kT), -* CV1 - "ii+ie+ee" heat capacity per ion [units of k] -* PDT1=(1/n_i kT)*(d P_C/d ln T)_V -* PDR1=(1/n_i kT)*(d P_C/d ln\rho)_T -* FC2,UC2,PC2,SC2,CV2 - analogous to FC1,UC1,PC1,SC1,CV1, but including -* the part corresponding to the ideal ion gas. This is useful for -* preventing accuracy loss in some cases (e.g., when SC2 << SC1). -* FC2 does not take into account the entropy of mixing S_{mix}: in a -* mixture, S_{mix}/(N_i k) has to be added externally (see MELANGE9). -* FC2 does not take into account the ion spin degeneracy either. -* When needed, the spin term must be added to the entropy externally. +! Version 16.09.08 +! call FHARM8 has been replaced by call FHARM12 27.04.12 +! Wigner-Kirkwood correction excluded 20.05.13 +! slight cleaning 10.12.14 +! Non-ideal parts of thermodynamic functions in the fully ionized plasma +! Stems from EOSFI5 and EOSFI05 v.04.10.05 +! Input: LIQSOL=0/1(liquid/solid), +! Zion,CMI - ion charge and mass numbers, +! RS=r_s (electronic density parameter), +! GAMI=Gamma_i (ion coupling), +! Output: FC1 and UC1 - non-ideal "ii+ie+ee" contribution to the +! free and internal energies (per ion per kT), +! PC1 - analogous contribution to pressure divided by (n_i kT), +! CV1 - "ii+ie+ee" heat capacity per ion [units of k] +! PDT1=(1/n_i kT)*(d P_C/d ln T)_V +! PDR1=(1/n_i kT)*(d P_C/d ln\rho)_T +! FC2,UC2,PC2,SC2,CV2 - analogous to FC1,UC1,PC1,SC1,CV1, but including +! the part corresponding to the ideal ion gas. This is useful for +! preventing accuracy loss in some cases (e.g., when SC2 << SC1). +! FC2 does not take into account the entropy of mixing S_{mix}: in a +! mixture, S_{mix}/(N_i k) has to be added externally (see MELANGE9). +! FC2 does not take into account the ion spin degeneracy either. +! When needed, the spin term must be added to the entropy externally. implicit double precision (A-H), double precision (O-Z) save parameter(C53=5.d0/3.d0,C76=7.d0/6.d0) ! TINY excl.10.12.14 @@ -426,12 +426,12 @@ subroutine EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, if (GAMI.le..0) stop'EOSFI8: invalid GAMI' GAME=GAMI/Zion**C53 call EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) ! "ee"("xc") -* Calculate "ii" part: +! Calculate "ii" part: COTPT=dsqrt(3.d0/AUM/CMI)/Zion**C76 ! auxiliary coefficient TPT=GAMI/dsqrt(RS)*COTPT ! = T_p/T in the OCP FidION=1.5*dlog(TPT**2/GAMI)-1.323515 -* 1.3235=1+0.5*ln(6/pi); FidION = F_{id.ion gas}/(N_i kT), but without -* the term x_i ln x_i = -S_{mix}/(N_i k). +! 1.3235=1+0.5*ln(6/pi); FidION = F_{id.ion gas}/(N_i kT), but without +! the term x_i ln x_i = -S_{mix}/(N_i k). if (LIQSOL.eq.0) then ! liquid call FITION9(GAMI, * FION,UION,PION,CVii,PDTii,PDRii) @@ -460,7 +460,7 @@ subroutine EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, SCItot=Sharm+Uah-Fah CVii=CVItot-1.5d0 ! minus 1.5=ideal-gas endif -* Calculate "ie" part: +! Calculate "ie" part: if (LIQSOL.eq.1) then call FSCRsol8(RS,GAMI,Zion,TPT, * FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR) @@ -469,7 +469,7 @@ subroutine EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, * FSCR,USCR,PSCR,CVSCR,PDTSCR,PDRSCR) S_SCR=USCR-FSCR endif -* Total excess quantities ("ii"+"ie"+"ee", per ion): +! Total excess quantities ("ii"+"ie"+"ee", per ion): FC0=FSCR+Zion*FXC UC0=USCR+Zion*UXC PC0=PSCR+Zion*PXC @@ -484,7 +484,7 @@ subroutine EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, CV1=CVii+CV0 PDT1=PDTii+PDT0 PDR1=PDRii+PDR0 -* Total excess + ideal-ion quantities +! Total excess + ideal-ion quantities FC2=FItot+FC0 UC2=UItot+UC0 PC2=PItot+PC0 @@ -495,20 +495,20 @@ subroutine EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, return end -* ================== ELECTRON-ION COULOMB LIQUID =================== * +! ================== ELECTRON-ION COULOMB LIQUID =================== ! subroutine FITION9(GAMI,FION,UION,PION,CVii,PDTii,PDRii) -* Version 11.09.08 -* Dummy argument Zion is deleted in 2009. -* Non-ideal contributions to thermodynamic functions of classical OCP. -* Stems from FITION00 v.24.05.00. -* Input: GAMI - ion coupling parameter -* Output: FION - ii free energy / N_i kT -* UION - ii internal energy / N_i kT -* PION - ii pressure / n_i kT -* CVii - ii heat capacity / N_i k -* PDTii = PION + d(PION)/d ln T = (1/N_i kT)*(d P_{ii}/d ln T) -* PDRii = PION + d(PION)/d ln\rho -* Parameters adjusted to Caillol (1999). +! Version 11.09.08 +! Dummy argument Zion is deleted in 2009. +! Non-ideal contributions to thermodynamic functions of classical OCP. +! Stems from FITION00 v.24.05.00. +! Input: GAMI - ion coupling parameter +! Output: FION - ii free energy / N_i kT +! UION - ii internal energy / N_i kT +! PION - ii pressure / n_i kT +! CVii - ii heat capacity / N_i k +! PDTii = PION + d(PION)/d ln T = (1/N_i kT)*(d P_{ii}/d ln T) +! PDRii = PION + d(PION)/d ln\rho +! Parameters adjusted to Caillol (1999). implicit double precision (A-H),double precision (O-Z) save parameter (A1=-.907347d0,A2=.62849d0,C1=.004500d0,G1=170.0, @@ -518,7 +518,7 @@ subroutine FITION9(GAMI,FION,UION,PION,CVii,PDTii,PDRii) - A2*dlog(dsqrt(GAMI/A2)+dsqrt(1.+GAMI/A2)))+ + 2.*A3*(dsqrt(GAMI)-datan(dsqrt(GAMI))) U0=dsqrt(GAMI)**3*(A1/dsqrt(A2+GAMI)+A3/(1.d0+GAMI)) -* This is the zeroth approximation. Correction: +! This is the zeroth approximation. Correction: UION=U0+C1*GAMI**2/(G1+GAMI)+C2*GAMI**2/(G2+GAMI**2) FION=F0+C1*(GAMI-G1*dlog(1.d0+GAMI/G1))+ + C2/2.*dlog(1.d0+GAMI**2/G2) @@ -533,16 +533,16 @@ subroutine FITION9(GAMI,FION,UION,PION,CVii,PDTii,PDRii) subroutine FSCRliq8(RS,GAME,Zion, * FSCR,USCR,PSCR,CVSCR,PDTSCR,PDRSCR) ! fit to the el.-ion scr. -* Version 11.09.08 -* cleaned 16.06.09 -* Stems from FSCRliq7 v. 09.06.07. Included a check for RS=0. -* INPUT: RS - density parameter, GAME - electron Coulomb parameter, -* Zion - ion charge number, -* OUTPUT: FSCR - screening (e-i) free energy per kT per 1 ion, -* USCR - internal energy per kT per 1 ion (screen.contrib.) -* PSCR - pressure divided by (n_i kT) (screen.contrib.) -* CVSCR - heat capacity per 1 ion (screen.contrib.) -* PDTSCR,PDRSCR = PSCR + d PSCR / d ln(T,\rho) +! Version 11.09.08 +! cleaned 16.06.09 +! Stems from FSCRliq7 v. 09.06.07. Included a check for RS=0. +! INPUT: RS - density parameter, GAME - electron Coulomb parameter, +! Zion - ion charge number, +! OUTPUT: FSCR - screening (e-i) free energy per kT per 1 ion, +! USCR - internal energy per kT per 1 ion (screen.contrib.) +! PSCR - pressure divided by (n_i kT) (screen.contrib.) +! CVSCR - heat capacity per 1 ion (screen.contrib.) +! PDTSCR,PDRSCR = PSCR + d PSCR / d ln(T,\rho) implicit double precision(A-H),double precision(O-Z) save parameter(XRS=.0140047,TINY=1.d-19) @@ -567,7 +567,7 @@ subroutine FSCRliq8(RS,GAME,Zion, Z13=exp(ZLN/3.) ! Zion**(1./3.) X=XRS/RS ! relativity parameter CTF=Zion**2*.2513*(Z13-1.+.2/sqrt(Z13)) -* Thomas-Fermi constant; .2513=(18/175)(12/\pi)^{2/3} +! Thomas-Fermi constant; .2513=(18/175)(12/\pi)^{2/3} P01=1.11*exp(.475*ZLN) P03=0.2+0.078*ZLN**2 PTX=1.16+.08*ZLN @@ -607,7 +607,7 @@ subroutine FSCRliq8(RS,GAME,Zion, COR0DXX=(U0DXX-(2.*U0DX*D0DX+U0*D0DXX)/D0+2.*(D0DX/D0)**2)/D0 COR0DGG=(U0DGG-2.*U0DG*D0DG/D0+2.*U0*(D0DG/D0)**2)/D0 COR0DXG=(U0DXG-(U0DX*D0DG+U0DG*D0DX)/D0+2.*U0*D0DX*D0DG/D0**2)/D0 -* Relativism: +! Relativism: RELE=dsqrt(1.d0+X**2) Q1=.18/dsqrt(dsqrt(Zion)) Q2=.2+.37/dsqrt(Zion) @@ -658,23 +658,23 @@ subroutine FSCRliq8(RS,GAME,Zion, return end -* ============== SUBROUTINES FOR THE SOLID STATE ================= * +! ============== SUBROUTINES FOR THE SOLID STATE ================= ! subroutine FSCRsol8(RS,GAMI,ZNUCL,TPT, * FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR) -* Version 28.05.08 -* undefined zero variable Q1DXG is wiped out 21.06.10 -* accuracy-loss safeguard added 10.08.16 -* safequard against Zion < 1 added 27.05.17 -* Fit to the el.-ion screening in bcc or fcc Coulomb solid -* Stems from FSCRsol8 v.09.06.07. Included a check for RS=0. -* INPUT: RS - el. density parameter, GAMI - ion coupling parameter, -* ZNUCL - ion charge, TPT=T_p/T - ion quantum parameter -* OUTPUT: FSCR - screening (e-i) free energy per kT per 1 ion, -* USCR - internal energy per kT per 1 ion (screen.contrib.) -* PSCR - pressure divided by (n_i kT) (screen.contrib.) -* S_SCR - screening entropy contribution / (N_i k) -* CVSCR - heat capacity per 1 ion (screen.contrib.) -* PDTSCR,PDRSCR = PSCR + d PSCR / d ln(T,\rho) +! Version 28.05.08 +! undefined zero variable Q1DXG is wiped out 21.06.10 +! accuracy-loss safeguard added 10.08.16 +! safequard against Zion < 1 added 27.05.17 +! Fit to the el.-ion screening in bcc or fcc Coulomb solid +! Stems from FSCRsol8 v.09.06.07. Included a check for RS=0. +! INPUT: RS - el. density parameter, GAMI - ion coupling parameter, +! ZNUCL - ion charge, TPT=T_p/T - ion quantum parameter +! OUTPUT: FSCR - screening (e-i) free energy per kT per 1 ion, +! USCR - internal energy per kT per 1 ion (screen.contrib.) +! PSCR - pressure divided by (n_i kT) (screen.contrib.) +! S_SCR - screening entropy contribution / (N_i k) +! CVSCR - heat capacity per 1 ion (screen.contrib.) +! PDTSCR,PDRSCR = PSCR + d PSCR / d ln(T,\rho) implicit double precision(A-H),double precision(O-Z) save dimension AP(4) ! parameters of the fit @@ -717,7 +717,7 @@ subroutine FSCRsol8(RS,GAMI,ZNUCL,TPT, Q1XDX=Q1X/XSR+4.*XSR**2*((R2/Q1D)**2-(AP(3)/Q1U)**2) Q1DX=Q1*Q1X Q1DXX=Q1DX*Q1X+Q1*Q1XDX -* New quantum factor, in order to suppress CVSCR at TPT >> 1 +! New quantum factor, in order to suppress CVSCR at TPT >> 1 if (TPT.lt.6./PX) then Y0=(PX*TPT)**2 Y0DX=Y0/XSR @@ -802,13 +802,13 @@ subroutine FSCRsol8(RS,GAMI,ZNUCL,TPT, end subroutine ANHARM8(GAMI,TPT,Fah,Uah,Pah,CVah,PDTah,PDRah) -* ANHARMONIC free energy Version 27.07.07 -* cleaned 16.06.09 -* Stems from ANHARM8b. Difference: AC=0., B1=.12 (.1217 - over accuracy) -* Input: GAMI - ionic Gamma, TPT=Tp/T - ionic quantum parameter -* Output: anharm.free en. Fah=F_{AH}/(N_i kT), internal energy Uah, -* pressure Pah=P_{AH}/(n_i kT), specific heat CVah = C_{V,AH}/(N_i k), -* PDTah = Pah + d Pah / d ln T, PDRah = Pah + d Pah / d ln\rho +! ANHARMONIC free energy Version 27.07.07 +! cleaned 16.06.09 +! Stems from ANHARM8b. Difference: AC=0., B1=.12 (.1217 - over accuracy) +! Input: GAMI - ionic Gamma, TPT=Tp/T - ionic quantum parameter +! Output: anharm.free en. Fah=F_{AH}/(N_i kT), internal energy Uah, +! pressure Pah=P_{AH}/(n_i kT), specific heat CVah = C_{V,AH}/(N_i k), +! PDTah = Pah + d Pah / d ln T, PDRah = Pah + d Pah / d ln\rho implicit double precision (A-H), double precision (O-Z) save parameter(NM=3) @@ -850,15 +850,15 @@ subroutine ANHARM8(GAMI,TPT,Fah,Uah,Pah,CVah,PDTah,PDRah) subroutine FHARM12(GAMI,TPT, * Fharm,Uharm,Pharm,CVth,Sth,PDTharm,PDRharm) -* Thermodynamic functions of a harmonic crystal, incl.stat.Coul.lattice -* -* Version 27.04.12 -* Stems from FHARM8 v.15.02.08 -* Replaced HLfit8 with HLfit12: rearranged output. -* Input: GAMI - ionic Gamma, TPT=T_{p,i}/T -* Output: Fharm=F/(N_i T), Uharm=U/(N_i T), Pharm=P/(n_i T), -* CVth=C_V/N_i, Sharm=S/N_i -* PDTharm = Pharm + d Pharm / d ln T, PDRharm = Pharm + d Pharm/d ln\rho +! Thermodynamic functions of a harmonic crystal, incl.stat.Coul.lattice +! +! Version 27.04.12 +! Stems from FHARM8 v.15.02.08 +! Replaced HLfit8 with HLfit12: rearranged output. +! Input: GAMI - ionic Gamma, TPT=T_{p,i}/T +! Output: Fharm=F/(N_i T), Uharm=U/(N_i T), Pharm=P/(n_i T), +! CVth=C_V/N_i, Sharm=S/N_i +! PDTharm = Pharm + d Pharm / d ln T, PDRharm = Pharm + d Pharm/d ln\rho implicit double precision (A-H), double precision (O-Z) save parameter(CM=.895929256d0) ! Madelung @@ -876,18 +876,18 @@ subroutine FHARM12(GAMI,TPT, end subroutine HLfit12(eta,F,U,CV,S,U1,CW,LATTICE) -* Version 24.04.12 -* Stems from HLfit8 v.03.12.08; -* differences: E0 excluded from U and F; -* U1 and d(CV)/d\ln(T) are added on the output. -* Fit to thermal part of the thermodynamic functions. -* Baiko, Potekhin, & Yakovlev (2001). -* Zero-point lattice quantum energy 1.5u_1\eta EXCLUDED (unlike HLfit8). -* Input: eta=Tp/T, LATTICE=1 for bcc, 2 for fcc -* Output: F and U (normalized to NkT) - due to phonon excitations, -* CV and S (normalized to Nk) in the HL model, -* U1 - the 1st phonon moment, -* CW=d(CV)/d\ln(T) +! Version 24.04.12 +! Stems from HLfit8 v.03.12.08; +! differences: E0 excluded from U and F; +! U1 and d(CV)/d\ln(T) are added on the output. +! Fit to thermal part of the thermodynamic functions. +! Baiko, Potekhin, & Yakovlev (2001). +! Zero-point lattice quantum energy 1.5u_1\eta EXCLUDED (unlike HLfit8). +! Input: eta=Tp/T, LATTICE=1 for bcc, 2 for fcc +! Output: F and U (normalized to NkT) - due to phonon excitations, +! CV and S (normalized to Nk) in the HL model, +! U1 - the 1st phonon moment, +! CW=d(CV)/d\ln(T) implicit double precision (A-H), double precision (O-Z) save parameter(EPS=1.d-5,TINY=1.d-99) @@ -992,20 +992,20 @@ subroutine HLfit12(eta,F,U,CV,S,U1,CW,LATTICE) subroutine CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, * FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) -* Version 02.07.09 -* Correction to the linear mixing rule for moderate to small Gamma -* Input: RS=r_s (if RS=0, then OCP, otherwise EIP) -* GAME=\Gamma_e -* Zmean= (average Z of all ions, without electrons) -* Z2mean=, Z52=, Z53=, Z321= -* Output: FMIX=\Delta f - corr.to the reduced free energy f=F/N_{ion}kT -* UMIX=\Delta u - corr.to the reduced internal energy u -* PMIX=\Delta u - corr.to the reduced pressure P=P/n_{ion}kT -* CVMIX=\Delta c - corr.to the reduced heat capacity c_V -* PDTMIX=(1/n_{ion}kT)d\Delta P / d ln T -* = \Delta p + d \Delta p / d ln T -* PDRMIX=(1/n_{ion}kT)d\Delta P / d ln n_e -* (composition is assumed fixed: Zmean,Z2mean,Z52,Z53=constant) +! Version 02.07.09 +! Correction to the linear mixing rule for moderate to small Gamma +! Input: RS=r_s (if RS=0, then OCP, otherwise EIP) +! GAME=\Gamma_e +! Zmean= (average Z of all ions, without electrons) +! Z2mean=, Z52=, Z53=, Z321= +! Output: FMIX=\Delta f - corr.to the reduced free energy f=F/N_{ion}kT +! UMIX=\Delta u - corr.to the reduced internal energy u +! PMIX=\Delta u - corr.to the reduced pressure P=P/n_{ion}kT +! CVMIX=\Delta c - corr.to the reduced heat capacity c_V +! PDTMIX=(1/n_{ion}kT)d\Delta P / d ln T +! = \Delta p + d \Delta p / d ln T +! PDRMIX=(1/n_{ion}kT)d\Delta P / d ln n_e +! (composition is assumed fixed: Zmean,Z2mean,Z52,Z53=constant) implicit double precision (A-H), double precision (O-Z) parameter (TINY=1.d-9) GAMImean=GAME*Z53 @@ -1045,31 +1045,31 @@ subroutine CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, return end -* =================== IDEAL ELECTRON GAS =========================== * +! =================== IDEAL ELECTRON GAS =========================== ! subroutine ELECT11(TEMP,CHI, * DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, * DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) -* Version 17.11.11 -* safeguard against huge (-CHI) values is added 27.05.17 -* ELECT9 v.04.03.09 + smooth match of two fits at chi >> 1 + add.outputs -* Compared to ELECTRON v.06.07.00, this S/R is completely rewritten: -* numerical differentiation is avoided now. -* Compared to ELECT7 v.06.06.07, -* - call BLIN7 is changed to call BLIN9, -* - Sommerfeld expansion is used at chi >~ 28 i.o. 1.e4 -* - Sommerfeld expansion is corrected: introduced DeltaEF, D1 and D2. -* Ideal electron-gas EOS. -* Input: TEMP - T [a.u.], CHI=\mu/T -* Output: DENS - electron number density n_e [a.u.], -* FEid - free energy / N_e kT, UEid - internal energy / N_e kT, -* PEid - pressure (P_e) / n_e kT, SEid - entropy / N_e k, -* CVE - heat capacity / N_e k, -* CHITE=(d ln P_e/d ln T)_V, CHIRE=(d ln P_e/d ln n_e)_T -* DlnDH=(d ln n_e/d CHI)_T = (T/n_e) (d n_e/d\mu)_T -* DlnDT=(d ln n_e/d ln T)_CHI -* DlnDHH=(d^2 ln n_e/d CHI^2)_T -* DlnDTT=(d^2 ln n_e/d (ln T)^2)_CHI -* DlnDHT=d^2 ln n_e/d (ln T) d CHI +! Version 17.11.11 +! safeguard against huge (-CHI) values is added 27.05.17 +! ELECT9 v.04.03.09 + smooth match of two fits at chi >> 1 + add.outputs +! Compared to ELECTRON v.06.07.00, this S/R is completely rewritten: +! numerical differentiation is avoided now. +! Compared to ELECT7 v.06.06.07, +! - call BLIN7 is changed to call BLIN9, +! - Sommerfeld expansion is used at chi >~ 28 i.o. 1.e4 +! - Sommerfeld expansion is corrected: introduced DeltaEF, D1 and D2. +! Ideal electron-gas EOS. +! Input: TEMP - T [a.u.], CHI=\mu/T +! Output: DENS - electron number density n_e [a.u.], +! FEid - free energy / N_e kT, UEid - internal energy / N_e kT, +! PEid - pressure (P_e) / n_e kT, SEid - entropy / N_e k, +! CVE - heat capacity / N_e k, +! CHITE=(d ln P_e/d ln T)_V, CHIRE=(d ln P_e/d ln n_e)_T +! DlnDH=(d ln n_e/d CHI)_T = (T/n_e) (d n_e/d\mu)_T +! DlnDT=(d ln n_e/d ln T)_CHI +! DlnDHH=(d^2 ln n_e/d CHI^2)_T +! DlnDTT=(d^2 ln n_e/d (ln T)^2)_CHI +! DlnDHT=d^2 ln n_e/d (ln T) d CHI implicit double precision (A-H), double precision (O-Z) save parameter (CHI2=28.d0,XMAX=20.d0) @@ -1113,8 +1113,8 @@ subroutine ELECT11(TEMP,CHI, subroutine ELECT11a(TEMP,CHI, * DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, * DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) -* Version 16.11.11 -* This is THE FIRST PART of ELECT9 v.04.03.09. +! Version 16.11.11 +! This is THE FIRST PART of ELECT9 v.04.03.09. implicit double precision (A-H), double precision (O-Z) save parameter (BOHR=137.036,PI=3.141592653d0) @@ -1129,17 +1129,17 @@ subroutine ELECT11a(TEMP,CHI, DENR=TPI*(W1*TEMR+W0) PR=TEMR*TPI/3.*(W2*TEMR+2.*W1) U=TEMR*TPI*(W2*TEMR+W1) -* (these are density, pressure, and internal energy in the rel.units) +! (these are density, pressure, and internal energy in the rel.units) PEid=PR/(DENR*TEMR) UEid=U/(DENR*TEMR) FEid=CHI-PEid DENS=DENR*BOHR3 ! converts from rel.units to a.u. SEid=UEid-FEid -* derivatives over T at constant chi: +! derivatives over T at constant chi: dndT=TPI*(1.5*W0/TEMR+2.5*W1+W0DT+TEMR*W1DT) ! (d n_e/dT)_\chi dPdT=TPI/3.*(5.*W1+2.*TEMR*W1DT+3.5*TEMR*W2+TEMR**2*W2DT)!dP/dT dUdT=TPI*(2.5*W1+TEMR*W1DT+3.5*TEMR*W2+TEMR**2*W2DT)!dU/dT_\chi -* derivatives over chi at constant T and second derivatives: +! derivatives over chi at constant T and second derivatives: dndH=TPI*(W0DX+TEMR*W1DX) ! (d n_e/d\chi)_T dndHH=TPI*(W0DXX+TEMR*W1DXX) ! (d^2 n_e/d\chi)_T dndTT=TPI*(.75*W0/TEMR**2+3.*W0DT/TEMR+W0DTT+ @@ -1161,9 +1161,9 @@ subroutine ELECT11a(TEMP,CHI, subroutine ELECT11b(TEMP,CHI, * DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, * DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) -* Version 17.11.11 -* Stems from ELECT9b v.19.01.10, Diff. - additional output. -* Sommerfeld expansion at very large CHI. +! Version 17.11.11 +! Stems from ELECT9b v.19.01.10, Diff. - additional output. +! Sommerfeld expansion at very large CHI. implicit double precision (A-H), double precision (O-Z) save parameter (BOHR=137.036,PI=3.141592653d0) @@ -1197,7 +1197,7 @@ subroutine ELECT11b(TEMP,CHI, CHITE=2.d0*DP/P DENR=PF**3/3.d0/PI2 ! n_e [rel.un.=\Compton^{-3}] DENS=DENR*BOHR3 ! conversion to a.u.(=\Bohr_radius^{-3}) -* derivatives over chi at constant T and T at constant chi: +! derivatives over chi at constant T and T at constant chi: TPI=TEMR*dsqrt(2.d0*TEMR)/PI2 ! common pre-factor call SOMMERF(TEMR,CHI, * W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, @@ -1220,7 +1220,7 @@ subroutine ELECT11b(TEMP,CHI, UEid=U/DT FEid=F/DT SEid=S/DT -* Empirical corrections of 16.02.09: +! Empirical corrections of 16.02.09: D1=DeltaEF/EF D2=D1*(4.d0-2.d0*(PF/G)) CVE=CVE/(1.d0+D2) @@ -1234,15 +1234,15 @@ subroutine SOMMERF(TEMR,CHI, * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, * W0XXX,W0XTT,W0XXT) -* Version 17.11.11 -* Sommerfeld expansion for the Fermi-Dirac integrals -* Input: TEMR=T/mc^2; CHI=(\mu-mc^2)/T -* Output: Wk - Fermi-Dirac integral of the order k+1/2 -* WkDX=dWk/dCHI, WkDT = dWk/dT, WkDXX=d^2 Wk / d CHI^2, -* WkDTT=d^2 Wk / d T^2, WkDXT=d^2 Wk /dCHIdT, -* W0XXX=d^3 W0 / d CHI^3, W0XTT=d^3 W0 /(d CHI d^2 T), -* W0XXT=d^3 W0 /dCHI^2 dT -* [Draft source: yellow book pages 124-127] +! Version 17.11.11 +! Sommerfeld expansion for the Fermi-Dirac integrals +! Input: TEMR=T/mc^2; CHI=(\mu-mc^2)/T +! Output: Wk - Fermi-Dirac integral of the order k+1/2 +! WkDX=dWk/dCHI, WkDT = dWk/dT, WkDXX=d^2 Wk / d CHI^2, +! WkDTT=d^2 Wk / d T^2, WkDXT=d^2 Wk /dCHIdT, +! W0XXX=d^3 W0 / d CHI^3, W0XTT=d^3 W0 /(d CHI d^2 T), +! W0XXT=d^3 W0 /dCHI^2 dT +! [Draft source: yellow book pages 124-127] implicit double precision (A-H), double precision (O-Z) save parameter(PI=3.141592653d0) @@ -1297,9 +1297,9 @@ subroutine SUBFERMJ(CMU1, * CJ02,CJ12,CJ22, * CJ03,CJ13,CJ23, * CJ04,CJ14,CJ24,CJ05) -* Version 17.11.11 -* corrected 04.03.21 -* Supplement to SOMMERF +! Version 17.11.11 +! corrected 04.03.21 +! Supplement to SOMMERF implicit double precision (A-H), double precision (O-Z) save parameter(EPS=1.d-4) ! inserted 04.03.21 @@ -1335,12 +1335,12 @@ subroutine SUBFERMJ(CMU1, end subroutine FERMI10(X,XMAX,FP,FM) -* Version 20.01.10 -* Fermi distribution function and its 3 derivatives -* Input: X - argument f(x) -* XMAX - max|X| where it is assumed that 0 < f(x) < 1. -* Output: FP = f(x) -* FM = 1-f(x) +! Version 20.01.10 +! Fermi distribution function and its 3 derivatives +! Input: X - argument f(x) +! XMAX - max|X| where it is assumed that 0 < f(x) < 1. +! Output: FP = f(x) +! FM = 1-f(x) implicit double precision (A-H), double precision (O-Z) save if (XMAX.lt.3.d0) stop'FERMI10: XMAX' @@ -1357,21 +1357,21 @@ subroutine FERMI10(X,XMAX,FP,FM) return end -* ============== ELECTRON EXCHANGE AND CORRELATION ================ * +! ============== ELECTRON EXCHANGE AND CORRELATION ================ ! subroutine EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) -* Version 09.06.07 -* Accuracy-loss cut-off modified on 10.08.16 -* Exchange-correlation contribution for the electron gas -* Stems from TANAKA1 v.03.03.96. Added derivatives. -* Input: RS - electron density parameter =electron-sphere radius in a.u. -* GAME - electron Coulomb coupling parameter -* Output: FXC - excess free energy of e-liquid per kT per one electron -* according to Tanaka & Ichimaru 85-87 and Ichimaru 93 -* UXC - internal energy contr.[per 1 electron, kT] -* PXC - pressure contribution divided by (n_e kT) -* CVXC - heat capacity divided by N_e k -* SXC - entropy divided by N_e k -* PDTXC,PDRXC = PXC + d PXC / d ln(T,\rho) +! Version 09.06.07 +! Accuracy-loss cut-off modified on 10.08.16 +! Exchange-correlation contribution for the electron gas +! Stems from TANAKA1 v.03.03.96. Added derivatives. +! Input: RS - electron density parameter =electron-sphere radius in a.u. +! GAME - electron Coulomb coupling parameter +! Output: FXC - excess free energy of e-liquid per kT per one electron +! according to Tanaka & Ichimaru 85-87 and Ichimaru 93 +! UXC - internal energy contr.[per 1 electron, kT] +! PXC - pressure contribution divided by (n_e kT) +! CVXC - heat capacity divided by N_e k +! SXC - entropy divided by N_e k +! PDTXC,PDRXC = PXC + d PXC / d ln(T,\rho) implicit double precision(A-H),double precision(O-Z) save parameter(EPS=1.d-8) ! 10.08.16 @@ -1550,18 +1550,18 @@ subroutine EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) return end -* ====================== AUXILIARY SUBROUTINES ==================== * +! ====================== AUXILIARY SUBROUTINES ==================== ! subroutine FERINV7(F,N,X,XDF,XDFF) ! Inverse Fermi intergals -* Version 24.05.07 -* X_q(f)=F^{-1}_q(f) : H.M.Antia 93 ApJS 84, 101 -* q=N-1/2=-1/2,1/2,3/2,5/2 (N=0,1,2,3) -* Input: F - argument, N=q+1/2 -* Output: X=X_q, XDF=dX/df, XDFF=d^2 X / df^2 -* Relative error: N = 0 1 2 3 -* for X: 3.e-9, 4.2e-9, 2.3e-9, 6.2e-9 -* jump at f=4: -* for XDF: 6.e-7, 5.4e-7, 9.6e-8, 3.1e-7 -* for XDFF: 4.7e-5, 4.8e-5, 2.3e-6, 1.5e-6 +! Version 24.05.07 +! X_q(f)=F^{-1}_q(f) : H.M.Antia 93 ApJS 84, 101 +! q=N-1/2=-1/2,1/2,3/2,5/2 (N=0,1,2,3) +! Input: F - argument, N=q+1/2 +! Output: X=X_q, XDF=dX/df, XDFF=d^2 X / df^2 +! Relative error: N = 0 1 2 3 +! for X: 3.e-9, 4.2e-9, 2.3e-9, 6.2e-9 +! jump at f=4: +! for XDF: 6.e-7, 5.4e-7, 9.6e-8, 3.1e-7 +! for XDFF: 4.7e-5, 4.8e-5, 2.3e-6, 1.5e-6 implicit double precision (A-H), double precision (O-Z) save dimension A(0:5,0:3),B(0:6,0:3),C(0:6,0:3),D(0:6,0:3), @@ -1661,15 +1661,15 @@ subroutine BLIN9(TEMP,CHI, * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, * W0XXX,W0XTT,W0XXT) -* Version 21.01.10 -* Stems from BLIN8 v.24.12.08 -* Difference - smooth matching of different CHI ranges -* Input: TEMP=T/mc^2; CHI=(\mu-mc^2)/T -* Output: Wk - Fermi-Dirac integral of the order k+1/2 -* WkDX=dWk/dCHI, WkDT = dWk/dT, WkDXX=d^2 Wk / d CHI^2, -* WkDTT=d^2 Wk / d T^2, WkDXT=d^2 Wk /dCHIdT, -* W0XXX=d^3 W0 / d CHI^3, W0XTT=d^3 W0 /(d CHI d^2 T), -* W0XXT=d^3 W0 /dCHI^2 dT +! Version 21.01.10 +! Stems from BLIN8 v.24.12.08 +! Difference - smooth matching of different CHI ranges +! Input: TEMP=T/mc^2; CHI=(\mu-mc^2)/T +! Output: Wk - Fermi-Dirac integral of the order k+1/2 +! WkDX=dWk/dCHI, WkDT = dWk/dT, WkDXX=d^2 Wk / d CHI^2, +! WkDTT=d^2 Wk / d T^2, WkDXT=d^2 Wk /dCHIdT, +! W0XXX=d^3 W0 / d CHI^3, W0XTT=d^3 W0 /(d CHI d^2 T), +! W0XXT=d^3 W0 /dCHI^2 dT implicit double precision (A-H), double precision (O-Z) save parameter (CHI1=0.6d0,CHI2=14.d0,XMAX=30.d0) @@ -1745,8 +1745,8 @@ subroutine BLIN9a(TEMP,CHI, * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, * W0XXX,W0XTT,W0XXT) -* Version 19.01.10 -* First part of BILN9: small CHI. Stems from BLIN9 v.24.12.08 +! Version 19.01.10 +! First part of BILN9: small CHI. Stems from BLIN9 v.24.12.08 implicit double precision (A-H), double precision (O-Z) save dimension AC(5,0:2),AU(5,0:2),AA(5,0:2) @@ -1838,9 +1838,9 @@ subroutine BLIN9b(TEMP,CHI, * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, * W0XXX,W0XTT,W0XXT) -* Version 19.01.10 -* Small syntax fix 15.03.13 -* Second part of BILN9: intermediate CHI. Stems from BLIN8 v.24.12.08 +! Version 19.01.10 +! Small syntax fix 15.03.13 +! Second part of BILN9: intermediate CHI. Stems from BLIN8 v.24.12.08 implicit double precision (A-H), double precision (O-Z) save dimension AX(5),AXI(5),AH(5),AV(5) @@ -1949,8 +1949,8 @@ subroutine BLIN9c(TEMP,CHI, * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, * W0XXX,W0XTT,W0XXT) -* Version 19.01.10 -* Third part of BILN9: large CHI. Stems from BLIN8 v.24.12.08 +! Version 19.01.10 +! Third part of BILN9: large CHI. Stems from BLIN8 v.24.12.08 implicit double precision (A-H), double precision (O-Z) save parameter (PI=3.141592653d0,PI26=PI*PI/6.) @@ -2034,7 +2034,7 @@ subroutine BLIN9c(TEMP,CHI, W2DXT=WDXT endif enddo ! next K -* ---------------------------------------------------------------- * +! ---------------------------------------------------------------- ! else ! CHI > 14, CHI*TEMP > 0.1: general high-\chi expansion D=1.d0+CHI*TEMP/2.d0 R=dsqrt(CHI*D) @@ -2159,11 +2159,11 @@ subroutine BLIN9c(TEMP,CHI, end subroutine CHEMFIT(DENS,TEMP,CHI) -* Version 07.06.07 -* This is merely an interface to CHEMFIT7 for compatibility purposes. -* Input: DENS - electron density [a.u.=6.7483346e24 cm^{-3}], -* TEMP - temperature [a.u.=2Ryd=3.1577e5 K] -* Output: CHI=\mu/TEMP, where \mu - electron chem.pot.w/o rest-energy +! Version 07.06.07 +! This is merely an interface to CHEMFIT7 for compatibility purposes. +! Input: DENS - electron density [a.u.=6.7483346e24 cm^{-3}], +! TEMP - temperature [a.u.=2Ryd=3.1577e5 K] +! Output: CHI=\mu/TEMP, where \mu - electron chem.pot.w/o rest-energy implicit double precision (A-H), double precision (O-Z) save DENR=DENS/2.5733806d6 ! n_e in rel.un.=\lambda_{Compton}^{-3} @@ -2174,18 +2174,18 @@ subroutine CHEMFIT(DENS,TEMP,CHI) subroutine CHEMFIT7(DENR,TEMR,CHI,CMU1,KDERIV, * CMUDENR,CMUDT,CMUDTT) -* Version 29.08.15 -* Fit to the chemical potential of free electron gas described in: -* G.Chabrier & A.Y.Potekhin, Phys.Rev.E 58, 4941 (1998) -* Stems from CHEMFIT v.10.10.96. The main difference - derivatives. -* All quantities are by default in relativistic units -* Input: DENR - electron density, TEMR - temperature -* KDERIV=0 if the derivatives are not required -* Output: CHI=CMU1/TEMR, where CMU1 = \mu-1 - chem.pot.w/o rest-energy -* CMUDENR = (d\mu/d n_e)_T -* CMUDT = (d\mu/dT)_V -* CMUDTT = (d^2\mu/dT^2)_V -* CMUDENR,CMUDT, and CMUDTT =0 on output, if KREDIV=0 +! Version 29.08.15 +! Fit to the chemical potential of free electron gas described in: +! G.Chabrier & A.Y.Potekhin, Phys.Rev.E 58, 4941 (1998) +! Stems from CHEMFIT v.10.10.96. The main difference - derivatives. +! All quantities are by default in relativistic units +! Input: DENR - electron density, TEMR - temperature +! KDERIV=0 if the derivatives are not required +! Output: CHI=CMU1/TEMR, where CMU1 = \mu-1 - chem.pot.w/o rest-energy +! CMUDENR = (d\mu/d n_e)_T +! CMUDT = (d\mu/dT)_V +! CMUDTT = (d^2\mu/dT^2)_V +! CMUDENR,CMUDT, and CMUDTT =0 on output, if KREDIV=0 implicit double precision (A-H), double precision (O-Z) save parameter (C13=1.d0/3.d0,PARA=1.612d0,PARB=6.192d0,PARC=.0944d0, @@ -2227,13 +2227,13 @@ subroutine CHEMFIT7(DENR,TEMR,CHI,CMU1,KDERIV, CMUDTT=0. return endif -* CALCULATE DERIVATIVES: -* 1: derivatives of CHI over THETA and T -* (a): Non-relativistic result: +! CALCULATE DERIVATIVES: +! 1: derivatives of CHI over THETA and T +! (a): Non-relativistic result: THETA52=THETA32*THETA CHIDY=-XDF/THETA52 ! d\chi/d\theta CHIDYY=(XDFF/THETA**4-2.5d0*CHIDY)/THETA ! d^2\chi/d\theta^2 -* (b): Relativistic corrections: +! (b): Relativistic corrections: if (THETA.gt.1.d-5) then Q1D=-Q1/(1.d0-T1) Q1DD=-Q1D*(1.d0+T1)/(1.d0-T1) From 7f592c85e277c9d8b48f5265250a7ba5b03249fd Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 07:37:43 -0700 Subject: [PATCH 07/70] Remove commented lines --- EOS/pc/eos17.f | 8 -------- 1 file changed, 8 deletions(-) diff --git a/EOS/pc/eos17.f b/EOS/pc/eos17.f index 79f829afba..29133ab7a7 100755 --- a/EOS/pc/eos17.f +++ b/EOS/pc/eos17.f @@ -268,7 +268,6 @@ subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, ! (0) Photons: UINTRAD=RAD*TEMP**4 PRESSRAD=UINTRAD/3. -C CVRAD=4.*UINTRAD/TEMP ! (1) ideal electron gas (including relativity and degeneracy) ----- * DENS=RHO/11.20587*Zmean/CMImean ! number density of electrons [au] call CHEMFIT(DENS,TEMP,CHI) @@ -375,17 +374,13 @@ subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, PDLR=PDLR+PRESSI*PDRMIX ! First-order: PRADnkT=PRESSRAD/PRESSI ! radiative pressure / n_i k T -C CVtot=CVtot+CVRAD -C Stot=Stot+CVRAD/3. PnkT=PRESS/PRESSI ! P / n_i k T UNkT=UINT/PRESSI ! U / N_i k T -C UNkT=UNkT+UINTRAD/PRESSI SNk=Stot/DENSI ! S / N_i k ! Second-order: CV=CVtot/DENSI ! C_V per ion CHIR=PDLR/PRESS ! d ln P / d ln\rho CHIT=PDLT/PRESS ! d ln P / d ln T -C CHIT=CHIT+4.*PRESSRAD/PRESS ! d ln P / d ln T return end @@ -680,7 +675,6 @@ subroutine FSCRsol8(RS,GAMI,ZNUCL,TPT, dimension AP(4) ! parameters of the fit parameter (C13=1.d0/3.d0,ENAT=2.7182818285d0,TINY=1.d-19) data AP/1.1866,.684,17.9,41.5/,PX/.205/ ! for bcc lattice -cc data AP/1.1857,.663,17.1,40./,PX/.212/ ! for fcc lattice if (RS.lt.0.) stop'FSCRliq8: RS < 0' if (RS.lt.TINY) then FSCR=0. @@ -1258,7 +1252,6 @@ subroutine SOMMERF(TEMR,CHI, * CJ03,CJ13,CJ23, * CJ04,CJ14,CJ24,CJ05) PIT26=(PI*TEMR)**2/6.d0 -CCC PITAU4=PIT26**2*0.7d0 CN0=dsqrt(.5d0/TEMR)/TEMR CN1=CN0/TEMR CN2=CN1/TEMR @@ -1269,7 +1262,6 @@ subroutine SOMMERF(TEMR,CHI, W1DX=CN0*(CJ11+PIT26*CJ13) W2DX=CN1*(CJ21+PIT26*CJ23) W0DT=CN1*(CMU1*CJ01-1.5d0*CJ00+PIT26*(CMU1*CJ03+.5d0*CJ02)) -CCC + CN1*PITAU4*(CMU1*CJ05+2.5d0*CJ04) W1DT=CN2*(CMU1*CJ11-2.5d0*CJ10+PIT26*(CMU1*CJ13-.5d0*CJ12)) W2DT=CN2/TEMR*(CMU1*CJ21-3.5d0*CJ20+PIT26*(CMU1*CJ23-1.5d0*CJ22)) W0DXX=CN0*TEMR**2*(CJ02+PIT26*CJ04) From 2623421145a1719d6f3531d8849ea031b7d06510 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 07:56:27 -0700 Subject: [PATCH 08/70] More explicit types --- EOS/pc/eos17.f | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/EOS/pc/eos17.f b/EOS/pc/eos17.f index 29133ab7a7..d6a3b58b94 100755 --- a/EOS/pc/eos17.f +++ b/EOS/pc/eos17.f @@ -109,7 +109,8 @@ program main implicit none double precision, parameter :: UN_T6 = .3157746 - double precision :: AY(2), AZion(2), ACMI(2) + integer, parameter :: NMIX = 2 + double precision :: AY(NMIX), AZion(NMIX), ACMI(NMIX) double precision :: RHO, RHOlg, T, Tlg, T6, Tnk, TEMP, DENS double precision :: Zmean, CMImean, Z2mean, GAMI, P double precision :: CHI, TPT, TEGRAD, PRADnkT @@ -129,7 +130,7 @@ program main RHO=10.d0**RHOlg write(*,112) TEMP=T6/UN_T6 ! T [au] - call MELANGE9(2,AY,AZion,ACMI,RHO,TEMP, ! input + call MELANGE9(AY,AZion,ACMI,RHO,TEMP, ! input * PRADnkT, ! additional output - radiative pressure * DENS,Zmean,CMImean,Z2mean,GAMI,CHI,TPT,LIQSOL, ! output param. * PnkT,UNkT,SNk,CV,CHIR,CHIT) ! output dimensionless TD functions @@ -159,7 +160,7 @@ program main 111 format(1P,12E12.3,I2) end program main - subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, + subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, * DENS,Zmean,CMImean,Z2mean,GAMImean,CHI,TPT,LIQSOL, * PnkT,UNkT,SNk,CV,CHIR,CHIT) ! Version 18.04.20 @@ -178,8 +179,7 @@ subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, ! choice based on comparison of total (non-OCP) free energies can be ! sometimes dangerous because of the fit uncertainties ("Local field ! correction" in solid and quantum effects in liquid are unknown)]. -! Input: NMIX - number of different elements; -! AY - their partial number densities, +! Input: AY - their partial number densities, ! AZion and ACMI - their charge and mass numbers, ! RHO - total mass density [g/cc] ! TEMP - temperature [in a.u.=2Ryd=3.1577e5 K]. @@ -204,15 +204,17 @@ subroutine MELANGE9(NMIX,AY,AZion,ACMI,RHO,TEMP,PRADnkT, ! CHIR - inverse compressibility -(d ln P / d ln V)_T ("\chi_r") ! CHIT = (d ln P / d ln T)_V ("\chi_T") implicit double precision (A-H), double precision (O-Z) - character CHWK save - parameter(TINY=1.d-7) - dimension AY(*),AZion(*),ACMI(*) - parameter (PI=3.141592653d0,C53=5.d0/3.d0,C13=1.d0/3.d0, - * AUM=1822.888d0, ! a.m.u./m_e - * GAMIMELT=175., ! OCP value of Gamma_i for melting - * RSIMELT=140., ! ion density parameter of quantum melting - * RAD=2.554d-7) ! Radiation constant (=4\sigma/c) (in a.u.) + double precision, parameter :: TINY = 1.d-7 + integer, parameter :: NMIX = 2 + double precision :: AY(NMIX), AZion(NMIX), ACMI(NMIX) + double precision, parameter :: PI = 3.141592653d0 + double precision, parameter :: C53 = 5.d0/3.d0 + double precision, parameter :: C13 = 1.d0/3.d0 + double precision, parameter :: AUM=1822.888d0 ! a.m.u./m_e + double precision, parameter :: GAMIMELT=175. ! OCP value of Gamma_i for melting + double precision, parameter :: RSIMELT=140. ! ion density parameter of quantum melting + double precision, parameter :: RAD=2.554d-7 ! Radiation constant (=4\sigma/c) (in a.u.) if (RHO.lt.1.e-19.or.RHO.gt.1.e15) stop'MELANGE: RHO out of range' CWK=1.d0 Y=0. From 2777c205eb43495a70dd6213acf6e8c8e9dbaa02 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 08:17:23 -0700 Subject: [PATCH 09/70] Answer verification --- EOS/pc/eos17.f | 76 ++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 68 insertions(+), 8 deletions(-) diff --git a/EOS/pc/eos17.f b/EOS/pc/eos17.f index d6a3b58b94..0432156b83 100755 --- a/EOS/pc/eos17.f +++ b/EOS/pc/eos17.f @@ -116,6 +116,7 @@ program main double precision :: CHI, TPT, TEGRAD, PRADnkT double precision :: PnkT, UNkT, SNk, CV, CHIR, CHIT integer :: LIQSOL + double precision :: dx AZion(1) = 6.0d0 AZion(2) = 8.0d0 ACMI(1) = 12.0d0 @@ -128,7 +129,6 @@ program main Tlg=dlog10(T) T6=10.d0**(Tlg-6.d0) RHO=10.d0**RHOlg - write(*,112) TEMP=T6/UN_T6 ! T [au] call MELANGE9(AY,AZion,ACMI,RHO,TEMP, ! input * PRADnkT, ! additional output - radiative pressure @@ -151,13 +151,73 @@ program main ! TPT=T_p/T, where T_p is the ion plasma temperature ! CHI - electron chemical potential, divided by kT ! LIQSOL = 0 in the liquid state, = 1 in the solid state - write(*,111) RHO,T6,P,PnkT,CV,CHIT,CHIR,UNkT,SNk,GAMI,TPT,CHI, - * LIQSOL - 112 format(/ - * ' rho [g/cc] T6 [K] P [Mbar] P/(n_i kT) Cv/(N k)', - * ' chi_T chi_r U/(N k T) S/(N k) Gamma_i', - * ' T_p/T chi_e liq/sol') - 111 format(1P,12E12.3,I2) + + dx = abs(P - 986087830999.01904d0) + if (dx / P > 1.d-15) then + print *, "P IS WRONG", dx / P + return + end if + + dx = abs(PnkT - 16.129464056742833d0) + if (dx / PnkT > 1.d-15) then + print *, "PnkT IS WRONG", dx / PnkT + return + end if + + dx = abs(CV - 8.5451229292858866d0) + if (dx / CV > 1.d-15) then + print *, "CV IS WRONG", dx / CV + return + end if + + dx = abs(CHIT - 0.24165606904443493d0) + if (dx / CHIT > 1.d-15) then + print *, "CHIT IS WRONG", dx / CHIT + return + end if + + dx = abs(CHIR - 1.3370085960654023d0) + if (dx / CHIR > 1.d-15) then + print *, "CHIR IS WRONG", dx / CHIR + return + end if + + dx = abs(UNkT - 30.712489657322770d0) + if (dx / UNkT > 1.d-15) then + print *, "UNkT IS WRONG", dx / UNkT + return + end if + + dx = abs(SNk - 23.797925638433309d0) + if (dx / SNk > 1.d-15) then + print *, "SNk IS WRONG", dx / SNk + return + end if + + dx = abs(GAMI - 0.96111630472601972d0) + if (dx / GAMI > 1.d-15) then + print *, "GAMI IS WRONG", dx / GAMI + return + end if + + dx = abs(TPT - 1.2400526419152945d-002) + if (dx / TPT > 1.d-15) then + print *, "TPT IS WRONG", dx / TPT + return + end if + + dx = abs(CHI - 5.5745494145734744d0) + if (dx / CHI > 1.d-15) then + print *, "CHI IS WRONG", dx / CHI + return + end if + + if (LIQSOL /= 0) then + print *, "LIQSOL IS WRONG", LIQSOL + return + end if + + print *, "SUCCESS" end program main subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, From b64e63b4cc3c5cf2bb13b41eb66dc95551eb49b2 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 08:21:22 -0700 Subject: [PATCH 10/70] Remove density rescaling --- EOS/pc/eos17.f | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/EOS/pc/eos17.f b/EOS/pc/eos17.f index 0432156b83..bb1289a6d7 100755 --- a/EOS/pc/eos17.f +++ b/EOS/pc/eos17.f @@ -265,6 +265,7 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, ! CHIT = (d ln P / d ln T)_V ("\chi_T") implicit double precision (A-H), double precision (O-Z) save + double precision, parameter :: CWK = 1.d0 ! Turn on Wigner corrections double precision, parameter :: TINY = 1.d-7 integer, parameter :: NMIX = 2 double precision :: AY(NMIX), AZion(NMIX), ACMI(NMIX) @@ -276,18 +277,6 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, double precision, parameter :: RSIMELT=140. ! ion density parameter of quantum melting double precision, parameter :: RAD=2.554d-7 ! Radiation constant (=4\sigma/c) (in a.u.) if (RHO.lt.1.e-19.or.RHO.gt.1.e15) stop'MELANGE: RHO out of range' - CWK=1.d0 - Y=0. - do IX=1,NMIX - Y=Y+AY(IX) - enddo - if (dabs(Y-1.d0).gt.TINY) then - do IX=1,NMIX - AY(IX)=AY(IX)/Y - enddo - print*,'MELANGE9: partial densities (and derivatives)', - * ' are rescaled by factor',1./Y - endif ! Sort the elements in ascending order in Z_j: KSORT=0 do I=2,NMIX From 3e2a9d6649bb5a128f64621ce9419fe4bbe98f16 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 08:22:11 -0700 Subject: [PATCH 11/70] Remove resorting --- EOS/pc/eos17.f | 21 --------------------- 1 file changed, 21 deletions(-) diff --git a/EOS/pc/eos17.f b/EOS/pc/eos17.f index bb1289a6d7..c142553c4b 100755 --- a/EOS/pc/eos17.f +++ b/EOS/pc/eos17.f @@ -277,27 +277,6 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, double precision, parameter :: RSIMELT=140. ! ion density parameter of quantum melting double precision, parameter :: RAD=2.554d-7 ! Radiation constant (=4\sigma/c) (in a.u.) if (RHO.lt.1.e-19.or.RHO.gt.1.e15) stop'MELANGE: RHO out of range' -! Sort the elements in ascending order in Z_j: - KSORT=0 - do I=2,NMIX - J=I - Z=AZion(J) - CMI=ACMI(J) - Y=AY(J) - 1 if (J.le.1.or.AZion(J-1).le.Z) goto 2 - AZion(J)=AZion(J-1) - ACMI(J)=ACMI(J-1) - AY(J)=AY(J-1) - J=J-1 - KSORT=1 - goto 1 - 2 AZion(J)=Z - ACMI(J)=CMI - AY(J)=Y - enddo - if (KSORT.eq.1) write(*,'('' Ions are resorted as follows:''/ - * '' i Z_i A_i x_i''/(0P,I3,'':'',1P,3E10.3))') - * (J,AZion(J),ACMI(J),AY(J),J=1,NMIX) ! Calculation of average values: Zmean=0. Z2mean=0. From ea4778d75f1a673d13018ed08a6574f2e26bcf8c Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 08:24:16 -0700 Subject: [PATCH 12/70] Formatting --- EOS/pc/eos17.f | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/EOS/pc/eos17.f b/EOS/pc/eos17.f index c142553c4b..4cfb67fcd0 100755 --- a/EOS/pc/eos17.f +++ b/EOS/pc/eos17.f @@ -277,7 +277,7 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, double precision, parameter :: RSIMELT=140. ! ion density parameter of quantum melting double precision, parameter :: RAD=2.554d-7 ! Radiation constant (=4\sigma/c) (in a.u.) if (RHO.lt.1.e-19.or.RHO.gt.1.e15) stop'MELANGE: RHO out of range' -! Calculation of average values: + ! Calculation of average values: Zmean=0. Z2mean=0. Z52=0. @@ -295,21 +295,21 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, Z321=Z321+AY(IX)*AZion(IX)*dsqrt(AZion(IX)+1.d0)**3 ! 26.12.09 CMImean=CMImean+AY(IX)*ACMI(IX) enddo -! (0) Photons: + ! (0) Photons: UINTRAD=RAD*TEMP**4 PRESSRAD=UINTRAD/3. -! (1) ideal electron gas (including relativity and degeneracy) ----- * + ! (1) ideal electron gas (including relativity and degeneracy) DENS=RHO/11.20587*Zmean/CMImean ! number density of electrons [au] call CHEMFIT(DENS,TEMP,CHI) -! NB: CHI can be used as true input instead of RHO or DENS + ! NB: CHI can be used as true input instead of RHO or DENS call ELECT11(TEMP,CHI, * DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, * DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) -! NB: at this point DENS is redefined (the difference can be ~0.1%) + ! NB: at this point DENS is redefined (the difference can be ~0.1%) DTE=DENS*TEMP PRESSE=PEid*DTE ! P_e [a.u.] UINTE=UEid*DTE ! U_e / V [a.u.] -! (2) non-ideal Coulomb EIP ---------------------------------------- * + ! (2) non-ideal Coulomb EIP RS=(.75d0/PI/DENS)**C13 ! r_s - electron density parameter RSI=RS*CMImean*Z73*AUM ! R_S - ion density parameter GAME=1.d0/RS/TEMP ! electron Coulomb parameter Gamma_e @@ -319,7 +319,7 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, else LIQSOL=1 ! solid regime endif -! Calculate partial thermodynamic quantities and combine them together: + ! Calculate partial thermodynamic quantities and combine them together: UINT=UINTE PRESS=PRESSE CVtot=CVE*DENS @@ -330,7 +330,7 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, PRESSI=DENSI*TEMP ! ideal-ions total pressure (normalization) TPT2=0. CTP=4.d0*PI/AUM/TEMP**2 ! common coefficient for TPT2.10.12.14 -! Add Coulomb+xc nonideal contributions, and ideal free energy: + ! Add Coulomb+xc nonideal contributions, and ideal free energy: do IX=1,NMIX if (AY(IX).lt.TINY) goto 10 ! skip this species Zion=AZion(IX) @@ -341,20 +341,20 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, call EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, * FC1,UC1,PC1,SC1,CV1,PDT1,PDR1, * FC2,UC2,PC2,SC2,CV2,PDT2,PDR2) -! First-order TD functions: + ! First-order TD functions: UINT=UINT+UC2*PRI ! internal energy density (e+i+Coul.) Stot=Stot+DNI*(SC2-dlog(AY(IX))) !entropy per unit volume[a.u.] PRESS=PRESS+PC2*PRI ! pressure (e+i+Coul.) [a.u.] -! Second-order functions (they take into account compositional changes): + ! Second-order functions (they take into account compositional changes): CVtot=CVtot+DNI*CV2 ! C_V (e+i+Coul.)/ V (optim.10.12.14) PDLT=PDLT+PRI*PDT2 ! d P / d ln T PDLR=PDLR+PRI*PDR2 ! d P / d ln\rho TPT2=TPT2+CTP*DNI/ACMI(IX)*AZion(IX)**2 ! opt.10.12.14 10 continue enddo ! next IX -! Wigner-Kirkwood perturbative correction for liquid: + ! Wigner-Kirkwood perturbative correction for liquid: TPT=dsqrt(TPT2) ! effective T_p/T - ion quantum parameter -! (in the case of a mixture, this estimate is crude) + ! (in the case of a mixture, this estimate is crude) if (LIQSOL.eq.0) then FWK=TPT2/24.d0*CWK ! Wigner-Kirkwood (quantum diffr.) term if (FWK.gt..7.and.CWK.gt.0.) then @@ -369,7 +369,7 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, PDLT=PDLT-FWK*PRESSI PDLR=PDLR+UWK*PRESSI endif -! Corrections to the linear mixing rule: + ! Corrections to the linear mixing rule: if (LIQSOL.eq.0) then ! liquid phase call CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, * FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) @@ -402,12 +402,12 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, CVtot=CVtot+DENSI*CVMIX PDLT=PDLT+PRESSI*PDTMIX PDLR=PDLR+PRESSI*PDRMIX -! First-order: + ! First-order: PRADnkT=PRESSRAD/PRESSI ! radiative pressure / n_i k T PnkT=PRESS/PRESSI ! P / n_i k T UNkT=UINT/PRESSI ! U / N_i k T SNk=Stot/DENSI ! S / N_i k -! Second-order: + ! Second-order: CV=CVtot/DENSI ! C_V per ion CHIR=PDLR/PRESS ! d ln P / d ln\rho CHIT=PDLT/PRESS ! d ln P / d ln T From d58b29d4a097c66fc4a58f7c48c476e20b11f09f Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 08:36:43 -0700 Subject: [PATCH 13/70] implicit none --- EOS/pc/eos17.f | 27 ++++++++++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) diff --git a/EOS/pc/eos17.f b/EOS/pc/eos17.f index 4cfb67fcd0..befe6402e9 100755 --- a/EOS/pc/eos17.f +++ b/EOS/pc/eos17.f @@ -263,12 +263,21 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, ! CV - heat capacity per ion, div. by Boltzmann const. ! CHIR - inverse compressibility -(d ln P / d ln V)_T ("\chi_r") ! CHIT = (d ln P / d ln T)_V ("\chi_T") - implicit double precision (A-H), double precision (O-Z) + !implicit double precision (A-H), double precision (O-Z) + implicit none save + integer, parameter :: NMIX = 2 + + double precision, intent(in) :: RHO, TEMP + double precision, intent(in) :: AY(NMIX), AZion(NMIX), ACMI(NMIX) + double precision, intent(inout) :: DENS, Zmean, Z2mean, GAMImean + double precision, intent(inout) :: CHI, TPT + integer, intent(inout) :: LIQSOL + double precision, intent(inout) :: SNk, UnkT, PnkT, PRADnkT + double precision, intent(inout) :: CV, CHIR, CHIT + double precision, parameter :: CWK = 1.d0 ! Turn on Wigner corrections double precision, parameter :: TINY = 1.d-7 - integer, parameter :: NMIX = 2 - double precision :: AY(NMIX), AZion(NMIX), ACMI(NMIX) double precision, parameter :: PI = 3.141592653d0 double precision, parameter :: C53 = 5.d0/3.d0 double precision, parameter :: C13 = 1.d0/3.d0 @@ -276,6 +285,18 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, double precision, parameter :: GAMIMELT=175. ! OCP value of Gamma_i for melting double precision, parameter :: RSIMELT=140. ! ion density parameter of quantum melting double precision, parameter :: RAD=2.554d-7 ! Radiation constant (=4\sigma/c) (in a.u.) + double precision :: Z52, Z53, Z73, Z321, CMImean, CMI + double precision :: Zion, Z13, X, X1, X2 + double precision :: UWK, UINTRAD, UMIX, UINTE, UINT, UEid, UC2,UC1 + double precision :: CHIRE, CHITE, CTP, CV1, CV2, CVE, CVMIX, CVtot + double precision :: DeltaG, DENSI, DNI, DTE, FC1, FC2, FEid, FMIX + double precision :: DlnDH, DlnDT, DlnDHH, DlnDHT, DlnDTT + double precision :: FWK, GAME, GAMI + integer :: i, ix, j + double precision :: PC1, PC2, PDLR, PDLT, PDR1, PDR2, PDRMIX + double precision :: PDT1, PDT2, PDTMIX, PEid, PMIX, PRESS, PRESSE + double precision :: PRESSI, PRESSRAD, PRI, RS, RSI, RZ, SC1, SC2 + double precision :: SEid, Stot, TPT2 if (RHO.lt.1.e-19.or.RHO.gt.1.e15) stop'MELANGE: RHO out of range' ! Calculation of average values: Zmean=0. From 692123ce2fc8508ab016664b3635e0a15a6a984f Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 09:11:52 -0700 Subject: [PATCH 14/70] Free form --- EOS/pc/eos17.f | 794 ++++++++++++++++++++++++++----------------------- 1 file changed, 423 insertions(+), 371 deletions(-) diff --git a/EOS/pc/eos17.f b/EOS/pc/eos17.f index befe6402e9..ddc2016d05 100755 --- a/EOS/pc/eos17.f +++ b/EOS/pc/eos17.f @@ -130,10 +130,10 @@ program main T6=10.d0**(Tlg-6.d0) RHO=10.d0**RHOlg TEMP=T6/UN_T6 ! T [au] - call MELANGE9(AY,AZion,ACMI,RHO,TEMP, ! input - * PRADnkT, ! additional output - radiative pressure - * DENS,Zmean,CMImean,Z2mean,GAMI,CHI,TPT,LIQSOL, ! output param. - * PnkT,UNkT,SNk,CV,CHIR,CHIT) ! output dimensionless TD functions + call MELANGE9(AY,AZion,ACMI,RHO,TEMP, & ! input + PRADnkT, & ! additional output - radiative pressure + DENS,Zmean,CMImean,Z2mean,GAMI,CHI,TPT,LIQSOL, & ! output param. + PnkT,UNkT,SNk,CV,CHIR,CHIT) ! output dimensionless TD functions Tnk=8.31447d13/CMImean*RHO*T6 ! n_i kT [erg/cc] P=PnkT*Tnk/1.d12 ! P [Mbar] TEGRAD=CHIT/(CHIT**2+CHIR*CV/PnkT) ! from Maxwell relat. @@ -220,9 +220,9 @@ program main print *, "SUCCESS" end program main - subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, - * DENS,Zmean,CMImean,Z2mean,GAMImean,CHI,TPT,LIQSOL, - * PnkT,UNkT,SNk,CV,CHIR,CHIT) + subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, & + DENS,Zmean,CMImean,Z2mean,GAMImean,CHI,TPT,LIQSOL, & + PnkT,UNkT,SNk,CV,CHIR,CHIT) ! Version 18.04.20 ! Difference from v.10.12.14: included switch-off of WK correction ! Stems from MELANGE8 v.26.12.09. @@ -297,7 +297,10 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, double precision :: PDT1, PDT2, PDTMIX, PEid, PMIX, PRESS, PRESSE double precision :: PRESSI, PRESSRAD, PRI, RS, RSI, RZ, SC1, SC2 double precision :: SEid, Stot, TPT2 - if (RHO.lt.1.e-19.or.RHO.gt.1.e15) stop'MELANGE: RHO out of range' + if (RHO.lt.1.e-19.or.RHO.gt.1.e15) then + print *, 'MELANGE: RHO out of range' + stop + end if ! Calculation of average values: Zmean=0. Z2mean=0. @@ -323,9 +326,9 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, DENS=RHO/11.20587*Zmean/CMImean ! number density of electrons [au] call CHEMFIT(DENS,TEMP,CHI) ! NB: CHI can be used as true input instead of RHO or DENS - call ELECT11(TEMP,CHI, - * DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, - * DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) + call ELECT11(TEMP,CHI, & + DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & + DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) ! NB: at this point DENS is redefined (the difference can be ~0.1%) DTE=DENS*TEMP PRESSE=PEid*DTE ! P_e [a.u.] @@ -359,9 +362,9 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, GAMI=Zion**C53*GAME ! Gamma_i for given ion species DNI=DENSI*AY(IX) ! number density of ions of given type PRI=DNI*TEMP ! = ideal-ions partial pressure (normalization) - call EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, - * FC1,UC1,PC1,SC1,CV1,PDT1,PDR1, - * FC2,UC2,PC2,SC2,CV2,PDT2,PDR2) + call EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, & + FC1,UC1,PC1,SC1,CV1,PDT1,PDR1, & + FC2,UC2,PC2,SC2,CV2,PDT2,PDR2) ! First-order TD functions: UINT=UINT+UC2*PRI ! internal energy density (e+i+Coul.) Stot=Stot+DNI*(SC2-dlog(AY(IX))) !entropy per unit volume[a.u.] @@ -392,8 +395,8 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, endif ! Corrections to the linear mixing rule: if (LIQSOL.eq.0) then ! liquid phase - call CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, - * FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) + call CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, & + FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) else ! solid phase (only Madelung contribution) [22.12.12] FMIX=0. do I=1,NMIX @@ -435,9 +438,9 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, return end - subroutine EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, - * FC1,UC1,PC1,SC1,CV1,PDT1,PDR1, - * FC2,UC2,PC2,SC2,CV2,PDT2,PDR2) + subroutine EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, & + FC1,UC1,PC1,SC1,CV1,PDT1,PDR1, & + FC2,UC2,PC2,SC2,CV2,PDT2,PDR2) ! Version 16.09.08 ! call FHARM8 has been replaced by call FHARM12 27.04.12 ! Wigner-Kirkwood correction excluded 20.05.13 @@ -465,11 +468,26 @@ subroutine EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, save parameter(C53=5.d0/3.d0,C76=7.d0/6.d0) ! TINY excl.10.12.14 parameter (AUM=1822.888d0) ! a.m.u/m_e - if (LIQSOL.ne.1.and.LIQSOL.ne.0) stop'EOSFI8: invalid LIQSOL' - if (CMI.le..1) stop'EOSFI8: too small CMI' - if (Zion.le..1) stop'EOSFI8: too small Zion' - if (RS.le..0) stop'EOSFI8: invalid RS' - if (GAMI.le..0) stop'EOSFI8: invalid GAMI' + if (LIQSOL.ne.1.and.LIQSOL.ne.0) then + print *, 'EOSFI8: invalid LIQSOL' + stop + end if + if (CMI.le..1) then + print *, 'EOSFI8: too small CMI' + stop + end if + if (Zion.le..1) then + print *, 'EOSFI8: too small Zion' + stop + end if + if (RS.le..0) then + print *, 'EOSFI8: invalid RS' + stop + end if + if (GAMI.le..0) then + print *, 'EOSFI8: invalid GAMI' + stop + end if GAME=GAMI/Zion**C53 call EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) ! "ee"("xc") ! Calculate "ii" part: @@ -479,8 +497,8 @@ subroutine EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, ! 1.3235=1+0.5*ln(6/pi); FidION = F_{id.ion gas}/(N_i kT), but without ! the term x_i ln x_i = -S_{mix}/(N_i k). if (LIQSOL.eq.0) then ! liquid - call FITION9(GAMI, - * FION,UION,PION,CVii,PDTii,PDRii) + call FITION9(GAMI, & + FION,UION,PION,CVii,PDTii,PDRii) FItot=FION+FidION UItot=UION+1.5 PItot=PION+1.d0 @@ -489,8 +507,8 @@ subroutine EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, PDTi=PDTii+1.d0 PDRi=PDRii+1.d0 else ! solid - call FHARM12(GAMI,TPT, - * Fharm,Uharm,Pharm,CVharm,Sharm,PDTharm,PDRharm) ! harm."ii" + call FHARM12(GAMI,TPT, & + Fharm,Uharm,Pharm,CVharm,Sharm,PDTharm,PDRharm) ! harm."ii" call ANHARM8(GAMI,TPT,Fah,Uah,Pah,CVah,PDTah,PDRah) ! anharm. FItot=Fharm+Fah FION=FItot-FidION @@ -508,11 +526,11 @@ subroutine EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, endif ! Calculate "ie" part: if (LIQSOL.eq.1) then - call FSCRsol8(RS,GAMI,Zion,TPT, - * FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR) + call FSCRsol8(RS,GAMI,Zion,TPT, & + FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR) else - call FSCRliq8(RS,GAME,Zion, - * FSCR,USCR,PSCR,CVSCR,PDTSCR,PDRSCR) + call FSCRliq8(RS,GAME,Zion, & + FSCR,USCR,PSCR,CVSCR,PDTSCR,PDRSCR) S_SCR=USCR-FSCR endif ! Total excess quantities ("ii"+"ie"+"ee", per ion): @@ -557,28 +575,28 @@ subroutine FITION9(GAMI,FION,UION,PION,CVii,PDTii,PDRii) ! Parameters adjusted to Caillol (1999). implicit double precision (A-H),double precision (O-Z) save - parameter (A1=-.907347d0,A2=.62849d0,C1=.004500d0,G1=170.0, - * C2=-8.4d-5,G2=.0037,SQ32=.8660254038d0) ! SQ32=sqrt(3)/2 + parameter (A1=-.907347d0,A2=.62849d0,C1=.004500d0,G1=170.0, & + C2=-8.4d-5,G2=.0037,SQ32=.8660254038d0) ! SQ32=sqrt(3)/2 A3=-SQ32-A1/dsqrt(A2) - F0=A1*(dsqrt(GAMI*(A2+GAMI))- - - A2*dlog(dsqrt(GAMI/A2)+dsqrt(1.+GAMI/A2)))+ - + 2.*A3*(dsqrt(GAMI)-datan(dsqrt(GAMI))) + F0=A1*(dsqrt(GAMI*(A2+GAMI))- & + A2*dlog(dsqrt(GAMI/A2)+dsqrt(1.+GAMI/A2)))+ & + 2.*A3*(dsqrt(GAMI)-datan(dsqrt(GAMI))) U0=dsqrt(GAMI)**3*(A1/dsqrt(A2+GAMI)+A3/(1.d0+GAMI)) ! This is the zeroth approximation. Correction: UION=U0+C1*GAMI**2/(G1+GAMI)+C2*GAMI**2/(G2+GAMI**2) - FION=F0+C1*(GAMI-G1*dlog(1.d0+GAMI/G1))+ - + C2/2.*dlog(1.d0+GAMI**2/G2) - CVii=-0.5*dsqrt(GAMI)**3*(A1*A2/dsqrt(A2+GAMI)**3+ - + A3*(1.d0-GAMI)/(1.d0+GAMI)**2) - - - GAMI**2*(C1*G1/(G1+GAMI)**2+C2*(G2-GAMI**2)/(G2+GAMI**2)**2) + FION=F0+C1*(GAMI-G1*dlog(1.d0+GAMI/G1))+ & + C2/2.*dlog(1.d0+GAMI**2/G2) + CVii=-0.5*dsqrt(GAMI)**3*(A1*A2/dsqrt(A2+GAMI)**3+ & + A3*(1.d0-GAMI)/(1.d0+GAMI)**2) - & + GAMI**2*(C1*G1/(G1+GAMI)**2+C2*(G2-GAMI**2)/(G2+GAMI**2)**2) PION=UION/3. PDRii=(4.*UION-CVii)/9. ! p_{ii} + d p_{ii} / d ln\rho PDTii=CVii/3. ! p_{ii} + d p_{ii} / d ln T return end - subroutine FSCRliq8(RS,GAME,Zion, - * FSCR,USCR,PSCR,CVSCR,PDTSCR,PDRSCR) ! fit to the el.-ion scr. + subroutine FSCRliq8(RS,GAME,Zion, & + FSCR,USCR,PSCR,CVSCR,PDTSCR,PDRSCR) ! fit to the el.-ion scr. ! Version 11.09.08 ! cleaned 16.06.09 ! Stems from FSCRliq7 v. 09.06.07. Included a check for RS=0. @@ -592,7 +610,10 @@ subroutine FSCRliq8(RS,GAME,Zion, implicit double precision(A-H),double precision(O-Z) save parameter(XRS=.0140047,TINY=1.d-19) - if (RS.lt.0.) stop'FSCRliq8: RS < 0' + if (RS.lt.0.) then + print *, 'FSCRliq8: RS < 0' + stop + end if if (RS.lt.TINY) then FSCR=0. USCR=0. @@ -662,22 +683,22 @@ subroutine FSCRliq8(RS,GAME,Zion, H1=H1U/H1D H1X=.4*X/H1U-(Q1+2.*Q2*X)/H1D H1DX=H1*H1X - H1DXX=H1DX*H1X+ - + H1*(.4/H1U-(.4*X/H1U)**2-2.*Q2/H1D+((Q1+2.*Q2*X)/H1D)**2) + H1DXX=H1DX*H1X+ & + H1*(.4/H1U-(.4*X/H1U)**2-2.*Q2/H1D+((Q1+2.*Q2*X)/H1D)**2) UP=CDH*SQG+P01*CTF*TX*COR0*H1 UPDX=P01*CTF*TX*(COR0DX*H1+COR0*H1DX) UPDG=.5*CDH/SQG+P01*CTF*(TXDG*COR0+TX*COR0DG)*H1 UPDXX=P01*CTF*TX*(COR0DXX*H1+2.*COR0DX*H1DX+COR0*H1DXX) - UPDGG=-.25*CDH/(SQG*GAME)+ - + P01*CTF*(TXDGG*COR0+2.*TXDG*COR0DG+TX*COR0DGG)*H1 - UPDXG=P01*CTF*(TXDG*(COR0DX*H1+COR0*H1DX)+ - + TX*(COR0DXG*H1+COR0DG*H1DX)) + UPDGG=-.25*CDH/(SQG*GAME)+ & + P01*CTF*(TXDGG*COR0+2.*TXDG*COR0DG+TX*COR0DGG)*H1 + UPDXG=P01*CTF*(TXDG*(COR0DX*H1+COR0*H1DX)+ & + TX*(COR0DXG*H1+COR0DG*H1DX)) DN1=P03*SQG+P01/RS*TX*COR1 DN1DX=P01*TX*(COR1/XRS+COR1DX/RS) DN1DG=.5*P03/SQG+P01/RS*(TXDG*COR1+TX*COR1DG) DN1DXX=P01*TX/XRS*(2.*COR1DX+X*COR1DXX) - DN1DGG=-.25*P03/(GAME*SQG)+ - + P01/RS*(TXDGG*COR1+2.*TXDG*COR1DG+TX*COR1DGG) + DN1DGG=-.25*P03/(GAME*SQG)+ & + P01/RS*(TXDGG*COR1+2.*TXDG*COR1DG+TX*COR1DGG) DN1DXG=P01*(TXDG*(COR1/XRS+COR1DX/RS)+TX*(COR1DG/XRS+COR1DXG/RS)) DN=1.+DN1/RELE DNDX=DN1DX/RELE-X*DN1/RELE**3 @@ -687,8 +708,8 @@ subroutine FSCRliq8(RS,GAME,Zion, DNDXG=DN1DXG/RELE-X*DN1DG/RELE**3 FSCR=-UP/DN*GAME FX=(UP*DNDX/DN-UPDX)/DN - FXDG=((UPDG*DNDX+UPDX*DNDG+UP*DNDXG-2.*UP*DNDX*DNDG/DN)/DN- - - UPDXG)/DN + FXDG=((UPDG*DNDX+UPDX*DNDG+UP*DNDXG-2.*UP*DNDX*DNDG/DN)/DN- & + UPDXG)/DN FDX=FX*GAME FG=(UP*DNDG/DN-UPDG)/DN FDG=FG*GAME-UP/DN @@ -705,8 +726,8 @@ subroutine FSCRliq8(RS,GAME,Zion, end ! ============== SUBROUTINES FOR THE SOLID STATE ================= ! - subroutine FSCRsol8(RS,GAMI,ZNUCL,TPT, - * FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR) + subroutine FSCRsol8(RS,GAMI,ZNUCL,TPT, & + FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR) ! Version 28.05.08 ! undefined zero variable Q1DXG is wiped out 21.06.10 ! accuracy-loss safeguard added 10.08.16 @@ -726,7 +747,10 @@ subroutine FSCRsol8(RS,GAMI,ZNUCL,TPT, dimension AP(4) ! parameters of the fit parameter (C13=1.d0/3.d0,ENAT=2.7182818285d0,TINY=1.d-19) data AP/1.1866,.684,17.9,41.5/,PX/.205/ ! for bcc lattice - if (RS.lt.0.) stop'FSCRliq8: RS < 0' + if (RS.lt.0.) then + print *, 'FSCRliq8: RS < 0' + stop + end if if (RS.lt.TINY) then FSCR=0. USCR=0. @@ -745,8 +769,8 @@ subroutine FSCRsol8(RS,GAMI,ZNUCL,TPT, XSR=.0140047/RS ! relativity parameter Z13=Zion**C13 P1=.00352*(1.-AP(1)/Zion**.267+.27/Zion) - P2=1.d0+2.25/Z13* - *(1.+AP(2)*Zion**5+.222*Zion**6)/(1.+.222*Zion**6) + P2=1.d0+2.25/Z13* & + (1.+AP(2)*Zion**5+.222*Zion**6)/(1.+.222*Zion**6) ZLN=dlog(Zion) Finf=sqrt(P2/XSR**2+1.)*Z13**2*P1 ! The TF limit FinfX=-P2/((P2+XSR**2)*XSR) @@ -797,15 +821,15 @@ subroutine FSCRsol8(RS,GAMI,ZNUCL,TPT, SUPDX=SUP*SUPX SUPG=.5d0*(SUPADG/SUPA-SUPBDG/SUPB) SUPDG=SUP*SUPG - SUPDXX=SUPDX*SUPX+ - + SUP*.5d0*(SUPADXX/SUPA-(SUPADX/SUPA)**2- - - SUPBDXX/SUPB+(SUPBDX/SUPB)**2) - SUPDGG=SUPDG*SUPG+ - + SUP*.5d0*(SUPADGG/SUPA-(SUPADG/SUPA)**2- - - SUPBDGG/SUPB+(SUPBDG/SUPB)**2) - SUPDXG=SUPDX*SUPG+ - + SUP*.5d0*((SUPADXG-SUPADX*SUPADG/SUPA)/SUPA- - - (SUPBDXG-SUPBDX*SUPBDG/SUPB)/SUPB) + SUPDXX=SUPDX*SUPX+ & + SUP*.5d0*(SUPADXX/SUPA-(SUPADX/SUPA)**2- & + SUPBDXX/SUPB+(SUPBDX/SUPB)**2) + SUPDGG=SUPDG*SUPG+ & + SUP*.5d0*(SUPADGG/SUPA-(SUPADG/SUPA)**2- & + SUPBDGG/SUPB+(SUPBDG/SUPB)**2) + SUPDXG=SUPDX*SUPG+ & + SUP*.5d0*((SUPADXG-SUPADX*SUPADG/SUPA)/SUPA- & + (SUPBDXG-SUPBDX*SUPBDG/SUPB)/SUPB) else SUP=PX*TPT SUPDX=.5d0*PX*TPT/XSR @@ -825,8 +849,8 @@ subroutine FSCRsol8(RS,GAMI,ZNUCL,TPT, W=1.d0+Q1/GR3 WDX=Q1DX/GR3-Q1*GR3DX/GR3**2 WDG=-Q1*GR3DG/GR3**2 - WDXX=Q1DXX/GR3- - - (2.d0*Q1DX*GR3DX+Q1*(GR3DXX-2.d0*GR3DX**2/GR3))/GR3**2 + WDXX=Q1DXX/GR3- & + (2.d0*Q1DX*GR3DX+Q1*(GR3DXX-2.d0*GR3DX**2/GR3))/GR3**2 WDGG=Q1*(2.d0*GR3DG**2/GR3-GR3DGG)/GR3**2 WDXG=-(Q1DX*GR3DG+Q1*(GR3DXG-2.d0*GR3DX*GR3DG/GR3))/GR3**2 FSCR=-GAMI*Finf*W @@ -841,8 +865,8 @@ subroutine FSCRsol8(RS,GAMI,ZNUCL,TPT, CVSCR=-GAMI**2*FDGG PSCR=(XSR*FDX+GAMI*FDG)/3.d0 PDTSCR=GAMI**2*(XSR*Finf*(FinfX*WDG+WDXG)-FDGG)/3.d0 - PDRSCR=(12.d0*PSCR+XSR**2*FDXX+2.d0*XSR*GAMI*FDXG+ - + GAMI**2*FDGG)/9.d0 + PDRSCR=(12.d0*PSCR+XSR**2*FDXX+2.d0*XSR*GAMI*FDXG+ & + GAMI**2*FDGG)/9.d0 return end @@ -881,8 +905,8 @@ subroutine ANHARM8(GAMI,TPT,Fah,Uah,Pah,CVah,PDTah,PDRah) Uah=Uah+(ACN*(1.+2.*TK2/CN))*SUPGN PN=AA(N)/3.+TK2*AA(N)/CN Pah=Pah+PN*SUPGN - CVah=CVah+((CN+1.)*AA(N)+(4.-2./CN)*AA(N)*TK2+ - + 4.*AA(N)*CK**2/CN*TPT4)*SUPGN + CVah=CVah+((CN+1.)*AA(N)+(4.-2./CN)*AA(N)*TK2+ & + 4.*AA(N)*CK**2/CN*TPT4)*SUPGN PDTah=PDTah+(PN*(1.+CN+2.*TK2)-2./CN*AA(N)*TK2)*SUPGN PDRah=PDRah+(PN*(1.-CN/3.-TK2)+AA(N)/CN*TK2)*SUPGN enddo @@ -893,8 +917,8 @@ subroutine ANHARM8(GAMI,TPT,Fah,Uah,Pah,CVah,PDTah,PDRah) return end - subroutine FHARM12(GAMI,TPT, - * Fharm,Uharm,Pharm,CVth,Sth,PDTharm,PDRharm) + subroutine FHARM12(GAMI,TPT, & + Fharm,Uharm,Pharm,CVth,Sth,PDTharm,PDRharm) ! Thermodynamic functions of a harmonic crystal, incl.stat.Coul.lattice ! ! Version 27.04.12 @@ -977,7 +1001,8 @@ subroutine HLfit12(eta,F,U,CV,S,U1,CW,LATTICE) C9=.00492387d0 C11=.00437506d0 else - stop'HLfit: unknown lattice type' + print *, 'HLfit: unknown lattice type' + stop endif if (eta.gt.1./EPS) then ! asymptote of Eq.(13) of BPY'01 U=3./(C11*eta**3) @@ -985,7 +1010,10 @@ subroutine HLfit12(eta,F,U,CV,S,U1,CW,LATTICE) CV=4.*U goto 50 elseif (eta.lt.EPS) then ! Eq.(17) of BPY'01 - if (eta.lt.TINY) stop'HLfit: eta is too small' + if (eta.lt.TINY) then + print *, 'HLfit: eta is too small' + stop + end if F=3.*dlog(eta)+CLM-1.5*U1*eta+eta**2/24. U=3.-1.5*U1*eta+eta**2/12. CV=3.-eta**2/12. @@ -1001,42 +1029,42 @@ subroutine HLfit12(eta,F,U,CV,S,U1,CW,LATTICE) B9=A6*C9 B11=A8*C11 UP=1.+A1*eta+A2*eta2+A3*eta3+A4*eta4+A6*eta6+A8*eta8 - DN=B0+B2*eta2+B4*eta4+B5*eta5+B6*eta6+ - + B7*eta7+eta8*(B9*eta+B11*eta3) + DN=B0+B2*eta2+B4*eta4+B5*eta5+B6*eta6+ & + B7*eta7+eta8*(B9*eta+B11*eta3) EA=dexp(-ALPHA*eta) EB=dexp(-BETA*eta) EG=dexp(-GAMMA*eta) F=dlog(1.d0-EA)+dlog(1.d0-EB)+dlog(1.-EG)-UP/DN ! F_{thermal}/NT - UP1=A1+ - + 2.*A2*eta+3.*A3*eta2+4.*A4*eta3+6.*A6*eta5+8.*A8*eta7 + UP1=A1+ & + 2.*A2*eta+3.*A3*eta2+4.*A4*eta3+6.*A6*eta5+8.*A8*eta7 UP2=2.*A2+6.*A3*eta+12.*A4*eta2+30.*A6*eta4+56.*A8*eta6 UP3=6.*A3+24.*A4*eta+120.*A6*eta3+336*A8*eta5 - DN1=2.*B2*eta+4.*B4*eta3+5.*B5*eta4+6.*B6*eta5+ - + 7.*B7*eta6+eta8*(9.*B9+11.*B11*eta2) - DN2=2.*B2+12.*B4*eta2+20.*B5*eta3+30.*B6*eta4+ - + 42.*B7*eta5+72.*B9*eta7+110.*B11*eta8*eta - DN3=24.*B4*eta+60.*B5*eta2+120.*B6*eta3+ - + 210.*B7*eta4+504.*B9*eta6+990.*B11*eta8 - DF1=ALPHA*EA/(1.d0-EA)+BETA*EB/(1.d0-EB)+GAMMA*EG/(1.d0-EG)- - - (UP1*DN-DN1*UP)/DN**2 ! int.en./NT/eta = df/d\eta - DF2=ALPHA**2*EA/(1.d0-EA)**2+BETA**2*EB/(1.d0-EB)**2+ - + GAMMA**2*EG/(1.d0-EG)**2+ - + ((UP2*DN-DN2*UP)*DN-2.*(UP1*DN-DN1*UP)*DN1)/DN**3 ! -d2f/d\eta^2 + DN1=2.*B2*eta+4.*B4*eta3+5.*B5*eta4+6.*B6*eta5+ & + 7.*B7*eta6+eta8*(9.*B9+11.*B11*eta2) + DN2=2.*B2+12.*B4*eta2+20.*B5*eta3+30.*B6*eta4+ & + 42.*B7*eta5+72.*B9*eta7+110.*B11*eta8*eta + DN3=24.*B4*eta+60.*B5*eta2+120.*B6*eta3+ & + 210.*B7*eta4+504.*B9*eta6+990.*B11*eta8 + DF1=ALPHA*EA/(1.d0-EA)+BETA*EB/(1.d0-EB)+GAMMA*EG/(1.d0-EG)- & + (UP1*DN-DN1*UP)/DN**2 ! int.en./NT/eta = df/d\eta + DF2=ALPHA**2*EA/(1.d0-EA)**2+BETA**2*EB/(1.d0-EB)**2+ & + GAMMA**2*EG/(1.d0-EG)**2+ & + ((UP2*DN-DN2*UP)*DN-2.*(UP1*DN-DN1*UP)*DN1)/DN**3 ! -d2f/d\eta^2 U=DF1*eta CV=DF2*eta2 - DF3=-ALPHA**3*EA/(1.d0-EA)**3*(1.+EA)- - - BETA**3*EB/(1.d0-EB)**3*(1.+EB)- - - GAMMA**3*EG/(1.d0-EG)**3*(1.+EG)+ - + UP3/DN-(3.*UP2*DN1+3.*UP1*DN2+UP*DN3)/DN**2+ - + 6.*DN1*(UP1*DN1+UP*DN2)/DN**3-6.*UP*DN1**3/DN**4 ! -d3f/d\eta^3 + DF3=-ALPHA**3*EA/(1.d0-EA)**3*(1.+EA)- & + BETA**3*EB/(1.d0-EB)**3*(1.+EB)- & + GAMMA**3*EG/(1.d0-EG)**3*(1.+EG)+ & + UP3/DN-(3.*UP2*DN1+3.*UP1*DN2+UP*DN3)/DN**2+ & + 6.*DN1*(UP1*DN1+UP*DN2)/DN**3-6.*UP*DN1**3/DN**4 ! -d3f/d\eta^3 CW=-2.*CV-eta3*DF3 50 continue S=U-F return end - subroutine CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, - * FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) + subroutine CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, & + FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) ! Version 02.07.09 ! Correction to the linear mixing rule for moderate to small Gamma ! Input: RS=r_s (if RS=0, then OCP, otherwise EIP) @@ -1091,9 +1119,9 @@ subroutine CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, end ! =================== IDEAL ELECTRON GAS =========================== ! - subroutine ELECT11(TEMP,CHI, - * DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, - * DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) + subroutine ELECT11(TEMP,CHI, & + DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & + DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) ! Version 17.11.11 ! safeguard against huge (-CHI) values is added 27.05.17 ! ELECT9 v.04.03.09 + smooth match of two fits at chi >> 1 + add.outputs @@ -1120,24 +1148,27 @@ subroutine ELECT11(TEMP,CHI, parameter (CHI2=28.d0,XMAX=20.d0) parameter (DCHI2=CHI2-1.d0) parameter (XSCAL2=XMAX/DCHI2) - if (CHI.lt.-1.d2) stop'ELECT11: too large negative CHI' ! 27.05.17 + if (CHI.lt.-1.d2) then + print *, 'ELECT11: too large negative CHI' ! 27.05.17 + stop + end if X2=(CHI-CHI2)*XSCAL2 if (X2.lt.-XMAX) then - call ELECT11a(TEMP,CHI, - * DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, - * DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) + call ELECT11a(TEMP,CHI, & + DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & + DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) elseif (X2.gt.XMAX) then - call ELECT11b(TEMP,CHI, - * DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, - * DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) + call ELECT11b(TEMP,CHI, & + DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & + DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) else call FERMI10(X2,XMAX,FP,FM) - call ELECT11a(TEMP,CHI, - * DENSa,FEida,PEida,UEida,SEida,CVEa,CHITEa,CHIREa, - * DlnDHa,DlnDTa,DlnDHHa,DlnDTTa,DlnDHTa) - call ELECT11b(TEMP,CHI, - * DENSb,FEidb,PEidb,UEidb,SEidb,CVEb,CHITEb,CHIREb, - * DlnDHb,DlnDTb,DlnDHHb,DlnDTTb,DlnDHTb) + call ELECT11a(TEMP,CHI, & + DENSa,FEida,PEida,UEida,SEida,CVEa,CHITEa,CHIREa, & + DlnDHa,DlnDTa,DlnDHHa,DlnDTTa,DlnDHTa) + call ELECT11b(TEMP,CHI, & + DENSb,FEidb,PEidb,UEidb,SEidb,CVEb,CHITEb,CHIREb, & + DlnDHb,DlnDTb,DlnDHHb,DlnDTTb,DlnDHTb) DENS=DENSa*FP+DENSb*FM FEid=FEida*FP+FEidb*FM PEid=PEida*FP+PEidb*FM @@ -1155,9 +1186,9 @@ subroutine ELECT11(TEMP,CHI, return end - subroutine ELECT11a(TEMP,CHI, - * DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, - * DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) + subroutine ELECT11a(TEMP,CHI, & + DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & + DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) ! Version 16.11.11 ! This is THE FIRST PART of ELECT9 v.04.03.09. implicit double precision (A-H), double precision (O-Z) @@ -1165,11 +1196,11 @@ subroutine ELECT11a(TEMP,CHI, parameter (BOHR=137.036,PI=3.141592653d0) parameter (PI2=PI**2,BOHR2=BOHR**2,BOHR3=BOHR2*BOHR) !cleaned 15/6 TEMR=TEMP/BOHR2 ! T in rel.units (=T/mc^2) - call BLIN9(TEMR,CHI, - * W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, - * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, - * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, - * W0XXX,W0XTT,W0XXT) + call BLIN9(TEMR,CHI, & + W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & + W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & + W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & + W0XXX,W0XTT,W0XXT) TPI=TEMR*dsqrt(2.d0*TEMR)/PI2 ! common pre-factor DENR=TPI*(W1*TEMR+W0) PR=TEMR*TPI/3.*(W2*TEMR+2.*W1) @@ -1187,8 +1218,8 @@ subroutine ELECT11a(TEMP,CHI, ! derivatives over chi at constant T and second derivatives: dndH=TPI*(W0DX+TEMR*W1DX) ! (d n_e/d\chi)_T dndHH=TPI*(W0DXX+TEMR*W1DXX) ! (d^2 n_e/d\chi)_T - dndTT=TPI*(.75*W0/TEMR**2+3.*W0DT/TEMR+W0DTT+ - + 3.75*W1/TEMR+5.*W1DT+TEMR*W1DTT) + dndTT=TPI*(.75*W0/TEMR**2+3.*W0DT/TEMR+W0DTT+ & + 3.75*W1/TEMR+5.*W1DT+TEMR*W1DTT) dndHT=TPI*(1.5*W0DX/TEMR+W0DXT+2.5*W1DX+TEMR*W1DXT) DlnDH=dndH/DENR ! (d ln n_e/d\chi)_T DlnDT=dndT*TEMR/DENR ! (d ln n_e/d ln T)_\chi @@ -1203,9 +1234,9 @@ subroutine ELECT11a(TEMP,CHI, return end - subroutine ELECT11b(TEMP,CHI, - * DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, - * DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) + subroutine ELECT11b(TEMP,CHI, & + DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & + DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) ! Version 17.11.11 ! Stems from ELECT9b v.19.01.10, Diff. - additional output. ! Sommerfeld expansion at very large CHI. @@ -1215,8 +1246,8 @@ subroutine ELECT11b(TEMP,CHI, parameter (PI2=PI**2,BOHR2=BOHR**2,BOHR3=BOHR2*BOHR) !cleaned 15/6 TEMR=TEMP/BOHR2 ! T in rel.units (=T/mc^2) EF=CHI*TEMR ! Fermi energy in mc^2 - zeroth aprox. = CMU1 - DeltaEF=PI2*TEMR**2/6.d0*(1.d0+2.d0*EF*(2.d0+EF))/ - / (EF*(1.d0+EF)*(2.d0+EF)) ! corr. [p.125, equiv.Eq.(6) of PC'10] + DeltaEF=PI2*TEMR**2/6.d0*(1.d0+2.d0*EF*(2.d0+EF))/ & + (EF*(1.d0+EF)*(2.d0+EF)) ! corr. [p.125, equiv.Eq.(6) of PC'10] EF=EF+DeltaEF ! corrected Fermi energy (14.02.09) G=1.d0+EF ! electron Lorentz-factor if (EF.gt.1.d-5) then ! relativistic expansion (Yak.&Shal.'89) @@ -1244,16 +1275,16 @@ subroutine ELECT11b(TEMP,CHI, DENS=DENR*BOHR3 ! conversion to a.u.(=\Bohr_radius^{-3}) ! derivatives over chi at constant T and T at constant chi: TPI=TEMR*dsqrt(2.d0*TEMR)/PI2 ! common pre-factor - call SOMMERF(TEMR,CHI, - * W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, - * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, - * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, - * W0XXX,W0XTT,W0XXT) + call SOMMERF(TEMR,CHI, & + W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & + W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & + W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & + W0XXX,W0XTT,W0XXT) dndH=TPI*(W0DX+TEMR*W1DX) ! (d n_e/d\chi)_T dndT=TPI*(1.5*W0/TEMR+2.5*W1+W0DT+TEMR*W1DT) ! (d n_e/dT)_\chi dndHH=TPI*(W0DXX+TEMR*W1DXX) ! (d^2 n_e/d\chi)_T - dndTT=TPI*(.75*W0/TEMR**2+3.*W0DT/TEMR+W0DTT+ - + 3.75*W1/TEMR+5.*W1DT+TEMR*W1DTT) + dndTT=TPI*(.75*W0/TEMR**2+3.*W0DT/TEMR+W0DTT+ & + 3.75*W1/TEMR+5.*W1DT+TEMR*W1DTT) dndHT=TPI*(1.5*W0DX/TEMR+W0DXT+2.5*W1DX+TEMR*W1DXT) DlnDH=dndH/DENR ! (d ln n_e/d\chi)_T DlnDT=dndT*TEMR/DENR ! (d ln n_e/d ln T)_\chi @@ -1274,11 +1305,11 @@ subroutine ELECT11b(TEMP,CHI, return end - subroutine SOMMERF(TEMR,CHI, - * W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, - * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, - * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, - * W0XXX,W0XTT,W0XXT) + subroutine SOMMERF(TEMR,CHI, & + W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & + W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & + W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & + W0XXX,W0XTT,W0XXT) ! Version 17.11.11 ! Sommerfeld expansion for the Fermi-Dirac integrals ! Input: TEMR=T/mc^2; CHI=(\mu-mc^2)/T @@ -1292,16 +1323,22 @@ subroutine SOMMERF(TEMR,CHI, save parameter(PI=3.141592653d0) parameter(PI2=PI**2) - if (CHI.lt..5d0) stop'SOMMERF: non-degenerate (small CHI)' - if (TEMR.le.0.d0) stop'SOMMERF: T < 0' + if (CHI.lt..5d0) then + print *, 'SOMMERF: non-degenerate (small CHI)' + stop + end if + if (TEMR.le.0.d0) then + print *, 'SOMMERF: T < 0' + stop + end if CMU1=CHI*TEMR ! chemical potential in rel.units CMU=1.d0+CMU1 - call SUBFERMJ(CMU1, - * CJ00,CJ10,CJ20, - * CJ01,CJ11,CJ21, - * CJ02,CJ12,CJ22, - * CJ03,CJ13,CJ23, - * CJ04,CJ14,CJ24,CJ05) + call SUBFERMJ(CMU1, & + CJ00,CJ10,CJ20, & + CJ01,CJ11,CJ21, & + CJ02,CJ12,CJ22, & + CJ03,CJ13,CJ23, & + CJ04,CJ14,CJ24,CJ05) PIT26=(PI*TEMR)**2/6.d0 CN0=dsqrt(.5d0/TEMR)/TEMR CN1=CN0/TEMR @@ -1321,32 +1358,35 @@ subroutine SOMMERF(TEMR,CHI, W0DXT=CN0*(CMU1*CJ02-.5d0*CJ01+PIT26*(CMU1*CJ04+1.5d0*CJ03)) W1DXT=CN1*(CMU1*CJ12-1.5d0*CJ11+PIT26*(CMU1*CJ14+.5d0*CJ13)) W2DXT=CN2*(CMU1*CJ22-2.5d0*CJ21+PIT26*(CMU1*CJ24-.5d0*CJ23)) - W0DTT=CN2*(3.75d0*CJ00-3.d0*CMU1*CJ01+CMU1**2*CJ02+ - + PIT26*(-.25d0*CJ02+CMU1*CJ03+CMU1**2*CJ04)) - W1DTT=CN2/TEMR*(8.75d0*CJ10-5.d0*CMU1*CJ11+CMU1**2*CJ12+ - + PIT26*(.75d0*CJ12-CMU1*CJ13+CMU1**2*CJ14)) - W2DTT=CN2/TEMR**2*(15.75d0*CJ20-7.d0*CMU1*CJ21+CMU1**2*CJ22+ - + PIT26*(3.75d0*CJ22-3.d0*CMU1*CJ23+CMU1**2*CJ24)) + W0DTT=CN2*(3.75d0*CJ00-3.d0*CMU1*CJ01+CMU1**2*CJ02+ & + PIT26*(-.25d0*CJ02+CMU1*CJ03+CMU1**2*CJ04)) + W1DTT=CN2/TEMR*(8.75d0*CJ10-5.d0*CMU1*CJ11+CMU1**2*CJ12+ & + PIT26*(.75d0*CJ12-CMU1*CJ13+CMU1**2*CJ14)) + W2DTT=CN2/TEMR**2*(15.75d0*CJ20-7.d0*CMU1*CJ21+CMU1**2*CJ22+ & + PIT26*(3.75d0*CJ22-3.d0*CMU1*CJ23+CMU1**2*CJ24)) W0XXX=CN0*TEMR**3*(CJ03+PIT26*CJ05) W0XXT=CN0*TEMR*(CMU1*CJ03+.5d0*CJ02+PIT26*(CMU1*CJ05+2.5d0*CJ04)) - W0XTT=CN1*(.75d0*CJ01-CMU1*CJ02+CMU1**2*CJ03+ - + PIT26*(.75d0*CJ03+3.d0*CMU1*CJ04+CMU1**2*CJ05)) + W0XTT=CN1*(.75d0*CJ01-CMU1*CJ02+CMU1**2*CJ03+ & + PIT26*(.75d0*CJ03+3.d0*CMU1*CJ04+CMU1**2*CJ05)) return end - subroutine SUBFERMJ(CMU1, - * CJ00,CJ10,CJ20, - * CJ01,CJ11,CJ21, - * CJ02,CJ12,CJ22, - * CJ03,CJ13,CJ23, - * CJ04,CJ14,CJ24,CJ05) + subroutine SUBFERMJ(CMU1, & + CJ00,CJ10,CJ20, & + CJ01,CJ11,CJ21, & + CJ02,CJ12,CJ22, & + CJ03,CJ13,CJ23, & + CJ04,CJ14,CJ24,CJ05) ! Version 17.11.11 ! corrected 04.03.21 ! Supplement to SOMMERF implicit double precision (A-H), double precision (O-Z) save parameter(EPS=1.d-4) ! inserted 04.03.21 - if (CMU1.le.0.d0) stop'SUBFERMJ: small CHI' + if (CMU1.le.0.d0) then + print *, 'SUBFERMJ: small CHI' + stop + end if CMU=1.d0+CMU1 X0=dsqrt(CMU1*(2.d0+CMU1)) X3=X0**3 @@ -1386,7 +1426,10 @@ subroutine FERMI10(X,XMAX,FP,FM) ! FM = 1-f(x) implicit double precision (A-H), double precision (O-Z) save - if (XMAX.lt.3.d0) stop'FERMI10: XMAX' + if (XMAX.lt.3.d0) then + print *, 'FERMI10: XMAX' + stop + end if if (X.gt.XMAX) then FP=0.d0 FM=1.d0 @@ -1451,8 +1494,8 @@ subroutine EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) A=.610887*A0/A1*T1 ! HF fit of Perrot and Dharma-wardana AH=A0DH/A0-A1DH/A1+T1DH/T1 ADH=A*AH - ADHH=ADH*AH+A*(A0DHH/A0-(A0DH/A0)**2-A1DHH/A1+(A1DH/A1)**2+ - + T1DHH/T1-(T1DH/T1)**2) + ADHH=ADH*AH+A*(A0DHH/A0-(A0DH/A0)**2-A1DHH/A1+(A1DH/A1)**2+ & + T1DHH/T1-(T1DH/T1)**2) B0=.341308+12.070873d0*THETA2+1.148889d0*THETA4 B0DH=24.141746d0*THETA+4.595556d0*THETA3 B0DHH=24.141746d0+13.786668d0*THETA2 @@ -1462,8 +1505,8 @@ subroutine EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) B=SQTH*T2*B0/B1 BH=.5/THETA+T2DH/T2+B0DH/B0-B1DH/B1 BDH=B*BH - BDHH=BDH*BH+B*(-.5/THETA2+T2DHH/T2-(T2DH/T2)**2+ - + B0DHH/B0-(B0DH/B0)**2-B1DHH/B1+(B1DH/B1)**2) + BDHH=BDH*BH+B*(-.5/THETA2+T2DHH/T2-(T2DH/T2)**2+ & + B0DHH/B0-(B0DH/B0)**2-B1DHH/B1+(B1DH/B1)**2) D0=.614925+16.996055d0*THETA2+1.489056*THETA4 D0DH=33.99211d0*THETA+5.956224d0*THETA3 D0DHH=33.99211d0+17.868672d0*THETA2 @@ -1473,8 +1516,8 @@ subroutine EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) D=SQTH*T2*D0/D1 DH=.5/THETA+T2DH/T2+D0DH/D0-D1DH/D1 DDH=D*DH - DDHH=DDH*DH+D*(-.5/THETA2+T2DHH/T2-(T2DH/T2)**2+ - + D0DHH/D0-(D0DH/D0)**2-D1DHH/D1+(D1DH/D1)**2) + DDHH=DDH*DH+D*(-.5/THETA2+T2DHH/T2-(T2DH/T2)**2+ & + D0DHH/D0-(D0DH/D0)**2-D1DHH/D1+(D1DH/D1)**2) E0=.539409+2.522206*THETA2+.178484*THETA4 E0DH=5.044412*THETA+.713936*THETA3 E0DHH=5.044412+2.141808*THETA2 @@ -1484,13 +1527,13 @@ subroutine EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) E=THETA*T1*E0/E1 EH=1./THETA+T1DH/T1+E0DH/E0-E1DH/E1 EDH=E*EH - EDHH=EDH*EH+E*(T1DHH/T1-(T1DH/T1)**2+E0DHH/E0-(E0DH/E0)**2- - - E1DHH/E1+(E1DH/E1)**2-1./THETA2) + EDHH=EDH*EH+E*(T1DHH/T1-(T1DH/T1)**2+E0DHH/E0-(E0DH/E0)**2- & + E1DHH/E1+(E1DH/E1)**2-1./THETA2) EXP1TH=dexp(-1./THETA) C=(.872496+.025248*EXP1TH)*E CDH=.025248*EXP1TH/THETA2*E+C*EDH/E - CDHH=.025248*EXP1TH/THETA2*(EDH+(1.-2.*THETA)/THETA2*E)+ - + CDH*EDH/E+C*EDHH/E-C*(EDH/E)**2 + CDHH=.025248*EXP1TH/THETA2*(EDH+(1.-2.*THETA)/THETA2*E)+ & + CDH*EDH/E+C*EDHH/E-C*(EDH/E)**2 DISCR=dsqrt(4.*E-D**2) DIDH=.5/DISCR*(4.*EDH-2.*D*DDH) DIDHH=(-((2.*EDH-D*DDH)/DISCR)**2+2.*EDHH-DDH**2-D*DDHH)/DISCR @@ -1502,8 +1545,8 @@ subroutine EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) S1DHG=S1DG*(CDH/C-EDH/E) B2=B-C*D/E B2DH=BDH-(CDH*D+C*DDH)/E+C*D*EDH/E**2 - B2DHH=BDHH-(CDHH*D+2.*CDH*DDH+C*DDHH)/E+ - + (2.*(CDH*D+C*DDH-C*D*EDH/E)*EDH+C*D*EDHH)/E**2 + B2DHH=BDHH-(CDHH*D+2.*CDH*DDH+C*DDHH)/E+ & + (2.*(CDH*D+C*DDH-C*D*EDH/E)*EDH+C*D*EDHH)/E**2 SQGE=dsqrt(GAME) S2=-2./E*B2*SQGE S2H=B2DH/B2-EDH/E @@ -1523,21 +1566,21 @@ subroutine EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) B3DHH=ADHH-CDHH/E+(2.*CDH*EDH+C*EDHH)/E**2-2.*C*EDH**2/E**3 C3=(D/E*B2-B3)/E ! =D*B2/E**2-B3/E C3DH=(DDH*B2+D*B2DH+B3*EDH)/E**2-2.*D*B2*EDH/E**3-B3DH/E - C3DHH=(-B3DHH+ - + (DDHH*B2+2.*DDH*B2DH+D*B2DHH+B3DH*EDH+B3*EDHH+B3DH*EDH)/E- - - 2.*((DDH*B2+D*B2DH+B3*EDH+DDH*B2+D*B2DH)*EDH+D*B2*EDHH)/E**2+ - + 6.*D*B2*EDH**2/E**3)/E + C3DHH=(-B3DHH+ & + (DDHH*B2+2.*DDH*B2DH+D*B2DHH+B3DH*EDH+B3*EDHH+B3DH*EDH)/E- & + 2.*((DDH*B2+D*B2DH+B3*EDH+DDH*B2+D*B2DH)*EDH+D*B2*EDHH)/E**2+ & + 6.*D*B2*EDH**2/E**3)/E S3=C3*dlog(R3) S3DH=S3*C3DH/C3+C3*R3DH/R3 - S3DHH=(S3DH*C3DH+S3*C3DHH)/C3-S3*(C3DH/C3)**2+ - + (C3DH*R3DH+C3*R3DHH)/R3-C3*(R3DH/R3)**2 + S3DHH=(S3DH*C3DH+S3*C3DHH)/C3-S3*(C3DH/C3)**2+ & + (C3DH*R3DH+C3*R3DHH)/R3-C3*(R3DH/R3)**2 S3DG=C3*R3DG/R3 S3DGG=C3*(R3DGG/R3-(R3DG/R3)**2) S3DHG=(C3DH*R3DG+C3*R3DHG)/R3-C3*R3DG*R3DH/R3**2 B4=2.-D**2/E B4DH=EDH*(D/E)**2-2.*D*DDH/E - B4DHH=EDHH*(D/E)**2+2.*EDH*(D/E)**2*(DDH/D-EDH/E)- - - 2.*(DDH**2+D*DDHH)/E+2.*D*DDH*EDH/E**2 + B4DHH=EDHH*(D/E)**2+2.*EDH*(D/E)**2*(DDH/D-EDH/E)- & + 2.*(DDH**2+D*DDHH)/E+2.*D*DDH*EDH/E**2 C4=2.*E*SQGE+D C4DH=2.*EDH*SQGE+DDH C4DHH=2.*EDHH*SQGE+DDHH @@ -1547,8 +1590,8 @@ subroutine EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) S4A=2./E/DISCR S4AH=EDH/E+DIDH/DISCR S4ADH=-S4A*S4AH - S4ADHH=-S4ADH*S4AH- - - S4A*(EDHH/E-(EDH/E)**2+DIDHH/DISCR-(DIDH/DISCR)**2) + S4ADHH=-S4ADH*S4AH- & + S4A*(EDHH/E-(EDH/E)**2+DIDHH/DISCR-(DIDH/DISCR)**2) S4B=D*B3+B4*B2 S4BDH=DDH*B3+D*B3DH+B4DH*B2+B4*B2DH S4BDHH=DDHH*B3+2.*DDH*B3DH+D*B3DHH+B4DHH*B2+2.*B4DH*B2DH+B4*B2DHH @@ -1558,17 +1601,17 @@ subroutine EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) UP2=DDH*DISCR-D*DIDH DN2=DISCR**2+D**2 S4CDH=UP1/DN1-UP2/DN2 - S4CDHH=(C4DHH*DISCR-C4*DIDHH)/DN1- - - UP1*2.*(DISCR*DIDH+C4*C4DH)/DN1**2- - - (DDHH*DISCR-D*DIDHH)/DN2+UP2*2.*(DISCR*DIDH+D*DDH)/DN2**2 + S4CDHH=(C4DHH*DISCR-C4*DIDHH)/DN1- & + UP1*2.*(DISCR*DIDH+C4*C4DH)/DN1**2- & + (DDHH*DISCR-D*DIDHH)/DN2+UP2*2.*(DISCR*DIDH+D*DDH)/DN2**2 S4CDG=C4DG*DISCR/DN1 S4CDGG=C4DGG*DISCR/DN1-2.*C4*DISCR*(C4DG/DN1)**2 - S4CDHG=(C4DHG*DISCR+C4DG*DIDH- - - C4DG*DISCR/DN1*2.*(DISCR*DIDH+C4*C4DH))/DN1 + S4CDHG=(C4DHG*DISCR+C4DG*DIDH- & + C4DG*DISCR/DN1*2.*(DISCR*DIDH+C4*C4DH))/DN1 S4=S4A*S4B*S4C S4DH=S4ADH*S4B*S4C+S4A*S4BDH*S4C+S4A*S4B*S4CDH - S4DHH=S4ADHH*S4B*S4C+S4A*S4BDHH*S4C+S4A*S4B*S4CDHH+ - + 2.*(S4ADH*S4BDH*S4C+S4ADH*S4B*S4CDH+S4A*S4BDH*S4CDH) + S4DHH=S4ADHH*S4B*S4C+S4A*S4BDHH*S4C+S4A*S4B*S4CDHH+ & + 2.*(S4ADH*S4BDH*S4C+S4ADH*S4B*S4CDH+S4A*S4BDH*S4CDH) S4DG=S4A*S4B*S4CDG S4DGG=S4A*S4B*S4CDGG S4DHG=S4A*S4B*S4CDHG+S4CDG*(S4ADH*S4B+S4A*S4BDH) @@ -1580,16 +1623,16 @@ subroutine EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) FXCDHG=S1DHG+S2DHG+S3DHG+S4DHG PXC=(GAME*FXCDG-2.*THETA*FXCDH)/3. UXC=GAME*FXCDG-THETA*FXCDH - SXC=(GAME*S2DG-S2+GAME*S3DG-S3+S4A*S4B*(GAME*S4CDG-S4C))- - - THETA*FXCDH + SXC=(GAME*S2DG-S2+GAME*S3DG-S3+S4A*S4B*(GAME*S4CDG-S4C))- & + THETA*FXCDH if (dabs(SXC).lt.EPS*dabs(THETA*FXCDH)) SXC=0. ! accuracy loss CVXC=2.*THETA*(GAME*FXCDHG-FXCDH)-THETA**2*FXCDHH-GAME**2*FXCDGG if (dabs(CVXC).lt.EPS*dabs(GAME**2*FXCDGG)) CVXC=0. ! accuracy PDLH=THETA*(GAME*FXCDHG-2.*FXCDH-2.*THETA*FXCDHH)/3. PDLG=GAME*(FXCDG+GAME*FXCDGG-2.*THETA*FXCDHG)/3. PDRXC=PXC+(PDLG-2.*PDLH)/3. - PDTXC=GAME*(THETA*FXCDHG-GAME*FXCDGG/3.)- - - THETA*(FXCDH/.75+THETA*FXCDHH/1.5) + PDTXC=GAME*(THETA*FXCDHG-GAME*FXCDGG/3.)- & + THETA*(FXCDH/.75+THETA*FXCDHH/1.5) return end @@ -1607,44 +1650,50 @@ subroutine FERINV7(F,N,X,XDF,XDFF) ! Inverse Fermi intergals ! for XDFF: 4.7e-5, 4.8e-5, 2.3e-6, 1.5e-6 implicit double precision (A-H), double precision (O-Z) save - dimension A(0:5,0:3),B(0:6,0:3),C(0:6,0:3),D(0:6,0:3), - * LA(0:3),LB(0:3),LD(0:3) - data A/-1.570044577033d4,1.001958278442d4,-2.805343454951d3, - * 4.121170498099d2,-3.174780572961d1,1.d0, ! X_{-1/2} - * 1.999266880833d4,5.702479099336d3,6.610132843877d2, - * 3.818838129486d1,1.d0,0., ! X_{1/2} - * 1.715627994191d2,1.125926232897d2,2.056296753055d1,1.d0,0.,0., - * 2.138969250409d2,3.539903493971d1,1.d0,0.,0.,0./, ! X_{5/2} - * B/-2.782831558471d4,2.886114034012d4,-1.274243093149d4, - * 3.063252215963d3,-4.225615045074d2,3.168918168284d1, - * -1.008561571363d0, ! X_{-1/2} - * 1.771804140488d4,-2.014785161019d3,9.130355392717d1, - * -1.670718177489d0,0.,0.,0., ! X_{1/2} - * 2.280653583157d2,1.193456203021d2,1.16774311354d1, - * -3.226808804038d-1,3.519268762788d-3,0.,0., ! X_{3/2} - * 7.10854551271d2,9.873746988121d1,1.067755522895d0, - * -1.182798726503d-2,0.,0.,0./, ! X_{5/2} - * C/2.206779160034d-8,-1.437701234283d-6,6.103116850636d-5, - * -1.169411057416d-3,1.814141021608d-2,-9.588603457639d-2,1.d0, - * -1.277060388085d-2,7.187946804945d-2,-4.262314235106d-1, - * 4.997559426872d-1,-1.285579118012d0,-3.930805454272d-1,1.d0, - * -6.321828169799d-3,-2.183147266896d-2,-1.05756279932d-1, - * -4.657944387545d-1,-5.951932864088d-1,3.6844711771d-1,1.d0, - * -3.312041011227d-2,1.315763372315d-1,-4.820942898296d-1, - * 5.099038074944d-1,5.49561349863d-1,-1.498867562255d0,1.d0/, - * D/8.827116613576d-8,-5.750804196059d-6,2.429627688357d-4, - * -4.601959491394d-3,6.932122275919d-2,-3.217372489776d-1, - * 3.124344749296d0, ! X_{-1/2} - * -9.745794806288d-3,5.485432756838d-2,-3.29946624326d-1, - * 4.077841975923d-1,-1.145531476975d0,-6.067091689181d-2,0., - * -4.381942605018d-3,-1.5132365041d-2,-7.850001283886d-2, - * -3.407561772612d-1,-5.074812565486d-1,-1.387107009074d-1,0., - * -2.315515517515d-2,9.198776585252d-2,-3.835879295548d-1, - * 5.415026856351d-1,-3.847241692193d-1,3.739781456585d-2, - * -3.008504449098d-2/, ! X_{5/2} - * LA/5,4,3,2/,LB/6,3,4,3/,LD/6,5,5,6/ - if (N.lt.0.or.N.gt.3) stop'FERINV7: Invalid subscript' - if (F.le.0.) stop'FERINV7: Non-positive argument' + dimension A(0:5,0:3),B(0:6,0:3),C(0:6,0:3),D(0:6,0:3), & + LA(0:3),LB(0:3),LD(0:3) + data A/-1.570044577033d4,1.001958278442d4,-2.805343454951d3, & + 4.121170498099d2,-3.174780572961d1,1.d0, & ! X_{-1/2} + 1.999266880833d4,5.702479099336d3,6.610132843877d2, & + 3.818838129486d1,1.d0,0., & ! X_{1/2} + 1.715627994191d2,1.125926232897d2,2.056296753055d1,1.d0,0.,0., & + 2.138969250409d2,3.539903493971d1,1.d0,0.,0.,0./, & ! X_{5/2} + B/-2.782831558471d4,2.886114034012d4,-1.274243093149d4, & + 3.063252215963d3,-4.225615045074d2,3.168918168284d1, & + -1.008561571363d0, & ! X_{-1/2} + 1.771804140488d4,-2.014785161019d3,9.130355392717d1, & + -1.670718177489d0,0.,0.,0., & ! X_{1/2} + 2.280653583157d2,1.193456203021d2,1.16774311354d1, & + -3.226808804038d-1,3.519268762788d-3,0.,0., & ! X_{3/2} + 7.10854551271d2,9.873746988121d1,1.067755522895d0, & + -1.182798726503d-2,0.,0.,0./, & ! X_{5/2} + C/2.206779160034d-8,-1.437701234283d-6,6.103116850636d-5, & + -1.169411057416d-3,1.814141021608d-2,-9.588603457639d-2,1.d0, & + -1.277060388085d-2,7.187946804945d-2,-4.262314235106d-1, & + 4.997559426872d-1,-1.285579118012d0,-3.930805454272d-1,1.d0, & + -6.321828169799d-3,-2.183147266896d-2,-1.05756279932d-1, & + -4.657944387545d-1,-5.951932864088d-1,3.6844711771d-1,1.d0, & + -3.312041011227d-2,1.315763372315d-1,-4.820942898296d-1, & + 5.099038074944d-1,5.49561349863d-1,-1.498867562255d0,1.d0/, & + D/8.827116613576d-8,-5.750804196059d-6,2.429627688357d-4, & + -4.601959491394d-3,6.932122275919d-2,-3.217372489776d-1,& + 3.124344749296d0, & ! X_{-1/2} + -9.745794806288d-3,5.485432756838d-2,-3.29946624326d-1, & + 4.077841975923d-1,-1.145531476975d0,-6.067091689181d-2,0., & + -4.381942605018d-3,-1.5132365041d-2,-7.850001283886d-2, & + -3.407561772612d-1,-5.074812565486d-1,-1.387107009074d-1,0., & + -2.315515517515d-2,9.198776585252d-2,-3.835879295548d-1, & + 5.415026856351d-1,-3.847241692193d-1,3.739781456585d-2, & + -3.008504449098d-2/, & ! X_{5/2} + LA/5,4,3,2/,LB/6,3,4,3/,LD/6,5,5,6/ + if (N.lt.0.or.N.gt.3) then + print *, 'FERINV7: Invalid subscript' + stop + end if + if (F.le.0.) then + print *, 'FERINV7: Non-positive argument' + stop + end if if (F.lt.4.) then T=F UP=0. @@ -1689,8 +1738,8 @@ subroutine FERINV7(F,N,X,XDF,XDFF) ! Inverse Fermi intergals enddo R=UP/DOWN R1=(UP1-UP*DOWN1/DOWN)/DOWN ! dR/dt - R2=(UP2-(2.*UP1*DOWN1+UP*DOWN2)/DOWN+2.*UP*(DOWN1/DOWN)**2)/ - / DOWN + R2=(UP2-(2.*UP1*DOWN1+UP*DOWN2)/DOWN+2.*UP*(DOWN1/DOWN)**2)/ & + DOWN X=R/T RT=(R1-R/T)/T XDF=T1*RT @@ -1699,11 +1748,11 @@ subroutine FERINV7(F,N,X,XDF,XDFF) ! Inverse Fermi intergals return end - subroutine BLIN9(TEMP,CHI, - * W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, - * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, - * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, - * W0XXX,W0XTT,W0XXT) + subroutine BLIN9(TEMP,CHI, & + W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & + W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & + W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & + W0XXX,W0XTT,W0XXT) ! Version 21.01.10 ! Stems from BLIN8 v.24.12.08 ! Difference - smooth matching of different CHI ranges @@ -1721,36 +1770,36 @@ subroutine BLIN9(TEMP,CHI, X1=(CHI-CHI1)*XSCAL1 X2=(CHI-CHI2)*XSCAL2 if (X1.lt.-XMAX) then - call BLIN9a(TEMP,CHI, - * W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, - * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, - * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, - * W0XXX,W0XTT,W0XXT) + call BLIN9a(TEMP,CHI, & + W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & + W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & + W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & + W0XXX,W0XTT,W0XXT) elseif (X2.lt.XMAX) then ! match two fits if (X1.lt.XMAX) then ! match fits "a" and "b" call FERMI10(X1,XMAX,FP,FM) - call BLIN9a(TEMP,CHI, - * W0a,W0DXa,W0DTa,W0DXXa,W0DTTa,W0DXTa, - * W1a,W1DXa,W1DTa,W1DXXa,W1DTTa,W1DXTa, - * W2a,W2DXa,W2DTa,W2DXXa,W2DTTa,W2DXTa, - * W0XXXa,W0XTTa,W0XXTa) - call BLIN9b(TEMP,CHI, - * W0b,W0DXb,W0DTb,W0DXXb,W0DTTb,W0DXTb, - * W1b,W1DXb,W1DTb,W1DXXb,W1DTTb,W1DXTb, - * W2b,W2DXb,W2DTb,W2DXXb,W2DTTb,W2DXTb, - * W0XXXb,W0XTTb,W0XXTb) + call BLIN9a(TEMP,CHI, & + W0a,W0DXa,W0DTa,W0DXXa,W0DTTa,W0DXTa, & + W1a,W1DXa,W1DTa,W1DXXa,W1DTTa,W1DXTa, & + W2a,W2DXa,W2DTa,W2DXXa,W2DTTa,W2DXTa, & + W0XXXa,W0XTTa,W0XXTa) + call BLIN9b(TEMP,CHI, & + W0b,W0DXb,W0DTb,W0DXXb,W0DTTb,W0DXTb, & + W1b,W1DXb,W1DTb,W1DXXb,W1DTTb,W1DXTb, & + W2b,W2DXb,W2DTb,W2DXXb,W2DTTb,W2DXTb, & + W0XXXb,W0XTTb,W0XXTb) else ! match fits "b" and "c" call FERMI10(X2,XMAX,FP,FM) - call BLIN9b(TEMP,CHI, - * W0a,W0DXa,W0DTa,W0DXXa,W0DTTa,W0DXTa, - * W1a,W1DXa,W1DTa,W1DXXa,W1DTTa,W1DXTa, - * W2a,W2DXa,W2DTa,W2DXXa,W2DTTa,W2DXTa, - * W0XXXa,W0XTTa,W0XXTa) - call BLIN9c(TEMP,CHI, - * W0b,W0DXb,W0DTb,W0DXXb,W0DTTb,W0DXTb, - * W1b,W1DXb,W1DTb,W1DXXb,W1DTTb,W1DXTb, - * W2b,W2DXb,W2DTb,W2DXXb,W2DTTb,W2DXTb, - * W0XXXb,W0XTTb,W0XXTb) + call BLIN9b(TEMP,CHI, & + W0a,W0DXa,W0DTa,W0DXXa,W0DTTa,W0DXTa, & + W1a,W1DXa,W1DTa,W1DXXa,W1DTTa,W1DXTa, & + W2a,W2DXa,W2DTa,W2DXXa,W2DTTa,W2DXTa, & + W0XXXa,W0XTTa,W0XXTa) + call BLIN9c(TEMP,CHI, & + W0b,W0DXb,W0DTb,W0DXXb,W0DTTb,W0DXTb, & + W1b,W1DXb,W1DTb,W1DXXb,W1DTTb,W1DXTb, & + W2b,W2DXb,W2DTb,W2DXXb,W2DTTb,W2DXTb, & + W0XXXb,W0XTTb,W0XXTb) endif W0=W0a*FP+W0b*FM W0DX=W0DXa*FP+W0DXb*FM !! +(W0a-W0b)*F1 @@ -1774,37 +1823,37 @@ subroutine BLIN9(TEMP,CHI, W2DTT=W2DTTa*FP+W2DTTb*FM W2DXT=W2DXTa*FP+W2DXTb*FM !! else - call BLIN9c(TEMP,CHI, - * W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, - * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, - * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, - * W0XXX,W0XTT,W0XXT) + call BLIN9c(TEMP,CHI, & + W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & + W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & + W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & + W0XXX,W0XTT,W0XXT) endif return end - subroutine BLIN9a(TEMP,CHI, - * W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, - * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, - * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, - * W0XXX,W0XTT,W0XXT) + subroutine BLIN9a(TEMP,CHI, & + W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & + W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & + W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & + W0XXX,W0XTT,W0XXT) ! Version 19.01.10 ! First part of BILN9: small CHI. Stems from BLIN9 v.24.12.08 implicit double precision (A-H), double precision (O-Z) save dimension AC(5,0:2),AU(5,0:2),AA(5,0:2) - data AC/.37045057 d0, .41258437 d0, - & 9.777982 d-2, 5.3734153 d-3, 3.8746281 d-5, ! c_i^0 - & .39603109 d0, .69468795 d0, - & .22322760 d0, 1.5262934 d-2, 1.3081939 d-4, ! c_i^1 - & .76934619 d0, 1.7891437 d0, - & .70754974 d0, 5.6755672 d-2, 5.5571480 d-4/ ! c_i^2 - data AU/.43139881 d0, 1.7597537 d0, - & 4.1044654 d0, 7.7467038 d0, 13.457678 d0, ! \chi_i^0 - & .81763176 d0, 2.4723339 d0, - & 5.1160061 d0, 9.0441465 d0, 15.049882 d0, ! \chi_i^1 - & 1.2558461 d0, 3.2070406 d0, - & 6.1239082 d0, 10.316126 d0, 16.597079 d0/ ! \chi_i^2 + data AC/.37045057d0, .41258437d0, & + 9.777982d-2, 5.3734153d-3, 3.8746281d-5, & ! c_i^0 + .39603109d0, .69468795d0, & + .22322760d0, 1.5262934d-2, 1.3081939d-4, & ! c_i^1 + .76934619d0, 1.7891437d0, & + .70754974d0, 5.6755672d-2, 5.5571480d-4/ ! c_i^2 + data AU/.43139881d0, 1.7597537d0, & + 4.1044654d0, 7.7467038d0, 13.457678d0, & ! \chi_i^0 + .81763176d0, 2.4723339d0, & + 5.1160061d0, 9.0441465d0, 15.049882d0, & ! \chi_i^1 + 1.2558461d0, 3.2070406d0, & + 6.1239082d0, 10.316126d0, 16.597079d0/ ! \chi_i^2 data KRUN/0/ KRUN=KRUN+1 if (KRUN.eq.1) then ! initialize @@ -1834,8 +1883,8 @@ subroutine BLIN9a(TEMP,CHI, WDXX=WDXX+AC(I,K)*SQ*(ECHI-AA(I,K))/DN**3 WDTT=WDTT-AC(I,K)*AU(I,K)**2/(DN*SQ**3) WDXT=WDXT+AC(I,K)*AU(I,K)/(SQ*DN**2) - WDXXX=WDXXX+AC(I,K)*SQ* - * (ECHI**2-4.*ECHI*AA(I,K)+AA(I,K)**2)/DN**4 + WDXXX=WDXXX+AC(I,K)*SQ* & + (ECHI**2-4.*ECHI*AA(I,K)+AA(I,K)**2)/DN**4 WDXTT=WDXTT-AC(I,K)*AU(I,K)**2/(DN**2*SQ**3) WDXXT=WDXXT+AC(I,K)*AU(I,K)*(ECHI-AA(I,K))/(SQ*DN**3) enddo @@ -1876,11 +1925,11 @@ subroutine BLIN9a(TEMP,CHI, return end - subroutine BLIN9b(TEMP,CHI, - * W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, - * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, - * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, - * W0XXX,W0XTT,W0XXT) + subroutine BLIN9b(TEMP,CHI, & + W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & + W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & + W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & + W0XXX,W0XTT,W0XXT) ! Version 19.01.10 ! Small syntax fix 15.03.13 ! Second part of BILN9: intermediate CHI. Stems from BLIN8 v.24.12.08 @@ -1888,15 +1937,18 @@ subroutine BLIN9b(TEMP,CHI, save dimension AX(5),AXI(5),AH(5),AV(5) parameter (EPS=1.d-3) - data AX/7.265351 d-2, .2694608 d0, - & .533122 d0, .7868801 d0, .9569313 d0/ ! x_i - data AXI/.26356032 d0, 1.4134031 d0, - & 3.5964258 d0, 7.0858100 d0, 12.640801 d0/ ! \xi_i - data AH/3.818735 d-2, .1256732 d0, - & .1986308 d0, .1976334 d0, .1065420 d0/ ! H_i - data AV/.29505869 d0, .32064856 d0, 7.3915570 d-2, - & 3.6087389 d-3, 2.3369894 d-5/ ! \bar{V}_i - if (CHI.lt.EPS) stop'BLIN9b: CHI is too small' + data AX/7.265351d-2, .2694608d0, & + .533122d0, .7868801d0, .9569313d0/ ! x_i + data AXI/.26356032d0, 1.4134031d0, & + 3.5964258d0, 7.0858100d0, 12.640801d0/ ! \xi_i + data AH/3.818735d-2, .1256732d0, & + .1986308d0, .1976334d0, .1065420d0/ ! H_i + data AV/.29505869d0, .32064856d0, 7.3915570d-2, & + 3.6087389d-3, 2.3369894d-5/ ! \bar{V}_i + if (CHI.lt.EPS) then + print *, 'BLIN9b: CHI is too small' + stop + end if do K=0,2 W=0. WDX=0. @@ -1923,12 +1975,12 @@ subroutine BLIN9b(TEMP,CHI, HDTT=-H*HT**2 HTX=1./CHI-.5*AX(I)*TEMP/D HDXT=HDX*HT+HDT*HTX - HDXXT=HDXX*HT+HDX*HT*HTX+HDXT*HTX+ - + HDT*(.25*(AX(I)*TEMP/D)**2-1./CHI**2) - HDXTT=HDXT*HT-HDX*.125*(AX(I)*CHI/D)**2+HDTT*HTX+ - + HDT*.5*AX(I)*(TEMP*.5*AX(I)*CHI/D**2-1./D) - HXXX=(2*K+3)/CHI**3+.125*(AX(I)*TEMP/D)**3- - - ECHI*(1.d0-ECHI)*(CE/DE)**3 + HDXXT=HDXX*HT+HDX*HT*HTX+HDXT*HTX+ & + HDT*(.25*(AX(I)*TEMP/D)**2-1./CHI**2) + HDXTT=HDXT*HT-HDX*.125*(AX(I)*CHI/D)**2+HDTT*HTX+ & + HDT*.5*AX(I)*(TEMP*.5*AX(I)*CHI/D**2-1./D) + HXXX=(2*K+3)/CHI**3+.125*(AX(I)*TEMP/D)**3- & + ECHI*(1.d0-ECHI)*(CE/DE)**3 HDXXX=HDXX*HX-2.*HDX*HXX+H*HXXX XICHI=AXI(I)+CHI DXI=1.d0+XICHI*TEMP/2. @@ -1939,15 +1991,15 @@ subroutine BLIN9b(TEMP,CHI, VDT=V*VT VXX=(K+.5)/XICHI**2+.125*(TEMP/DXI)**2 VDXX=VDX*VX-V*VXX - VDXXX=VDXX*VX-2.*VDX*VXX+ - + V*((2*K+1)/XICHI**3+.125*(TEMP/DXI)**3) + VDXXX=VDXX*VX-2.*VDX*VXX+ & + V*((2*K+1)/XICHI**3+.125*(TEMP/DXI)**3) VXXT=(1.-.5*TEMP*XICHI/DXI)/DXI VDTT=-V*VT**2 VXT=1./XICHI-.5*TEMP/DXI VDXT=VDT*VXT+VDX*VT VDXXT=VDXT*VX+VDX*.25*VXXT-VDT*VXX-V*.25*TEMP/DXI*VXXT - VDXTT=VDTT*VXT-VDT*.5*VXXT+VDXT*VT- - - VDX*.125*(XICHI/DXI)**2 + VDXTT=VDTT*VXT-VDT*.5*VXXT+VDXT*VT- & + VDX*.125*(XICHI/DXI)**2 W=W+AH(I)*AX(I)**K*H+AV(I)*V WDX=WDX+AH(I)*AX(I)**K*HDX+AV(I)*VDX WDT=WDT+AH(I)*AX(I)**K*HDT+AV(I)*VDT @@ -1987,18 +2039,18 @@ subroutine BLIN9b(TEMP,CHI, return end - subroutine BLIN9c(TEMP,CHI, - * W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, - * W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, - * W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, - * W0XXX,W0XTT,W0XXT) + subroutine BLIN9c(TEMP,CHI, & + W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & + W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & + W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & + W0XXX,W0XTT,W0XXT) ! Version 19.01.10 ! Third part of BILN9: large CHI. Stems from BLIN8 v.24.12.08 implicit double precision (A-H), double precision (O-Z) save parameter (PI=3.141592653d0,PI26=PI*PI/6.) - dimension AM(0:2),AMDX(0:2),AMDT(0:2), - * AMDXX(0:2),AMDTT(0:2),AMDXT(0:2) + dimension AM(0:2),AMDX(0:2),AMDT(0:2), & + AMDXX(0:2),AMDTT(0:2),AMDXT(0:2) if (CHI*TEMP.lt..1) then do K=0,2 W=0. @@ -2013,15 +2065,15 @@ subroutine BLIN9c(TEMP,CHI, do J=0,4 ! for nonrel.Fermi integrals from k+1/2 to k+4.5 CNU=K+J+.5 ! nonrelativistic Fermi integral index \nu CHINU=CHI**(K+J)*dsqrt(CHI) ! \chi^\nu - F=CHINU*(CHI/(CNU+1.)+PI26*CNU/CHI+ ! nonrel.Fermi - + .7*PI26**2*CNU*(CNU-1.)*(CNU-2.)/CHI**3) - FDX=CHINU*(1.+PI26*CNU*(CNU-1.)/CHI**2+ - + .7*PI26**2*CNU*(CNU-1.)*(CNU-2.)*(CNU-3.)/CHI**4) - FDXX=CHINU/CHI*CNU*(1.+PI26*(CNU-1.)*(CNU-2.)/CHI**2+ - + .7*PI26**2*(CNU-1.)*(CNU-2.)*(CNU-3.)*(CNU-4.)/CHI**4) - FDXXX=CHINU/CHI**2*CNU*(CNU-1.)* - * (1.+PI26*(CNU-2.)*(CNU-3.)/CHI**2+ - + .7*PI26**2*(CNU-2.)*(CNU-3.)*(CNU-4.)*(CNU-5.)/CHI**4) + F=CHINU*(CHI/(CNU+1.)+PI26*CNU/CHI+ & ! nonrel.Fermi + .7*PI26**2*CNU*(CNU-1.)*(CNU-2.)/CHI**3) + FDX=CHINU*(1.+PI26*CNU*(CNU-1.)/CHI**2+ & + .7*PI26**2*CNU*(CNU-1.)*(CNU-2.)*(CNU-3.)/CHI**4) + FDXX=CHINU/CHI*CNU*(1.+PI26*(CNU-1.)*(CNU-2.)/CHI**2+ & + .7*PI26**2*(CNU-1.)*(CNU-2.)*(CNU-3.)*(CNU-4.)/CHI**4) + FDXXX=CHINU/CHI**2*CNU*(CNU-1.)* & + (1.+PI26*(CNU-2.)*(CNU-3.)/CHI**2+ & + .7*PI26**2*(CNU-2.)*(CNU-3.)*(CNU-4.)*(CNU-5.)/CHI**4) if (J.eq.0) then W=F WDX=FDX @@ -2111,8 +2163,8 @@ subroutine BLIN9c(TEMP,CHI, AMDXX(K)=AMDX(K)*FMX+AM(K)*FMXX FMTT=2.d0*FMT2**2-FMT1**2 AMDTT(K)=AMDT(K)*FMT+AM(K)*FMTT - AMDXT(K)=AMDX(K)*FMT+AM(K)*(CKM*(1.d0-CKM*CHI*TEMP)- - - .25d0/D+.125d0*CHI*TEMP/D**2) + AMDXT(K)=AMDX(K)*FMT+AM(K)*(CKM*(1.d0-CKM*CHI*TEMP)- & + .25d0/D+.125d0*CHI*TEMP/D**2) if (K.eq.0) then FMXXX=(2*K-1)/CHI**3+2.d0*FMX1**3-8.d0*FMX2**3 AMDXXX=AMDXX(K)*FMX+2.d0*AMDX(K)*FMXX+AM(K)*FMXXX @@ -2142,25 +2194,25 @@ subroutine BLIN9c(TEMP,CHI, ASQ3=A*SQ2T**3 ASQ3DX=ADX*SQ2T**3 FJ0DX=.5d0*(R+XT1*RDX)-ADX/ASQ3 - FJ0DT=.5d0*(XT1*RDT-R/TEMP**2)-ADT/ASQ3+ - + .75d0/(TEMP**2*SQ2T)*Aln + FJ0DT=.5d0*(XT1*RDT-R/TEMP**2)-ADT/ASQ3+ & + .75d0/(TEMP**2*SQ2T)*Aln FJ0DXX=RDX+.5d0*XT1*RDXX+(ADX/A)**2/SQ2T**3-ADXX/ASQ3 - FJ0DTT=R/TEMP**3-RDT/TEMP**2+.5d0*XT1*RDTT+ - + 3.d0/(ASQ3*TEMP)*ADT+ - + (ADT/A)**2/SQ2T**3-ADTT/ASQ3-1.875d0/(TEMP**3*SQ2T)*Aln + FJ0DTT=R/TEMP**3-RDT/TEMP**2+.5d0*XT1*RDTT+ & + 3.d0/(ASQ3*TEMP)*ADT+ & + (ADT/A)**2/SQ2T**3-ADTT/ASQ3-1.875d0/(TEMP**3*SQ2T)*Aln BXT=1.5d0/TEMP*ADX+ADX*ADT/A-ADXT - BXXT=1.5d0/TEMP*ADXX+(ADXX*ADT+ADX*ADXT)/A- - - (ADX/A)**2*ADT-ADXXT + BXXT=1.5d0/TEMP*ADXX+(ADXX*ADT+ADX*ADXT)/A- & + (ADX/A)**2*ADT-ADXXT FJ0DXT=.5d0*(RDT-RDX/TEMP**2+XT1*RDXT)+BXT/ASQ3 - FJ0XXX=RDXX*1.5d0+.5d0*XT1*RDXXX+ - + (2.d0*ADX*(ADXX/A-(ADX/A)**2)- - - SQ2T*RDXXX+ADXX/ASQ3*ASQ3DX)/ASQ3 - FJ0XTT=RDX/TEMP**3-RDXT/TEMP**2+.5d0*(RDTT+XT1*RDXTT)+ - + 3.d0/TEMP*(ADXT-ADT/ASQ3*ASQ3DX)/ASQ3+ - + (2.d0*ADT*(ADXT/A-ADT*ADX/A**2)- - - ADXTT+ADTT*ASQ3DX/ASQ3)/ASQ3-1.875d0/(TEMP**3*SQ2T)*ADX/A - FJ0XXT=.5d0*(RDXT-RDXX/TEMP**2+RDXT+XT1*RDXXT)+ - + (BXXT-BXT*ASQ3DX/ASQ3)/ASQ3 + FJ0XXX=RDXX*1.5d0+.5d0*XT1*RDXXX+ & + (2.d0*ADX*(ADXX/A-(ADX/A)**2)- & + SQ2T*RDXXX+ADXX/ASQ3*ASQ3DX)/ASQ3 + FJ0XTT=RDX/TEMP**3-RDXT/TEMP**2+.5d0*(RDTT+XT1*RDXTT)+ & + 3.d0/TEMP*(ADXT-ADT/ASQ3*ASQ3DX)/ASQ3+ & + (2.d0*ADT*(ADXT/A-ADT*ADX/A**2)- & + ADXTT+ADTT*ASQ3DX/ASQ3)/ASQ3-1.875d0/(TEMP**3*SQ2T)*ADX/A + FJ0XXT=.5d0*(RDXT-RDXX/TEMP**2+RDXT+XT1*RDXXT)+ & + (BXXT-BXT*ASQ3DX/ASQ3)/ASQ3 W0=FJ0+PI26*AM(0) W0DX=FJ0DX+PI26*AMDX(0) W0DT=FJ0DT+PI26*AMDT(0) @@ -2185,12 +2237,12 @@ subroutine BLIN9c(TEMP,CHI, FJ2=(.5d0*CHI*R**3-1.25d0*FJ1)/TEMP FJ2DX=(.5d0*R**3+1.5d0*CHI*R**2*RDX-1.25d0*FJ1DX)/TEMP FJ2DT=(1.5d0*CHI*R**2*RDT-1.25d0*FJ1DT-FJ2)/TEMP - FJ2DXX=(3.d0*R*RDX*(R+CHI*RDX)+1.5d0*CHI*R**2*RDXX- - - 1.25d0*FJ1DXX)/TEMP - FJ2DTT=(3.d0*CHI*R*(RDT**2+.5d0*R*RDTT)- - - 1.25d0*FJ1DTT-2.d0*FJ2DT)/TEMP - FJ2DXT=(1.5d0*R*RDT*(R+2.d0*CHI*RDX)+1.5d0*CHI*R**2*RDXT- - - 1.25d0*FJ1DXT-FJ2DX)/TEMP + FJ2DXX=(3.d0*R*RDX*(R+CHI*RDX)+1.5d0*CHI*R**2*RDXX- & + 1.25d0*FJ1DXX)/TEMP + FJ2DTT=(3.d0*CHI*R*(RDT**2+.5d0*R*RDTT)- & + 1.25d0*FJ1DTT-2.d0*FJ2DT)/TEMP + FJ2DXT=(1.5d0*R*RDT*(R+2.d0*CHI*RDX)+1.5d0*CHI*R**2*RDXT- & + 1.25d0*FJ1DXT-FJ2DX)/TEMP W2=FJ2+PI26*AM(2) W2DX=FJ2DX+PI26*AMDX(2) W2DT=FJ2DT+PI26*AMDT(2) @@ -2215,8 +2267,8 @@ subroutine CHEMFIT(DENS,TEMP,CHI) return end - subroutine CHEMFIT7(DENR,TEMR,CHI,CMU1,KDERIV, - * CMUDENR,CMUDT,CMUDTT) + subroutine CHEMFIT7(DENR,TEMR,CHI,CMU1,KDERIV, & + CMUDENR,CMUDT,CMUDTT) ! Version 29.08.15 ! Fit to the chemical potential of free electron gas described in: ! G.Chabrier & A.Y.Potekhin, Phys.Rev.E 58, 4941 (1998) @@ -2231,8 +2283,8 @@ subroutine CHEMFIT7(DENR,TEMR,CHI,CMU1,KDERIV, ! CMUDENR,CMUDT, and CMUDTT =0 on output, if KREDIV=0 implicit double precision (A-H), double precision (O-Z) save - parameter (C13=1.d0/3.d0,PARA=1.612d0,PARB=6.192d0,PARC=.0944d0, - * PARF=5.535d0,PARG=.698d0) + parameter (C13=1.d0/3.d0,PARA=1.612d0,PARB=6.192d0,PARC=.0944d0, & + PARF=5.535d0,PARG=.698d0) parameter(XEPST=228.d0) ! the largest argument of e^{-X} PF0=(29.6088132d0*DENR)**C13 ! Classical Fermi momentum if (PF0.gt.1.d-4) then @@ -2261,8 +2313,8 @@ subroutine CHEMFIT7(DENR,TEMR,CHI,CMU1,KDERIV, CT=1.d0+G/H F=2.d0*C13/THETA32 call FERINV7(F,1,X,XDF,XDFF) - CHI=X ! non-relativistic result - - - 1.5d0*dlog(CT) ! Relativistic fit + CHI=X & ! non-relativistic result + - 1.5d0*dlog(CT) ! Relativistic fit CMU1=TEMR*CHI ! Fit to chemical potential w/o mc^2 if (KDERIV.eq.0) then ! DISMISS DERIVATIVES CMUDENR=0. @@ -2288,8 +2340,8 @@ subroutine CHEMFIT7(DENR,TEMR,CHI,CMU1,KDERIV, Q2DD=30.d0/(THETA52*THETA) ! d^2 q_2 / d \theta^2 U3D=-2.d0*T1**2 D3D=PARF*PARG*THETAG/THETA+PARB*T1**2*THETAC*(PARC/THETA-2.d0) - D3DD=PARF*PARG*(PARG-1.d0)*THETAG/THETA**2+ - +PARB*T1**2*THETAC*(PARC*(PARC-1.d0)/THETA**2-4.d0*PARC/THETA+4.d0) + D3DD=PARF*PARG*(PARG-1.d0)*THETAG/THETA**2+ & + PARB*T1**2*THETAC*(PARC*(PARC-1.d0)/THETA**2-4.d0*PARC/THETA+4.d0) Q3D=(D3D*U3/D3-U3D)/D3 Q3DD=(2.d0*U3D+(2.d0*U3D*D3D+U3*D3DD)/D3-2.d0*U3*(D3D/D3)**2)/D3 GDY=TEMR*(Q1D*SQT+(Q2D*Q3+Q2*Q3D)*TEMR) ! dG/d\theta @@ -2299,8 +2351,8 @@ subroutine CHEMFIT7(DENR,TEMR,CHI,CMU1,KDERIV, GDYT=1.5d0*Q1D*SQT+2.d0*(Q2D*Q3+Q2*Q3D)*TEMR HDY=(-.5d0/THETA**2+Q2D+.5d0*(Q2D-Q2/THETA)/THETA*TEMR)*TEMR HDT=(.5d0+Q2*TEMR)/THETA+Q2 - HDYY=TEMR/THETA**3+Q2DD*TEMR+ - + TEMR**2*(.5d0*Q2DD-Q2D/THETA+Q2/THETA**2)/THETA + HDYY=TEMR/THETA**3+Q2DD*TEMR+ & + TEMR**2*(.5d0*Q2DD-Q2D/THETA+Q2/THETA**2)/THETA HDTT=Q2/THETA HDYT=Q2D*(1.d0+TEMR/THETA)-(.5d0+Q2*TEMR)/THETA**2 CTY=GDY/G-HDY/H @@ -2318,7 +2370,7 @@ subroutine CHEMFIT7(DENR,TEMR,CHI,CMU1,KDERIV, CHIDYT=1.5d0*(CTDY*CTDT/CT**2-CTDYT/CT) CMUDENR=-(THETA*PF0)**2/(3.d0*DENR*(1.d0+TF))*CHIDY CMUDT=CHI+THETA*CHIDY+TEMR*CHIDT - CMUDTT=2.d0*(CHIDY/TF+CHIDT+THETA*CHIDYT)+ - + THETA/TF*CHIDYY+TEMR*CHIDTT + CMUDTT=2.d0*(CHIDY/TF+CHIDT+THETA*CHIDYT)+ & + THETA/TF*CHIDYY+TEMR*CHIDTT return end From b359f64716ed7829e46674f91a14e7b83560fc8d Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 09:12:09 -0700 Subject: [PATCH 15/70] F90 --- EOS/pc/{eos17.f => eos17.f90} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename EOS/pc/{eos17.f => eos17.f90} (100%) diff --git a/EOS/pc/eos17.f b/EOS/pc/eos17.f90 similarity index 100% rename from EOS/pc/eos17.f rename to EOS/pc/eos17.f90 From c223422c4318734abfc9938ad6a59238026600cf Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 09:20:19 -0700 Subject: [PATCH 16/70] No more goto --- EOS/pc/eos17.f90 | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index ddc2016d05..7921e797e5 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -356,7 +356,7 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, & CTP=4.d0*PI/AUM/TEMP**2 ! common coefficient for TPT2.10.12.14 ! Add Coulomb+xc nonideal contributions, and ideal free energy: do IX=1,NMIX - if (AY(IX).lt.TINY) goto 10 ! skip this species + if (AY(IX).ge.TINY) then Zion=AZion(IX) CMI=ACMI(IX) GAMI=Zion**C53*GAME ! Gamma_i for given ion species @@ -374,7 +374,7 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, & PDLT=PDLT+PRI*PDT2 ! d P / d ln T PDLR=PDLR+PRI*PDR2 ! d P / d ln\rho TPT2=TPT2+CTP*DNI/ACMI(IX)*AZion(IX)**2 ! opt.10.12.14 - 10 continue + end if enddo ! next IX ! Wigner-Kirkwood perturbative correction for liquid: TPT=dsqrt(TPT2) ! effective T_p/T - ion quantum parameter @@ -404,14 +404,17 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, & RZ=AZion(J)/AZion(I) X2=AY(J)/(AY(I)+AY(J)) X1=dim(1.d0,X2) - if (X1.lt.TINY) goto 11 ! 27.01.19 - if (X2.lt.TINY) goto 11 + if (X1.lt.TINY) then + cycle ! 27.01.19 + end if + if (X2.lt.TINY) then + cycle + end if X=X2/RZ+(1.d0-1.d0/RZ)*X2**RZ GAMI=AZion(I)**C53*GAME ! Gamma_i corrected 14.05.13 DeltaG=.012*(1.d0-1.d0/RZ**2)*(X1+X2*RZ**C53) DeltaG=DeltaG*X/X2*dim(1.d0,X)/X1 FMIX=FMIX+AY(I)*AY(J)*GAMI*DeltaG - 11 continue enddo enddo UMIX=FMIX @@ -1008,7 +1011,8 @@ subroutine HLfit12(eta,F,U,CV,S,U1,CW,LATTICE) U=3./(C11*eta**3) F=-U/3. CV=4.*U - goto 50 + S=U-F + return elseif (eta.lt.EPS) then ! Eq.(17) of BPY'01 if (eta.lt.TINY) then print *, 'HLfit: eta is too small' @@ -1017,7 +1021,8 @@ subroutine HLfit12(eta,F,U,CV,S,U1,CW,LATTICE) F=3.*dlog(eta)+CLM-1.5*U1*eta+eta**2/24. U=3.-1.5*U1*eta+eta**2/12. CV=3.-eta**2/12. - goto 50 + S=U-F + return endif eta2=eta**2 eta3=eta2*eta @@ -1058,7 +1063,6 @@ subroutine HLfit12(eta,F,U,CV,S,U1,CW,LATTICE) UP3/DN-(3.*UP2*DN1+3.*UP1*DN2+UP*DN3)/DN**2+ & 6.*DN1*(UP1*DN1+UP*DN2)/DN**3-6.*UP*DN1**3/DN**4 ! -d3f/d\eta^3 CW=-2.*CV-eta3*DF3 - 50 continue S=U-F return end From d5e56d17a48f267a850cfac2752e3af75f72a466 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 09:21:48 -0700 Subject: [PATCH 17/70] Add makefile --- EOS/pc/Makefile | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 EOS/pc/Makefile diff --git a/EOS/pc/Makefile b/EOS/pc/Makefile new file mode 100644 index 0000000000..1a3a43384e --- /dev/null +++ b/EOS/pc/Makefile @@ -0,0 +1,6 @@ +test: eos17.f90 + gfortran -o test eos17.f90 + +run: + ./test + From fddabac1891e5903b952583a6ae3c5e417190573 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 09:32:21 -0700 Subject: [PATCH 18/70] Implicit none --- EOS/pc/eos17.f90 | 25 +++++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 7921e797e5..954028784c 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -2285,11 +2285,28 @@ subroutine CHEMFIT7(DENR,TEMR,CHI,CMU1,KDERIV, & ! CMUDT = (d\mu/dT)_V ! CMUDTT = (d^2\mu/dT^2)_V ! CMUDENR,CMUDT, and CMUDTT =0 on output, if KREDIV=0 - implicit double precision (A-H), double precision (O-Z) + implicit none + double precision, intent(in) :: DENR, TEMR + integer, intent(in) :: KDERIV + double precision, intent(inout) :: CHI, CMU1, CMUDENR, CMUDT, CMUDTT save - parameter (C13=1.d0/3.d0,PARA=1.612d0,PARB=6.192d0,PARC=.0944d0, & - PARF=5.535d0,PARG=.698d0) - parameter(XEPST=228.d0) ! the largest argument of e^{-X} + double precision, parameter :: C13 = 1.d0 / 3.d0 + double precision, parameter :: PARA = 1.612d0 + double precision, parameter :: PARB = 6.192d0 + double precision, parameter :: PARC = .0944d0 + double precision, parameter :: PARF=5.535d0 + double precision, parameter :: PARG=.698d0 + double precision, parameter :: XEPST = 228.d0 ! the largest argument of e^{-X} + + double precision :: PF0, TF, THETA, THETA32, Q2, T1 + double precision :: U3, THETAC, THETAG, D3, Q3, Q1 + double precision :: SQT, G, U3D, Q1D, Q3D, THETA52 + double precision :: Q3DD, Q2DD, Q1DD, Q2D, HDYY, HDYT + double precision :: HDY, HDT, HDTT, GH, H, GDYY, GDY, GDT + double precision :: GDYT, GDTT, F, D3DD, D3D, CTT, CTY + double precision :: CDTYY, CTDYY, CTDYT, CTDY, CTDTT, CTDT + double precision :: CT, CHIDYY, CHIDYT, CHIDY, CHIDT, CHIDTT + double precision :: X, XDF, XDFF PF0=(29.6088132d0*DENR)**C13 ! Classical Fermi momentum if (PF0.gt.1.d-4) then TF=dsqrt(1.d0+PF0**2)-1.d0 ! Fermi temperature From b9c5885c889d68ad68dc0423b03176e8fc7341ed Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 09:35:49 -0700 Subject: [PATCH 19/70] Implicit none --- EOS/pc/eos17.f90 | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 954028784c..aa78caf369 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -1652,10 +1652,20 @@ subroutine FERINV7(F,N,X,XDF,XDFF) ! Inverse Fermi intergals ! jump at f=4: ! for XDF: 6.e-7, 5.4e-7, 9.6e-8, 3.1e-7 ! for XDFF: 4.7e-5, 4.8e-5, 2.3e-6, 1.5e-6 - implicit double precision (A-H), double precision (O-Z) - save - dimension A(0:5,0:3),B(0:6,0:3),C(0:6,0:3),D(0:6,0:3), & - LA(0:3),LB(0:3),LD(0:3) + !implicit double precision (A-H), double precision (O-Z) + implicit none + double precision, intent(in) :: F + integer, intent(in) :: N + double precision, intent(inout) :: X, XDF, XDFF + save + double precision :: UP, UP1, UP2, T, T1, T2, R, R1, R2 + double precision :: P, RT, DOWN, DOWN1, DOWN2 + integer :: i + double precision :: A(0:5,0:3) + double precision :: B(0:6,0:3) + double precision :: C(0:6,0:3) + double precision :: D(0:6,0:3) + integer :: LA(0:3), LB(0:3), LD(0:3) data A/-1.570044577033d4,1.001958278442d4,-2.805343454951d3, & 4.121170498099d2,-3.174780572961d1,1.d0, & ! X_{-1/2} 1.999266880833d4,5.702479099336d3,6.610132843877d2, & From 038f580518c1e316f6fbb004292ced75bf29468b Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 10:32:39 -0700 Subject: [PATCH 20/70] First attempt at converting ferinv7 to C++ --- EOS/pc/Makefile | 5 +- EOS/pc/eos17.f90 | 134 +++++------------------------------------------ 2 files changed, 15 insertions(+), 124 deletions(-) diff --git a/EOS/pc/Makefile b/EOS/pc/Makefile index 1a3a43384e..26d7960e50 100644 --- a/EOS/pc/Makefile +++ b/EOS/pc/Makefile @@ -1,5 +1,6 @@ -test: eos17.f90 - gfortran -o test eos17.f90 +test: eos17.f90 eos_c.cpp + g++ -o eos_c.o -c eos_c.cpp + gfortran -o test eos_c.o eos17.f90 run: ./test diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index aa78caf369..0283c2f1d7 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -1640,127 +1640,6 @@ subroutine EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) return end -! ====================== AUXILIARY SUBROUTINES ==================== ! - subroutine FERINV7(F,N,X,XDF,XDFF) ! Inverse Fermi intergals -! Version 24.05.07 -! X_q(f)=F^{-1}_q(f) : H.M.Antia 93 ApJS 84, 101 -! q=N-1/2=-1/2,1/2,3/2,5/2 (N=0,1,2,3) -! Input: F - argument, N=q+1/2 -! Output: X=X_q, XDF=dX/df, XDFF=d^2 X / df^2 -! Relative error: N = 0 1 2 3 -! for X: 3.e-9, 4.2e-9, 2.3e-9, 6.2e-9 -! jump at f=4: -! for XDF: 6.e-7, 5.4e-7, 9.6e-8, 3.1e-7 -! for XDFF: 4.7e-5, 4.8e-5, 2.3e-6, 1.5e-6 - !implicit double precision (A-H), double precision (O-Z) - implicit none - double precision, intent(in) :: F - integer, intent(in) :: N - double precision, intent(inout) :: X, XDF, XDFF - save - double precision :: UP, UP1, UP2, T, T1, T2, R, R1, R2 - double precision :: P, RT, DOWN, DOWN1, DOWN2 - integer :: i - double precision :: A(0:5,0:3) - double precision :: B(0:6,0:3) - double precision :: C(0:6,0:3) - double precision :: D(0:6,0:3) - integer :: LA(0:3), LB(0:3), LD(0:3) - data A/-1.570044577033d4,1.001958278442d4,-2.805343454951d3, & - 4.121170498099d2,-3.174780572961d1,1.d0, & ! X_{-1/2} - 1.999266880833d4,5.702479099336d3,6.610132843877d2, & - 3.818838129486d1,1.d0,0., & ! X_{1/2} - 1.715627994191d2,1.125926232897d2,2.056296753055d1,1.d0,0.,0., & - 2.138969250409d2,3.539903493971d1,1.d0,0.,0.,0./, & ! X_{5/2} - B/-2.782831558471d4,2.886114034012d4,-1.274243093149d4, & - 3.063252215963d3,-4.225615045074d2,3.168918168284d1, & - -1.008561571363d0, & ! X_{-1/2} - 1.771804140488d4,-2.014785161019d3,9.130355392717d1, & - -1.670718177489d0,0.,0.,0., & ! X_{1/2} - 2.280653583157d2,1.193456203021d2,1.16774311354d1, & - -3.226808804038d-1,3.519268762788d-3,0.,0., & ! X_{3/2} - 7.10854551271d2,9.873746988121d1,1.067755522895d0, & - -1.182798726503d-2,0.,0.,0./, & ! X_{5/2} - C/2.206779160034d-8,-1.437701234283d-6,6.103116850636d-5, & - -1.169411057416d-3,1.814141021608d-2,-9.588603457639d-2,1.d0, & - -1.277060388085d-2,7.187946804945d-2,-4.262314235106d-1, & - 4.997559426872d-1,-1.285579118012d0,-3.930805454272d-1,1.d0, & - -6.321828169799d-3,-2.183147266896d-2,-1.05756279932d-1, & - -4.657944387545d-1,-5.951932864088d-1,3.6844711771d-1,1.d0, & - -3.312041011227d-2,1.315763372315d-1,-4.820942898296d-1, & - 5.099038074944d-1,5.49561349863d-1,-1.498867562255d0,1.d0/, & - D/8.827116613576d-8,-5.750804196059d-6,2.429627688357d-4, & - -4.601959491394d-3,6.932122275919d-2,-3.217372489776d-1,& - 3.124344749296d0, & ! X_{-1/2} - -9.745794806288d-3,5.485432756838d-2,-3.29946624326d-1, & - 4.077841975923d-1,-1.145531476975d0,-6.067091689181d-2,0., & - -4.381942605018d-3,-1.5132365041d-2,-7.850001283886d-2, & - -3.407561772612d-1,-5.074812565486d-1,-1.387107009074d-1,0., & - -2.315515517515d-2,9.198776585252d-2,-3.835879295548d-1, & - 5.415026856351d-1,-3.847241692193d-1,3.739781456585d-2, & - -3.008504449098d-2/, & ! X_{5/2} - LA/5,4,3,2/,LB/6,3,4,3/,LD/6,5,5,6/ - if (N.lt.0.or.N.gt.3) then - print *, 'FERINV7: Invalid subscript' - stop - end if - if (F.le.0.) then - print *, 'FERINV7: Non-positive argument' - stop - end if - if (F.lt.4.) then - T=F - UP=0. - UP1=0. - UP2=0. - DOWN=0. - DOWN1=0. - DOWN2=0. - do I=LA(N),0,-1 - UP=UP*T+A(I,N) - if (I.ge.1) UP1=UP1*T+A(I,N)*I - if (I.ge.2) UP2=UP2*T+A(I,N)*I*(I-1) - enddo - do I=LB(N),0,-1 - DOWN=DOWN*T+B(I,N) - if (I.ge.1) DOWN1=DOWN1*T+B(I,N)*I - if (I.ge.2) DOWN2=DOWN2*T+B(I,N)*I*(I-1) - enddo - X=dlog(T*UP/DOWN) - XDF=1.d0/T+UP1/UP-DOWN1/DOWN - XDFF=-1.d0/T**2+UP2/UP-(UP1/UP)**2-DOWN2/DOWN+(DOWN1/DOWN)**2 - else - P=-1./(.5+N) ! = -1/(1+\nu) = power index - T=F**P ! t - argument of the rational fraction - T1=P*T/F ! dt/df - T2=P*(P-1.)*T/F**2 ! d^2 t / df^2 - UP=0. - UP1=0. - UP2=0. - DOWN=0. - DOWN1=0. - DOWN2=0. - do I=6,0,-1 - UP=UP*T+C(I,N) - if (I.ge.1) UP1=UP1*T+C(I,N)*I - if (I.ge.2) UP2=UP2*T+C(I,N)*I*(I-1) - enddo - do I=LD(N),0,-1 - DOWN=DOWN*T+D(I,N) - if (I.ge.1) DOWN1=DOWN1*T+D(I,N)*I - if (I.ge.2) DOWN2=DOWN2*T+D(I,N)*I*(I-1) - enddo - R=UP/DOWN - R1=(UP1-UP*DOWN1/DOWN)/DOWN ! dR/dt - R2=(UP2-(2.*UP1*DOWN1+UP*DOWN2)/DOWN+2.*UP*(DOWN1/DOWN)**2)/ & - DOWN - X=R/T - RT=(R1-R/T)/T - XDF=T1*RT - XDFF=T2*RT+T1**2*(R2-2.*RT)/T - endif - return - end subroutine BLIN9(TEMP,CHI, & W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & @@ -2295,7 +2174,18 @@ subroutine CHEMFIT7(DENR,TEMR,CHI,CMU1,KDERIV, & ! CMUDT = (d\mu/dT)_V ! CMUDTT = (d^2\mu/dT^2)_V ! CMUDENR,CMUDT, and CMUDTT =0 on output, if KREDIV=0 + use iso_c_binding implicit none + + interface + subroutine ferinv7(F, N, X, XDF, XDFF) bind(C, name='ferinv7') + implicit none + double precision, intent(in), value :: F + integer, intent(in), value :: N + double precision, intent(inout) :: X, XDF, XDFF + end subroutine ferinv7 + end interface + double precision, intent(in) :: DENR, TEMR integer, intent(in) :: KDERIV double precision, intent(inout) :: CHI, CMU1, CMUDENR, CMUDT, CMUDTT @@ -2343,7 +2233,7 @@ subroutine CHEMFIT7(DENR,TEMR,CHI,CMU1,KDERIV, & H=(1.d0+.5d0*TEMR/THETA)*(1.d0+Q2*TEMR) CT=1.d0+G/H F=2.d0*C13/THETA32 - call FERINV7(F,1,X,XDF,XDFF) + call ferinv7(F, 1, X, XDF, XDFF) CHI=X & ! non-relativistic result - 1.5d0*dlog(CT) ! Relativistic fit CMU1=TEMR*CHI ! Fit to chemical potential w/o mc^2 From 05f97fefa068067e3e0aaf6db3d393c2de289990 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 10:46:47 -0700 Subject: [PATCH 21/70] lstdc++ --- EOS/pc/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/EOS/pc/Makefile b/EOS/pc/Makefile index 26d7960e50..418a170987 100644 --- a/EOS/pc/Makefile +++ b/EOS/pc/Makefile @@ -1,6 +1,6 @@ test: eos17.f90 eos_c.cpp g++ -o eos_c.o -c eos_c.cpp - gfortran -o test eos_c.o eos17.f90 + gfortran -o test eos_c.o eos17.f90 -lstdc++ run: ./test From 72a5c6d00c569accccc04012640f74c73805a0f0 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 10:47:01 -0700 Subject: [PATCH 22/70] Check in C++ file --- EOS/pc/eos_c.cpp | 156 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 156 insertions(+) create mode 100644 EOS/pc/eos_c.cpp diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp new file mode 100644 index 0000000000..9855d9ef5c --- /dev/null +++ b/EOS/pc/eos_c.cpp @@ -0,0 +1,156 @@ +#include +#include +#include +#include +#include + +extern "C" +{ + // Inverse Fermi integrals + void ferinv7 (double F, int N, + double& X, + double& XDF, + double& XDFF) + { + // Version 24.05.07 + // X_q(f)=F^{-1}_q(f) : H.M.Antia 93 ApJS 84, 101 + // q=N-1/2=-1/2,1/2,3/2,5/2 (N=0,1,2,3) + // Input: F - argument, N=q+1/2 + // Output: X=X_q, XDF=dX/df, XDFF=d^2 X / df^2 + // Relative error: N = 0 1 2 3 + // for X: 3.e-9, 4.2e-9, 2.3e-9, 6.2e-9 + // jump at f=4: + // for XDF: 6.e-7, 5.4e-7, 9.6e-8, 3.1e-7 + // for XDFF: 4.7e-5, 4.8e-5, 2.3e-6, 1.5e-6 + + const double A[4][6] = {{-1.570044577033e4, 1.001958278442e4, -2.805343454951e3, + 4.121170498099e2, -3.174780572961e1, 1.e0}, // X_{-1/2} + { 1.999266880833e4, 5.702479099336e3, 6.610132843877e2, + 3.818838129486e1, 1.e0, 0.0}, // X_{1/2} + { 1.715627994191e2, 1.125926232897e2, 2.056296753055e1, + 1.e0, 0.0, 0.0}, + { 2.138969250409e2, 3.539903493971e1, 1.e0, + 0.0, 0.0, 0.0}}; // X_{5/2} + + const double B[4][7] = {{-2.782831558471e4, 2.886114034012e4, -1.274243093149e4, + 3.063252215963e3, -4.225615045074e2, 3.168918168284e1, + -1.008561571363e0}, // X_{-1/2} + { 1.771804140488e4, -2.014785161019e3, 9.130355392717e1, + -1.670718177489e0, 0.0, 0.0, + 0.0}, // X_{1/2} + { 2.280653583157e2, 1.193456203021e2, 1.16774311354e1, + -3.226808804038e-1, 3.519268762788e-3, 0.0, + 0.0}, // X_{3/2} + { 7.10854551271e2, 9.873746988121e1, 1.067755522895e0, + -1.182798726503e-2, 0.0, 0.0, + 0.0}}; // X_{5/2} + + const double C[4][7] = {{ 2.206779160034e-8, -1.437701234283e-6, 6.103116850636e-5, + -1.169411057416e-3, 1.814141021608e-2, -9.588603457639e-2, + 1.e0}, + {-1.277060388085e-2, 7.187946804945e-2, -4.262314235106e-1, + 4.997559426872e-1, -1.285579118012e0, -3.930805454272e-1, + 1.e0}, + {-6.321828169799e-3, -2.183147266896e-2, -1.05756279932e-1, + -4.657944387545e-1, -5.951932864088e-1, 3.6844711771e-1, + 1.e0}, + {-3.312041011227e-2, 1.315763372315e-1, -4.820942898296e-1, + 5.099038074944e-1, 5.49561349863e-1, -1.498867562255e0, + 1.e0}}; + + const double D[4][7] = {{ 8.827116613576e-8, -5.750804196059e-6, 2.429627688357e-4, + -4.601959491394e-3, 6.932122275919e-2, -3.217372489776e-1, + 3.124344749296e0}, // X_{-1/2} + {-9.745794806288e-3, 5.485432756838e-2, -3.29946624326e-1, + 4.077841975923e-1, -1.145531476975e0, -6.067091689181e-2, + 0.0}, + {-4.381942605018e-3, -1.5132365041e-2, -7.850001283886e-2, + -3.407561772612e-1, -5.074812565486e-1, -1.387107009074e-1, + 0.0}, + {-2.315515517515e-2, 9.198776585252e-2, -3.835879295548e-1, + 5.415026856351e-1, -3.847241692193e-1, 3.739781456585e-2, + -3.008504449098e-2}}; // X_{5/2} + + const int LA[4] = {5, 4, 3, 2}; + const int LB[4] = {6, 3, 4, 3}; + const int LD[4] = {6, 5, 5, 6}; + + if (N < 0 || N > 3) { + printf("FERINV7: Invalid subscript\n"); + exit(1); + } + if (F <= 0.0) { + printf("FERINV7: Non-positive argument\n"); + exit(1); + } + if (F < 4) { + double T = F; + double UP = 0.0; + double UP1 = 0.0; + double UP2 = 0.0; + double DOWN = 0.0; + double DOWN1 = 0.0; + double DOWN2 = 0.0; + for (int i = LA[N]; i >= 0; --i) { + UP = UP * T + A[N][i]; + if (i >= 1) { + UP1 = UP1 * T + A[N][i] * i; + } + if (i >= 2) { + UP2 = UP2 * T + A[N][i] * i * (i-1); + } + } + for (int i = LB[N]; i >= 0; --i) { + DOWN = DOWN * T + B[N][i]; + if (i >= 1) { + DOWN1 = DOWN1 * T + B[N][i] * i; + } + if (i >= 2) { + DOWN2 = DOWN2 * T + B[N][i] * i * (i-1); + } + } + X = std::log(T * UP / DOWN); + XDF = 1.0 / T + UP1 / UP - DOWN1 / DOWN; + XDFF = -1.0 / (T * T) + UP2 / UP - (UP1 / UP) * (UP1 / UP) - + DOWN2 / DOWN + (DOWN1 / DOWN) * (DOWN1 / DOWN); + } + else { + double P = -1.0 / (0.5 + (double) N); // = -1/(1+\nu) = power index + double T = std::pow(F, P); // t - argument of the rational fraction + double T1 = P * T / F; // dt/df + double T2 = P * (P - 1.0) * T / (F * F); // d^2 t / df^2 + double UP = 0.0; + double UP1 = 0.0; + double UP2 = 0.0; + double DOWN = 0.0; + double DOWN1 = 0.0; + double DOWN2 = 0.0; + for (int i = 6; i >= 0; --i) { + UP = UP * T + C[N][i]; + if (i >= 1) { + UP1 = UP1 * T + C[N][i] * i; + } + if (i >= 2) { + UP2 = UP2 * T + C[N][i] * i * (i-1); + } + } + for (int i = LD[N]; i >= 0; --i) { + DOWN = DOWN * T + D[N][i]; + if (i >= 1) { + DOWN1 = DOWN1 * T + D[N][i] * i; + } + if (i >= 2) { + DOWN2 = DOWN2 * T + D[N][i] * i * (i-1); + } + } + double R = UP / DOWN; + double R1 = (UP1 - UP * DOWN1 / DOWN) / DOWN; // dR/dt + double R2 = (UP2 - (2.0 * UP1 * DOWN1 + UP * DOWN2) / DOWN + + 2.0 * UP * (DOWN1 / DOWN) * (DOWN1 / DOWN)) / DOWN; + X = R/T; + double RT = (R1 - R / T) / T; + XDF = T1 * RT; + XDFF = T2 * RT + T1 * T1 * (R2 - 2.0 * RT) / T; + } + } +} From 3a1237fd7270fc29dfc12e655b8f22f212ab9802 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 10:48:45 -0700 Subject: [PATCH 23/70] Fix comparison --- EOS/pc/eos_c.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 9855d9ef5c..aae420a7df 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -83,7 +83,7 @@ extern "C" printf("FERINV7: Non-positive argument\n"); exit(1); } - if (F < 4) { + if (F < 4.0) { double T = F; double UP = 0.0; double UP1 = 0.0; From 2c64033b40867fc306d7f061bad6998f454fdb63 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 11:03:10 -0700 Subject: [PATCH 24/70] Print diffs without judgment --- EOS/pc/eos17.f90 | 34 +++++++++++----------------------- 1 file changed, 11 insertions(+), 23 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 0283c2f1d7..4e1238f9a1 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -154,70 +154,58 @@ program main dx = abs(P - 986087830999.01904d0) if (dx / P > 1.d-15) then - print *, "P IS WRONG", dx / P - return + print *, "P DIFF", dx / P end if dx = abs(PnkT - 16.129464056742833d0) if (dx / PnkT > 1.d-15) then - print *, "PnkT IS WRONG", dx / PnkT - return + print *, "PnkT DIFF", dx / PnkT end if dx = abs(CV - 8.5451229292858866d0) if (dx / CV > 1.d-15) then - print *, "CV IS WRONG", dx / CV - return + print *, "CV DIFF", dx / CV end if dx = abs(CHIT - 0.24165606904443493d0) if (dx / CHIT > 1.d-15) then - print *, "CHIT IS WRONG", dx / CHIT - return + print *, "CHIT DIFF", dx / CHIT end if dx = abs(CHIR - 1.3370085960654023d0) if (dx / CHIR > 1.d-15) then - print *, "CHIR IS WRONG", dx / CHIR - return + print *, "CHIR DIFF", dx / CHIR end if dx = abs(UNkT - 30.712489657322770d0) if (dx / UNkT > 1.d-15) then - print *, "UNkT IS WRONG", dx / UNkT - return + print *, "UNkT DIFF", dx / UNkT end if dx = abs(SNk - 23.797925638433309d0) if (dx / SNk > 1.d-15) then - print *, "SNk IS WRONG", dx / SNk - return + print *, "SNk DIFF", dx / SNk end if dx = abs(GAMI - 0.96111630472601972d0) if (dx / GAMI > 1.d-15) then - print *, "GAMI IS WRONG", dx / GAMI - return + print *, "GAMI DIFF", dx / GAMI end if dx = abs(TPT - 1.2400526419152945d-002) if (dx / TPT > 1.d-15) then - print *, "TPT IS WRONG", dx / TPT - return + print *, "TPT DIFF", dx / TPT end if dx = abs(CHI - 5.5745494145734744d0) if (dx / CHI > 1.d-15) then - print *, "CHI IS WRONG", dx / CHI - return + print *, "CHI DIFF", dx / CHI end if if (LIQSOL /= 0) then - print *, "LIQSOL IS WRONG", LIQSOL - return + print *, "LIQSOL DIFF", LIQSOL end if - print *, "SUCCESS" end program main subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, & From e42fddbdba2cbb2ba27e29048cf040e3f7f1d4ec Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 11:10:30 -0700 Subject: [PATCH 25/70] Hardcode N = 1 in Fermi integral --- EOS/pc/eos17.f90 | 5 +- EOS/pc/eos_c.cpp | 230 ++++++++++++++++++++--------------------------- 2 files changed, 97 insertions(+), 138 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 4e1238f9a1..c5b56746be 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -2166,10 +2166,9 @@ subroutine CHEMFIT7(DENR,TEMR,CHI,CMU1,KDERIV, & implicit none interface - subroutine ferinv7(F, N, X, XDF, XDFF) bind(C, name='ferinv7') + subroutine ferinv7(F, X, XDF, XDFF) bind(C, name='ferinv7') implicit none double precision, intent(in), value :: F - integer, intent(in), value :: N double precision, intent(inout) :: X, XDF, XDFF end subroutine ferinv7 end interface @@ -2221,7 +2220,7 @@ end subroutine ferinv7 H=(1.d0+.5d0*TEMR/THETA)*(1.d0+Q2*TEMR) CT=1.d0+G/H F=2.d0*C13/THETA32 - call ferinv7(F, 1, X, XDF, XDFF) + call ferinv7(F, X, XDF, XDFF) CHI=X & ! non-relativistic result - 1.5d0*dlog(CT) ! Relativistic fit CMU1=TEMR*CHI ! Fit to chemical potential w/o mc^2 diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index aae420a7df..765d56cda2 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -6,151 +6,111 @@ extern "C" { - // Inverse Fermi integrals - void ferinv7 (double F, int N, + // Inverse Fermi integrals with q=1/2 + void ferinv7 (double F, double& X, double& XDF, double& XDFF) { // Version 24.05.07 // X_q(f)=F^{-1}_q(f) : H.M.Antia 93 ApJS 84, 101 - // q=N-1/2=-1/2,1/2,3/2,5/2 (N=0,1,2,3) - // Input: F - argument, N=q+1/2 + // Input: F - argument // Output: X=X_q, XDF=dX/df, XDFF=d^2 X / df^2 - // Relative error: N = 0 1 2 3 - // for X: 3.e-9, 4.2e-9, 2.3e-9, 6.2e-9 + // Relative error: + // for X: 4.2e-9 // jump at f=4: - // for XDF: 6.e-7, 5.4e-7, 9.6e-8, 3.1e-7 - // for XDFF: 4.7e-5, 4.8e-5, 2.3e-6, 1.5e-6 + // for XDF: 5.4e-7 + // for XDFF: 4.8e-5 - const double A[4][6] = {{-1.570044577033e4, 1.001958278442e4, -2.805343454951e3, - 4.121170498099e2, -3.174780572961e1, 1.e0}, // X_{-1/2} - { 1.999266880833e4, 5.702479099336e3, 6.610132843877e2, - 3.818838129486e1, 1.e0, 0.0}, // X_{1/2} - { 1.715627994191e2, 1.125926232897e2, 2.056296753055e1, - 1.e0, 0.0, 0.0}, - { 2.138969250409e2, 3.539903493971e1, 1.e0, - 0.0, 0.0, 0.0}}; // X_{5/2} + const double A[6] = { 1.999266880833e4, 5.702479099336e3, 6.610132843877e2, + 3.818838129486e1, 1.e0, 0.0}; + const double B[7] = { 1.771804140488e4, -2.014785161019e3, 9.130355392717e1, + -1.670718177489e0, 0.0, 0.0, + 0.0}; + const double C[7] = {-1.277060388085e-2, 7.187946804945e-2, -4.262314235106e-1, + 4.997559426872e-1, -1.285579118012e0, -3.930805454272e-1, + 1.e0}; + const double D[7] = {-9.745794806288e-3, 5.485432756838e-2, -3.29946624326e-1, + 4.077841975923e-1, -1.145531476975e0, -6.067091689181e-2, + 0.0}; + const int LA = 4; + const int LB = 3; + const int LD = 5; - const double B[4][7] = {{-2.782831558471e4, 2.886114034012e4, -1.274243093149e4, - 3.063252215963e3, -4.225615045074e2, 3.168918168284e1, - -1.008561571363e0}, // X_{-1/2} - { 1.771804140488e4, -2.014785161019e3, 9.130355392717e1, - -1.670718177489e0, 0.0, 0.0, - 0.0}, // X_{1/2} - { 2.280653583157e2, 1.193456203021e2, 1.16774311354e1, - -3.226808804038e-1, 3.519268762788e-3, 0.0, - 0.0}, // X_{3/2} - { 7.10854551271e2, 9.873746988121e1, 1.067755522895e0, - -1.182798726503e-2, 0.0, 0.0, - 0.0}}; // X_{5/2} + const int N = 1; - const double C[4][7] = {{ 2.206779160034e-8, -1.437701234283e-6, 6.103116850636e-5, - -1.169411057416e-3, 1.814141021608e-2, -9.588603457639e-2, - 1.e0}, - {-1.277060388085e-2, 7.187946804945e-2, -4.262314235106e-1, - 4.997559426872e-1, -1.285579118012e0, -3.930805454272e-1, - 1.e0}, - {-6.321828169799e-3, -2.183147266896e-2, -1.05756279932e-1, - -4.657944387545e-1, -5.951932864088e-1, 3.6844711771e-1, - 1.e0}, - {-3.312041011227e-2, 1.315763372315e-1, -4.820942898296e-1, - 5.099038074944e-1, 5.49561349863e-1, -1.498867562255e0, - 1.e0}}; - - const double D[4][7] = {{ 8.827116613576e-8, -5.750804196059e-6, 2.429627688357e-4, - -4.601959491394e-3, 6.932122275919e-2, -3.217372489776e-1, - 3.124344749296e0}, // X_{-1/2} - {-9.745794806288e-3, 5.485432756838e-2, -3.29946624326e-1, - 4.077841975923e-1, -1.145531476975e0, -6.067091689181e-2, - 0.0}, - {-4.381942605018e-3, -1.5132365041e-2, -7.850001283886e-2, - -3.407561772612e-1, -5.074812565486e-1, -1.387107009074e-1, - 0.0}, - {-2.315515517515e-2, 9.198776585252e-2, -3.835879295548e-1, - 5.415026856351e-1, -3.847241692193e-1, 3.739781456585e-2, - -3.008504449098e-2}}; // X_{5/2} - - const int LA[4] = {5, 4, 3, 2}; - const int LB[4] = {6, 3, 4, 3}; - const int LD[4] = {6, 5, 5, 6}; - - if (N < 0 || N > 3) { - printf("FERINV7: Invalid subscript\n"); - exit(1); - } - if (F <= 0.0) { - printf("FERINV7: Non-positive argument\n"); - exit(1); - } - if (F < 4.0) { - double T = F; - double UP = 0.0; - double UP1 = 0.0; - double UP2 = 0.0; - double DOWN = 0.0; - double DOWN1 = 0.0; - double DOWN2 = 0.0; - for (int i = LA[N]; i >= 0; --i) { - UP = UP * T + A[N][i]; - if (i >= 1) { - UP1 = UP1 * T + A[N][i] * i; - } - if (i >= 2) { - UP2 = UP2 * T + A[N][i] * i * (i-1); - } - } - for (int i = LB[N]; i >= 0; --i) { - DOWN = DOWN * T + B[N][i]; - if (i >= 1) { - DOWN1 = DOWN1 * T + B[N][i] * i; - } - if (i >= 2) { - DOWN2 = DOWN2 * T + B[N][i] * i * (i-1); - } - } - X = std::log(T * UP / DOWN); - XDF = 1.0 / T + UP1 / UP - DOWN1 / DOWN; - XDFF = -1.0 / (T * T) + UP2 / UP - (UP1 / UP) * (UP1 / UP) - - DOWN2 / DOWN + (DOWN1 / DOWN) * (DOWN1 / DOWN); - } - else { - double P = -1.0 / (0.5 + (double) N); // = -1/(1+\nu) = power index - double T = std::pow(F, P); // t - argument of the rational fraction - double T1 = P * T / F; // dt/df - double T2 = P * (P - 1.0) * T / (F * F); // d^2 t / df^2 - double UP = 0.0; - double UP1 = 0.0; - double UP2 = 0.0; - double DOWN = 0.0; - double DOWN1 = 0.0; - double DOWN2 = 0.0; - for (int i = 6; i >= 0; --i) { - UP = UP * T + C[N][i]; - if (i >= 1) { - UP1 = UP1 * T + C[N][i] * i; - } - if (i >= 2) { - UP2 = UP2 * T + C[N][i] * i * (i-1); - } - } - for (int i = LD[N]; i >= 0; --i) { - DOWN = DOWN * T + D[N][i]; - if (i >= 1) { - DOWN1 = DOWN1 * T + D[N][i] * i; - } - if (i >= 2) { - DOWN2 = DOWN2 * T + D[N][i] * i * (i-1); - } - } - double R = UP / DOWN; - double R1 = (UP1 - UP * DOWN1 / DOWN) / DOWN; // dR/dt - double R2 = (UP2 - (2.0 * UP1 * DOWN1 + UP * DOWN2) / DOWN + - 2.0 * UP * (DOWN1 / DOWN) * (DOWN1 / DOWN)) / DOWN; - X = R/T; - double RT = (R1 - R / T) / T; - XDF = T1 * RT; - XDFF = T2 * RT + T1 * T1 * (R2 - 2.0 * RT) / T; - } + if (F <= 0.0) { + printf("FERINV7: Non-positive argument\n"); + exit(1); + } + if (F < 4.0) { + double T = F; + double UP = 0.0; + double UP1 = 0.0; + double UP2 = 0.0; + double DOWN = 0.0; + double DOWN1 = 0.0; + double DOWN2 = 0.0; + for (int i = LA; i >= 0; --i) { + UP = UP * T + A[i]; + if (i >= 1) { + UP1 = UP1 * T + A[i] * i; + } + if (i >= 2) { + UP2 = UP2 * T + A[i] * i * (i-1); + } + } + for (int i = LB; i >= 0; --i) { + DOWN = DOWN * T + B[i]; + if (i >= 1) { + DOWN1 = DOWN1 * T + B[i] * i; + } + if (i >= 2) { + DOWN2 = DOWN2 * T + B[i] * i * (i-1); + } + } + X = std::log(T * UP / DOWN); + XDF = 1.0 / T + UP1 / UP - DOWN1 / DOWN; + XDFF = -1.0 / (T * T) + UP2 / UP - (UP1 / UP) * (UP1 / UP) - + DOWN2 / DOWN + (DOWN1 / DOWN) * (DOWN1 / DOWN); + } + else { + double P = -1.0 / (0.5 + (double) N); // = -1/(1+\nu) = power index + double T = std::pow(F, P); // t - argument of the rational fraction + double T1 = P * T / F; // dt/df + double T2 = P * (P - 1.0) * T / (F * F); // d^2 t / df^2 + double UP = 0.0; + double UP1 = 0.0; + double UP2 = 0.0; + double DOWN = 0.0; + double DOWN1 = 0.0; + double DOWN2 = 0.0; + for (int i = 6; i >= 0; --i) { + UP = UP * T + C[i]; + if (i >= 1) { + UP1 = UP1 * T + C[i] * i; + } + if (i >= 2) { + UP2 = UP2 * T + C[i] * i * (i-1); + } + } + for (int i = LD; i >= 0; --i) { + DOWN = DOWN * T + D[i]; + if (i >= 1) { + DOWN1 = DOWN1 * T + D[i] * i; + } + if (i >= 2) { + DOWN2 = DOWN2 * T + D[i] * i * (i-1); + } + } + double R = UP / DOWN; + double R1 = (UP1 - UP * DOWN1 / DOWN) / DOWN; // dR/dt + double R2 = (UP2 - (2.0 * UP1 * DOWN1 + UP * DOWN2) / DOWN + + 2.0 * UP * (DOWN1 / DOWN) * (DOWN1 / DOWN)) / DOWN; + X = R/T; + double RT = (R1 - R / T) / T; + XDF = T1 * RT; + XDFF = T2 * RT + T1 * T1 * (R2 - 2.0 * RT) / T; + } } } From 7f743a0eca729b14cf7fbcf88cc2b143d544d782 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 11:35:10 -0700 Subject: [PATCH 26/70] chemfit to C++ --- EOS/pc/eos17.f90 | 156 +++-------------------------------------------- EOS/pc/eos_c.cpp | 60 ++++++++++++++++++ 2 files changed, 67 insertions(+), 149 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index c5b56746be..ff7af18517 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -285,6 +285,13 @@ subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, & double precision :: PDT1, PDT2, PDTMIX, PEid, PMIX, PRESS, PRESSE double precision :: PRESSI, PRESSRAD, PRI, RS, RSI, RZ, SC1, SC2 double precision :: SEid, Stot, TPT2 + interface + subroutine chemfit(dens, temp, chi) bind(C, name='chemfit') + implicit none + double precision, intent(in), value :: dens, temp + double precision, intent(inout) :: chi + end subroutine chemfit + end interface if (RHO.lt.1.e-19.or.RHO.gt.1.e15) then print *, 'MELANGE: RHO out of range' stop @@ -2133,152 +2140,3 @@ subroutine BLIN9c(TEMP,CHI, & endif return end - - subroutine CHEMFIT(DENS,TEMP,CHI) -! Version 07.06.07 -! This is merely an interface to CHEMFIT7 for compatibility purposes. -! Input: DENS - electron density [a.u.=6.7483346e24 cm^{-3}], -! TEMP - temperature [a.u.=2Ryd=3.1577e5 K] -! Output: CHI=\mu/TEMP, where \mu - electron chem.pot.w/o rest-energy - implicit double precision (A-H), double precision (O-Z) - save - DENR=DENS/2.5733806d6 ! n_e in rel.un.=\lambda_{Compton}^{-3} - TEMR=TEMP/1.8778865d4 ! T in rel.un.=(mc^2/k)=5.93e9 K - call CHEMFIT7(DENR,TEMR,CHI,CMU1,0,CMUDENR,CMUDT,CMUDTT) - return - end - - subroutine CHEMFIT7(DENR,TEMR,CHI,CMU1,KDERIV, & - CMUDENR,CMUDT,CMUDTT) -! Version 29.08.15 -! Fit to the chemical potential of free electron gas described in: -! G.Chabrier & A.Y.Potekhin, Phys.Rev.E 58, 4941 (1998) -! Stems from CHEMFIT v.10.10.96. The main difference - derivatives. -! All quantities are by default in relativistic units -! Input: DENR - electron density, TEMR - temperature -! KDERIV=0 if the derivatives are not required -! Output: CHI=CMU1/TEMR, where CMU1 = \mu-1 - chem.pot.w/o rest-energy -! CMUDENR = (d\mu/d n_e)_T -! CMUDT = (d\mu/dT)_V -! CMUDTT = (d^2\mu/dT^2)_V -! CMUDENR,CMUDT, and CMUDTT =0 on output, if KREDIV=0 - use iso_c_binding - implicit none - - interface - subroutine ferinv7(F, X, XDF, XDFF) bind(C, name='ferinv7') - implicit none - double precision, intent(in), value :: F - double precision, intent(inout) :: X, XDF, XDFF - end subroutine ferinv7 - end interface - - double precision, intent(in) :: DENR, TEMR - integer, intent(in) :: KDERIV - double precision, intent(inout) :: CHI, CMU1, CMUDENR, CMUDT, CMUDTT - save - double precision, parameter :: C13 = 1.d0 / 3.d0 - double precision, parameter :: PARA = 1.612d0 - double precision, parameter :: PARB = 6.192d0 - double precision, parameter :: PARC = .0944d0 - double precision, parameter :: PARF=5.535d0 - double precision, parameter :: PARG=.698d0 - double precision, parameter :: XEPST = 228.d0 ! the largest argument of e^{-X} - - double precision :: PF0, TF, THETA, THETA32, Q2, T1 - double precision :: U3, THETAC, THETAG, D3, Q3, Q1 - double precision :: SQT, G, U3D, Q1D, Q3D, THETA52 - double precision :: Q3DD, Q2DD, Q1DD, Q2D, HDYY, HDYT - double precision :: HDY, HDT, HDTT, GH, H, GDYY, GDY, GDT - double precision :: GDYT, GDTT, F, D3DD, D3D, CTT, CTY - double precision :: CDTYY, CTDYY, CTDYT, CTDY, CTDTT, CTDT - double precision :: CT, CHIDYY, CHIDYT, CHIDY, CHIDT, CHIDTT - double precision :: X, XDF, XDFF - PF0=(29.6088132d0*DENR)**C13 ! Classical Fermi momentum - if (PF0.gt.1.d-4) then - TF=dsqrt(1.d0+PF0**2)-1.d0 ! Fermi temperature - else - TF=.5d0*PF0**2 - endif - THETA=TEMR/TF - THETA32=THETA*dsqrt(THETA) - Q2=12.d0+8.d0/THETA32 - T1=0. - if (THETA.lt.XEPST) T1=dexp(-THETA) - U3=T1**2+PARA - THETAC=THETA**PARC - THETAG=THETA**PARG - D3=PARB*THETAC*T1**2+PARF*THETAG - Q3=1.365568127d0-U3/D3 ! 1.365...=2/\pi^{1/3} - if (THETA.gt.1.d-5) then - Q1=1.5d0*T1/(1.d0-T1) - else - Q1=1.5d0/THETA - endif - SQT=dsqrt(TEMR) - G=(1.d0+Q2*TEMR*Q3+Q1*SQT)*TEMR - H=(1.d0+.5d0*TEMR/THETA)*(1.d0+Q2*TEMR) - CT=1.d0+G/H - F=2.d0*C13/THETA32 - call ferinv7(F, X, XDF, XDFF) - CHI=X & ! non-relativistic result - - 1.5d0*dlog(CT) ! Relativistic fit - CMU1=TEMR*CHI ! Fit to chemical potential w/o mc^2 - if (KDERIV.eq.0) then ! DISMISS DERIVATIVES - CMUDENR=0. - CMUDT=0. - CMUDTT=0. - return - endif -! CALCULATE DERIVATIVES: -! 1: derivatives of CHI over THETA and T -! (a): Non-relativistic result: - THETA52=THETA32*THETA - CHIDY=-XDF/THETA52 ! d\chi/d\theta - CHIDYY=(XDFF/THETA**4-2.5d0*CHIDY)/THETA ! d^2\chi/d\theta^2 -! (b): Relativistic corrections: - if (THETA.gt.1.d-5) then - Q1D=-Q1/(1.d0-T1) - Q1DD=-Q1D*(1.d0+T1)/(1.d0-T1) - else - Q1D=-1.5d0/THETA**2 - Q1DD=-2.d0*Q1D/THETA ! sign corrected 08.08.11 - endif - Q2D=-12.d0/THETA52 ! d q_2 / d \theta - Q2DD=30.d0/(THETA52*THETA) ! d^2 q_2 / d \theta^2 - U3D=-2.d0*T1**2 - D3D=PARF*PARG*THETAG/THETA+PARB*T1**2*THETAC*(PARC/THETA-2.d0) - D3DD=PARF*PARG*(PARG-1.d0)*THETAG/THETA**2+ & - PARB*T1**2*THETAC*(PARC*(PARC-1.d0)/THETA**2-4.d0*PARC/THETA+4.d0) - Q3D=(D3D*U3/D3-U3D)/D3 - Q3DD=(2.d0*U3D+(2.d0*U3D*D3D+U3*D3DD)/D3-2.d0*U3*(D3D/D3)**2)/D3 - GDY=TEMR*(Q1D*SQT+(Q2D*Q3+Q2*Q3D)*TEMR) ! dG/d\theta - GDT=1.d0+1.5d0*Q1*SQT+2.d0*Q2*Q3*TEMR - GDYY=TEMR*(Q1DD*SQT+(Q2DD*Q3+2.d0*Q2D*Q3D+Q2*Q3DD)*TEMR) - GDTT=.75d0*Q1/SQT+2.d0*Q2*Q3 - GDYT=1.5d0*Q1D*SQT+2.d0*(Q2D*Q3+Q2*Q3D)*TEMR - HDY=(-.5d0/THETA**2+Q2D+.5d0*(Q2D-Q2/THETA)/THETA*TEMR)*TEMR - HDT=(.5d0+Q2*TEMR)/THETA+Q2 - HDYY=TEMR/THETA**3+Q2DD*TEMR+ & - TEMR**2*(.5d0*Q2DD-Q2D/THETA+Q2/THETA**2)/THETA - HDTT=Q2/THETA - HDYT=Q2D*(1.d0+TEMR/THETA)-(.5d0+Q2*TEMR)/THETA**2 - CTY=GDY/G-HDY/H - CTT=GDT/G-HDT/H - GH=G/H - CTDY=GH*CTY - CTDT=GH*CTT - CTDYY=CTDY*CTY+GH*(GDYY/G-(GDY/G)**2-HDYY/H+(HDY/H)**2) - CTDTT=CTDT*CTT+GH*(GDTT/G-(GDT/G)**2-HDTT/H+(HDT/H)**2) - CTDYT=CTDT*CTY+GH*(GDYT/G-GDY*GDT/G**2-HDYT/H+HDY*HDT/H**2) - CHIDY=CHIDY-1.5d0*CTDY/CT - CHIDT=-1.5d0*CTDT/CT - CHIDYY=CHIDYY+1.5d0*((CTDY/CT)**2-CTDYY/CT) - CHIDTT=1.5d0*((CTDT/CT)**2-CTDTT/CT) - CHIDYT=1.5d0*(CTDY*CTDT/CT**2-CTDYT/CT) - CMUDENR=-(THETA*PF0)**2/(3.d0*DENR*(1.d0+TF))*CHIDY - CMUDT=CHI+THETA*CHIDY+TEMR*CHIDT - CMUDTT=2.d0*(CHIDY/TF+CHIDT+THETA*CHIDYT)+ & - THETA/TF*CHIDYY+TEMR*CHIDTT - return - end diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 765d56cda2..8e65a3a4d6 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -113,4 +113,64 @@ extern "C" XDFF = T2 * RT + T1 * T1 * (R2 - 2.0 * RT) / T; } } + + void chemfit (double DENS, double TEMP, double& CHI) + { + // Version 29.08.15 + // Fit to the chemical potential of free electron gas described in: + // G.Chabrier & A.Y.Potekhin, Phys.Rev.E 58, 4941 (1998) + // Stems from CHEMFIT v.10.10.96. The main difference - derivatives. + // Input: DENS - electron density [a.u.=6.7483346e24 cm^{-3}], + // TEMP - temperature [a.u.=2Ryd=3.1577e5 K] + // Output: CHI = CMU1 / TEMR, where CMU1 = \mu-1 - chem.pot.w/o rest-energy + + const double C13 = 1.0 / 3.0; + const double PARA = 1.612; + const double PARB = 6.192; + const double PARC = 0.0944; + const double PARF = 5.535; + const double PARG = 0.698; + const double XEPST = 228.0; // the largest argument of e^{-X} + + double DENR = DENS / 2.5733806e6; // n_e in rel.un.=\lambda_{Compton}^{-3} + double TEMR = TEMP / 1.8778865e4; // T in rel.un.=(mc^2/k)=5.93e9 K + + double PF0 = std::pow(29.6088132 * DENR, C13); // Classical Fermi momentum + double TF; + if (PF0 > 1.e-4) { + TF = std::sqrt(1.0 + PF0 * PF0) - 1.0; // Fermi temperature + } + else { + TF = 0.50 * PF0 * PF0; + } + + double THETA = TEMR / TF; + double THETA32 = THETA * std::sqrt(THETA); + double Q2 = 12.0 + 8.0 / THETA32; + double T1 = 0.0; + if (THETA < XEPST) { + T1 = std::exp(-THETA); + } + double U3 = T1 * T1 + PARA; + double THETAC = std::pow(THETA, PARC); + double THETAG = std::pow(THETA, PARG); + double D3 = PARB * THETAC * T1 * T1 + PARF * THETAG; + double Q3 = 1.365568127 - U3 / D3; // 1.365...=2/\pi^{1/3} + double Q1; + if (THETA > 1.e-5) { + Q1 = 1.5 * T1 / (1.0 - T1); + } + else { + Q1 = 1.5 / THETA; + } + double SQT = std::sqrt(TEMR); + double G = (1.0 + Q2 * TEMR * Q3 + Q1 * SQT) * TEMR; + double H = (1.0 + 0.5 * TEMR / THETA) * (1.0 + Q2 * TEMR); + double CT = 1.0 + G / H; + double F = 2.0 * C13 / THETA32; + double X, XDF, XDFF; + ferinv7(F, X, XDF, XDFF); + CHI = X // Non-relativistic result + - 1.50 * std::log(CT); // Relativistic fit + } } From 243b58a511d50687765a5e464cc994c8894f1960 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 11:38:00 -0700 Subject: [PATCH 27/70] Real --- EOS/pc/eos_c.cpp | 144 ++++++++++++++++++++++++++--------------------- 1 file changed, 80 insertions(+), 64 deletions(-) diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 8e65a3a4d6..61792b2ac1 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -4,13 +4,29 @@ #include #include +typedef double Real; + +inline namespace literals { + constexpr Real + operator"" _rt( long double x ) + { + return Real( x ); + } + + constexpr Real + operator"" _rt( unsigned long long int x ) + { + return Real( x ); + } +} + extern "C" { // Inverse Fermi integrals with q=1/2 - void ferinv7 (double F, - double& X, - double& XDF, - double& XDFF) + void ferinv7 (Real F, + Real& X, + Real& XDF, + Real& XDFF) { // Version 24.05.07 // X_q(f)=F^{-1}_q(f) : H.M.Antia 93 ApJS 84, 101 @@ -22,17 +38,17 @@ extern "C" // for XDF: 5.4e-7 // for XDFF: 4.8e-5 - const double A[6] = { 1.999266880833e4, 5.702479099336e3, 6.610132843877e2, - 3.818838129486e1, 1.e0, 0.0}; - const double B[7] = { 1.771804140488e4, -2.014785161019e3, 9.130355392717e1, - -1.670718177489e0, 0.0, 0.0, - 0.0}; - const double C[7] = {-1.277060388085e-2, 7.187946804945e-2, -4.262314235106e-1, - 4.997559426872e-1, -1.285579118012e0, -3.930805454272e-1, - 1.e0}; - const double D[7] = {-9.745794806288e-3, 5.485432756838e-2, -3.29946624326e-1, - 4.077841975923e-1, -1.145531476975e0, -6.067091689181e-2, - 0.0}; + const Real A[6] = { 1.999266880833e4, 5.702479099336e3, 6.610132843877e2, + 3.818838129486e1, 1.e0, 0.0}; + const Real B[7] = { 1.771804140488e4, -2.014785161019e3, 9.130355392717e1, + -1.670718177489e0, 0.0, 0.0, + 0.0}; + const Real C[7] = {-1.277060388085e-2, 7.187946804945e-2, -4.262314235106e-1, + 4.997559426872e-1, -1.285579118012e0, -3.930805454272e-1, + 1.e0}; + const Real D[7] = {-9.745794806288e-3, 5.485432756838e-2, -3.29946624326e-1, + 4.077841975923e-1, -1.145531476975e0, -6.067091689181e-2, + 0.0}; const int LA = 4; const int LB = 3; const int LD = 5; @@ -44,13 +60,13 @@ extern "C" exit(1); } if (F < 4.0) { - double T = F; - double UP = 0.0; - double UP1 = 0.0; - double UP2 = 0.0; - double DOWN = 0.0; - double DOWN1 = 0.0; - double DOWN2 = 0.0; + Real T = F; + Real UP = 0.0; + Real UP1 = 0.0; + Real UP2 = 0.0; + Real DOWN = 0.0; + Real DOWN1 = 0.0; + Real DOWN2 = 0.0; for (int i = LA; i >= 0; --i) { UP = UP * T + A[i]; if (i >= 1) { @@ -75,16 +91,16 @@ extern "C" DOWN2 / DOWN + (DOWN1 / DOWN) * (DOWN1 / DOWN); } else { - double P = -1.0 / (0.5 + (double) N); // = -1/(1+\nu) = power index - double T = std::pow(F, P); // t - argument of the rational fraction - double T1 = P * T / F; // dt/df - double T2 = P * (P - 1.0) * T / (F * F); // d^2 t / df^2 - double UP = 0.0; - double UP1 = 0.0; - double UP2 = 0.0; - double DOWN = 0.0; - double DOWN1 = 0.0; - double DOWN2 = 0.0; + Real P = -1.0 / (0.5 + (Real) N); // = -1/(1+\nu) = power index + Real T = std::pow(F, P); // t - argument of the rational fraction + Real T1 = P * T / F; // dt/df + Real T2 = P * (P - 1.0) * T / (F * F); // d^2 t / df^2 + Real UP = 0.0; + Real UP1 = 0.0; + Real UP2 = 0.0; + Real DOWN = 0.0; + Real DOWN1 = 0.0; + Real DOWN2 = 0.0; for (int i = 6; i >= 0; --i) { UP = UP * T + C[i]; if (i >= 1) { @@ -103,18 +119,18 @@ extern "C" DOWN2 = DOWN2 * T + D[i] * i * (i-1); } } - double R = UP / DOWN; - double R1 = (UP1 - UP * DOWN1 / DOWN) / DOWN; // dR/dt - double R2 = (UP2 - (2.0 * UP1 * DOWN1 + UP * DOWN2) / DOWN + + Real R = UP / DOWN; + Real R1 = (UP1 - UP * DOWN1 / DOWN) / DOWN; // dR/dt + Real R2 = (UP2 - (2.0 * UP1 * DOWN1 + UP * DOWN2) / DOWN + 2.0 * UP * (DOWN1 / DOWN) * (DOWN1 / DOWN)) / DOWN; X = R/T; - double RT = (R1 - R / T) / T; + Real RT = (R1 - R / T) / T; XDF = T1 * RT; XDFF = T2 * RT + T1 * T1 * (R2 - 2.0 * RT) / T; } } - void chemfit (double DENS, double TEMP, double& CHI) + void chemfit (Real DENS, Real TEMP, Real& CHI) { // Version 29.08.15 // Fit to the chemical potential of free electron gas described in: @@ -124,19 +140,19 @@ extern "C" // TEMP - temperature [a.u.=2Ryd=3.1577e5 K] // Output: CHI = CMU1 / TEMR, where CMU1 = \mu-1 - chem.pot.w/o rest-energy - const double C13 = 1.0 / 3.0; - const double PARA = 1.612; - const double PARB = 6.192; - const double PARC = 0.0944; - const double PARF = 5.535; - const double PARG = 0.698; - const double XEPST = 228.0; // the largest argument of e^{-X} + const Real C13 = 1.0 / 3.0; + const Real PARA = 1.612; + const Real PARB = 6.192; + const Real PARC = 0.0944; + const Real PARF = 5.535; + const Real PARG = 0.698; + const Real XEPST = 228.0; // the largest argument of e^{-X} - double DENR = DENS / 2.5733806e6; // n_e in rel.un.=\lambda_{Compton}^{-3} - double TEMR = TEMP / 1.8778865e4; // T in rel.un.=(mc^2/k)=5.93e9 K + Real DENR = DENS / 2.5733806e6; // n_e in rel.un.=\lambda_{Compton}^{-3} + Real TEMR = TEMP / 1.8778865e4; // T in rel.un.=(mc^2/k)=5.93e9 K - double PF0 = std::pow(29.6088132 * DENR, C13); // Classical Fermi momentum - double TF; + Real PF0 = std::pow(29.6088132 * DENR, C13); // Classical Fermi momentum + Real TF; if (PF0 > 1.e-4) { TF = std::sqrt(1.0 + PF0 * PF0) - 1.0; // Fermi temperature } @@ -144,31 +160,31 @@ extern "C" TF = 0.50 * PF0 * PF0; } - double THETA = TEMR / TF; - double THETA32 = THETA * std::sqrt(THETA); - double Q2 = 12.0 + 8.0 / THETA32; - double T1 = 0.0; + Real THETA = TEMR / TF; + Real THETA32 = THETA * std::sqrt(THETA); + Real Q2 = 12.0 + 8.0 / THETA32; + Real T1 = 0.0; if (THETA < XEPST) { T1 = std::exp(-THETA); } - double U3 = T1 * T1 + PARA; - double THETAC = std::pow(THETA, PARC); - double THETAG = std::pow(THETA, PARG); - double D3 = PARB * THETAC * T1 * T1 + PARF * THETAG; - double Q3 = 1.365568127 - U3 / D3; // 1.365...=2/\pi^{1/3} - double Q1; + Real U3 = T1 * T1 + PARA; + Real THETAC = std::pow(THETA, PARC); + Real THETAG = std::pow(THETA, PARG); + Real D3 = PARB * THETAC * T1 * T1 + PARF * THETAG; + Real Q3 = 1.365568127 - U3 / D3; // 1.365...=2/\pi^{1/3} + Real Q1; if (THETA > 1.e-5) { Q1 = 1.5 * T1 / (1.0 - T1); } else { Q1 = 1.5 / THETA; } - double SQT = std::sqrt(TEMR); - double G = (1.0 + Q2 * TEMR * Q3 + Q1 * SQT) * TEMR; - double H = (1.0 + 0.5 * TEMR / THETA) * (1.0 + Q2 * TEMR); - double CT = 1.0 + G / H; - double F = 2.0 * C13 / THETA32; - double X, XDF, XDFF; + Real SQT = std::sqrt(TEMR); + Real G = (1.0 + Q2 * TEMR * Q3 + Q1 * SQT) * TEMR; + Real H = (1.0 + 0.5 * TEMR / THETA) * (1.0 + Q2 * TEMR); + Real CT = 1.0 + G / H; + Real F = 2.0 * C13 / THETA32; + Real X, XDF, XDFF; ferinv7(F, X, XDF, XDFF); CHI = X // Non-relativistic result - 1.50 * std::log(CT); // Relativistic fit From 2fd8d47029614c804a30eada393c3ef33a10aacd Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 11:41:51 -0700 Subject: [PATCH 28/70] _rt --- EOS/pc/eos_c.cpp | 112 +++++++++++++++++++++++------------------------ 1 file changed, 56 insertions(+), 56 deletions(-) diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 61792b2ac1..cddcdf06a9 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -38,35 +38,35 @@ extern "C" // for XDF: 5.4e-7 // for XDFF: 4.8e-5 - const Real A[6] = { 1.999266880833e4, 5.702479099336e3, 6.610132843877e2, - 3.818838129486e1, 1.e0, 0.0}; - const Real B[7] = { 1.771804140488e4, -2.014785161019e3, 9.130355392717e1, - -1.670718177489e0, 0.0, 0.0, - 0.0}; - const Real C[7] = {-1.277060388085e-2, 7.187946804945e-2, -4.262314235106e-1, - 4.997559426872e-1, -1.285579118012e0, -3.930805454272e-1, - 1.e0}; - const Real D[7] = {-9.745794806288e-3, 5.485432756838e-2, -3.29946624326e-1, - 4.077841975923e-1, -1.145531476975e0, -6.067091689181e-2, - 0.0}; + const Real A[6] = { 1.999266880833e4_rt, 5.702479099336e3_rt, 6.610132843877e2_rt, + 3.818838129486e1_rt, 1.0_rt, 0.0_rt}; + const Real B[7] = { 1.771804140488e4_rt, -2.014785161019e3_rt, 9.130355392717e1_rt, + -1.670718177489e0_rt, 0.0_rt, 0.0_rt, + 0.0_rt}; + const Real C[7] = {-1.277060388085e-2_rt, 7.187946804945e-2_rt, -4.262314235106e-1_rt, + 4.997559426872e-1_rt, -1.285579118012e0_rt, -3.930805454272e-1_rt, + 1.0_rt}; + const Real D[7] = {-9.745794806288e-3_rt, 5.485432756838e-2_rt, -3.29946624326e-1_rt, + 4.077841975923e-1_rt, -1.145531476975e0_rt, -6.067091689181e-2_rt, + 0.0_rt}; const int LA = 4; const int LB = 3; const int LD = 5; const int N = 1; - if (F <= 0.0) { + if (F <= 0.0_rt) { printf("FERINV7: Non-positive argument\n"); exit(1); } - if (F < 4.0) { + if (F < 4.0_rt) { Real T = F; - Real UP = 0.0; - Real UP1 = 0.0; - Real UP2 = 0.0; - Real DOWN = 0.0; - Real DOWN1 = 0.0; - Real DOWN2 = 0.0; + Real UP = 0.0_rt; + Real UP1 = 0.0_rt; + Real UP2 = 0.0_rt; + Real DOWN = 0.0_rt; + Real DOWN1 = 0.0_rt; + Real DOWN2 = 0.0_rt; for (int i = LA; i >= 0; --i) { UP = UP * T + A[i]; if (i >= 1) { @@ -86,21 +86,21 @@ extern "C" } } X = std::log(T * UP / DOWN); - XDF = 1.0 / T + UP1 / UP - DOWN1 / DOWN; - XDFF = -1.0 / (T * T) + UP2 / UP - (UP1 / UP) * (UP1 / UP) - + XDF = 1.0_rt / T + UP1 / UP - DOWN1 / DOWN; + XDFF = -1.0_rt / (T * T) + UP2 / UP - (UP1 / UP) * (UP1 / UP) - DOWN2 / DOWN + (DOWN1 / DOWN) * (DOWN1 / DOWN); } else { - Real P = -1.0 / (0.5 + (Real) N); // = -1/(1+\nu) = power index + Real P = -1.0_rt / (0.5_rt + (Real) N); // = -1/(1+\nu) = power index Real T = std::pow(F, P); // t - argument of the rational fraction Real T1 = P * T / F; // dt/df - Real T2 = P * (P - 1.0) * T / (F * F); // d^2 t / df^2 - Real UP = 0.0; - Real UP1 = 0.0; - Real UP2 = 0.0; - Real DOWN = 0.0; - Real DOWN1 = 0.0; - Real DOWN2 = 0.0; + Real T2 = P * (P - 1.0_rt) * T / (F * F); // d^2 t / df^2 + Real UP = 0.0_rt; + Real UP1 = 0.0_rt; + Real UP2 = 0.0_rt; + Real DOWN = 0.0_rt; + Real DOWN1 = 0.0_rt; + Real DOWN2 = 0.0_rt; for (int i = 6; i >= 0; --i) { UP = UP * T + C[i]; if (i >= 1) { @@ -121,12 +121,12 @@ extern "C" } Real R = UP / DOWN; Real R1 = (UP1 - UP * DOWN1 / DOWN) / DOWN; // dR/dt - Real R2 = (UP2 - (2.0 * UP1 * DOWN1 + UP * DOWN2) / DOWN + - 2.0 * UP * (DOWN1 / DOWN) * (DOWN1 / DOWN)) / DOWN; + Real R2 = (UP2 - (2.0_rt * UP1 * DOWN1 + UP * DOWN2) / DOWN + + 2.0_rt * UP * (DOWN1 / DOWN) * (DOWN1 / DOWN)) / DOWN; X = R/T; Real RT = (R1 - R / T) / T; XDF = T1 * RT; - XDFF = T2 * RT + T1 * T1 * (R2 - 2.0 * RT) / T; + XDFF = T2 * RT + T1 * T1 * (R2 - 2.0_rt * RT) / T; } } @@ -140,30 +140,30 @@ extern "C" // TEMP - temperature [a.u.=2Ryd=3.1577e5 K] // Output: CHI = CMU1 / TEMR, where CMU1 = \mu-1 - chem.pot.w/o rest-energy - const Real C13 = 1.0 / 3.0; - const Real PARA = 1.612; - const Real PARB = 6.192; - const Real PARC = 0.0944; - const Real PARF = 5.535; - const Real PARG = 0.698; - const Real XEPST = 228.0; // the largest argument of e^{-X} + const Real C13 = 1.0_rt / 3.0_rt; + const Real PARA = 1.612_rt; + const Real PARB = 6.192_rt; + const Real PARC = 0.0944_rt; + const Real PARF = 5.535_rt; + const Real PARG = 0.698_rt; + const Real XEPST = 228.0_rt; // the largest argument of e^{-X} - Real DENR = DENS / 2.5733806e6; // n_e in rel.un.=\lambda_{Compton}^{-3} - Real TEMR = TEMP / 1.8778865e4; // T in rel.un.=(mc^2/k)=5.93e9 K + Real DENR = DENS / 2.5733806e6_rt; // n_e in rel.un.=\lambda_{Compton}^{-3} + Real TEMR = TEMP / 1.8778865e4_rt; // T in rel.un.=(mc^2/k)=5.93e9 K - Real PF0 = std::pow(29.6088132 * DENR, C13); // Classical Fermi momentum + Real PF0 = std::pow(29.6088132_rt * DENR, C13); // Classical Fermi momentum Real TF; - if (PF0 > 1.e-4) { - TF = std::sqrt(1.0 + PF0 * PF0) - 1.0; // Fermi temperature + if (PF0 > 1.e-4_rt) { + TF = std::sqrt(1.0_rt + PF0 * PF0) - 1.0_rt; // Fermi temperature } else { - TF = 0.50 * PF0 * PF0; + TF = 0.5_rt * PF0 * PF0; } Real THETA = TEMR / TF; Real THETA32 = THETA * std::sqrt(THETA); - Real Q2 = 12.0 + 8.0 / THETA32; - Real T1 = 0.0; + Real Q2 = 12.0_rt + 8.0_rt / THETA32; + Real T1 = 0.0_rt; if (THETA < XEPST) { T1 = std::exp(-THETA); } @@ -171,22 +171,22 @@ extern "C" Real THETAC = std::pow(THETA, PARC); Real THETAG = std::pow(THETA, PARG); Real D3 = PARB * THETAC * T1 * T1 + PARF * THETAG; - Real Q3 = 1.365568127 - U3 / D3; // 1.365...=2/\pi^{1/3} + Real Q3 = 1.365568127_rt - U3 / D3; // 1.365...=2/\pi^{1/3} Real Q1; - if (THETA > 1.e-5) { - Q1 = 1.5 * T1 / (1.0 - T1); + if (THETA > 1.e-5_rt) { + Q1 = 1.5_rt * T1 / (1.0_rt - T1); } else { Q1 = 1.5 / THETA; } Real SQT = std::sqrt(TEMR); - Real G = (1.0 + Q2 * TEMR * Q3 + Q1 * SQT) * TEMR; - Real H = (1.0 + 0.5 * TEMR / THETA) * (1.0 + Q2 * TEMR); - Real CT = 1.0 + G / H; - Real F = 2.0 * C13 / THETA32; + Real G = (1.0_rt + Q2 * TEMR * Q3 + Q1 * SQT) * TEMR; + Real H = (1.0_rt + 0.5 * TEMR / THETA) * (1.0_rt + Q2 * TEMR); + Real CT = 1.0_rt + G / H; + Real F = 2.0_rt * C13 / THETA32; Real X, XDF, XDFF; ferinv7(F, X, XDF, XDFF); - CHI = X // Non-relativistic result - - 1.50 * std::log(CT); // Relativistic fit + CHI = X // Non-relativistic result + - 1.5_rt * std::log(CT); // Relativistic fit } } From 35c0908c0f08fee467330e391be94670bb10ea91 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 11:47:55 -0700 Subject: [PATCH 29/70] Remove unused derivatives from ferinv7 --- EOS/pc/eos_c.cpp | 65 ++++++------------------------------------------ 1 file changed, 8 insertions(+), 57 deletions(-) diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index cddcdf06a9..88d60f6fb4 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -22,21 +22,15 @@ inline namespace literals { extern "C" { - // Inverse Fermi integrals with q=1/2 - void ferinv7 (Real F, - Real& X, - Real& XDF, - Real& XDFF) + // Inverse Fermi integral with q=1/2 + void ferinv7 (Real F, Real& X) { // Version 24.05.07 // X_q(f)=F^{-1}_q(f) : H.M.Antia 93 ApJS 84, 101 - // Input: F - argument - // Output: X=X_q, XDF=dX/df, XDFF=d^2 X / df^2 + // Input: F + // Output: X = X_q // Relative error: // for X: 4.2e-9 - // jump at f=4: - // for XDF: 5.4e-7 - // for XDFF: 4.8e-5 const Real A[6] = { 1.999266880833e4_rt, 5.702479099336e3_rt, 6.610132843877e2_rt, 3.818838129486e1_rt, 1.0_rt, 0.0_rt}; @@ -56,77 +50,34 @@ extern "C" const int N = 1; if (F <= 0.0_rt) { - printf("FERINV7: Non-positive argument\n"); + printf("ferinv7: Non-positive argument\n"); exit(1); } if (F < 4.0_rt) { Real T = F; Real UP = 0.0_rt; - Real UP1 = 0.0_rt; - Real UP2 = 0.0_rt; Real DOWN = 0.0_rt; - Real DOWN1 = 0.0_rt; - Real DOWN2 = 0.0_rt; for (int i = LA; i >= 0; --i) { UP = UP * T + A[i]; - if (i >= 1) { - UP1 = UP1 * T + A[i] * i; - } - if (i >= 2) { - UP2 = UP2 * T + A[i] * i * (i-1); - } } for (int i = LB; i >= 0; --i) { DOWN = DOWN * T + B[i]; - if (i >= 1) { - DOWN1 = DOWN1 * T + B[i] * i; - } - if (i >= 2) { - DOWN2 = DOWN2 * T + B[i] * i * (i-1); - } } X = std::log(T * UP / DOWN); - XDF = 1.0_rt / T + UP1 / UP - DOWN1 / DOWN; - XDFF = -1.0_rt / (T * T) + UP2 / UP - (UP1 / UP) * (UP1 / UP) - - DOWN2 / DOWN + (DOWN1 / DOWN) * (DOWN1 / DOWN); } else { Real P = -1.0_rt / (0.5_rt + (Real) N); // = -1/(1+\nu) = power index Real T = std::pow(F, P); // t - argument of the rational fraction - Real T1 = P * T / F; // dt/df - Real T2 = P * (P - 1.0_rt) * T / (F * F); // d^2 t / df^2 Real UP = 0.0_rt; - Real UP1 = 0.0_rt; - Real UP2 = 0.0_rt; Real DOWN = 0.0_rt; - Real DOWN1 = 0.0_rt; - Real DOWN2 = 0.0_rt; for (int i = 6; i >= 0; --i) { UP = UP * T + C[i]; - if (i >= 1) { - UP1 = UP1 * T + C[i] * i; - } - if (i >= 2) { - UP2 = UP2 * T + C[i] * i * (i-1); - } } for (int i = LD; i >= 0; --i) { DOWN = DOWN * T + D[i]; - if (i >= 1) { - DOWN1 = DOWN1 * T + D[i] * i; - } - if (i >= 2) { - DOWN2 = DOWN2 * T + D[i] * i * (i-1); - } } Real R = UP / DOWN; - Real R1 = (UP1 - UP * DOWN1 / DOWN) / DOWN; // dR/dt - Real R2 = (UP2 - (2.0_rt * UP1 * DOWN1 + UP * DOWN2) / DOWN + - 2.0_rt * UP * (DOWN1 / DOWN) * (DOWN1 / DOWN)) / DOWN; - X = R/T; - Real RT = (R1 - R / T) / T; - XDF = T1 * RT; - XDFF = T2 * RT + T1 * T1 * (R2 - 2.0_rt * RT) / T; + X = R / T; } } @@ -184,8 +135,8 @@ extern "C" Real H = (1.0_rt + 0.5 * TEMR / THETA) * (1.0_rt + Q2 * TEMR); Real CT = 1.0_rt + G / H; Real F = 2.0_rt * C13 / THETA32; - Real X, XDF, XDFF; - ferinv7(F, X, XDF, XDFF); + Real X; + ferinv7(F, X); CHI = X // Non-relativistic result - 1.5_rt * std::log(CT); // Relativistic fit } From bc76805edc583a04d429516c5eef0cb384fae67f Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 12:46:50 -0700 Subject: [PATCH 30/70] Add hotter test --- EOS/pc/eos17.f90 | 186 +++++++++++++++++++++++++++++------------------ 1 file changed, 114 insertions(+), 72 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index ff7af18517..37ccb4a8b2 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -116,95 +116,137 @@ program main double precision :: CHI, TPT, TEGRAD, PRADnkT double precision :: PnkT, UNkT, SNk, CV, CHIR, CHIT integer :: LIQSOL - double precision :: dx + double precision :: x, T_arr(2) + integer :: i AZion(1) = 6.0d0 AZion(2) = 8.0d0 ACMI(1) = 12.0d0 ACMI(2) = 16.0d0 AY(1) = 0.6d0 AY(2) = 0.4d0 - T = 1.d9 - RHO = 1.d7 - RHOlg=dlog10(RHO) - Tlg=dlog10(T) - T6=10.d0**(Tlg-6.d0) - RHO=10.d0**RHOlg - TEMP=T6/UN_T6 ! T [au] - call MELANGE9(AY,AZion,ACMI,RHO,TEMP, & ! input - PRADnkT, & ! additional output - radiative pressure - DENS,Zmean,CMImean,Z2mean,GAMI,CHI,TPT,LIQSOL, & ! output param. - PnkT,UNkT,SNk,CV,CHIR,CHIT) ! output dimensionless TD functions - Tnk=8.31447d13/CMImean*RHO*T6 ! n_i kT [erg/cc] - P=PnkT*Tnk/1.d12 ! P [Mbar] - TEGRAD=CHIT/(CHIT**2+CHIR*CV/PnkT) ! from Maxwell relat. -! -------------------- OUTPUT -------------------------------- * -! Here in the output we have: -! RHO - mass density in g/cc -! P - total pressure in Mbar (i.e. in 1.e12 dyn/cm^2) -! PnkT=P/nkT, where n is the number density of ions, T temperature -! CV - heat capacity at constant volume, divided by number of ions, /k -! CHIT - logarithmic derivative of pressure \chi_T -! CHIR - logarithmic derivative of pressure \chi_\rho -! UNkT - internal energy divided by NkT, N being the number of ions -! SNk - entropy divided by number of ions, /k -! GAMI - ionic Coulomb coupling parameter -! TPT=T_p/T, where T_p is the ion plasma temperature -! CHI - electron chemical potential, divided by kT -! LIQSOL = 0 in the liquid state, = 1 in the solid state + T_arr(1) = 1.d9 + T_arr(2) = 5.d9 - dx = abs(P - 986087830999.01904d0) - if (dx / P > 1.d-15) then - print *, "P DIFF", dx / P - end if + do i = 1, 2 + print *, "iter ", i + T = T_arr(i) + RHO = 1.d7 + RHOlg=dlog10(RHO) + Tlg=dlog10(T) + T6=10.d0**(Tlg-6.d0) + RHO=10.d0**RHOlg + TEMP=T6/UN_T6 ! T [au] + call MELANGE9(AY,AZion,ACMI,RHO,TEMP, & ! input + PRADnkT, & ! additional output - radiative pressure + DENS,Zmean,CMImean,Z2mean,GAMI,CHI,TPT,LIQSOL, & ! output param. + PnkT,UNkT,SNk,CV,CHIR,CHIT) ! output dimensionless TD functions + Tnk=8.31447d13/CMImean*RHO*T6 ! n_i kT [erg/cc] + P=PnkT*Tnk/1.d12 ! P [Mbar] + TEGRAD=CHIT/(CHIT**2+CHIR*CV/PnkT) ! from Maxwell relat. + ! -------------------- OUTPUT -------------------------------- * + ! Here in the output we have: + ! RHO - mass density in g/cc + ! P - total pressure in Mbar (i.e. in 1.e12 dyn/cm^2) + ! PnkT=P/nkT, where n is the number density of ions, T temperature + ! CV - heat capacity at constant volume, divided by number of ions, /k + ! CHIT - logarithmic derivative of pressure \chi_T + ! CHIR - logarithmic derivative of pressure \chi_\rho + ! UNkT - internal energy divided by NkT, N being the number of ions + ! SNk - entropy divided by number of ions, /k + ! GAMI - ionic Coulomb coupling parameter + ! TPT=T_p/T, where T_p is the ion plasma temperature + ! CHI - electron chemical potential, divided by kT + ! LIQSOL = 0 in the liquid state, = 1 in the solid state - dx = abs(PnkT - 16.129464056742833d0) - if (dx / PnkT > 1.d-15) then - print *, "PnkT DIFF", dx / PnkT - end if + if (i == 1) then + x = 986087830999.01904d0 + else if (i == 2) then + x = 2495983700684.0181d0 + end if - dx = abs(CV - 8.5451229292858866d0) - if (dx / CV > 1.d-15) then - print *, "CV DIFF", dx / CV - end if + print *, "P DIFF", abs(x - P) / P - dx = abs(CHIT - 0.24165606904443493d0) - if (dx / CHIT > 1.d-15) then - print *, "CHIT DIFF", dx / CHIT - end if + if (i == 1) then + x = 16.129464056742833d0 + else if (i == 2) then + x = 8.1653739394820484d0 + end if - dx = abs(CHIR - 1.3370085960654023d0) - if (dx / CHIR > 1.d-15) then - print *, "CHIR DIFF", dx / CHIR - end if + print *, "PnkT DIFF", abs(x - PnkT) / PnkT - dx = abs(UNkT - 30.712489657322770d0) - if (dx / UNkT > 1.d-15) then - print *, "UNkT DIFF", dx / UNkT - end if + if (i == 1) then + x = 8.5451229292858866d0 + else if (i == 2) then + x = 18.539323243568369d0 + end if - dx = abs(SNk - 23.797925638433309d0) - if (dx / SNk > 1.d-15) then - print *, "SNk DIFF", dx / SNk - end if + print *, "CV DIFF", abs(x - CV) / CV - dx = abs(GAMI - 0.96111630472601972d0) - if (dx / GAMI > 1.d-15) then - print *, "GAMI DIFF", dx / GAMI - end if + if (i == 1) then + x = 0.24165606904443493d0 + else if (i == 2) then + x = 0.88747950206022497d0 + end if - dx = abs(TPT - 1.2400526419152945d-002) - if (dx / TPT > 1.d-15) then - print *, "TPT DIFF", dx / TPT - end if + print *, "CHIT DIFF", abs(x - CHIT) / CHIT - dx = abs(CHI - 5.5745494145734744d0) - if (dx / CHI > 1.d-15) then - print *, "CHI DIFF", dx / CHI - end if + if (i == 1) then + x = 1.3370085960654023d0 + else if (i == 2) then + x = 1.0433031714423413d0 + end if - if (LIQSOL /= 0) then - print *, "LIQSOL DIFF", LIQSOL - end if + print *, "CHIR DIFF", abs(x - CHIR) / CHIR + + if (i == 1) then + x = 30.712489657322770d0 + else if (i == 2) then + x = 18.110542903803580d0 + end if + + print *, "UNkT DIFF", abs(x - UNkT) / UNkT + + if (i == 1) then + x = 23.797925638433309d0 + else if (i == 2) then + x = 45.817442265862802d0 + end if + + print *, "SNk DIFF", abs(x - SNk) / SNk + + if (i == 1) then + x = 0.96111630472601972d0 + else if (i == 2) then + x = 0.19172836887561015d0 + end if + + print *, "GAMI DIFF", abs(x - GAMI) / GAMI + + if (i == 1) then + x = 1.2400526419152945d-2 + else if (i == 2) then + x = 2.4705336474828152d-3 + end if + + print *, "TPT DIFF", abs(x - TPT) / TPT + + if (i == 1) then + x = 5.5745494145734744d0 + else if (i == 2) then + x = -0.43436266588208006d0 + end if + + print *, "CHI DIFF", abs(x - CHI) / CHI + + if (i == 1) then + x = 0 + else if (i == 2) then + x = 0 + end if + + print *, "LIQSOL DIFF", abs(x - LIQSOL) + + end do end program main From c266105be635dbefbef04fc9afebc0ce39606c54 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 13:02:34 -0700 Subject: [PATCH 31/70] Add cold T case --- EOS/pc/eos17.f90 | 223 ++++++++++++++++++++++++++--------------------- 1 file changed, 125 insertions(+), 98 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 37ccb4a8b2..398f6f6fc2 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -116,8 +116,8 @@ program main double precision :: CHI, TPT, TEGRAD, PRADnkT double precision :: PnkT, UNkT, SNk, CV, CHIR, CHIT integer :: LIQSOL - double precision :: x, T_arr(2) - integer :: i + double precision :: x, T_arr(3), rho_arr(2) + integer :: i, j AZion(1) = 6.0d0 AZion(2) = 8.0d0 ACMI(1) = 12.0d0 @@ -126,126 +126,153 @@ program main AY(2) = 0.4d0 T_arr(1) = 1.d9 T_arr(2) = 5.d9 + T_arr(3) = 1.d6 + rho_arr(1) = 1.d7 + rho_arr(2) = 5.d9 - do i = 1, 2 - print *, "iter ", i - T = T_arr(i) - RHO = 1.d7 - RHOlg=dlog10(RHO) - Tlg=dlog10(T) - T6=10.d0**(Tlg-6.d0) - RHO=10.d0**RHOlg - TEMP=T6/UN_T6 ! T [au] - call MELANGE9(AY,AZion,ACMI,RHO,TEMP, & ! input - PRADnkT, & ! additional output - radiative pressure - DENS,Zmean,CMImean,Z2mean,GAMI,CHI,TPT,LIQSOL, & ! output param. - PnkT,UNkT,SNk,CV,CHIR,CHIT) ! output dimensionless TD functions - Tnk=8.31447d13/CMImean*RHO*T6 ! n_i kT [erg/cc] - P=PnkT*Tnk/1.d12 ! P [Mbar] - TEGRAD=CHIT/(CHIT**2+CHIR*CV/PnkT) ! from Maxwell relat. - ! -------------------- OUTPUT -------------------------------- * - ! Here in the output we have: - ! RHO - mass density in g/cc - ! P - total pressure in Mbar (i.e. in 1.e12 dyn/cm^2) - ! PnkT=P/nkT, where n is the number density of ions, T temperature - ! CV - heat capacity at constant volume, divided by number of ions, /k - ! CHIT - logarithmic derivative of pressure \chi_T - ! CHIR - logarithmic derivative of pressure \chi_\rho - ! UNkT - internal energy divided by NkT, N being the number of ions - ! SNk - entropy divided by number of ions, /k - ! GAMI - ionic Coulomb coupling parameter - ! TPT=T_p/T, where T_p is the ion plasma temperature - ! CHI - electron chemical potential, divided by kT - ! LIQSOL = 0 in the liquid state, = 1 in the solid state + do j = 1, 1 + do i = 1, 3 + print *, "iter ", i, j + T = T_arr(i) + RHO = RHO_arr(j) + RHOlg=dlog10(RHO) + Tlg=dlog10(T) + T6=10.d0**(Tlg-6.d0) + RHO=10.d0**RHOlg + TEMP=T6/UN_T6 ! T [au] + call MELANGE9(AY,AZion,ACMI,RHO,TEMP, & ! input + PRADnkT, & ! additional output - radiative pressure + DENS,Zmean,CMImean,Z2mean,GAMI,CHI,TPT,LIQSOL, & ! output param. + PnkT,UNkT,SNk,CV,CHIR,CHIT) ! output dimensionless TD functions + Tnk=8.31447d13/CMImean*RHO*T6 ! n_i kT [erg/cc] + P=PnkT*Tnk/1.d12 ! P [Mbar] + TEGRAD=CHIT/(CHIT**2+CHIR*CV/PnkT) ! from Maxwell relat. + ! -------------------- OUTPUT -------------------------------- * + ! Here in the output we have: + ! RHO - mass density in g/cc + ! P - total pressure in Mbar (i.e. in 1.e12 dyn/cm^2) + ! PnkT=P/nkT, where n is the number density of ions, T temperature + ! CV - heat capacity at constant volume, divided by number of ions, /k + ! CHIT - logarithmic derivative of pressure \chi_T + ! CHIR - logarithmic derivative of pressure \chi_\rho + ! UNkT - internal energy divided by NkT, N being the number of ions + ! SNk - entropy divided by number of ions, /k + ! GAMI - ionic Coulomb coupling parameter + ! TPT=T_p/T, where T_p is the ion plasma temperature + ! CHI - electron chemical potential, divided by kT + ! LIQSOL = 0 in the liquid state, = 1 in the solid state - if (i == 1) then - x = 986087830999.01904d0 - else if (i == 2) then - x = 2495983700684.0181d0 - end if + if (i == 1 .and. j == 1) then + x = 986087830999.01904d0 + else if (i == 2 .and. j == 1) then + x = 2495983700684.0181d0 + else if (i == 3 .and. j == 1) then + x = 826241619577.72607d0 + end if - print *, "P DIFF", abs(x - P) / P + print *, "P DIFF", abs(x - P) / P - if (i == 1) then - x = 16.129464056742833d0 - else if (i == 2) then - x = 8.1653739394820484d0 - end if + if (i == 1 .and. j == 1) then + x = 16.129464056742833d0 + else if (i == 2 .and. j == 1) then + x = 8.1653739394820484d0 + else if (i == 3 .and. j == 2) then + x = 13514.855458323951d0 + end if - print *, "PnkT DIFF", abs(x - PnkT) / PnkT + print *, "PnkT DIFF", abs(x - PnkT) / PnkT - if (i == 1) then - x = 8.5451229292858866d0 - else if (i == 2) then - x = 18.539323243568369d0 - end if + if (i == 1 .and. j == 1) then + x = 8.5451229292858866d0 + else if (i == 2 .and. j == 1) then + x = 18.539323243568369d0 + else if (i == 3 .and. j == 1) then + x = 0.73822827392302692d0 + end if - print *, "CV DIFF", abs(x - CV) / CV + print *, "CV DIFF", abs(x - CV) / CV - if (i == 1) then - x = 0.24165606904443493d0 - else if (i == 2) then - x = 0.88747950206022497d0 - end if + if (i == 1 .and. j == 1) then + x = 0.24165606904443493d0 + else if (i == 2 .and. j == 1) then + x = 0.88747950206022497d0 + else if (i == 3 .and. j == 1) then + x = 2.7120648074179433d-5 + end if - print *, "CHIT DIFF", abs(x - CHIT) / CHIT + print *, "CHIT DIFF", abs(x - CHIT) / CHIT - if (i == 1) then - x = 1.3370085960654023d0 - else if (i == 2) then - x = 1.0433031714423413d0 - end if + if (i == 1 .and. j == 1) then + x = 1.3370085960654023d0 + else if (i == 2 .and. j == 1) then + x = 1.0433031714423413d0 + else if (i == 3 .and. j == 1) then + x = 1.4524787201645497d0 + end if - print *, "CHIR DIFF", abs(x - CHIR) / CHIR + print *, "CHIR DIFF", abs(x - CHIR) / CHIR - if (i == 1) then - x = 30.712489657322770d0 - else if (i == 2) then - x = 18.110542903803580d0 - end if + if (i == 1 .and. j == 1) then + x = 30.712489657322770d0 + else if (i == 2 .and. j == 1) then + x = 18.110542903803580d0 + else if (i == 3 .and. j == 1) then + x = 25265.106328521317d0 + end if - print *, "UNkT DIFF", abs(x - UNkT) / UNkT + print *, "UNkT DIFF", abs(x - UNkT) / UNkT - if (i == 1) then - x = 23.797925638433309d0 - else if (i == 2) then - x = 45.817442265862802d0 - end if + if (i == 1 .and. j == 1) then + x = 23.797925638433309d0 + else if (i == 2 .and. j == 1) then + x = 45.817442265862802d0 + else if (i == 3 .and. j == 1) then + x = 1.0215909624032917d0 + end if - print *, "SNk DIFF", abs(x - SNk) / SNk + print *, "SNk DIFF", abs(x - SNk) / SNk - if (i == 1) then - x = 0.96111630472601972d0 - else if (i == 2) then - x = 0.19172836887561015d0 - end if + if (i == 1 .and. j == 1) then + x = 0.96111630472601972d0 + else if (i == 2 .and. j == 1) then + x = 0.19172836887561015d0 + else if (i == 3 .and. j == 1) then + x = 960.24524371490861d0 + end if - print *, "GAMI DIFF", abs(x - GAMI) / GAMI + print *, "GAMI DIFF", abs(x - GAMI) / GAMI - if (i == 1) then - x = 1.2400526419152945d-2 - else if (i == 2) then - x = 2.4705336474828152d-3 - end if + if (i == 1 .and. j == 1) then + x = 1.2400526419152945d-2 + else if (i == 2 .and. j == 1) then + x = 2.4705336474828152d-3 + else if (i == 3 .and. j == 1) then + x = 12.383672318439324d0 + end if - print *, "TPT DIFF", abs(x - TPT) / TPT + print *, "TPT DIFF", abs(x - TPT) / TPT - if (i == 1) then - x = 5.5745494145734744d0 - else if (i == 2) then - x = -0.43436266588208006d0 - end if + if (i == 1 .and. j == 1) then + x = 5.5745494145734744d0 + else if (i == 2 .and. j == 1) then + x = -0.43436266588208006d0 + else if (i == 3 .and. j == 1) then + x = 5894.2025691009021d0 + end if - print *, "CHI DIFF", abs(x - CHI) / CHI + print *, "CHI DIFF", abs(x - CHI) / CHI - if (i == 1) then - x = 0 - else if (i == 2) then - x = 0 - end if + if (i == 1 .and. j == 1) then + x = 0 + else if (i == 2 .and. j == 1) then + x = 0 + else if (i == 3 .and. j == 1) then + x = 1 + end if - print *, "LIQSOL DIFF", abs(x - LIQSOL) + print *, "LIQSOL DIFF", abs(x - LIQSOL) + end do end do end program main From 1167d162e497533ff79ee57b542bbdcfb7ab8eb6 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 13:14:28 -0700 Subject: [PATCH 32/70] Print out max diff over all fields --- EOS/pc/eos17.f90 | 52 ++++++++++++++++++++++++++++++++++++------------ 1 file changed, 39 insertions(+), 13 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 398f6f6fc2..e98b31d731 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -116,7 +116,7 @@ program main double precision :: CHI, TPT, TEGRAD, PRADnkT double precision :: PnkT, UNkT, SNk, CV, CHIR, CHIT integer :: LIQSOL - double precision :: x, T_arr(3), rho_arr(2) + double precision :: x, diff, max_diff, T_arr(3), rho_arr(2) integer :: i, j AZion(1) = 6.0d0 AZion(2) = 8.0d0 @@ -130,6 +130,8 @@ program main rho_arr(1) = 1.d7 rho_arr(2) = 5.d9 + max_diff = 0.0d0 + do j = 1, 1 do i = 1, 3 print *, "iter ", i, j @@ -170,17 +172,21 @@ program main x = 826241619577.72607d0 end if - print *, "P DIFF", abs(x - P) / P + diff = abs(x - P) / P + max_diff = max(diff, max_diff) + print *, "P DIFF", diff if (i == 1 .and. j == 1) then x = 16.129464056742833d0 else if (i == 2 .and. j == 1) then x = 8.1653739394820484d0 - else if (i == 3 .and. j == 2) then + else if (i == 3 .and. j == 1) then x = 13514.855458323951d0 end if - print *, "PnkT DIFF", abs(x - PnkT) / PnkT + diff = abs(x - PnkT) / PnkT + max_diff = max(diff, max_diff) + print *, "PnkT DIFF", diff if (i == 1 .and. j == 1) then x = 8.5451229292858866d0 @@ -190,7 +196,9 @@ program main x = 0.73822827392302692d0 end if - print *, "CV DIFF", abs(x - CV) / CV + diff = abs(x - CV) / CV + max_diff = max(diff, max_diff) + print *, "CV DIFF", diff if (i == 1 .and. j == 1) then x = 0.24165606904443493d0 @@ -200,7 +208,9 @@ program main x = 2.7120648074179433d-5 end if - print *, "CHIT DIFF", abs(x - CHIT) / CHIT + diff = abs(x - CHIT) / CHIT + max_diff = max(diff, max_diff) + print *, "CHIT DIFF", diff if (i == 1 .and. j == 1) then x = 1.3370085960654023d0 @@ -210,7 +220,9 @@ program main x = 1.4524787201645497d0 end if - print *, "CHIR DIFF", abs(x - CHIR) / CHIR + diff = abs(x - CHIR) / CHIR + max_diff = max(diff, max_diff) + print *, "CHIR DIFF", diff if (i == 1 .and. j == 1) then x = 30.712489657322770d0 @@ -220,7 +232,9 @@ program main x = 25265.106328521317d0 end if - print *, "UNkT DIFF", abs(x - UNkT) / UNkT + diff = abs(x - UNkT) / UNkT + max_diff = max(diff, max_diff) + print *, "UNkT DIFF", diff if (i == 1 .and. j == 1) then x = 23.797925638433309d0 @@ -230,7 +244,9 @@ program main x = 1.0215909624032917d0 end if - print *, "SNk DIFF", abs(x - SNk) / SNk + diff = abs(x - SNk) / SNk + max_diff = max(diff, max_diff) + print *, "SNk DIFF", diff if (i == 1 .and. j == 1) then x = 0.96111630472601972d0 @@ -240,7 +256,9 @@ program main x = 960.24524371490861d0 end if - print *, "GAMI DIFF", abs(x - GAMI) / GAMI + diff = abs(x - GAMI) / GAMI + max_diff = max(diff, max_diff) + print *, "GAMI DIFF", diff if (i == 1 .and. j == 1) then x = 1.2400526419152945d-2 @@ -250,7 +268,9 @@ program main x = 12.383672318439324d0 end if - print *, "TPT DIFF", abs(x - TPT) / TPT + diff = abs(x - TPT) / TPT + max_diff = max(diff, max_diff) + print *, "TPT DIFF", diff if (i == 1 .and. j == 1) then x = 5.5745494145734744d0 @@ -260,7 +280,9 @@ program main x = 5894.2025691009021d0 end if - print *, "CHI DIFF", abs(x - CHI) / CHI + diff = abs(x - CHI) / CHI + max_diff = max(diff, max_diff) + print *, "CHI DIFF", diff if (i == 1 .and. j == 1) then x = 0 @@ -270,11 +292,15 @@ program main x = 1 end if - print *, "LIQSOL DIFF", abs(x - LIQSOL) + diff = abs(x - LIQSOL) + max_diff = max(diff, max_diff) + print *, "LIQSOL DIFF", diff end do end do + print *, "max diff = ", max_diff + end program main subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, & From fcf656adf7ef9842667c2bda167df5fcbc0a3a90 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 13:31:05 -0700 Subject: [PATCH 33/70] blin9a to C++ --- EOS/pc/eos17.f90 | 108 +++++++---------------------------------------- EOS/pc/eos_c.cpp | 101 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 116 insertions(+), 93 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index e98b31d731..de9f4a07e4 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -1750,6 +1750,21 @@ subroutine BLIN9(TEMP,CHI, & parameter (CHI1=0.6d0,CHI2=14.d0,XMAX=30.d0) parameter (DCHI1=.1d0,DCHI2=CHI2-CHI1-DCHI1) parameter (XSCAL1=XMAX/DCHI1,XSCAL2=XMAX/DCHI2) + interface + subroutine blin9a(TEMP,CHI, & + W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & + W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & + W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & + W0XXX,W0XTT,W0XXT) bind(C, name="blin9a") + implicit none + double precision, intent(in), value :: TEMP, CHI + double precision :: W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & + W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & + W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & + W0XXX,W0XTT,W0XXT + end subroutine blin9a + end interface + X1=(CHI-CHI1)*XSCAL1 X2=(CHI-CHI2)*XSCAL2 if (X1.lt.-XMAX) then @@ -1815,99 +1830,6 @@ subroutine BLIN9(TEMP,CHI, & return end - subroutine BLIN9a(TEMP,CHI, & - W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & - W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & - W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & - W0XXX,W0XTT,W0XXT) -! Version 19.01.10 -! First part of BILN9: small CHI. Stems from BLIN9 v.24.12.08 - implicit double precision (A-H), double precision (O-Z) - save - dimension AC(5,0:2),AU(5,0:2),AA(5,0:2) - data AC/.37045057d0, .41258437d0, & - 9.777982d-2, 5.3734153d-3, 3.8746281d-5, & ! c_i^0 - .39603109d0, .69468795d0, & - .22322760d0, 1.5262934d-2, 1.3081939d-4, & ! c_i^1 - .76934619d0, 1.7891437d0, & - .70754974d0, 5.6755672d-2, 5.5571480d-4/ ! c_i^2 - data AU/.43139881d0, 1.7597537d0, & - 4.1044654d0, 7.7467038d0, 13.457678d0, & ! \chi_i^0 - .81763176d0, 2.4723339d0, & - 5.1160061d0, 9.0441465d0, 15.049882d0, & ! \chi_i^1 - 1.2558461d0, 3.2070406d0, & - 6.1239082d0, 10.316126d0, 16.597079d0/ ! \chi_i^2 - data KRUN/0/ - KRUN=KRUN+1 - if (KRUN.eq.1) then ! initialize - do J=0,2 - do I=1,5 - AA(I,J)=dexp(-AU(I,J)) - enddo - enddo - endif - do K=0,2 - W=0. - WDX=0. - WDT=0. - WDXX=0. - WDTT=0. - WDXT=0. - WDXXX=0. - WDXTT=0. - WDXXT=0. - ECHI=dexp(-CHI) - do I=1,5 - SQ=dsqrt(1.d0+AU(I,K)*TEMP/2.) - DN=AA(I,K)+ECHI ! e^{-\chi_i}+e^{-\chi}) - W=W+AC(I,K)*SQ/DN - WDX=WDX+AC(I,K)*SQ/DN**2 - WDT=WDT+AC(I,K)*AU(I,K)/(SQ*DN) - WDXX=WDXX+AC(I,K)*SQ*(ECHI-AA(I,K))/DN**3 - WDTT=WDTT-AC(I,K)*AU(I,K)**2/(DN*SQ**3) - WDXT=WDXT+AC(I,K)*AU(I,K)/(SQ*DN**2) - WDXXX=WDXXX+AC(I,K)*SQ* & - (ECHI**2-4.*ECHI*AA(I,K)+AA(I,K)**2)/DN**4 - WDXTT=WDXTT-AC(I,K)*AU(I,K)**2/(DN**2*SQ**3) - WDXXT=WDXXT+AC(I,K)*AU(I,K)*(ECHI-AA(I,K))/(SQ*DN**3) - enddo - WDX=WDX*ECHI - WDT=WDT/4. - WDXX=WDXX*ECHI - WDTT=WDTT/16. - WDXT=WDXT/4.*ECHI - WDXXX=WDXXX*ECHI - WDXTT=WDXTT*ECHI/16. - WDXXT=WDXXT/4.*ECHI - if (K.eq.0) then - W0=W - W0DX=WDX - W0DT=WDT - W0DXX=WDXX - W0DTT=WDTT - W0DXT=WDXT - W0XXX=WDXXX - W0XTT=WDXTT - W0XXT=WDXXT - elseif (K.eq.1) then - W1=W - W1DX=WDX - W1DT=WDT - W1DXX=WDXX - W1DTT=WDTT - W1DXT=WDXT - else - W2=W - W2DX=WDX - W2DT=WDT - W2DXX=WDXX - W2DTT=WDTT - W2DXT=WDXT - endif - enddo ! next K - return - end - subroutine BLIN9b(TEMP,CHI, & W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 88d60f6fb4..62deb19f8c 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -140,4 +140,105 @@ extern "C" CHI = X // Non-relativistic result - 1.5_rt * std::log(CT); // Relativistic fit } + + void blin9a(double TEMP, double CHI, + double& W0, double& W0DX, double& W0DT, double& W0DXX, + double& W0DTT, double& W0DXT, + double& W1, double& W1DX, double& W1DT, double& W1DXX, + double& W1DTT, double& W1DXT, + double& W2, double& W2DX, double& W2DT, double& W2DXX, + double& W2DTT, double& W2DXT, + double& W0XXX, double& W0XTT, double& W0XXT) + { + // Version 19.01.10 + // First part of blin9: small CHI. Stems from blin9 v.24.12.08 + const double AC[3][5] = {{0.37045057_rt, 0.41258437_rt, + 9.777982e-2_rt, 5.3734153e-3_rt, 3.8746281e-5_rt}, // c_i^0 + {0.39603109_rt, 0.69468795_rt, + 0.22322760_rt, 1.5262934e-2_rt, 1.3081939e-4_rt}, // c_i^1 + {0.76934619_rt, 1.7891437_rt, + 0.70754974_rt, 5.6755672e-2_rt, 5.5571480e-4_rt}}; // c_i^2 + + const double AU[3][5] = {{0.43139881_rt, 1.7597537_rt, + 4.10446540_rt, 7.7467038_rt, 13.457678_rt}, // \chi_i^0 + {0.81763176_rt, 2.4723339_rt, + 5.11600610_rt, 9.0441465_rt, 15.049882_rt}, // \chi_i^1 + {1.25584610_rt, 3.2070406_rt, + 6.12390820_rt, 10.3161260_rt, 16.597079_rt}}; // \chi_i^2 + + const double AA[3][5] = {{std::exp(-AU[0][0]), std::exp(-AU[0][1]), + std::exp(-AU[0][2]), std::exp(-AU[0][3]), std::exp(-AU[0][4])}, // \chi_i^0 + {std::exp(-AU[1][0]), std::exp(-AU[1][1]), + std::exp(-AU[1][2]), std::exp(-AU[1][3]), std::exp(-AU[1][4])}, // \chi_i^1 + {std::exp(-AU[2][0]), std::exp(-AU[2][1]), + std::exp(-AU[2][2]), std::exp(-AU[2][3]), std::exp(-AU[2][4])}}; // \chi_i^2 + + for (int k = 0; k <= 2; ++k) { + Real W = 0.0; + Real WDX = 0.0; + Real WDT = 0.0; + Real WDXX = 0.0; + Real WDTT = 0.0; + Real WDXT = 0.0; + Real WDXXX = 0.0; + Real WDXTT = 0.0; + Real WDXXT = 0.0; + Real ECHI = std::exp(-CHI); + + for (int i = 0; i <= 4; ++i) { + Real SQ = std::sqrt(1.0_rt + AU[k][i] * TEMP / 2.0_rt); + Real DN = AA[k][i] + ECHI; // e^{-\chi_i}+e^{-\chi}) + + W = W + AC[k][i] * SQ / DN; + WDX = WDX + AC[k][i] * SQ / (DN * DN); + WDT = WDT + AC[k][i] * AU[k][i] / (SQ * DN); + WDXX = WDXX + AC[k][i] * SQ * (ECHI - AA[k][i]) / (DN * DN * DN); + WDTT = WDTT - AC[k][i] * AU[k][i] * AU[k][i] / (DN * SQ * SQ * SQ); + WDXT = WDXT + AC[k][i] * AU[k][i] / (SQ * DN * DN); + WDXXX = WDXXX + AC[k][i] * SQ * + (ECHI * ECHI - 4.0_rt * ECHI * AA[k][i] + AA[k][i] * AA[k][i]) / + (DN * DN * DN * DN); + WDXTT = WDXTT - AC[k][i] * AU[k][i] * AU[k][i] / (DN * DN * SQ * SQ * SQ); + WDXXT = WDXXT + AC[k][i] * AU[k][i] * (ECHI - AA[k][i]) / (SQ * DN * DN * DN); + } + + WDX = WDX * ECHI; + WDT = WDT / 4.0_rt; + WDXX = WDXX * ECHI; + WDTT = WDTT / 16.0_rt; + WDXT = WDXT / 4.0_rt * ECHI; + WDXXX = WDXXX * ECHI; + WDXTT = WDXTT * ECHI / 16.0_rt; + WDXXT = WDXXT / 4.0_rt * ECHI; + + if (k == 0) { + W0 = W; + W0DX = WDX; + W0DT = WDT; + W0DXX = WDXX; + W0DTT = WDTT; + W0DXT = WDXT; + W0XXX = WDXXX; + W0XTT = WDXTT; + W0XXT = WDXXT; + } + else if (k == 1) { + W1 = W; + W1DX = WDX; + W1DT = WDT; + W1DXX = WDXX; + W1DTT = WDTT; + W1DXT = WDXT; + } + else { + W2 = W; + W2DX = WDX; + W2DT = WDT; + W2DXX = WDXX; + W2DTT = WDTT; + W2DXT = WDXT; + } + } + } + } From 5e01c0ab57640b5d40847dc5c829217300143916 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 13:40:46 -0700 Subject: [PATCH 34/70] fermi10 to C++ --- EOS/pc/eos17.f90 | 41 +++++++++++++++-------------------------- EOS/pc/eos_c.cpp | 41 +++++++++++++++++++++++++++++++++-------- 2 files changed, 48 insertions(+), 34 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index de9f4a07e4..24d9602e62 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -1242,6 +1242,14 @@ subroutine ELECT11(TEMP,CHI, & parameter (CHI2=28.d0,XMAX=20.d0) parameter (DCHI2=CHI2-1.d0) parameter (XSCAL2=XMAX/DCHI2) + interface + subroutine fermi10(X,XMAX,FP,FM) bind(C, name="fermi10") + implicit none + double precision, intent(in), value :: X, XMAX + double precision, intent(inout) :: FP, FM + end subroutine fermi10 + end interface + if (CHI.lt.-1.d2) then print *, 'ELECT11: too large negative CHI' ! 27.05.17 stop @@ -1511,32 +1519,6 @@ subroutine SUBFERMJ(CMU1, & return end - subroutine FERMI10(X,XMAX,FP,FM) -! Version 20.01.10 -! Fermi distribution function and its 3 derivatives -! Input: X - argument f(x) -! XMAX - max|X| where it is assumed that 0 < f(x) < 1. -! Output: FP = f(x) -! FM = 1-f(x) - implicit double precision (A-H), double precision (O-Z) - save - if (XMAX.lt.3.d0) then - print *, 'FERMI10: XMAX' - stop - end if - if (X.gt.XMAX) then - FP=0.d0 - FM=1.d0 - elseif (X.lt.-XMAX) then - FP=1.d0 - FM=0.d0 - else - FP=1.d0/(dexp(X)+1.d0) - FM=1.d0-FP - endif - return - end - ! ============== ELECTRON EXCHANGE AND CORRELATION ================ ! subroutine EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) ! Version 09.06.07 @@ -1764,6 +1746,13 @@ subroutine blin9a(TEMP,CHI, & W0XXX,W0XTT,W0XXT end subroutine blin9a end interface + interface + subroutine fermi10(X,XMAX,FP,FM) bind(C, name="fermi10") + implicit none + double precision, intent(in), value :: X, XMAX + double precision, intent(inout) :: FP, FM + end subroutine fermi10 + end interface X1=(CHI-CHI1)*XSCAL1 X2=(CHI-CHI2)*XSCAL2 diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 62deb19f8c..2c30888446 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -141,14 +141,14 @@ extern "C" - 1.5_rt * std::log(CT); // Relativistic fit } - void blin9a(double TEMP, double CHI, - double& W0, double& W0DX, double& W0DT, double& W0DXX, - double& W0DTT, double& W0DXT, - double& W1, double& W1DX, double& W1DT, double& W1DXX, - double& W1DTT, double& W1DXT, - double& W2, double& W2DX, double& W2DT, double& W2DXX, - double& W2DTT, double& W2DXT, - double& W0XXX, double& W0XTT, double& W0XXT) + void blin9a (double TEMP, double CHI, + double& W0, double& W0DX, double& W0DT, double& W0DXX, + double& W0DTT, double& W0DXT, + double& W1, double& W1DX, double& W1DT, double& W1DXX, + double& W1DTT, double& W1DXT, + double& W2, double& W2DX, double& W2DT, double& W2DXX, + double& W2DTT, double& W2DXT, + double& W0XXX, double& W0XTT, double& W0XXT) { // Version 19.01.10 // First part of blin9: small CHI. Stems from blin9 v.24.12.08 @@ -241,4 +241,29 @@ extern "C" } } + void fermi10 (double X, double XMAX, double& FP, double& FM) + { + // Version 20.01.10 + // Fermi distribution function and its 3 derivatives + // Input: X - argument f(x) + // XMAX - max|X| where it is assumed that 0 < f(x) < 1. + // Output: FP = f(x) + // FM = 1-f(x) + if (XMAX < 3.0_rt) { + printf("FERMI10: XMAX\n"); + exit(1); + } + if (X > XMAX) { + FP = 0.0_rt; + FM = 1.0_rt; + } + else if (X < -XMAX) { + FP = 1.0_rt; + FM = 0.0_rt; + } + else { + FP = 1.0 / (std::exp(X) + 1.0_rt); + FM = 1.0 - FP; + } + } } From 2189ba9c9f5b3fe4c2d9c19c844a09209353bfab Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 13:41:45 -0700 Subject: [PATCH 35/70] Remove unneeded abort --- EOS/pc/eos_c.cpp | 4 ---- 1 file changed, 4 deletions(-) diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 2c30888446..322039c391 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -249,10 +249,6 @@ extern "C" // XMAX - max|X| where it is assumed that 0 < f(x) < 1. // Output: FP = f(x) // FM = 1-f(x) - if (XMAX < 3.0_rt) { - printf("FERMI10: XMAX\n"); - exit(1); - } if (X > XMAX) { FP = 0.0_rt; FM = 1.0_rt; From a0d20b427a8e5432aa176e756e8904eb15792ae3 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 14:17:52 -0700 Subject: [PATCH 36/70] blin9b to C++ --- EOS/pc/eos17.f90 | 128 ++++++----------------------------------------- EOS/pc/eos_c.cpp | 126 +++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 139 insertions(+), 115 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 24d9602e62..8ad509ed75 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -1746,6 +1746,20 @@ subroutine blin9a(TEMP,CHI, & W0XXX,W0XTT,W0XXT end subroutine blin9a end interface + interface + subroutine blin9b(TEMP,CHI, & + W0b,W0DXb,W0DTb,W0DXXb,W0DTTb,W0DXTb, & + W1b,W1DXb,W1DTb,W1DXXb,W1DTTb,W1DXTb, & + W2b,W2DXb,W2DTb,W2DXXb,W2DTTb,W2DXTb, & + W0XXXb,W0XTTb,W0XXTb) bind(C, name="blin9b") + implicit none + double precision, intent(in), value :: TEMP, CHI + double precision :: W0b,W0DXb,W0DTb,W0DXXb,W0DTTb,W0DXTb, & + W1b,W1DXb,W1DTb,W1DXXb,W1DTTb,W1DXTb, & + W2b,W2DXb,W2DTb,W2DXXb,W2DTTb,W2DXTb, & + W0XXXb,W0XTTb,W0XXTb + end subroutine blin9b + end interface interface subroutine fermi10(X,XMAX,FP,FM) bind(C, name="fermi10") implicit none @@ -1819,120 +1833,6 @@ end subroutine fermi10 return end - subroutine BLIN9b(TEMP,CHI, & - W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & - W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & - W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & - W0XXX,W0XTT,W0XXT) -! Version 19.01.10 -! Small syntax fix 15.03.13 -! Second part of BILN9: intermediate CHI. Stems from BLIN8 v.24.12.08 - implicit double precision (A-H), double precision (O-Z) - save - dimension AX(5),AXI(5),AH(5),AV(5) - parameter (EPS=1.d-3) - data AX/7.265351d-2, .2694608d0, & - .533122d0, .7868801d0, .9569313d0/ ! x_i - data AXI/.26356032d0, 1.4134031d0, & - 3.5964258d0, 7.0858100d0, 12.640801d0/ ! \xi_i - data AH/3.818735d-2, .1256732d0, & - .1986308d0, .1976334d0, .1065420d0/ ! H_i - data AV/.29505869d0, .32064856d0, 7.3915570d-2, & - 3.6087389d-3, 2.3369894d-5/ ! \bar{V}_i - if (CHI.lt.EPS) then - print *, 'BLIN9b: CHI is too small' - stop - end if - do K=0,2 - W=0. - WDX=0. - WDT=0. - WDXX=0. - WDTT=0. - WDXT=0. - WDXXX=0. - WDXTT=0. - WDXXT=0. - SQCHI=dsqrt(CHI) - do I=1,5 - CE=AX(I)-1.d0 - ECHI=dexp(CE*CHI) - DE=1.d0+ECHI - D=1.d0+AX(I)*CHI*TEMP/2. - H=CHI**(K+1)*SQCHI*dsqrt(D)/DE - HX=(K+1.5)/CHI+.25*AX(I)*TEMP/D-ECHI*CE/DE - HDX=H*HX - HXX=(K+1.5)/CHI**2+.125*(AX(I)*TEMP/D)**2+ECHI*(CE/DE)**2 - HDXX=HDX*HX-H*HXX - HT=.25*AX(I)*CHI/D - HDT=H*HT - HDTT=-H*HT**2 - HTX=1./CHI-.5*AX(I)*TEMP/D - HDXT=HDX*HT+HDT*HTX - HDXXT=HDXX*HT+HDX*HT*HTX+HDXT*HTX+ & - HDT*(.25*(AX(I)*TEMP/D)**2-1./CHI**2) - HDXTT=HDXT*HT-HDX*.125*(AX(I)*CHI/D)**2+HDTT*HTX+ & - HDT*.5*AX(I)*(TEMP*.5*AX(I)*CHI/D**2-1./D) - HXXX=(2*K+3)/CHI**3+.125*(AX(I)*TEMP/D)**3- & - ECHI*(1.d0-ECHI)*(CE/DE)**3 - HDXXX=HDXX*HX-2.*HDX*HXX+H*HXXX - XICHI=AXI(I)+CHI - DXI=1.d0+XICHI*TEMP/2. - V=XICHI**K*dsqrt(XICHI*DXI) - VX=(K+.5)/XICHI+.25*TEMP/DXI - VDX=V*VX - VT=.25*XICHI/DXI - VDT=V*VT - VXX=(K+.5)/XICHI**2+.125*(TEMP/DXI)**2 - VDXX=VDX*VX-V*VXX - VDXXX=VDXX*VX-2.*VDX*VXX+ & - V*((2*K+1)/XICHI**3+.125*(TEMP/DXI)**3) - VXXT=(1.-.5*TEMP*XICHI/DXI)/DXI - VDTT=-V*VT**2 - VXT=1./XICHI-.5*TEMP/DXI - VDXT=VDT*VXT+VDX*VT - VDXXT=VDXT*VX+VDX*.25*VXXT-VDT*VXX-V*.25*TEMP/DXI*VXXT - VDXTT=VDTT*VXT-VDT*.5*VXXT+VDXT*VT- & - VDX*.125*(XICHI/DXI)**2 - W=W+AH(I)*AX(I)**K*H+AV(I)*V - WDX=WDX+AH(I)*AX(I)**K*HDX+AV(I)*VDX - WDT=WDT+AH(I)*AX(I)**K*HDT+AV(I)*VDT - WDXX=WDXX+AH(I)*AX(I)**K*HDXX+AV(I)*VDXX - WDTT=WDTT+AH(I)*AX(I)**K*HDTT+AV(I)*VDTT - WDXT=WDXT+AH(I)*AX(I)**K*HDXT+AV(I)*VDXT - WDXXX=WDXXX+AH(I)*AX(I)**K*HDXXX+AV(I)*VDXXX - WDXTT=WDXTT+AH(I)*AX(I)**K*HDXTT+AV(I)*VDXTT - WDXXT=WDXXT+AH(I)*AX(I)**K*HDXXT+AV(I)*VDXXT - enddo - if (K.eq.0) then - W0=W - W0DX=WDX - W0DT=WDT - W0DXX=WDXX - W0DTT=WDTT - W0DXT=WDXT - W0XXX=WDXXX - W0XTT=WDXTT - W0XXT=WDXXT - elseif (K.eq.1) then - W1=W - W1DX=WDX - W1DT=WDT - W1DXX=WDXX - W1DTT=WDTT - W1DXT=WDXT - else - W2=W - W2DX=WDX - W2DT=WDT - W2DXX=WDXX - W2DTT=WDTT - W2DXT=WDXT - endif - enddo ! next K - return - end - subroutine BLIN9c(TEMP,CHI, & W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 322039c391..7ddd06781b 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -241,7 +241,131 @@ extern "C" } } - void fermi10 (double X, double XMAX, double& FP, double& FM) + void blin9b(Real TEMP, Real CHI, + Real& W0, Real& W0DX, Real& W0DT, Real& W0DXX, + Real& W0DTT, Real& W0DXT, + Real& W1, Real& W1DX, Real& W1DT, Real& W1DXX, + Real& W1DTT, Real& W1DXT, + Real& W2, Real& W2DX, Real& W2DT, Real& W2DXX, + Real& W2DTT, Real& W2DXT, + Real& W0XXX, Real& W0XTT, Real& W0XXT) + { + // Version 19.01.10 + // Small syntax fix 15.03.13 + // Second part of BILN9: intermediate CHI. Stems from BLIN8 v.24.12.08 + const Real EPS = 1.e-3; + + const Real AX[5] = {7.265351e-2_rt, 0.2694608_rt, + 0.533122_rt, 0.7868801_rt, 0.9569313_rt}; // x_i + const Real AXI[5] = {0.26356032_rt, 1.4134031_rt, + 3.59642580_rt, 7.0858100_rt, 12.640801_rt}; // \xi_i + const Real AH[5] = {3.818735e-2_rt, 0.1256732_rt, + 0.1986308_rt, 0.1976334_rt, 0.1065420_rt}; // H_i + const Real AV[5] = {0.29505869_rt, 0.32064856_rt, + 7.3915570e-2_rt, 3.6087389e-3_rt, 2.3369894e-5_rt}; // \bar{V}_i + + if (CHI < EPS) { + printf("BLIN9b: CHI is too small\n"); + exit(1); + } + + for (int k = 0; k <= 2; ++k) { + Real W = 0.0; + Real WDX = 0.0; + Real WDT = 0.0; + Real WDXX = 0.0; + Real WDTT = 0.0; + Real WDXT = 0.0; + Real WDXXX = 0.0; + Real WDXTT = 0.0; + Real WDXXT = 0.0; + Real SQCHI = std::sqrt(CHI); + + for (int i = 0; i <= 4; ++i) { + Real CE = AX[i] - 1.0_rt; + Real ECHI = std::exp(CE * CHI); + Real DE = 1.0_rt + ECHI; + Real D = 1.0_rt + AX[i] * CHI * TEMP / 2.0_rt; + Real H = std::pow(CHI, k + 1) * SQCHI * std::sqrt(D) / DE; + Real HX = (k + 1.5_rt) / CHI + 0.25_rt * AX[i] * TEMP / D - ECHI * CE / DE; + Real HDX = H * HX; + Real HXX = (k + 1.5_rt) / (CHI * CHI) + 0.125_rt * (AX[i] * TEMP / D) * (AX[i] * TEMP / D) + + ECHI * (CE / DE) * (CE / DE); + Real HDXX = HDX * HX - H * HXX; + Real HT = 0.25_rt * AX[i] * CHI / D; + Real HDT = H * HT; + Real HDTT = -H * HT * HT; + Real HTX = 1.0_rt / CHI - 0.5_rt * AX[i] * TEMP / D; + Real HDXT = HDX * HT + HDT * HTX; + Real HDXXT = HDXX * HT + HDX * HT * HTX + HDXT * HTX + + HDT * (0.25_rt * (AX[i] * TEMP / D) * (AX[i] * TEMP / D) - + 1.0_rt / (CHI * CHI)); + Real HDXTT = HDXT * HT - HDX * 0.125_rt * (AX[i] * CHI / D) * (AX[i] * CHI / D) + HDTT * HTX + + HDT * 0.5_rt * AX[i] * (TEMP * 0.5_rt * AX[i] * CHI / (D * D) - 1.0_rt / D); + Real HXXX = (2 * k + 3) / (CHI * CHI * CHI) + 0.125_rt * (AX[i] * TEMP / D) * (AX[i] * TEMP / D) * + (AX[i] * TEMP / D) - ECHI * (1.0_rt - ECHI) * (CE / DE) * (CE / DE) * (CE / DE); + Real HDXXX = HDXX * HX - 2.0_rt * HDX * HXX + H * HXXX; + Real XICHI = AXI[i] + CHI; + Real DXI = 1.0_rt + XICHI * TEMP / 2.0_rt; + Real V = std::pow(XICHI, k) * std::sqrt(XICHI * DXI); + Real VX= (k + 0.5_rt) / XICHI + 0.25_rt * TEMP / DXI; + Real VDX = V * VX; + Real VT = 0.25_rt * XICHI / DXI; + Real VDT = V * VT; + Real VXX = (k + 0.5_rt) / (XICHI * XICHI) + 0.125_rt * (TEMP / DXI) * (TEMP / DXI); + Real VDXX = VDX * VX - V * VXX; + Real VDXXX = VDXX * VX - 2.0_rt * VDX * VXX + + V * ((2 * k + 1) / (XICHI * XICHI * XICHI) + + 0.125_rt * (TEMP / DXI) * (TEMP / DXI) * (TEMP / DXI)); + Real VXXT = (1.0_rt - 0.5_rt * TEMP * XICHI / DXI) / DXI; + Real VDTT = -V * VT * VT; + Real VXT = 1.0_rt / XICHI - 0.5_rt * TEMP / DXI; + Real VDXT = VDT * VXT + VDX * VT; + Real VDXXT = VDXT * VX + VDX * 0.25_rt * VXXT - VDT * VXX - V * 0.25_rt * TEMP / DXI * VXXT; + Real VDXTT = VDTT * VXT - VDT * 0.5_rt * VXXT + VDXT * VT - + VDX * 0.125_rt * (XICHI / DXI) * (XICHI / DXI); + W = W + AH[i] * std::pow(AX[i], k) * H + AV[i] * V; + WDX = WDX + AH[i] * std::pow(AX[i], k) * HDX + AV[i] * VDX; + WDT = WDT + AH[i] * std::pow(AX[i], k) * HDT + AV[i] * VDT; + WDXX = WDXX + AH[i] * std::pow(AX[i], k) * HDXX + AV[i] * VDXX; + WDTT = WDTT + AH[i] * std::pow(AX[i], k) * HDTT + AV[i] * VDTT; + WDXT = WDXT + AH[i] * std::pow(AX[i], k) * HDXT + AV[i] * VDXT; + WDXXX = WDXXX + AH[i] * std::pow(AX[i], k) * HDXXX + AV[i] * VDXXX; + WDXTT = WDXTT + AH[i] * std::pow(AX[i], k) * HDXTT + AV[i] * VDXTT; + WDXXT = WDXXT + AH[i] * std::pow(AX[i], k) * HDXXT + AV[i] * VDXXT; + } + + if (k == 0) { + W0 = W; + W0DX = WDX; + W0DT = WDT; + W0DXX = WDXX; + W0DTT = WDTT; + W0DXT = WDXT; + W0XXX = WDXXX; + W0XTT = WDXTT; + W0XXT = WDXXT; + } + else if (k == 1) { + W1 = W; + W1DX = WDX; + W1DT = WDT; + W1DXX = WDXX; + W1DTT = WDTT; + W1DXT = WDXT; + } + else { + W2 = W; + W2DX = WDX; + W2DT = WDT; + W2DXX = WDXX; + W2DTT = WDTT; + W2DXT = WDXT; + } + } + } + + void fermi10 (Real X, Real XMAX, Real& FP, Real& FM) { // Version 20.01.10 // Fermi distribution function and its 3 derivatives From 20bd042b6b745604b52bea4944afe5de0dd55907 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 14:18:35 -0700 Subject: [PATCH 37/70] double -> Real --- EOS/pc/eos_c.cpp | 52 ++++++++++++++++++++++++------------------------ 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 7ddd06781b..fdd1b2abe5 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -141,37 +141,37 @@ extern "C" - 1.5_rt * std::log(CT); // Relativistic fit } - void blin9a (double TEMP, double CHI, - double& W0, double& W0DX, double& W0DT, double& W0DXX, - double& W0DTT, double& W0DXT, - double& W1, double& W1DX, double& W1DT, double& W1DXX, - double& W1DTT, double& W1DXT, - double& W2, double& W2DX, double& W2DT, double& W2DXX, - double& W2DTT, double& W2DXT, - double& W0XXX, double& W0XTT, double& W0XXT) + void blin9a (Real TEMP, Real CHI, + Real& W0, Real& W0DX, Real& W0DT, Real& W0DXX, + Real& W0DTT, Real& W0DXT, + Real& W1, Real& W1DX, Real& W1DT, Real& W1DXX, + Real& W1DTT, Real& W1DXT, + Real& W2, Real& W2DX, Real& W2DT, Real& W2DXX, + Real& W2DTT, Real& W2DXT, + Real& W0XXX, Real& W0XTT, Real& W0XXT) { // Version 19.01.10 // First part of blin9: small CHI. Stems from blin9 v.24.12.08 - const double AC[3][5] = {{0.37045057_rt, 0.41258437_rt, - 9.777982e-2_rt, 5.3734153e-3_rt, 3.8746281e-5_rt}, // c_i^0 - {0.39603109_rt, 0.69468795_rt, - 0.22322760_rt, 1.5262934e-2_rt, 1.3081939e-4_rt}, // c_i^1 - {0.76934619_rt, 1.7891437_rt, - 0.70754974_rt, 5.6755672e-2_rt, 5.5571480e-4_rt}}; // c_i^2 + const Real AC[3][5] = {{0.37045057_rt, 0.41258437_rt, + 9.777982e-2_rt, 5.3734153e-3_rt, 3.8746281e-5_rt}, // c_i^0 + {0.39603109_rt, 0.69468795_rt, + 0.22322760_rt, 1.5262934e-2_rt, 1.3081939e-4_rt}, // c_i^1 + {0.76934619_rt, 1.7891437_rt, + 0.70754974_rt, 5.6755672e-2_rt, 5.5571480e-4_rt}}; // c_i^2 - const double AU[3][5] = {{0.43139881_rt, 1.7597537_rt, - 4.10446540_rt, 7.7467038_rt, 13.457678_rt}, // \chi_i^0 - {0.81763176_rt, 2.4723339_rt, - 5.11600610_rt, 9.0441465_rt, 15.049882_rt}, // \chi_i^1 - {1.25584610_rt, 3.2070406_rt, - 6.12390820_rt, 10.3161260_rt, 16.597079_rt}}; // \chi_i^2 + const Real AU[3][5] = {{0.43139881_rt, 1.7597537_rt, + 4.10446540_rt, 7.7467038_rt, 13.457678_rt}, // \chi_i^0 + {0.81763176_rt, 2.4723339_rt, + 5.11600610_rt, 9.0441465_rt, 15.049882_rt}, // \chi_i^1 + {1.25584610_rt, 3.2070406_rt, + 6.12390820_rt, 10.3161260_rt, 16.597079_rt}}; // \chi_i^2 - const double AA[3][5] = {{std::exp(-AU[0][0]), std::exp(-AU[0][1]), - std::exp(-AU[0][2]), std::exp(-AU[0][3]), std::exp(-AU[0][4])}, // \chi_i^0 - {std::exp(-AU[1][0]), std::exp(-AU[1][1]), - std::exp(-AU[1][2]), std::exp(-AU[1][3]), std::exp(-AU[1][4])}, // \chi_i^1 - {std::exp(-AU[2][0]), std::exp(-AU[2][1]), - std::exp(-AU[2][2]), std::exp(-AU[2][3]), std::exp(-AU[2][4])}}; // \chi_i^2 + const Real AA[3][5] = {{std::exp(-AU[0][0]), std::exp(-AU[0][1]), + std::exp(-AU[0][2]), std::exp(-AU[0][3]), std::exp(-AU[0][4])}, // \chi_i^0 + {std::exp(-AU[1][0]), std::exp(-AU[1][1]), + std::exp(-AU[1][2]), std::exp(-AU[1][3]), std::exp(-AU[1][4])}, // \chi_i^1 + {std::exp(-AU[2][0]), std::exp(-AU[2][1]), + std::exp(-AU[2][2]), std::exp(-AU[2][3]), std::exp(-AU[2][4])}}; // \chi_i^2 for (int k = 0; k <= 2; ++k) { Real W = 0.0; From 799c4c9ec4a246e5e1e9492045d56b66bf84c23c Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 14:19:19 -0700 Subject: [PATCH 38/70] Add clean target to makefile --- EOS/pc/Makefile | 2 ++ 1 file changed, 2 insertions(+) diff --git a/EOS/pc/Makefile b/EOS/pc/Makefile index 418a170987..d0e5e4376a 100644 --- a/EOS/pc/Makefile +++ b/EOS/pc/Makefile @@ -5,3 +5,5 @@ test: eos17.f90 eos_c.cpp run: ./test +clean: + rm -f *.o ./test From 3d5cb9999e379442b993ca291784197b6d4043dd Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 19:45:46 -0700 Subject: [PATCH 39/70] blin9c to C++ --- EOS/pc/eos17.f90 | 227 +++---------------------------------------- EOS/pc/eos_c.cpp | 245 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 258 insertions(+), 214 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 8ad509ed75..91d855c79a 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -1760,6 +1760,19 @@ subroutine blin9b(TEMP,CHI, & W0XXXb,W0XTTb,W0XXTb end subroutine blin9b end interface + interface + subroutine blin9c(TEMP,CHI, & + W0b,W0DXb,W0DTb,W0DXXb,W0DTTb,W0DXTb, & + W1b,W1DXb,W1DTb,W1DXXb,W1DTTb,W1DXTb, & + W2b,W2DXb,W2DTb,W2DXXb,W2DTTb,W2DXTb, & + W0XXXb,W0XTTb,W0XXTb) bind(C, name="blin9c") + double precision, intent(in), value :: TEMP, CHI + double precision :: W0b,W0DXb,W0DTb,W0DXXb,W0DTTb,W0DXTb, & + W1b,W1DXb,W1DTb,W1DXXb,W1DTTb,W1DXTb, & + W2b,W2DXb,W2DTb,W2DXXb,W2DTTb,W2DXTb, & + W0XXXb,W0XTTb,W0XXTb + end subroutine blin9c + end interface interface subroutine fermi10(X,XMAX,FP,FM) bind(C, name="fermi10") implicit none @@ -1832,217 +1845,3 @@ end subroutine fermi10 endif return end - - subroutine BLIN9c(TEMP,CHI, & - W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & - W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & - W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & - W0XXX,W0XTT,W0XXT) -! Version 19.01.10 -! Third part of BILN9: large CHI. Stems from BLIN8 v.24.12.08 - implicit double precision (A-H), double precision (O-Z) - save - parameter (PI=3.141592653d0,PI26=PI*PI/6.) - dimension AM(0:2),AMDX(0:2),AMDT(0:2), & - AMDXX(0:2),AMDTT(0:2),AMDXT(0:2) - if (CHI*TEMP.lt..1) then - do K=0,2 - W=0. - WDX=0. - WDT=0. - WDXX=0. - WDTT=0. - WDXT=0. - WDXXX=0. - WDXTT=0. - WDXXT=0. - do J=0,4 ! for nonrel.Fermi integrals from k+1/2 to k+4.5 - CNU=K+J+.5 ! nonrelativistic Fermi integral index \nu - CHINU=CHI**(K+J)*dsqrt(CHI) ! \chi^\nu - F=CHINU*(CHI/(CNU+1.)+PI26*CNU/CHI+ & ! nonrel.Fermi - .7*PI26**2*CNU*(CNU-1.)*(CNU-2.)/CHI**3) - FDX=CHINU*(1.+PI26*CNU*(CNU-1.)/CHI**2+ & - .7*PI26**2*CNU*(CNU-1.)*(CNU-2.)*(CNU-3.)/CHI**4) - FDXX=CHINU/CHI*CNU*(1.+PI26*(CNU-1.)*(CNU-2.)/CHI**2+ & - .7*PI26**2*(CNU-1.)*(CNU-2.)*(CNU-3.)*(CNU-4.)/CHI**4) - FDXXX=CHINU/CHI**2*CNU*(CNU-1.)* & - (1.+PI26*(CNU-2.)*(CNU-3.)/CHI**2+ & - .7*PI26**2*(CNU-2.)*(CNU-3.)*(CNU-4.)*(CNU-5.)/CHI**4) - if (J.eq.0) then - W=F - WDX=FDX - WDXX=FDXX - WDXXX=FDXXX - elseif (J.eq.1) then - C=.25*TEMP - W=W+C*F ! Fermi-Dirac, expressed through Fermi - WDX=WDX+C*FDX - WDXX=WDXX+C*FDXX - WDT=F/4. - WDXT=FDX/4. - WDTT=0. - WDXXX=WDXXX+C*FDXXX - WDXXT=FDXX/4. - WDXTT=0. - else - C=-C/J*(2*J-3)/4.*TEMP - W=W+C*F - WDX=WDX+C*FDX - WDT=WDT+C*J/TEMP*F - WDXX=WDXX+C*FDXX - WDTT=WDTT+C*J*(J-1)/TEMP**2*F - WDXT=WDXT+C*J/TEMP*FDX - WDXXX=WDXXX+C*FDXXX - WDXTT=WDXTT+C*J*(J-1)/TEMP**2*FDX - WDXXT=WDXXT+C*J/TEMP*FDXX - endif - enddo ! next J - if (K.eq.0) then - W0=W - W0DX=WDX - W0DT=WDT - W0DXX=WDXX - W0DTT=WDTT - W0DXT=WDXT - W0XXX=WDXXX - W0XTT=WDXTT - W0XXT=WDXXT - elseif (K.eq.1) then - W1=W - W1DX=WDX - W1DT=WDT - W1DXX=WDXX - W1DTT=WDTT - W1DXT=WDXT - else - W2=W - W2DX=WDX - W2DT=WDT - W2DXX=WDXX - W2DTT=WDTT - W2DXT=WDXT - endif - enddo ! next K -! ---------------------------------------------------------------- ! - else ! CHI > 14, CHI*TEMP > 0.1: general high-\chi expansion - D=1.d0+CHI*TEMP/2.d0 - R=dsqrt(CHI*D) - RX=.5d0/CHI+.25d0*TEMP/D - RDX=R*RX - RDT=.25d0*CHI**2/R - RXX=-.5d0/CHI**2-.125d0*(TEMP/D)**2 - RDXX=RDX*RX+R*RXX - RDTT=-.25d0*RDT*CHI/D - RXT=.25d0/D-.125d0*CHI*TEMP/D**2 - RDXT=RDT*RX+R*RXT - RXXX=1.d0/CHI**3+.125d0*(TEMP/D)**3 - RDXXX=RDXX*RX+2.d0*RDX*RXX+R*RXXX - RXTT=-.25d0/D**2*CHI+.125d0*CHI**2*TEMP/D**3 - RDXTT=RDTT*RX+2.d0*RDT*RXT+R*RXTT - RXXT=-RXT*TEMP/D - RDXXT=RDXT*RX+RDX*RXT+RDT*RXX+R*RXXT - do K=0,2 - DM=K+.5d0+(K+1.d0)*CHI*TEMP/2.d0 - AM(K)=CHI**K*DM/R - FMX1=.5d0*(K+1.)*TEMP/DM - FMX2=.25d0*TEMP/D - FMX=(K-.5d0)/CHI+FMX1-FMX2 - AMDX(K)=AM(K)*FMX - CKM=.5d0*(K+1.d0)/DM - FMT1=CKM*CHI - FMT2=.25d0*CHI/D - FMT=FMT1-FMT2 - AMDT(K)=AM(K)*FMT - FMXX=-(K-.5d0)/CHI**2-FMX1**2+2.d0*FMX2**2 - AMDXX(K)=AMDX(K)*FMX+AM(K)*FMXX - FMTT=2.d0*FMT2**2-FMT1**2 - AMDTT(K)=AMDT(K)*FMT+AM(K)*FMTT - AMDXT(K)=AMDX(K)*FMT+AM(K)*(CKM*(1.d0-CKM*CHI*TEMP)- & - .25d0/D+.125d0*CHI*TEMP/D**2) - if (K.eq.0) then - FMXXX=(2*K-1)/CHI**3+2.d0*FMX1**3-8.d0*FMX2**3 - AMDXXX=AMDXX(K)*FMX+2.d0*AMDX(K)*FMXX+AM(K)*FMXXX - FMT1DX=CKM-TEMP*CHI*CKM**2 - FMT2DX=(.25d0-CHI*TEMP*.125d0/D)/D - FMXT=FMT1DX-FMT2DX - FMTTX=4.d0*FMT2*FMT2DX-2.d0*FMT1*FMT1DX - AMDXTT=AMDXT(K)*FMT+AMDT(K)*FMXT+AMDX(K)*FMTT+AM(K)*FMTTX - FMX1DT=CKM-CHI*TEMP*CKM**2 - FMX2DT=.25d0/D*(1.d0-.5d0*CHI*TEMP/D) - FMXXT=4.d0*FMX2*FMX2DT-2.d0*FMX1*FMX1DT - AMDXXT=AMDXT(K)*FMX+AMDX(K)*FMXT+AMDT(K)*FMXX+AM(K)*FMXXT - endif - enddo - SQ2T=dsqrt(2.d0*TEMP) - A=1.d0+CHI*TEMP+SQ2T*R - ADX=TEMP+SQ2T*RDX - ADT=CHI+R/SQ2T+SQ2T*RDT - ADXX=SQ2T*RDXX - ADTT=-R/SQ2T**3+2.d0/SQ2T*RDT+SQ2T*RDTT - ADXT=1.d0+RDX/SQ2T+SQ2T*RDXT - ADXTT=-RDX/SQ2T**3+2.d0/SQ2T*RDXT+SQ2T*RDXTT - ADXXT=RDXX/SQ2T+SQ2T*RDXXT - XT1=CHI+1.d0/TEMP - Aln=dlog(A) - FJ0=.5d0*XT1*R-Aln/SQ2T**3 - ASQ3=A*SQ2T**3 - ASQ3DX=ADX*SQ2T**3 - FJ0DX=.5d0*(R+XT1*RDX)-ADX/ASQ3 - FJ0DT=.5d0*(XT1*RDT-R/TEMP**2)-ADT/ASQ3+ & - .75d0/(TEMP**2*SQ2T)*Aln - FJ0DXX=RDX+.5d0*XT1*RDXX+(ADX/A)**2/SQ2T**3-ADXX/ASQ3 - FJ0DTT=R/TEMP**3-RDT/TEMP**2+.5d0*XT1*RDTT+ & - 3.d0/(ASQ3*TEMP)*ADT+ & - (ADT/A)**2/SQ2T**3-ADTT/ASQ3-1.875d0/(TEMP**3*SQ2T)*Aln - BXT=1.5d0/TEMP*ADX+ADX*ADT/A-ADXT - BXXT=1.5d0/TEMP*ADXX+(ADXX*ADT+ADX*ADXT)/A- & - (ADX/A)**2*ADT-ADXXT - FJ0DXT=.5d0*(RDT-RDX/TEMP**2+XT1*RDXT)+BXT/ASQ3 - FJ0XXX=RDXX*1.5d0+.5d0*XT1*RDXXX+ & - (2.d0*ADX*(ADXX/A-(ADX/A)**2)- & - SQ2T*RDXXX+ADXX/ASQ3*ASQ3DX)/ASQ3 - FJ0XTT=RDX/TEMP**3-RDXT/TEMP**2+.5d0*(RDTT+XT1*RDXTT)+ & - 3.d0/TEMP*(ADXT-ADT/ASQ3*ASQ3DX)/ASQ3+ & - (2.d0*ADT*(ADXT/A-ADT*ADX/A**2)- & - ADXTT+ADTT*ASQ3DX/ASQ3)/ASQ3-1.875d0/(TEMP**3*SQ2T)*ADX/A - FJ0XXT=.5d0*(RDXT-RDXX/TEMP**2+RDXT+XT1*RDXXT)+ & - (BXXT-BXT*ASQ3DX/ASQ3)/ASQ3 - W0=FJ0+PI26*AM(0) - W0DX=FJ0DX+PI26*AMDX(0) - W0DT=FJ0DT+PI26*AMDT(0) - W0DXX=FJ0DXX+PI26*AMDXX(0) - W0DTT=FJ0DTT+PI26*AMDTT(0) - W0DXT=FJ0DXT+PI26*AMDXT(0) - W0XXX=FJ0XXX+PI26*AMDXXX - W0XTT=FJ0XTT+PI26*AMDXTT - W0XXT=FJ0XXT+PI26*AMDXXT - FJ1=(R**3/1.5d0-FJ0)/TEMP - FJ1DX=(2.d0*R**2*RDX-FJ0DX)/TEMP - FJ1DT=(2.d0*R**2*RDT-FJ0DT-FJ1)/TEMP - FJ1DXX=(4.d0*R*RDX**2+2.d0*R**2*RDXX-FJ0DXX)/TEMP - FJ1DTT=(4.d0*R*RDT**2+2.d0*R**2*RDTT-FJ0DTT-2.d0*FJ1DT)/TEMP - FJ1DXT=(4.d0*R*RDX*RDT+2.d0*R**2*RDXT-FJ0DXT-FJ1DX)/TEMP - W1=FJ1+PI26*AM(1) - W1DX=FJ1DX+PI26*AMDX(1) - W1DT=FJ1DT+PI26*AMDT(1) - W1DXX=FJ1DXX+PI26*AMDXX(1) - W1DTT=FJ1DTT+PI26*AMDTT(1) - W1DXT=FJ1DXT+PI26*AMDXT(1) - FJ2=(.5d0*CHI*R**3-1.25d0*FJ1)/TEMP - FJ2DX=(.5d0*R**3+1.5d0*CHI*R**2*RDX-1.25d0*FJ1DX)/TEMP - FJ2DT=(1.5d0*CHI*R**2*RDT-1.25d0*FJ1DT-FJ2)/TEMP - FJ2DXX=(3.d0*R*RDX*(R+CHI*RDX)+1.5d0*CHI*R**2*RDXX- & - 1.25d0*FJ1DXX)/TEMP - FJ2DTT=(3.d0*CHI*R*(RDT**2+.5d0*R*RDTT)- & - 1.25d0*FJ1DTT-2.d0*FJ2DT)/TEMP - FJ2DXT=(1.5d0*R*RDT*(R+2.d0*CHI*RDX)+1.5d0*CHI*R**2*RDXT- & - 1.25d0*FJ1DXT-FJ2DX)/TEMP - W2=FJ2+PI26*AM(2) - W2DX=FJ2DX+PI26*AMDX(2) - W2DT=FJ2DT+PI26*AMDT(2) - W2DXX=FJ2DXX+PI26*AMDXX(2) - W2DTT=FJ2DTT+PI26*AMDTT(2) - W2DXT=FJ2DXT+PI26*AMDXT(2) - endif - return - end diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index fdd1b2abe5..7b2f7f5432 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -365,6 +365,251 @@ extern "C" } } + void blin9c (Real TEMP, Real CHI, + Real& W0, Real& W0DX, Real& W0DT, Real& W0DXX, Real& W0DTT, Real& W0DXT, + Real& W1, Real& W1DX, Real& W1DT, Real& W1DXX, Real& W1DTT, Real& W1DXT, + Real& W2, Real& W2DX, Real& W2DT, Real& W2DXX, Real& W2DTT, Real& W2DXT, + Real& W0XXX, Real& W0XTT, Real& W0XXT) + { + // Version 19.01.10 + // Third part of BILN9: large CHI. Stems from BLIN8 v.24.12.08 + const Real PI = 3.141592653_rt; + const Real PI26 = PI * PI / 6.0; + + Real AM[3], AMDX[3], AMDT[3], AMDXX[3], AMDTT[3], AMDXT[3]; + + if (CHI * TEMP < 0.1_rt) { + + for (int k = 0; k <= 2; ++k) { + Real W = 0.0_rt; + Real WDX = 0.0_rt; + Real WDT = 0.0_rt; + Real WDXX = 0.0_rt; + Real WDTT = 0.0_rt; + Real WDXT = 0.0_rt; + Real WDXXX = 0.0_rt; + Real WDXTT = 0.0_rt; + Real WDXXT = 0.0_rt; + + Real C; + + for (int j = 0; j <= 4; ++j) { // for nonrel.Fermi integrals from k+1/2 to k+4.5 + Real CNU = k + j + 0.5_rt; // nonrelativistic Fermi integral index \nu + Real CHINU = std::pow(CHI, k + j) * std::sqrt(CHI); // \chi^\nu + Real F = CHINU * (CHI / (CNU + 1.0_rt) + PI26 * CNU / CHI + // nonrel.Fermi + 0.7_rt * PI26 * PI26 * CNU * (CNU - 1.0_rt) * + (CNU - 2.0_rt) / (CHI * CHI * CHI)); + Real FDX = CHINU * (1.0_rt + PI26 * CNU * (CNU - 1.0_rt) / (CHI * CHI) + + 0.7_rt * PI26 * PI26 * CNU * (CNU - 1.0_rt) * (CNU - 2.0_rt) + * (CNU - 3.0_rt) / (CHI * CHI * CHI * CHI)); + Real FDXX = CHINU / CHI * CNU * + (1.0_rt + PI26 * (CNU - 1.0_rt) * + (CNU - 2.0_rt) / (CHI * CHI) + + 0.7_rt * PI26 * PI26 * (CNU - 1.0_rt) * (CNU - 2.0_rt) * + (CNU - 3.0_rt) * (CNU - 4.0_rt) / (CHI * CHI * CHI * CHI)); + Real FDXXX = CHINU / (CHI * CHI) * CNU * (CNU - 1.0_rt) * + (1.0_rt + PI26 * (CNU - 2.0_rt) * (CNU - 3.0_rt) / (CHI * CHI) + + 0.7_rt * PI26 * PI26 * (CNU - 2.0_rt) * (CNU - 3.0_rt) * + (CNU - 4.0_rt) * (CNU - 5.0_rt) / (CHI * CHI * CHI * CHI)); + + if (j == 0) { + W = F; + WDX = FDX; + WDXX = FDXX; + WDXXX = FDXXX; + } + else if (j == 1) { + C = 0.25_rt * TEMP; + W = W + C * F; // Fermi-Dirac, expressed through Fermi + WDX = WDX + C * FDX; + WDXX = WDXX + C * FDXX; + WDT = F / 4.0_rt; + WDXT = FDX / 4.0_rt; + WDTT = 0.0_rt; + WDXXX = WDXXX + C * FDXXX; + WDXXT = FDXX / 4.0_rt; + WDXTT = 0.0_rt; + } + else { + C = -C / j * (2 * j - 3) / 4.0_rt * TEMP; + W = W + C * F; + WDX = WDX + C * FDX; + WDT = WDT + C * j / TEMP * F; + WDXX = WDXX + C * FDXX; + WDTT = WDTT + C * j * (j - 1) / (TEMP * TEMP) * F; + WDXT = WDXT + C * j / TEMP * FDX; + WDXXX = WDXXX + C * FDXXX; + WDXTT = WDXTT + C * j * (j - 1) / (TEMP * TEMP) * FDX; + WDXXT = WDXXT + C * j / TEMP * FDXX; + } + } + + if (k == 0) { + W0 = W; + W0DX = WDX; + W0DT = WDT; + W0DXX = WDXX; + W0DTT = WDTT; + W0DXT = WDXT; + W0XXX = WDXXX; + W0XTT = WDXTT; + W0XXT = WDXXT; + } + else if (k == 1) { + W1 = W; + W1DX = WDX; + W1DT = WDT; + W1DXX = WDXX; + W1DTT = WDTT; + W1DXT = WDXT; + } + else { + W2 = W; + W2DX = WDX; + W2DT = WDT; + W2DXX = WDXX; + W2DTT = WDTT; + W2DXT = WDXT; + } + } + + } + else { // CHI > 14, CHI * TEMP > 0.1: general high-\chi expansion + + Real D = 1.0_rt + CHI * TEMP / 2.0_rt; + Real R = std::sqrt(CHI * D); + Real RX = 0.5_rt / CHI + 0.25_rt * TEMP / D; + Real RDX = R * RX; + Real RDT = 0.25_rt * CHI * CHI / R; + Real RXX = -0.5_rt / (CHI * CHI) - 0.125_rt * (TEMP / D) * (TEMP / D); + Real RDXX = RDX * RX + R * RXX; + Real RDTT = -0.25_rt * RDT * CHI / D; + Real RXT = 0.25_rt / D - 0.125_rt * CHI * TEMP / (D * D); + Real RDXT = RDT * RX + R * RXT; + Real RXXX = 1.0_rt / (CHI * CHI * CHI) + 0.125_rt * (TEMP / D) * (TEMP / D) * (TEMP / D); + Real RDXXX = RDXX * RX + 2.0_rt * RDX * RXX + R * RXXX; + Real RXTT = -0.25_rt / (D * D) * CHI + 0.125_rt * CHI * CHI * TEMP / (D * D * D); + Real RDXTT = RDTT * RX + 2.0_rt * RDT * RXT + R * RXTT; + Real RXXT = -RXT * TEMP / D; + Real RDXXT = RDXT * RX + RDX * RXT + RDT * RXX + R * RXXT; + + Real AMDXXX, AMDXTT, AMDXXT; + + for (int k = 0; k <= 2; ++k) { + Real DM = k + 0.5_rt + (k + 1.0_rt) * CHI * TEMP / 2.0_rt; + AM[k] = std::pow(CHI, k) * DM / R; + Real FMX1 = 0.5_rt * (k + 1.0_rt) * TEMP / DM; + Real FMX2 = 0.25_rt * TEMP / D; + Real FMX = (k - 0.5_rt) / CHI + FMX1 - FMX2; + AMDX[k] = AM[k] * FMX; + Real CkM = 0.5_rt * (k + 1.0_rt) / DM; + Real FMT1 = CkM * CHI; + Real FMT2 = 0.25_rt * CHI / D; + Real FMT = FMT1 - FMT2; + AMDT[k] = AM[k] * FMT; + Real FMXX = -(k - 0.5_rt) / (CHI * CHI) - FMX1 * FMX1 + 2.0_rt * FMX2 * FMX2; + AMDXX[k] = AMDX[k] * FMX + AM[k] * FMXX; + Real FMTT = 2.0_rt * FMT2 * FMT2 - FMT1 * FMT1; + AMDTT[k] = AMDT[k] * FMT + AM[k] * FMTT; + AMDXT[k] = AMDX[k] * FMT + AM[k] * (CkM * (1.0_rt - CkM * CHI * TEMP) - + 0.25_rt / D + 0.125_rt * CHI * TEMP / (D * D)); + + if (k == 0) { + Real FMXXX = (2 * k - 1) / (CHI * CHI * CHI) + 2.0_rt * FMX1 * FMX1 * FMX1 - + 8.0_rt * FMX2 * FMX2 * FMX2; + AMDXXX = AMDXX[k] * FMX + 2.0_rt * AMDX[k] * FMXX + AM[k] * FMXXX; + Real FMT1DX = CkM - TEMP * CHI * CkM * CkM; + Real FMT2DX = (0.25_rt - CHI * TEMP * 0.125_rt / D) / D; + Real FMXT = FMT1DX - FMT2DX; + Real FMTTX = 4.0_rt * FMT2 * FMT2DX - 2.0_rt * FMT1 * FMT1DX; + AMDXTT = AMDXT[k] * FMT + AMDT[k] * FMXT + AMDX[k] * FMTT + AM[k] * FMTTX; + Real FMX1DT = CkM - CHI * TEMP * CkM * CkM; + Real FMX2DT = 0.25_rt / D * (1.0_rt - 0.5_rt * CHI * TEMP / D); + Real FMXXT = 4.0_rt * FMX2 * FMX2DT - 2.0_rt * FMX1 * FMX1DT; + AMDXXT = AMDXT[k] * FMX + AMDX[k] * FMXT + AMDT[k] * FMXX + AM[k] * FMXXT; + } + } + + Real SQ2T = std::sqrt(2.0_rt * TEMP); + Real A = 1.0_rt + CHI * TEMP + SQ2T * R; + Real ADX = TEMP + SQ2T * RDX; + Real ADT = CHI + R / SQ2T + SQ2T * RDT; + Real ADXX = SQ2T * RDXX; + Real ADTT = -R / (SQ2T * SQ2T * SQ2T) + 2.0_rt / SQ2T * RDT + SQ2T * RDTT; + Real ADXT = 1.0_rt + RDX / SQ2T + SQ2T * RDXT; + Real ADXTT = -RDX / (SQ2T * SQ2T * SQ2T) + 2.0_rt / SQ2T * RDXT + SQ2T * RDXTT; + Real ADXXT = RDXX / SQ2T + SQ2T * RDXXT; + Real XT1 = CHI + 1.0_rt / TEMP; + Real Aln = std::log(A); + Real FJ0 = 0.5_rt * XT1 * R - Aln / (SQ2T * SQ2T * SQ2T); + Real ASQ3 = A * SQ2T * SQ2T * SQ2T; + Real ASQ3DX = ADX * SQ2T * SQ2T * SQ2T; + Real FJ0DX = 0.5_rt * (R + XT1 * RDX) - ADX / ASQ3; + Real FJ0DT = 0.5_rt * (XT1 * RDT - R / (TEMP * TEMP)) - ADT / ASQ3 + + 0.75_rt / (TEMP * TEMP * SQ2T) * Aln; + Real FJ0DXX = RDX + 0.5_rt * XT1 * RDXX + (ADX / A) * (ADX / A) / (SQ2T * SQ2T * SQ2T) - ADXX / ASQ3; + Real FJ0DTT = R / (TEMP * TEMP * TEMP) - RDT / (TEMP * TEMP) + 0.5_rt * XT1 * RDTT + + 3.0_rt / (ASQ3 * TEMP) * ADT + + (ADT / A) * (ADT / A) / (SQ2T * SQ2T * SQ2T) - ADTT / ASQ3 - + 1.875_rt / (TEMP * TEMP * TEMP * SQ2T) * Aln; + Real BXT = 1.5_rt / TEMP * ADX + ADX * ADT / A - ADXT; + Real BXXT = 1.5_rt / TEMP * ADXX + (ADXX * ADT + ADX * ADXT) / A - + (ADX / A) * (ADX / A) * ADT - ADXXT; + Real FJ0DXT = 0.5_rt * (RDT - RDX / (TEMP * TEMP) + XT1 * RDXT) + BXT / ASQ3; + Real FJ0XXX = RDXX * 1.5_rt + 0.5_rt * XT1 * RDXXX + + (2.0_rt * ADX * (ADXX / A - (ADX / A) * (ADX / A)) - + SQ2T * RDXXX + ADXX / ASQ3 * ASQ3DX) / ASQ3; + Real FJ0XTT = RDX / (TEMP * TEMP * TEMP) - RDXT / (TEMP * TEMP) + 0.5_rt * (RDTT + XT1 * RDXTT) + + 3.0_rt / TEMP * (ADXT - ADT / ASQ3 * ASQ3DX) / ASQ3 + + (2.0_rt * ADT * (ADXT / A - ADT * ADX / (A * A)) - + ADXTT + ADTT * ASQ3DX / ASQ3) / ASQ3 - 1.875_rt / (TEMP * TEMP * TEMP * SQ2T) * ADX / A; + Real FJ0XXT = 0.5_rt * (RDXT - RDXX / (TEMP * TEMP) + RDXT + XT1 * RDXXT) + + (BXXT - BXT * ASQ3DX / ASQ3) / ASQ3; + + W0 = FJ0 + PI26 * AM[0]; + W0DX = FJ0DX + PI26 * AMDX[0]; + W0DT = FJ0DT + PI26 * AMDT[0]; + W0DXX = FJ0DXX + PI26 * AMDXX[0]; + W0DTT = FJ0DTT + PI26 * AMDTT[0]; + W0DXT = FJ0DXT + PI26 * AMDXT[0]; + W0XXX = FJ0XXX + PI26 * AMDXXX; + W0XTT = FJ0XTT + PI26 * AMDXTT; + W0XXT = FJ0XXT + PI26 * AMDXXT; + + Real FJ1 = (R * R * R / 1.5_rt - FJ0) / TEMP; + Real FJ1DX = (2.0_rt * R * R * RDX - FJ0DX) / TEMP; + Real FJ1DT = (2.0_rt * R * R * RDT - FJ0DT - FJ1) / TEMP; + Real FJ1DXX = (4.0_rt * R * RDX * RDX + 2.0_rt * R * R * RDXX - FJ0DXX) / TEMP; + Real FJ1DTT = (4.0_rt * R * RDT * RDX + 2.0_rt * R * R * RDTT - FJ0DTT - 2.0_rt * FJ1DT) / TEMP; + Real FJ1DXT = (4.0_rt * R * RDX * RDT + 2.0_rt * R * R * RDXT - FJ0DXT - FJ1DX) / TEMP; + + W1 = FJ1 + PI26 * AM[1]; + W1DX = FJ1DX + PI26 * AMDX[1]; + W1DT = FJ1DT + PI26 * AMDT[1]; + W1DXX = FJ1DXX + PI26 * AMDXX[1]; + W1DTT = FJ1DTT + PI26 * AMDTT[1]; + W1DXT = FJ1DXT + PI26 * AMDXT[1]; + + Real FJ2 = (0.5_rt * CHI * R * R * R - 1.25_rt * FJ1) / TEMP; + Real FJ2DX = (0.5_rt * R * R * R + 1.5_rt * CHI * R * R * RDX - 1.25_rt * FJ1DX) / TEMP; + Real FJ2DT = (1.5_rt * CHI * R * R * RDT - 1.25_rt * FJ1DT - FJ2) / TEMP; + Real FJ2DXX = (3.0_rt * R * RDX * (R + CHI * RDX) + 1.5_rt * CHI * R * R * RDXX - + 1.25_rt * FJ1DXX) / TEMP; + Real FJ2DTT = (3.0_rt * CHI * R * (RDT * RDT + 0.5_rt * R * RDTT) - + 1.25_rt * FJ1DTT - 2.0_rt * FJ2DT) / TEMP; + Real FJ2DXT = (1.5_rt * R * RDT * (R + 2.0_rt * CHI * RDX) + 1.5_rt * CHI * R * R * RDXT - + 1.25_rt * FJ1DXT - FJ2DX) / TEMP; + + W2 = FJ2 + PI26 * AM[2]; + W2DX = FJ2DX + PI26 * AMDX[2]; + W2DT = FJ2DT + PI26 * AMDT[2]; + W2DXX = FJ2DXX + PI26 * AMDXX[2]; + W2DTT = FJ2DTT + PI26 * AMDTT[2]; + W2DXT = FJ2DXT + PI26 * AMDXT[2]; + } + + } + void fermi10 (Real X, Real XMAX, Real& FP, Real& FM) { // Version 20.01.10 From bb59790a2251093fa1cd31cf5460f38d0788ad31 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 19:57:57 -0700 Subject: [PATCH 40/70] blin9 to C++ --- EOS/pc/eos17.f90 | 146 +++++------------------------------------------ EOS/pc/eos_c.cpp | 115 +++++++++++++++++++++++++++++++++++++ 2 files changed, 129 insertions(+), 132 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 91d855c79a..85a0c20347 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -1297,6 +1297,20 @@ subroutine ELECT11a(TEMP,CHI, & save parameter (BOHR=137.036,PI=3.141592653d0) parameter (PI2=PI**2,BOHR2=BOHR**2,BOHR3=BOHR2*BOHR) !cleaned 15/6 + interface + subroutine blin9(TEMR,CHI, & + W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & + W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & + W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & + W0XXX,W0XTT,W0XXT) bind(C, name="blin9") + implicit none + double precision, intent(in), value :: TEMR, CHI + double precision :: W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & + W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & + W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & + W0XXX,W0XTT,W0XXT + end subroutine blin9 + end interface TEMR=TEMP/BOHR2 ! T in rel.units (=T/mc^2) call BLIN9(TEMR,CHI, & W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & @@ -1713,135 +1727,3 @@ subroutine EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) end - subroutine BLIN9(TEMP,CHI, & - W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & - W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & - W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & - W0XXX,W0XTT,W0XXT) -! Version 21.01.10 -! Stems from BLIN8 v.24.12.08 -! Difference - smooth matching of different CHI ranges -! Input: TEMP=T/mc^2; CHI=(\mu-mc^2)/T -! Output: Wk - Fermi-Dirac integral of the order k+1/2 -! WkDX=dWk/dCHI, WkDT = dWk/dT, WkDXX=d^2 Wk / d CHI^2, -! WkDTT=d^2 Wk / d T^2, WkDXT=d^2 Wk /dCHIdT, -! W0XXX=d^3 W0 / d CHI^3, W0XTT=d^3 W0 /(d CHI d^2 T), -! W0XXT=d^3 W0 /dCHI^2 dT - implicit double precision (A-H), double precision (O-Z) - save - parameter (CHI1=0.6d0,CHI2=14.d0,XMAX=30.d0) - parameter (DCHI1=.1d0,DCHI2=CHI2-CHI1-DCHI1) - parameter (XSCAL1=XMAX/DCHI1,XSCAL2=XMAX/DCHI2) - interface - subroutine blin9a(TEMP,CHI, & - W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & - W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & - W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & - W0XXX,W0XTT,W0XXT) bind(C, name="blin9a") - implicit none - double precision, intent(in), value :: TEMP, CHI - double precision :: W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & - W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & - W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & - W0XXX,W0XTT,W0XXT - end subroutine blin9a - end interface - interface - subroutine blin9b(TEMP,CHI, & - W0b,W0DXb,W0DTb,W0DXXb,W0DTTb,W0DXTb, & - W1b,W1DXb,W1DTb,W1DXXb,W1DTTb,W1DXTb, & - W2b,W2DXb,W2DTb,W2DXXb,W2DTTb,W2DXTb, & - W0XXXb,W0XTTb,W0XXTb) bind(C, name="blin9b") - implicit none - double precision, intent(in), value :: TEMP, CHI - double precision :: W0b,W0DXb,W0DTb,W0DXXb,W0DTTb,W0DXTb, & - W1b,W1DXb,W1DTb,W1DXXb,W1DTTb,W1DXTb, & - W2b,W2DXb,W2DTb,W2DXXb,W2DTTb,W2DXTb, & - W0XXXb,W0XTTb,W0XXTb - end subroutine blin9b - end interface - interface - subroutine blin9c(TEMP,CHI, & - W0b,W0DXb,W0DTb,W0DXXb,W0DTTb,W0DXTb, & - W1b,W1DXb,W1DTb,W1DXXb,W1DTTb,W1DXTb, & - W2b,W2DXb,W2DTb,W2DXXb,W2DTTb,W2DXTb, & - W0XXXb,W0XTTb,W0XXTb) bind(C, name="blin9c") - double precision, intent(in), value :: TEMP, CHI - double precision :: W0b,W0DXb,W0DTb,W0DXXb,W0DTTb,W0DXTb, & - W1b,W1DXb,W1DTb,W1DXXb,W1DTTb,W1DXTb, & - W2b,W2DXb,W2DTb,W2DXXb,W2DTTb,W2DXTb, & - W0XXXb,W0XTTb,W0XXTb - end subroutine blin9c - end interface - interface - subroutine fermi10(X,XMAX,FP,FM) bind(C, name="fermi10") - implicit none - double precision, intent(in), value :: X, XMAX - double precision, intent(inout) :: FP, FM - end subroutine fermi10 - end interface - - X1=(CHI-CHI1)*XSCAL1 - X2=(CHI-CHI2)*XSCAL2 - if (X1.lt.-XMAX) then - call BLIN9a(TEMP,CHI, & - W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & - W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & - W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & - W0XXX,W0XTT,W0XXT) - elseif (X2.lt.XMAX) then ! match two fits - if (X1.lt.XMAX) then ! match fits "a" and "b" - call FERMI10(X1,XMAX,FP,FM) - call BLIN9a(TEMP,CHI, & - W0a,W0DXa,W0DTa,W0DXXa,W0DTTa,W0DXTa, & - W1a,W1DXa,W1DTa,W1DXXa,W1DTTa,W1DXTa, & - W2a,W2DXa,W2DTa,W2DXXa,W2DTTa,W2DXTa, & - W0XXXa,W0XTTa,W0XXTa) - call BLIN9b(TEMP,CHI, & - W0b,W0DXb,W0DTb,W0DXXb,W0DTTb,W0DXTb, & - W1b,W1DXb,W1DTb,W1DXXb,W1DTTb,W1DXTb, & - W2b,W2DXb,W2DTb,W2DXXb,W2DTTb,W2DXTb, & - W0XXXb,W0XTTb,W0XXTb) - else ! match fits "b" and "c" - call FERMI10(X2,XMAX,FP,FM) - call BLIN9b(TEMP,CHI, & - W0a,W0DXa,W0DTa,W0DXXa,W0DTTa,W0DXTa, & - W1a,W1DXa,W1DTa,W1DXXa,W1DTTa,W1DXTa, & - W2a,W2DXa,W2DTa,W2DXXa,W2DTTa,W2DXTa, & - W0XXXa,W0XTTa,W0XXTa) - call BLIN9c(TEMP,CHI, & - W0b,W0DXb,W0DTb,W0DXXb,W0DTTb,W0DXTb, & - W1b,W1DXb,W1DTb,W1DXXb,W1DTTb,W1DXTb, & - W2b,W2DXb,W2DTb,W2DXXb,W2DTTb,W2DXTb, & - W0XXXb,W0XTTb,W0XXTb) - endif - W0=W0a*FP+W0b*FM - W0DX=W0DXa*FP+W0DXb*FM !! +(W0a-W0b)*F1 - W0DT=W0DTa*FP+W0DTb*FM - W0DXX=W0DXXa*FP+W0DXXb*FM !! +2.d0*(W0DXa-W0DXb)*F1+(W0a-W0b)*F2 - W0DTT=W0DTTa*FP+W0DTTb*FM - W0DXT=W0DXTa*FP+W0DXTb*FM !! +(W0DTa-W0DTb)*F1 - W0XXX=W0XXXa*FP+W0XXXb*FM !! +3.d0*(W0DXXa-W0DXXb)*F1+3.d0*(W0DXa-W0DXb)*F2+(W0a-W0b)*F3 - W0XTT=W0XTTa*FP+W0XTTb*FM !! +(W0DTTa-W0DTTb)*F1 - W0XXT=W0XXTa*FP+W0XXTb*FM !! +2.d0*(W0DXTa-W0DXTb)*F1+(W0DTa-W0DTb)*F2 - W1=W1a*FP+W1b*FM - W1DX=W1DXa*FP+W1DXb*FM !! +(W1a-W1b)*F1 - W1DT=W1DTa*FP+W1DTb*FM - W1DXX=W1DXXa*FP+W1DXXb*FM !! +2.d0*(W1DXa-W1DXb)*F1+(W1a-W1b)*F2 - W1DTT=W1DTTa*FP+W1DTTb*FM - W1DXT=W1DXTa*FP+W1DXTb*FM !! +(W1DTa-W1DTb)*F1 - W2=W2a*FP+W2b*FM - W2DX=W2DXa*FP+W2DXb*FM !! +(W2a-W2b)*F1 - W2DT=W2DTa*FP+W2DTb*FM - W2DXX=W2DXXa*FP+W2DXXb*FM !! +2.d0*(W2DXa-W2DXb)*F1+(W2a-W2b)*F2 - W2DTT=W2DTTa*FP+W2DTTb*FM - W2DXT=W2DXTa*FP+W2DXTb*FM !! - else - call BLIN9c(TEMP,CHI, & - W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & - W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & - W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & - W0XXX,W0XTT,W0XXT) - endif - return - end diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 7b2f7f5432..8407040316 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -631,4 +631,119 @@ extern "C" FM = 1.0 - FP; } } + + void blin9 (Real TEMP, Real CHI, + Real& W0, Real& W0DX, Real& W0DT, Real& W0DXX, Real& W0DTT, Real& W0DXT, + Real& W1, Real& W1DX, Real& W1DT, Real& W1DXX, Real& W1DTT, Real& W1DXT, + Real& W2, Real& W2DX, Real& W2DT, Real& W2DXX, Real& W2DTT, Real& W2DXT, + Real& W0XXX, Real& W0XTT, Real& W0XXT) + { + // Version 21.01.10 + // Stems from BLIN8 v.24.12.08 + // Difference - smooth matching of different CHI ranges + // Input: TEMP=T/mc^2; CHI=(\mu-mc^2)/T + // Output: Wk - Fermi-Dirac integral of the order k+1/2 + // WkDX=dWk/dCHI, WkDT = dWk/dT, WkDXX=d^2 Wk / d CHI^2, + // WkDTT=d^2 Wk / d T^2, WkDXT=d^2 Wk /dCHIdT, + // W0XXX=d^3 W0 / d CHI^3, W0XTT=d^3 W0 /(d CHI d^2 T), + // W0XXT=d^3 W0 /dCHI^2 dT + + const Real CHI1 = 0.6_rt; + const Real CHI2 = 14.0_rt; + const Real XMAX = 30.0_rt; + const Real DCHI1 = 0.1_rt; + const Real DCHI2 = CHI2 - CHI1 - DCHI1; + const Real XSCAL1 = XMAX / DCHI1; + const Real XSCAL2 = XMAX / DCHI2; + + Real X1 = (CHI - CHI1) * XSCAL1; + Real X2 = (CHI - CHI2) * XSCAL2; + + if (X1 < - XMAX) { + + blin9a(TEMP, CHI, + W0, W0DX, W0DT, W0DXX, W0DTT, W0DXT, + W1, W1DX, W1DT, W1DXX, W1DTT, W1DXT, + W2, W2DX, W2DT, W2DXX, W2DTT, W2DXT, + W0XXX, W0XTT, W0XXT); + + } + else if (X2 < XMAX) { // match two fits + + Real W0a, W0DXa, W0DTa, W0DXXa, W0DTTa, W0DXTa, + W1a, W1DXa, W1DTa, W1DXXa, W1DTTa, W1DXTa, + W2a, W2DXa, W2DTa, W2DXXa, W2DTTa, W2DXTa, + W0XXXa, W0XTTa, W0XXTa; + + Real W0b, W0DXb, W0DTb, W0DXXb, W0DTTb, W0DXTb, + W1b, W1DXb, W1DTb, W1DXXb, W1DTTb, W1DXTb, + W2b, W2DXb, W2DTb, W2DXXb, W2DTTb, W2DXTb, + W0XXXb, W0XTTb, W0XXTb; + + Real FP, FM; + + if (X1 < XMAX) { // match fits "a" and "b" + + fermi10(X1, XMAX, FP, FM); + blin9a(TEMP, CHI, + W0a, W0DXa, W0DTa, W0DXXa, W0DTTa, W0DXTa, + W1a, W1DXa, W1DTa, W1DXXa, W1DTTa, W1DXTa, + W2a, W2DXa, W2DTa, W2DXXa, W2DTTa, W2DXTa, + W0XXXa, W0XTTa, W0XXTa); + blin9b(TEMP, CHI, + W0b, W0DXb, W0DTb, W0DXXb, W0DTTb, W0DXTb, + W1b, W1DXb, W1DTb, W1DXXb, W1DTTb, W1DXTb, + W2b, W2DXb, W2DTb, W2DXXb, W2DTTb, W2DXTb, + W0XXXb, W0XTTb, W0XXTb); + + } + else { // match fits "b" and "c" + + fermi10(X2, XMAX, FP, FM); + blin9b(TEMP, CHI, + W0a, W0DXa, W0DTa, W0DXXa, W0DTTa, W0DXTa, + W1a, W1DXa, W1DTa, W1DXXa, W1DTTa, W1DXTa, + W2a, W2DXa, W2DTa, W2DXXa, W2DTTa, W2DXTa, + W0XXXa, W0XTTa, W0XXTa); + blin9c(TEMP, CHI, + W0b, W0DXb, W0DTb, W0DXXb, W0DTTb, W0DXTb, + W1b, W1DXb, W1DTb, W1DXXb, W1DTTb, W1DXTb, + W2b, W2DXb, W2DTb, W2DXXb, W2DTTb, W2DXTb, + W0XXXb, W0XTTb, W0XXTb); + + } + + W0 = W0a * FP + W0b * FM; + W0DX = W0DXa * FP + W0DXb * FM; + W0DT = W0DTa * FP + W0DTb * FM; + W0DXX = W0DXXa * FP + W0DXXb * FM; + W0DTT = W0DTTa * FP + W0DTTb * FM; + W0DXT = W0DXTa * FP + W0DXTb * FM; + W0XXX = W0XXXa * FP + W0XXXb * FM; + W0XTT = W0XTTa * FP + W0XTTb * FM; + W0XXT = W0XXTa * FP + W0XXTb * FM; + W1 = W1a * FP + W1b * FM; + W1DX = W1DXa * FP + W1DXb * FM; + W1DT = W1DTa * FP + W1DTb * FM; + W1DXX = W1DXXa * FP + W1DXXb * FM; + W1DTT = W1DTTa * FP + W1DTTb * FM; + W1DXT = W1DXTa * FP + W1DXTb * FM; + W2 = W2a * FP + W2b * FM; + W2DX = W2DXa * FP + W2DXb * FM; + W2DT = W2DTa * FP + W2DTb * FM; + W2DXX = W2DXXa * FP + W2DXXb * FM; + W2DTT = W2DTTa * FP + W2DTTb * FM; + W2DXT = W2DXTa * FP + W2DXTb * FM; + + } + else { + + blin9c(TEMP, CHI, + W0, W0DX, W0DT, W0DXX, W0DTT, W0DXT, + W1, W1DX, W1DT, W1DXX, W1DTT, W1DXT, + W2, W2DX, W2DT, W2DXX, W2DTT, W2DXT, + W0XXX, W0XTT, W0XXT); + + } + } } From 5fb30970278be85f4ee48e9a3d57c839405291f7 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 22:42:09 -0700 Subject: [PATCH 41/70] excor7 to C++ --- EOS/pc/eos17.f90 | 203 ++----------------------------------------- EOS/pc/eos_c.cpp | 221 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 229 insertions(+), 195 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 85a0c20347..0f65e6482d 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -561,6 +561,14 @@ subroutine EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, & save parameter(C53=5.d0/3.d0,C76=7.d0/6.d0) ! TINY excl.10.12.14 parameter (AUM=1822.888d0) ! a.m.u/m_e + interface + subroutine excor7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) bind(C, name="excor7") + implicit none + double precision, intent(in), value :: RS, GAME + double precision :: FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC + end subroutine excor7 + end interface + if (LIQSOL.ne.1.and.LIQSOL.ne.0) then print *, 'EOSFI8: invalid LIQSOL' stop @@ -1532,198 +1540,3 @@ subroutine SUBFERMJ(CMU1, & CJ05=(-12.d0*CMU1**2-24.d0*CMU1-15.d0)/(X5*X0**2) return end - -! ============== ELECTRON EXCHANGE AND CORRELATION ================ ! - subroutine EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) -! Version 09.06.07 -! Accuracy-loss cut-off modified on 10.08.16 -! Exchange-correlation contribution for the electron gas -! Stems from TANAKA1 v.03.03.96. Added derivatives. -! Input: RS - electron density parameter =electron-sphere radius in a.u. -! GAME - electron Coulomb coupling parameter -! Output: FXC - excess free energy of e-liquid per kT per one electron -! according to Tanaka & Ichimaru 85-87 and Ichimaru 93 -! UXC - internal energy contr.[per 1 electron, kT] -! PXC - pressure contribution divided by (n_e kT) -! CVXC - heat capacity divided by N_e k -! SXC - entropy divided by N_e k -! PDTXC,PDRXC = PXC + d PXC / d ln(T,\rho) - implicit double precision(A-H),double precision(O-Z) - save - parameter(EPS=1.d-8) ! 10.08.16 - THETA=.543*RS/GAME ! non-relativistic degeneracy parameter - SQTH=dsqrt(THETA) - THETA2=THETA**2 - THETA3=THETA2*THETA - THETA4=THETA3*THETA - if (THETA.gt..005) then - CHT1=dcosh(1.d0/THETA) - SHT1=dsinh(1.d0/THETA) - CHT2=dcosh(1.d0/SQTH) - SHT2=dsinh(1.d0/SQTH) - T1=SHT1/CHT1 ! dtanh(1.d0/THETA) - T2=SHT2/CHT2 ! dtanh(1./dsqrt(THETA)) - T1DH=-1./(THETA*CHT1)**2 ! d T1 / d\theta - T1DHH=2./(THETA*CHT1)**3*(CHT1-SHT1/THETA) - T2DH=-.5*SQTH/(THETA*CHT2)**2 - T2DHH=(.75*SQTH*CHT2-.5*SHT2)/(THETA*CHT2)**3 - else - T1=1. - T2=1. - T1DH=0. - T2DH=0. - T1DHH=0. - T2DHH=0. - endif - A0=.75+3.04363*THETA2-.09227*THETA3+1.7035*THETA4 - A0DH=6.08726*THETA-.27681*THETA2+6.814*THETA3 - A0DHH=6.08726-.55362*THETA+20.442*THETA2 - A1=1.+8.31051*THETA2+5.1105*THETA4 - A1DH=16.62102*THETA+20.442*THETA3 - A1DHH=16.62102+61.326*THETA2 - A=.610887*A0/A1*T1 ! HF fit of Perrot and Dharma-wardana - AH=A0DH/A0-A1DH/A1+T1DH/T1 - ADH=A*AH - ADHH=ADH*AH+A*(A0DHH/A0-(A0DH/A0)**2-A1DHH/A1+(A1DH/A1)**2+ & - T1DHH/T1-(T1DH/T1)**2) - B0=.341308+12.070873d0*THETA2+1.148889d0*THETA4 - B0DH=24.141746d0*THETA+4.595556d0*THETA3 - B0DHH=24.141746d0+13.786668d0*THETA2 - B1=1.+10.495346d0*THETA2+1.326623*THETA4 - B1DH=20.990692d0*THETA+5.306492*THETA3 - B1DHH=20.990692d0+15.919476d0*THETA2 - B=SQTH*T2*B0/B1 - BH=.5/THETA+T2DH/T2+B0DH/B0-B1DH/B1 - BDH=B*BH - BDHH=BDH*BH+B*(-.5/THETA2+T2DHH/T2-(T2DH/T2)**2+ & - B0DHH/B0-(B0DH/B0)**2-B1DHH/B1+(B1DH/B1)**2) - D0=.614925+16.996055d0*THETA2+1.489056*THETA4 - D0DH=33.99211d0*THETA+5.956224d0*THETA3 - D0DHH=33.99211d0+17.868672d0*THETA2 - D1=1.+10.10935*THETA2+1.22184*THETA4 - D1DH=20.2187*THETA+4.88736*THETA3 - D1DHH=20.2187+14.66208*THETA2 - D=SQTH*T2*D0/D1 - DH=.5/THETA+T2DH/T2+D0DH/D0-D1DH/D1 - DDH=D*DH - DDHH=DDH*DH+D*(-.5/THETA2+T2DHH/T2-(T2DH/T2)**2+ & - D0DHH/D0-(D0DH/D0)**2-D1DHH/D1+(D1DH/D1)**2) - E0=.539409+2.522206*THETA2+.178484*THETA4 - E0DH=5.044412*THETA+.713936*THETA3 - E0DHH=5.044412+2.141808*THETA2 - E1=1.+2.555501*THETA2+.146319*THETA4 - E1DH=5.111002*THETA+.585276*THETA3 - E1DHH=5.111002+1.755828*THETA2 - E=THETA*T1*E0/E1 - EH=1./THETA+T1DH/T1+E0DH/E0-E1DH/E1 - EDH=E*EH - EDHH=EDH*EH+E*(T1DHH/T1-(T1DH/T1)**2+E0DHH/E0-(E0DH/E0)**2- & - E1DHH/E1+(E1DH/E1)**2-1./THETA2) - EXP1TH=dexp(-1./THETA) - C=(.872496+.025248*EXP1TH)*E - CDH=.025248*EXP1TH/THETA2*E+C*EDH/E - CDHH=.025248*EXP1TH/THETA2*(EDH+(1.-2.*THETA)/THETA2*E)+ & - CDH*EDH/E+C*EDHH/E-C*(EDH/E)**2 - DISCR=dsqrt(4.*E-D**2) - DIDH=.5/DISCR*(4.*EDH-2.*D*DDH) - DIDHH=(-((2.*EDH-D*DDH)/DISCR)**2+2.*EDHH-DDH**2-D*DDHH)/DISCR - S1=-C/E*GAME - S1H=CDH/C-EDH/E - S1DH=S1*S1H - S1DHH=S1DH*S1H+S1*(CDHH/C-(CDH/C)**2-EDHH/E+(EDH/E)**2) - S1DG=-C/E ! => S1DGG=0 - S1DHG=S1DG*(CDH/C-EDH/E) - B2=B-C*D/E - B2DH=BDH-(CDH*D+C*DDH)/E+C*D*EDH/E**2 - B2DHH=BDHH-(CDHH*D+2.*CDH*DDH+C*DDHH)/E+ & - (2.*(CDH*D+C*DDH-C*D*EDH/E)*EDH+C*D*EDHH)/E**2 - SQGE=dsqrt(GAME) - S2=-2./E*B2*SQGE - S2H=B2DH/B2-EDH/E - S2DH=S2*S2H - S2DHH=S2DH*S2H+S2*(B2DHH/B2-(B2DH/B2)**2-EDHH/E+(EDH/E)**2) - S2DG=.5*S2/GAME - S2DGG=-.5*S2DG/GAME - S2DHG=.5*S2DH/GAME - R3=E*GAME+D*SQGE+1. - R3DH=EDH*GAME+DDH*SQGE - R3DHH=EDHH*GAME+DDHH*SQGE - R3DG=E+.5*D/SQGE - R3DGG=-.25*D/(GAME*SQGE) - R3DHG=EDH+.5*DDH/SQGE - B3=A-C/E - B3DH=ADH-CDH/E+C*EDH/E**2 - B3DHH=ADHH-CDHH/E+(2.*CDH*EDH+C*EDHH)/E**2-2.*C*EDH**2/E**3 - C3=(D/E*B2-B3)/E ! =D*B2/E**2-B3/E - C3DH=(DDH*B2+D*B2DH+B3*EDH)/E**2-2.*D*B2*EDH/E**3-B3DH/E - C3DHH=(-B3DHH+ & - (DDHH*B2+2.*DDH*B2DH+D*B2DHH+B3DH*EDH+B3*EDHH+B3DH*EDH)/E- & - 2.*((DDH*B2+D*B2DH+B3*EDH+DDH*B2+D*B2DH)*EDH+D*B2*EDHH)/E**2+ & - 6.*D*B2*EDH**2/E**3)/E - S3=C3*dlog(R3) - S3DH=S3*C3DH/C3+C3*R3DH/R3 - S3DHH=(S3DH*C3DH+S3*C3DHH)/C3-S3*(C3DH/C3)**2+ & - (C3DH*R3DH+C3*R3DHH)/R3-C3*(R3DH/R3)**2 - S3DG=C3*R3DG/R3 - S3DGG=C3*(R3DGG/R3-(R3DG/R3)**2) - S3DHG=(C3DH*R3DG+C3*R3DHG)/R3-C3*R3DG*R3DH/R3**2 - B4=2.-D**2/E - B4DH=EDH*(D/E)**2-2.*D*DDH/E - B4DHH=EDHH*(D/E)**2+2.*EDH*(D/E)**2*(DDH/D-EDH/E)- & - 2.*(DDH**2+D*DDHH)/E+2.*D*DDH*EDH/E**2 - C4=2.*E*SQGE+D - C4DH=2.*EDH*SQGE+DDH - C4DHH=2.*EDHH*SQGE+DDHH - C4DG=E/SQGE - C4DGG=-.5*E/(GAME*SQGE) - C4DHG=EDH/SQGE - S4A=2./E/DISCR - S4AH=EDH/E+DIDH/DISCR - S4ADH=-S4A*S4AH - S4ADHH=-S4ADH*S4AH- & - S4A*(EDHH/E-(EDH/E)**2+DIDHH/DISCR-(DIDH/DISCR)**2) - S4B=D*B3+B4*B2 - S4BDH=DDH*B3+D*B3DH+B4DH*B2+B4*B2DH - S4BDHH=DDHH*B3+2.*DDH*B3DH+D*B3DHH+B4DHH*B2+2.*B4DH*B2DH+B4*B2DHH - S4C=datan(C4/DISCR)-datan(D/DISCR) - UP1=C4DH*DISCR-C4*DIDH - DN1=DISCR**2+C4**2 - UP2=DDH*DISCR-D*DIDH - DN2=DISCR**2+D**2 - S4CDH=UP1/DN1-UP2/DN2 - S4CDHH=(C4DHH*DISCR-C4*DIDHH)/DN1- & - UP1*2.*(DISCR*DIDH+C4*C4DH)/DN1**2- & - (DDHH*DISCR-D*DIDHH)/DN2+UP2*2.*(DISCR*DIDH+D*DDH)/DN2**2 - S4CDG=C4DG*DISCR/DN1 - S4CDGG=C4DGG*DISCR/DN1-2.*C4*DISCR*(C4DG/DN1)**2 - S4CDHG=(C4DHG*DISCR+C4DG*DIDH- & - C4DG*DISCR/DN1*2.*(DISCR*DIDH+C4*C4DH))/DN1 - S4=S4A*S4B*S4C - S4DH=S4ADH*S4B*S4C+S4A*S4BDH*S4C+S4A*S4B*S4CDH - S4DHH=S4ADHH*S4B*S4C+S4A*S4BDHH*S4C+S4A*S4B*S4CDHH+ & - 2.*(S4ADH*S4BDH*S4C+S4ADH*S4B*S4CDH+S4A*S4BDH*S4CDH) - S4DG=S4A*S4B*S4CDG - S4DGG=S4A*S4B*S4CDGG - S4DHG=S4A*S4B*S4CDHG+S4CDG*(S4ADH*S4B+S4A*S4BDH) - FXC=S1+S2+S3+S4 - FXCDH=S1DH+S2DH+S3DH+S4DH - FXCDG=S1DG+S2DG+S3DG+S4DG - FXCDHH=S1DHH+S2DHH+S3DHH+S4DHH - FXCDGG=S2DGG+S3DGG+S4DGG - FXCDHG=S1DHG+S2DHG+S3DHG+S4DHG - PXC=(GAME*FXCDG-2.*THETA*FXCDH)/3. - UXC=GAME*FXCDG-THETA*FXCDH - SXC=(GAME*S2DG-S2+GAME*S3DG-S3+S4A*S4B*(GAME*S4CDG-S4C))- & - THETA*FXCDH - if (dabs(SXC).lt.EPS*dabs(THETA*FXCDH)) SXC=0. ! accuracy loss - CVXC=2.*THETA*(GAME*FXCDHG-FXCDH)-THETA**2*FXCDHH-GAME**2*FXCDGG - if (dabs(CVXC).lt.EPS*dabs(GAME**2*FXCDGG)) CVXC=0. ! accuracy - PDLH=THETA*(GAME*FXCDHG-2.*FXCDH-2.*THETA*FXCDHH)/3. - PDLG=GAME*(FXCDG+GAME*FXCDGG-2.*THETA*FXCDHG)/3. - PDRXC=PXC+(PDLG-2.*PDLH)/3. - PDTXC=GAME*(THETA*FXCDHG-GAME*FXCDGG/3.)- & - THETA*(FXCDH/.75+THETA*FXCDHH/1.5) - return - end - - diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 8407040316..d043cb95b6 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -746,4 +746,225 @@ extern "C" } } + + void excor7 (double RS, double GAME, + double& FXC, double& UXC, double& PXC, + double& CVXC, double& SXC, double& PDTXC, + double& PDRXC) + { + // Version 09.06.07 + // Accuracy-loss cut-off modified on 10.08.16 + // Exchange-correlation contribution for the electron gas + // Stems from TANAKA1 v.03.03.96. Added derivatives. + // Input: RS - electron density parameter =electron-sphere radius in a.u. + // GAME - electron Coulomb coupling parameter + // Output: FXC - excess free energy of e-liquid per kT per one electron + // according to Tanaka & Ichimaru 85-87 and Ichimaru 93 + // UXC - internal energy contr.[per 1 electron, kT] + // PXC - pressure contribution divided by (n_e kT) + // CVXC - heat capacity divided by N_e k + // SXC - entropy divided by N_e k + // PDTXC,PDRXC = PXC + d PXC / d ln(T,\rho) + const Real EPS = 1.e-8_rt; // 10.08.16 + + Real THETA = 0.543_rt * RS / GAME; // non-relativistic degeneracy parameter + Real SQTH = std::sqrt(THETA); + Real THETA2 = THETA * THETA; + Real THETA3 = THETA2 * THETA; + Real THETA4 = THETA3 * THETA; + + Real T1, T1DH, T1DHH, T2, T2DH, T2DHH; + + if (THETA > .005_rt) { + Real CHT1 = std::cosh(1.0_rt / THETA); + Real SHT1 = std::sinh(1.0_rt / THETA); + Real CHT2 = std::cosh(1.0_rt / SQTH); + Real SHT2 = std::sinh(1.0_rt / SQTH); + T1 = SHT1 / CHT1; // tanh(1.0_rt / THETA) + T2 = SHT2 / CHT2; // tanh(1.0_rt / sqrt(THETA)) + T1DH = -1.0_rt / ((THETA * CHT1) * (THETA * CHT1)); // d T1 / d\theta + T1DHH = 2.0_rt / ((THETA * CHT1) * (THETA * CHT1) * (THETA * CHT1)) * + (CHT1 - SHT1 / THETA); + T2DH = -0.5_rt * SQTH / ((THETA * CHT2) * (THETA * CHT2)); + T2DHH = (0.75_rt * SQTH * CHT2 - 0.5_rt * SHT2) / + ((THETA * CHT2) * (THETA * CHT2) * (THETA * CHT2)); + } + else { + T1 = 1.0_rt; + T2 = 1.0_rt; + T1DH = 0.0_rt; + T2DH = 0.0_rt; + T1DHH = 0.0_rt; + T2DHH = 0.0_rt; + } + + Real A0 = 0.75_rt + 3.04363_rt * THETA2 - 0.09227_rt * THETA3 + 1.7035_rt * THETA4; + Real A0DH = 6.08726_rt * THETA - 0.27681_rt * THETA2 + 6.814_rt * THETA3; + Real A0DHH = 6.08726_rt - 0.55362_rt * THETA + 20.442_rt * THETA2; + Real A1 = 1.0_rt + 8.31051_rt * THETA2 + 5.1105_rt * THETA4; + Real A1DH = 16.62102_rt * THETA + 20.442_rt * THETA3; + Real A1DHH = 16.62102_rt + 61.326_rt * THETA2; + Real A = 0.610887_rt * A0 / A1 * T1; // HF fit of Perrot and Dharma - wardana + Real AH = A0DH / A0 - A1DH / A1 + T1DH / T1; + Real ADH = A * AH; + Real ADHH = ADH * AH + A * (A0DHH / A0 - (A0DH / A0) * (A0DH / A0) - + A1DHH / A1 + (A1DH / A1) * (A1DH / A1) + + T1DHH / T1 - (T1DH / T1) * (T1DH / T1)); + Real B0 = 0.341308_rt + 12.070873_rt * THETA2 + 1.148889_rt * THETA4; + Real B0DH = 24.141746_rt * THETA + 4.595556_rt * THETA3; + Real B0DHH = 24.141746_rt + 13.786668_rt * THETA2; + Real B1 = 1.0_rt + 10.495346_rt * THETA2 + 1.326623 * THETA4; + Real B1DH = 20.990692_rt * THETA + 5.306492 * THETA3; + Real B1DHH = 20.990692_rt + 15.919476_rt * THETA2; + Real B = SQTH * T2 * B0 / B1; + Real BH = 0.5_rt / THETA + T2DH / T2 + B0DH / B0 - B1DH / B1; + Real BDH = B * BH; + Real BDHH = BDH * BH + B * (-0.5_rt / THETA2 + T2DHH / T2 - (T2DH / T2) * (T2DH / T2) + + B0DHH / B0 - (B0DH / B0) * (B0DH / B0) - B1DHH / B1 + + (B1DH / B1) * (B1DH / B1)); + Real D0 = 0.614925_rt + 16.996055_rt * THETA2 + 1.489056_rt * THETA4; + Real D0DH = 33.99211_rt * THETA + 5.956224_rt * THETA3; + Real D0DHH = 33.99211_rt + 17.868672_rt * THETA2; + Real D1 = 1.0_rt + 10.10935_rt * THETA2 + 1.22184_rt * THETA4; + Real D1DH = 20.2187_rt * THETA + 4.88736_rt * THETA3; + Real D1DHH = 20.2187_rt + 14.66208_rt * THETA2; + Real D = SQTH * T2 * D0 / D1; + Real DH = 0.5_rt / THETA + T2DH / T2 + D0DH / D0 - D1DH / D1; + Real DDH = D * DH; + Real DDHH = DDH * DH + D * (-0.5_rt / THETA2 + T2DHH / T2 - (T2DH / T2) * (T2DH / T2) + + D0DHH / D0 - (D0DH / D0) * (D0DH / D0) - D1DHH / D1 + + (D1DH / D1) * (D1DH / D1)); + Real E0 = 0.539409_rt + 2.522206_rt * THETA2 + 0.178484_rt * THETA4; + Real E0DH = 5.044412_rt * THETA + 0.713936_rt * THETA3; + Real E0DHH = 5.044412_rt + 2.141808_rt * THETA2; + Real E1 = 1.0_rt + 2.555501_rt * THETA2 + 0.146319_rt * THETA4; + Real E1DH = 5.111002_rt * THETA + 0.585276_rt * THETA3; + Real E1DHH = 5.111002_rt + 1.755828_rt * THETA2; + Real E = THETA * T1 * E0 / E1; + Real EH = 1.0_rt / THETA + T1DH / T1 + E0DH / E0 - E1DH / E1; + Real EDH = E * EH; + Real EDHH = EDH * EH + E * (T1DHH / T1 - (T1DH / T1) * (T1DH / T1) + E0DHH / E0 - + (E0DH / E0) * (E0DH / E0) - + E1DHH / E1 + (E1DH / E1) * (E1DH / E1) - 1.0_rt / THETA2); + Real EXP1TH = std::exp(-1.0_rt / THETA); + Real C = (0.872496_rt + 0.025248_rt * EXP1TH) * E; + Real CDH = 0.025248_rt * EXP1TH / THETA2 * E + C * EDH / E; + Real CDHH = 0.025248_rt * EXP1TH / THETA2 * (EDH + (1.0_rt - 2.0_rt * THETA) / THETA2 * E) + + CDH * EDH / E + C * EDHH / E - C * (EDH / E) * (EDH / E); + Real DISCR = std::sqrt(4.0_rt * E - D * D); + Real DIDH = 0.5_rt / DISCR * (4.0_rt * EDH - 2.0_rt * D * DDH); + Real DIDHH = (-std::pow((2.0_rt * EDH - D * DDH) / DISCR, 2) + 2.0_rt * EDHH - + DDH * DDH - D * DDHH) / DISCR; + Real S1 = -C / E * GAME; + Real S1H = CDH / C - EDH / E; + Real S1DH = S1 * S1H; + Real S1DHH = S1DH * S1H + S1 * (CDHH / C - (CDH / C) * (CDH / C) - + EDHH / E + (EDH / E) * (EDH / E)); + Real S1DG = -C / E; // = > S1DGG = 0 + Real S1DHG = S1DG * (CDH / C - EDH / E); + Real B2 = B - C * D / E; + Real B2DH = BDH - (CDH * D + C * DDH) / E + C * D * EDH / (E * E); + Real B2DHH = BDHH - (CDHH * D + 2.0_rt * CDH * DDH + C * DDHH) / E + + (2.0_rt * (CDH * D + C * DDH - C * D * EDH / E) * EDH + + C * D * EDHH) / (E * E); + Real SQGE = std::sqrt(GAME); + Real S2 = -2.0_rt / E * B2 * SQGE; + Real S2H = B2DH / B2 - EDH / E; + Real S2DH = S2 * S2H; + Real S2DHH = S2DH * S2H + S2 * (B2DHH / B2 - (B2DH / B2) * (B2DH / B2) - + EDHH / E + (EDH / E) * (EDH / E)); + Real S2DG = 0.5_rt * S2 / GAME; + Real S2DGG = -0.5_rt * S2DG / GAME; + Real S2DHG = 0.5_rt * S2DH / GAME; + Real R3 = E * GAME + D * SQGE + 1.0_rt; + Real R3DH = EDH * GAME + DDH * SQGE; + Real R3DHH = EDHH * GAME + DDHH * SQGE; + Real R3DG = E + 0.5_rt * D / SQGE; + Real R3DGG = -0.25_rt * D / (GAME * SQGE); + Real R3DHG = EDH + 0.5_rt * DDH / SQGE; + Real B3 = A - C / E; + Real B3DH = ADH - CDH / E + C * EDH / (E * E); + Real B3DHH = ADHH - CDHH / E + (2.0_rt * CDH * EDH + C * EDHH) / (E * E) - + 2.0_rt * C * EDH * EDH / (E * E * E); + Real C3 = (D / E * B2 - B3) / E; // = D * B2 / (E * E) - B3 / E; + Real C3DH = (DDH * B2 + D * B2DH + B3 * EDH) / (E * E) - + 2.0_rt * D * B2 * EDH / (E * E * E) - B3DH / E; + Real C3DHH = (-B3DHH + + (DDHH * B2 + 2.0_rt * DDH * B2DH + D * B2DHH + + B3DH * EDH + B3 * EDHH + B3DH * EDH) / E - + 2.0_rt * ((DDH * B2 + D * B2DH + B3 * EDH + DDH * B2 + D * B2DH) * EDH + + D * B2 * EDHH) / (E * E) + + 6.0_rt * D * B2 * EDH * EDH / (E * E * E)) / E; + Real S3 = C3 * std::log(R3); + Real S3DH = S3 * C3DH / C3 + C3 * R3DH / R3; + Real S3DHH = (S3DH * C3DH + S3 * C3DHH) / C3 - S3 * (C3DH / C3) * (C3DH / C3) + + (C3DH * R3DH + C3 * R3DHH) / R3 - C3 * (R3DH / R3) * (R3DH / R3); + Real S3DG = C3 * R3DG / R3; + Real S3DGG = C3 * (R3DGG / R3 - (R3DG / R3) * (R3DG / R3)); + Real S3DHG = (C3DH * R3DG + C3 * R3DHG) / R3 - C3 * R3DG * R3DH / (R3 * R3); + Real B4 = 2.0_rt - D * D / E; + Real B4DH = EDH * (D / E) * (D / E) - 2.0_rt * D * DDH / E; + Real B4DHH = EDHH * (D / E) * (D / E) + 2.0_rt * EDH * (D / E) * (D / E) * (DDH / D - EDH / E) - + 2.0_rt * (DDH * DDH + D * DDHH) / E + 2.0_rt * D * DDH * EDH / (E * E); + Real C4 = 2.0_rt * E * SQGE + D; + Real C4DH = 2.0_rt * EDH * SQGE + DDH; + Real C4DHH = 2.0_rt * EDHH * SQGE + DDHH; + Real C4DG = E / SQGE; + Real C4DGG = -0.5_rt * E / (GAME * SQGE); + Real C4DHG = EDH / SQGE; + Real S4A = 2.0_rt / E / DISCR; + Real S4AH = EDH / E + DIDH / DISCR; + Real S4ADH = -S4A * S4AH; + Real S4ADHH = -S4ADH * S4AH - + S4A * (EDHH / E - (EDH / E) * (EDH / E) + DIDHH / DISCR - + (DIDH / DISCR) * (DIDH / DISCR)); + Real S4B = D * B3 + B4 * B2; + Real S4BDH = DDH * B3 + D * B3DH + B4DH * B2 + B4 * B2DH; + Real S4BDHH = DDHH * B3 + 2.0_rt * DDH * B3DH + D * B3DHH + B4DHH * B2 + + 2.0_rt * B4DH * B2DH + B4 * B2DHH; + Real S4C = std::atan(C4 / DISCR) - std::atan(D / DISCR); + Real UP1 = C4DH * DISCR - C4 * DIDH; + Real DN1 = DISCR * DISCR + C4 * C4; + Real UP2 = DDH * DISCR - D * DIDH; + Real DN2 = DISCR * DISCR + D * D; + Real S4CDH = UP1 / DN1 - UP2 / DN2; + Real S4CDHH = (C4DHH * DISCR - C4 * DIDHH) / DN1 - + UP1 * 2.0_rt * (DISCR * DIDH + C4 * C4DH) / (DN1 * DN1) - + (DDHH * DISCR - D * DIDHH) / DN2 + UP2 * 2.0_rt * + (DISCR * DIDH + D * DDH) / (DN2 * DN2); + Real S4CDG = C4DG * DISCR / DN1; + Real S4CDGG = C4DGG * DISCR / DN1 - 2.0_rt * C4 * DISCR * (C4DG / DN1) * (C4DG / DN1); + Real S4CDHG = (C4DHG * DISCR + C4DG * DIDH - + C4DG * DISCR / DN1 * 2.0_rt * (DISCR * DIDH + C4 * C4DH)) / DN1; + Real S4 = S4A * S4B * S4C; + Real S4DH = S4ADH * S4B * S4C + S4A * S4BDH * S4C + S4A * S4B * S4CDH; + Real S4DHH = S4ADHH * S4B * S4C + S4A * S4BDHH * S4C + S4A * S4B * S4CDHH + + 2.0_rt * (S4ADH * S4BDH * S4C + S4ADH * S4B * S4CDH + S4A * S4BDH * S4CDH); + Real S4DG = S4A * S4B * S4CDG; + Real S4DGG = S4A * S4B * S4CDGG; + Real S4DHG = S4A * S4B * S4CDHG + S4CDG * (S4ADH * S4B + S4A * S4BDH); + + FXC = S1 + S2 + S3 + S4; + Real FXCDH = S1DH + S2DH + S3DH + S4DH; + Real FXCDG = S1DG + S2DG + S3DG + S4DG; + Real FXCDHH = S1DHH + S2DHH + S3DHH + S4DHH; + Real FXCDGG = S2DGG + S3DGG + S4DGG; + Real FXCDHG = S1DHG + S2DHG + S3DHG + S4DHG; + PXC = (GAME * FXCDG - 2.0_rt * THETA * FXCDH) / 3.0_rt; + UXC = GAME * FXCDG - THETA * FXCDH; + SXC = (GAME * S2DG - S2 + GAME * S3DG - S3 + S4A * S4B * (GAME * S4CDG - S4C)) - + THETA * FXCDH; + if (std::abs(SXC) < EPS * std::abs(THETA * FXCDH)) { + SXC = 0.0_rt; // accuracy loss + } + CVXC = 2.0_rt * THETA * (GAME * FXCDHG - FXCDH) - THETA * THETA * FXCDHH - GAME * GAME * FXCDGG; + if (std::abs(CVXC) < EPS * std::abs(GAME * GAME * FXCDGG)) { + CVXC = 0.0_rt; // accuracy + } + Real PDLH = THETA * (GAME * FXCDHG - 2.0_rt * FXCDH - 2.0_rt * THETA * FXCDHH) / 3.0_rt; + Real PDLG = GAME * (FXCDG + GAME * FXCDGG - 2.0_rt * THETA * FXCDHG) / 3.0_rt; + PDRXC = PXC + (PDLG - 2.0_rt * PDLH) / 3.0_rt; + PDTXC = GAME * (THETA * FXCDHG - GAME * FXCDGG / 3.0_rt) - + THETA * (FXCDH / 0.75_rt + THETA * FXCDHH / 1.5_rt); + } } From 44ae7e56590f20ff12c9055e4cab445ed118b9eb Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 22:58:09 -0700 Subject: [PATCH 42/70] subfermj to C++ --- EOS/pc/eos17.f90 | 63 +++++++++++++----------------------------------- EOS/pc/eos_c.cpp | 49 +++++++++++++++++++++++++++++++++++++ 2 files changed, 66 insertions(+), 46 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 0f65e6482d..2762626432 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -1447,6 +1447,23 @@ subroutine SOMMERF(TEMR,CHI, & save parameter(PI=3.141592653d0) parameter(PI2=PI**2) + interface + subroutine subfermj(CMU1, & + CJ00,CJ10,CJ20, & + CJ01,CJ11,CJ21, & + CJ02,CJ12,CJ22, & + CJ03,CJ13,CJ23, & + CJ04,CJ14,CJ24,CJ05) bind(C, name="subfermj") + implicit none + double precision, intent(in), value :: CMU1 + double precision :: CJ00,CJ10,CJ20, & + CJ01,CJ11,CJ21, & + CJ02,CJ12,CJ22, & + CJ03,CJ13,CJ23, & + CJ04,CJ14,CJ24,CJ05 + end subroutine subfermj + end interface + if (CHI.lt..5d0) then print *, 'SOMMERF: non-degenerate (small CHI)' stop @@ -1494,49 +1511,3 @@ subroutine SOMMERF(TEMR,CHI, & PIT26*(.75d0*CJ03+3.d0*CMU1*CJ04+CMU1**2*CJ05)) return end - - subroutine SUBFERMJ(CMU1, & - CJ00,CJ10,CJ20, & - CJ01,CJ11,CJ21, & - CJ02,CJ12,CJ22, & - CJ03,CJ13,CJ23, & - CJ04,CJ14,CJ24,CJ05) -! Version 17.11.11 -! corrected 04.03.21 -! Supplement to SOMMERF - implicit double precision (A-H), double precision (O-Z) - save - parameter(EPS=1.d-4) ! inserted 04.03.21 - if (CMU1.le.0.d0) then - print *, 'SUBFERMJ: small CHI' - stop - end if - CMU=1.d0+CMU1 - X0=dsqrt(CMU1*(2.d0+CMU1)) - X3=X0**3 - X5=X0**5 - if (X0.lt.EPS) then - CJ00=X3/3.d0 - CJ10=.1d0*X5 - CJ20=X0**7/28.d0 - else - CL=dlog(X0+CMU) - CJ00=.5d0*(X0*CMU-CL) ! J_{1/2}^0 - CJ10=X3/3.d0-CJ00 ! J_{3/2}^0 - CJ20=(.75d0*CMU-2.d0)/3.d0*X3+1.25d0*CJ00 ! J_{5/2}^0 - endif - CJ01=X0 ! J_{1/2}^1 - CJ11=CJ01*CMU1 ! J_{3/2}^1 - CJ21=CJ11*CMU1 ! J_{5/2}^1 - CJ02=CMU/X0 ! J_{1/2}^2 - CJ12=CMU1/X0*(3.d0+2.d0*CMU1) ! J_{3/2}^2 - CJ22=CMU1**2/X0*(5.d0+3.d0*CMU1) ! J_{5/2}^2 - CJ03=-1.d0/X3 ! J_{1/2}^3 - CJ13=CMU1/X3*(2.d0*CMU1**2+6.d0*CMU1+3.d0) - CJ23=CMU1**2/X3*(6.d0*CMU1**2+2.d1*CMU1+1.5d1) - CJ04=3.d0*CMU/X5 - CJ14=-3.d0*CMU1/X5 - CJ24=CMU1**2/X5*(6.d0*CMU1**3+3.d1*CMU1**2+45.d0*CMU1+15.d0) - CJ05=(-12.d0*CMU1**2-24.d0*CMU1-15.d0)/(X5*X0**2) - return - end diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index d043cb95b6..d8cb19162a 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -967,4 +967,53 @@ extern "C" PDTXC = GAME * (THETA * FXCDHG - GAME * FXCDGG / 3.0_rt) - THETA * (FXCDH / 0.75_rt + THETA * FXCDHH / 1.5_rt); } + + void subfermj (Real CMU1, + Real& CJ00, Real& CJ10, Real& CJ20, + Real& CJ01, Real& CJ11, Real& CJ21, + Real& CJ02, Real& CJ12, Real& CJ22, + Real& CJ03, Real& CJ13, Real& CJ23, + Real& CJ04, Real& CJ14, Real& CJ24, Real& CJ05) + { + // Version 17.11.11 + // corrected 04.03.21 + // Supplement to SOMMERF + const Real EPS = 1.e-4_rt; // inserted 04.03.21 + if (CMU1 <= 0.0_rt) { + printf("SUBFERMJ: small CHI\n"); + exit(1); + } + + Real CMU = 1.0_rt + CMU1; + Real X0 = std::sqrt(CMU1 * (2.0_rt + CMU1)); + Real X3 = X0 * X0 * X0; + Real X5 = X3 * X0 * X0; + Real X7 = X5 * X0 * X0; + if (X0 < EPS) { + CJ00 = X3 / 3.0_rt; + CJ10 = 0.1_rt * X5; + CJ20 = X7 / 28.0_rt; + } + else { + Real CL = std::log(X0 + CMU); + CJ00 = 0.5_rt * (X0 * CMU - CL); // J_{1/2}^0 + CJ10 = X3 / 3.0_rt - CJ00; // J_{3/2}^0 + CJ20 = (0.75_rt * CMU - 2.0_rt) / 3.0_rt * X3 + 1.25_rt * CJ00; // J_{5/2}^0 + } + + CJ01 = X0; // J_{1/2}^1 + CJ11 = CJ01 * CMU1; // J_{3/2}^1 + CJ21 = CJ11 * CMU1; // J_{5/2}^1 + Real RCJ02 = CMU / X0; // J_{1/2}^2 + CJ12 = CMU1 / X0 * (3.0_rt + 2.0_rt * CMU1); // J_{3/2}^2 + CJ22 = CMU1 * CMU1 / X0 * (5.0_rt + 3.0_rt * CMU1); // J_{5/2}^2 + CJ03 = -1.0_rt / X3; // J_{1/2}^3 + CJ13 = CMU1 / X3 * (2.0_rt * CMU1 * CMU1 + 6.0_rt * CMU1 + 3.0_rt); + CJ23 = CMU1 * CMU1 / X3 * (6.0_rt * CMU1 * CMU1 + 2.0e1_rt * CMU1 + 1.5e1_rt); + CJ04 = 3.0_rt * CMU / X5; + CJ14 = -3.0_rt * CMU1 / X5; + CJ24 = CMU1 * CMU1 / X5 * (6.0_rt * CMU1 * CMU1 * CMU1 + 3.0e1_rt * CMU1 * CMU1 + + 45.0_rt * CMU1 + 15.0_rt); + CJ05 = (-12.0_rt * CMU1 * CMU1 - 24.0_rt * CMU1 - 15.0_rt) / (X7); + } } From f5309b3d3db7f250b266167130ce88fd6548a300 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 23:09:39 -0700 Subject: [PATCH 43/70] sommerf to C++ --- EOS/pc/eos17.f90 | 98 ++++++++---------------------------------------- EOS/pc/eos_c.cpp | 77 +++++++++++++++++++++++++++++++++++++ 2 files changed, 92 insertions(+), 83 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 2762626432..063487da4f 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -1368,6 +1368,21 @@ subroutine ELECT11b(TEMP,CHI, & save parameter (BOHR=137.036,PI=3.141592653d0) parameter (PI2=PI**2,BOHR2=BOHR**2,BOHR3=BOHR2*BOHR) !cleaned 15/6 + interface + subroutine sommerf(TEMR,CHI, & + W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & + W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & + W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & + W0XXX,W0XTT,W0XXT) bind(C, name="sommerf") + implicit none + double precision, intent(in), value :: TEMR, CHI + double precision :: W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & + W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & + W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & + W0XXX,W0XTT,W0XXT + end subroutine sommerf + end interface + TEMR=TEMP/BOHR2 ! T in rel.units (=T/mc^2) EF=CHI*TEMR ! Fermi energy in mc^2 - zeroth aprox. = CMU1 DeltaEF=PI2*TEMR**2/6.d0*(1.d0+2.d0*EF*(2.d0+EF))/ & @@ -1428,86 +1443,3 @@ subroutine ELECT11b(TEMP,CHI, & CHITE=CHITE/(1.d0+D2) return end - - subroutine SOMMERF(TEMR,CHI, & - W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & - W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & - W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & - W0XXX,W0XTT,W0XXT) -! Version 17.11.11 -! Sommerfeld expansion for the Fermi-Dirac integrals -! Input: TEMR=T/mc^2; CHI=(\mu-mc^2)/T -! Output: Wk - Fermi-Dirac integral of the order k+1/2 -! WkDX=dWk/dCHI, WkDT = dWk/dT, WkDXX=d^2 Wk / d CHI^2, -! WkDTT=d^2 Wk / d T^2, WkDXT=d^2 Wk /dCHIdT, -! W0XXX=d^3 W0 / d CHI^3, W0XTT=d^3 W0 /(d CHI d^2 T), -! W0XXT=d^3 W0 /dCHI^2 dT -! [Draft source: yellow book pages 124-127] - implicit double precision (A-H), double precision (O-Z) - save - parameter(PI=3.141592653d0) - parameter(PI2=PI**2) - interface - subroutine subfermj(CMU1, & - CJ00,CJ10,CJ20, & - CJ01,CJ11,CJ21, & - CJ02,CJ12,CJ22, & - CJ03,CJ13,CJ23, & - CJ04,CJ14,CJ24,CJ05) bind(C, name="subfermj") - implicit none - double precision, intent(in), value :: CMU1 - double precision :: CJ00,CJ10,CJ20, & - CJ01,CJ11,CJ21, & - CJ02,CJ12,CJ22, & - CJ03,CJ13,CJ23, & - CJ04,CJ14,CJ24,CJ05 - end subroutine subfermj - end interface - - if (CHI.lt..5d0) then - print *, 'SOMMERF: non-degenerate (small CHI)' - stop - end if - if (TEMR.le.0.d0) then - print *, 'SOMMERF: T < 0' - stop - end if - CMU1=CHI*TEMR ! chemical potential in rel.units - CMU=1.d0+CMU1 - call SUBFERMJ(CMU1, & - CJ00,CJ10,CJ20, & - CJ01,CJ11,CJ21, & - CJ02,CJ12,CJ22, & - CJ03,CJ13,CJ23, & - CJ04,CJ14,CJ24,CJ05) - PIT26=(PI*TEMR)**2/6.d0 - CN0=dsqrt(.5d0/TEMR)/TEMR - CN1=CN0/TEMR - CN2=CN1/TEMR - W0=CN0*(CJ00+PIT26*CJ02) ! +CN0*PITAU4*CJ04 - W1=CN1*(CJ10+PIT26*CJ12) ! +CN1*PITAU4*CJ14 - W2=CN2*(CJ20+PIT26*CJ22) ! +CN2*PITAU4*CJ24 - W0DX=CN0*TEMR*(CJ01+PIT26*CJ03) ! +CN0*PITAU4*CJ05 - W1DX=CN0*(CJ11+PIT26*CJ13) - W2DX=CN1*(CJ21+PIT26*CJ23) - W0DT=CN1*(CMU1*CJ01-1.5d0*CJ00+PIT26*(CMU1*CJ03+.5d0*CJ02)) - W1DT=CN2*(CMU1*CJ11-2.5d0*CJ10+PIT26*(CMU1*CJ13-.5d0*CJ12)) - W2DT=CN2/TEMR*(CMU1*CJ21-3.5d0*CJ20+PIT26*(CMU1*CJ23-1.5d0*CJ22)) - W0DXX=CN0*TEMR**2*(CJ02+PIT26*CJ04) - W1DXX=CN0*TEMR*(CJ12+PIT26*CJ14) - W2DXX=CN0*(CJ22+PIT26*CJ24) - W0DXT=CN0*(CMU1*CJ02-.5d0*CJ01+PIT26*(CMU1*CJ04+1.5d0*CJ03)) - W1DXT=CN1*(CMU1*CJ12-1.5d0*CJ11+PIT26*(CMU1*CJ14+.5d0*CJ13)) - W2DXT=CN2*(CMU1*CJ22-2.5d0*CJ21+PIT26*(CMU1*CJ24-.5d0*CJ23)) - W0DTT=CN2*(3.75d0*CJ00-3.d0*CMU1*CJ01+CMU1**2*CJ02+ & - PIT26*(-.25d0*CJ02+CMU1*CJ03+CMU1**2*CJ04)) - W1DTT=CN2/TEMR*(8.75d0*CJ10-5.d0*CMU1*CJ11+CMU1**2*CJ12+ & - PIT26*(.75d0*CJ12-CMU1*CJ13+CMU1**2*CJ14)) - W2DTT=CN2/TEMR**2*(15.75d0*CJ20-7.d0*CMU1*CJ21+CMU1**2*CJ22+ & - PIT26*(3.75d0*CJ22-3.d0*CMU1*CJ23+CMU1**2*CJ24)) - W0XXX=CN0*TEMR**3*(CJ03+PIT26*CJ05) - W0XXT=CN0*TEMR*(CMU1*CJ03+.5d0*CJ02+PIT26*(CMU1*CJ05+2.5d0*CJ04)) - W0XTT=CN1*(.75d0*CJ01-CMU1*CJ02+CMU1**2*CJ03+ & - PIT26*(.75d0*CJ03+3.d0*CMU1*CJ04+CMU1**2*CJ05)) - return - end diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index d8cb19162a..129d26a7f8 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -1016,4 +1016,81 @@ extern "C" 45.0_rt * CMU1 + 15.0_rt); CJ05 = (-12.0_rt * CMU1 * CMU1 - 24.0_rt * CMU1 - 15.0_rt) / (X7); } + + void sommerf (Real TEMR, Real CHI, + Real& W0, Real& W0DX, Real& W0DT, Real& W0DXX, Real& W0DTT, Real& W0DXT, + Real& W1, Real& W1DX, Real& W1DT, Real& W1DXX, Real& W1DTT, Real& W1DXT, + Real& W2, Real& W2DX, Real& W2DT, Real& W2DXX, Real& W2DTT, Real& W2DXT, + Real& W0XXX, Real& W0XTT, Real& W0XXT) + { + // Version 17.11.11 + // Sommerfeld expansion for the Fermi-Dirac integrals + // Input: TEMR=T/mc^2; CHI=(\mu-mc^2)/T + // Output: Wk - Fermi-Dirac integral of the order k+1/2 + // WkDX=dWk/dCHI, WkDT = dWk/dT, WkDXX=d^2 Wk / d CHI^2, + // WkDTT=d^2 Wk / d T^2, WkDXT=d^2 Wk /dCHIdT, + // W0XXX=d^3 W0 / d CHI^3, W0XTT=d^3 W0 /(d CHI d^2 T), + // W0XXT=d^3 W0 /dCHI^2 dT + // [Draft source: yellow book pages 124-127] + + const Real PI = 3.141592653_rt; + const Real PI2 = PI * PI; + + if (CHI < 0.5_rt) { + printf("SOMMERF: non-degenerate (small CHI)\n"); + exit(1); + } + + if (TEMR <= 0.0_rt) { + printf("SOMMERF: T < 0\n"); + exit(1); + } + + Real CMU1 = CHI * TEMR; // chemical potential in rel.units + Real CMU = 1.0_rt + CMU1; + + Real CJ00, CJ10, CJ20; + Real CJ01, CJ11, CJ21; + Real CJ02, CJ12, CJ22; + Real CJ03, CJ13, CJ23; + Real CJ04, CJ14, CJ24; + Real CJ05; + + subfermj(CMU1, + CJ00, CJ10, CJ20, + CJ01, CJ11, CJ21, + CJ02, CJ12, CJ22, + CJ03, CJ13, CJ23, + CJ04, CJ14, CJ24, CJ05); + + Real PIT26 = (PI * TEMR)*(PI * TEMR) / 6.0_rt; + Real CN0 = std::sqrt(0.5_rt / TEMR) / TEMR; + Real CN1 = CN0 / TEMR; + Real CN2 = CN1 / TEMR; + W0 = CN0 * (CJ00 + PIT26 * CJ02); // + CN0 * PITAU4 * CJ04 + W1 = CN1 * (CJ10 + PIT26 * CJ12); // + CN1 * PITAU4 * CJ14 + W2 = CN2 * (CJ20 + PIT26 * CJ22); // + CN2 * PITAU4 * CJ24 + W0DX = CN0 * TEMR * (CJ01 + PIT26 * CJ03); // + CN0 * PITAU4 * CJ05 + W1DX = CN0 * (CJ11 + PIT26 * CJ13); + W2DX = CN1 * (CJ21 + PIT26 * CJ23); + W0DT = CN1 * (CMU1 * CJ01 - 1.5_rt * CJ00 + PIT26 * (CMU1 * CJ03 + 0.5_rt * CJ02)); + W1DT = CN2 * (CMU1 * CJ11 - 2.5_rt * CJ10 + PIT26 * (CMU1 * CJ13 - 0.5_rt * CJ12)); + W2DT = CN2 / TEMR * (CMU1 * CJ21 - 3.5_rt * CJ20 + PIT26 * (CMU1 * CJ23 - 1.5_rt * CJ22)); + W0DXX = CN0 * TEMR * TEMR * (CJ02 + PIT26 * CJ04); + W1DXX = CN0 * TEMR * (CJ12 + PIT26 * CJ14); + W2DXX = CN0 * (CJ22 + PIT26 * CJ24); + W0DXT = CN0 * (CMU1 * CJ02 - 0.5_rt * CJ01 + PIT26 * (CMU1 * CJ04 + 1.5_rt * CJ03)); + W1DXT = CN1 * (CMU1 * CJ12 - 1.5_rt * CJ11 + PIT26 * (CMU1 * CJ14 + 0.5_rt * CJ13)); + W2DXT = CN2 * (CMU1 * CJ22 - 2.5_rt * CJ21 + PIT26 * (CMU1 * CJ24 - 0.5_rt * CJ23)); + W0DTT = CN2 * (3.75_rt * CJ00 - 3.0_rt * CMU1 * CJ01 + CMU1 * CMU1 * CJ02 + + PIT26 * (-0.25_rt * CJ02 + CMU1 * CJ03 + CMU1 * CMU1 * CJ04)); + W1DTT = CN2 / TEMR * (8.75_rt * CJ10 - 5.0_rt * CMU1 * CJ11 + CMU1 * CMU1 * CJ12 + + PIT26 * (0.75_rt * CJ12 - CMU1 * CJ13 + CMU1 * CMU1 * CJ14)); + W2DTT = CN2 / TEMR * TEMR * (15.75_rt * CJ20 - 7.0_rt * CMU1 * CJ21 + CMU1 * CMU1 * CJ22 + + PIT26 * (3.75_rt * CJ22 - 3.0_rt * CMU1 * CJ23 + CMU1 * CMU1 * CJ24)); + W0XXX = CN0 * TEMR * TEMR * TEMR * (CJ03 + PIT26 * CJ05); + W0XXT = CN0 * TEMR * (CMU1 * CJ03 + 0.5_rt * CJ02 + PIT26 * (CMU1 * CJ05 + 2.5_rt * CJ04)); + W0XTT = CN1 * (0.75_rt * CJ01 - CMU1 * CJ02 + CMU1 * CMU1 * CJ03 + + PIT26 * (0.75_rt * CJ03 + 3.0_rt * CMU1 * CJ04 + CMU1 * CMU1 * CJ05)); + } } From 0858c5584846adb8b3d69a77ce5dbb58553e3c10 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 23:48:39 -0700 Subject: [PATCH 44/70] elect11b to C++ --- EOS/pc/eos17.f90 | 94 +++++------------------------------------------- EOS/pc/eos_c.cpp | 92 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 100 insertions(+), 86 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 063487da4f..2f15d7a866 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -1256,6 +1256,14 @@ subroutine fermi10(X,XMAX,FP,FM) bind(C, name="fermi10") double precision, intent(in), value :: X, XMAX double precision, intent(inout) :: FP, FM end subroutine fermi10 + subroutine elect11b(TEMP,CHI, & + DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & + DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) bind(C, name="elect11b") + implicit none + double precision, intent(in), value:: TEMP,CHI + double precision :: DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & + DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT + end subroutine elect11b end interface if (CHI.lt.-1.d2) then @@ -1357,89 +1365,3 @@ end subroutine blin9 CHIRE=DENR/PR*dPdH/dndH ! (dndH*TEMR*PEid) ! DENS/PRE*dPdH/dndH return end - - subroutine ELECT11b(TEMP,CHI, & - DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & - DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) -! Version 17.11.11 -! Stems from ELECT9b v.19.01.10, Diff. - additional output. -! Sommerfeld expansion at very large CHI. - implicit double precision (A-H), double precision (O-Z) - save - parameter (BOHR=137.036,PI=3.141592653d0) - parameter (PI2=PI**2,BOHR2=BOHR**2,BOHR3=BOHR2*BOHR) !cleaned 15/6 - interface - subroutine sommerf(TEMR,CHI, & - W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & - W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & - W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & - W0XXX,W0XTT,W0XXT) bind(C, name="sommerf") - implicit none - double precision, intent(in), value :: TEMR, CHI - double precision :: W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & - W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & - W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & - W0XXX,W0XTT,W0XXT - end subroutine sommerf - end interface - - TEMR=TEMP/BOHR2 ! T in rel.units (=T/mc^2) - EF=CHI*TEMR ! Fermi energy in mc^2 - zeroth aprox. = CMU1 - DeltaEF=PI2*TEMR**2/6.d0*(1.d0+2.d0*EF*(2.d0+EF))/ & - (EF*(1.d0+EF)*(2.d0+EF)) ! corr. [p.125, equiv.Eq.(6) of PC'10] - EF=EF+DeltaEF ! corrected Fermi energy (14.02.09) - G=1.d0+EF ! electron Lorentz-factor - if (EF.gt.1.d-5) then ! relativistic expansion (Yak.&Shal.'89) - PF=dsqrt(G**2-1.d0) ! Fermi momentum [rel.un.=mc] - F=(PF*(1.+2.d0*PF**2)*G-PF**3/.375d0-dlog(PF+G))/8.d0/PI2!F/V - DF=-TEMR**2*PF*G/6.d0 ! thermal correction to F/V - P=(PF*G*(PF**2/1.5d0-1.d0)+dlog(PF+G))/8.d0/PI2 ! P(T=0) - DP=TEMR**2*PF*(PF**2+2.d0)/G/18.d0 ! thermal correction to P - CVE=PI2*TEMR*G/PF**2 - else ! nonrelativistic limit - PF=dsqrt(2.d0*EF) - F=PF**5*0.1d0/PI2 - DF=-TEMR**2*PF/6.d0 - P=F/1.5d0 - DP=TEMR**2*PF/9.d0 - CVE=PI2*TEMR/EF/2.d0 - endif - F=F+DF - P=P+DP - S=-2.d0*DF ! entropy per unit volume [rel.un.] - U=F+S - CHIRE=PF**5/(9.d0*PI2*P*G) - CHITE=2.d0*DP/P - DENR=PF**3/3.d0/PI2 ! n_e [rel.un.=\Compton^{-3}] - DENS=DENR*BOHR3 ! conversion to a.u.(=\Bohr_radius^{-3}) -! derivatives over chi at constant T and T at constant chi: - TPI=TEMR*dsqrt(2.d0*TEMR)/PI2 ! common pre-factor - call SOMMERF(TEMR,CHI, & - W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & - W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & - W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & - W0XXX,W0XTT,W0XXT) - dndH=TPI*(W0DX+TEMR*W1DX) ! (d n_e/d\chi)_T - dndT=TPI*(1.5*W0/TEMR+2.5*W1+W0DT+TEMR*W1DT) ! (d n_e/dT)_\chi - dndHH=TPI*(W0DXX+TEMR*W1DXX) ! (d^2 n_e/d\chi)_T - dndTT=TPI*(.75*W0/TEMR**2+3.*W0DT/TEMR+W0DTT+ & - 3.75*W1/TEMR+5.*W1DT+TEMR*W1DTT) - dndHT=TPI*(1.5*W0DX/TEMR+W0DXT+2.5*W1DX+TEMR*W1DXT) - DlnDH=dndH/DENR ! (d ln n_e/d\chi)_T - DlnDT=dndT*TEMR/DENR ! (d ln n_e/d ln T)_\chi - DlnDHH=dndHH/DENR-DlnDH**2 ! (d^2 ln n_e/d\chi^2)_T - DlnDTT=TEMR**2/DENR*dndTT+DlnDT-DlnDT**2 ! d^2 ln n_e/d ln T^2 - DlnDHT=TEMR/DENR*(dndHT-dndT*DlnDH) ! d^2 ln n_e/d\chi d ln T - DT=DENR*TEMR - PEid=P/DT - UEid=U/DT - FEid=F/DT - SEid=S/DT -! Empirical corrections of 16.02.09: - D1=DeltaEF/EF - D2=D1*(4.d0-2.d0*(PF/G)) - CVE=CVE/(1.d0+D2) - SEid=SEid/(1.d0+D1) - CHITE=CHITE/(1.d0+D2) - return - end diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 129d26a7f8..f9472650d8 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -1093,4 +1093,96 @@ extern "C" W0XTT = CN1 * (0.75_rt * CJ01 - CMU1 * CJ02 + CMU1 * CMU1 * CJ03 + PIT26 * (0.75_rt * CJ03 + 3.0_rt * CMU1 * CJ04 + CMU1 * CMU1 * CJ05)); } + + void elect11b(Real TEMP, Real CHI, + Real& DENS, Real& FEid, Real& PEid, Real& UEid, + Real& SEid, Real& CVE, Real& CHITE, Real& CHIRE, + Real& DlnDH, Real& DlnDT, Real& DlnDHH, + Real& DlnDTT, Real& DlnDHT) + { + // Version 17.11.11 + // Stems from ELECT9b v.19.01.10, Diff. - additional output. + // Sommerfeld expansion at very large CHI. + + const Real BOHR = 137.036_rt; + const Real PI = 3.141592653_rt; + const Real PI2 = PI * PI; + const Real BOHR2 = BOHR * BOHR; + const Real BOHR3 = BOHR2 * BOHR; // cleaned 15/6 + + Real TEMR = TEMP / BOHR2; // T in rel.units ( = T/mc^2) + Real EF = CHI * TEMR; // Fermi energy in mc^2 - zeroth aprox. = CMU1 + Real DeltaEF = PI2 * TEMR * TEMR / 6.0_rt * (1.0_rt + 2.0_rt * EF * (2.0_rt + EF)) / + (EF * (1.0_rt + EF) * (2.0_rt + EF)); // corr. [p.125, equiv.Eq.(6) of PC'10] + EF = EF + DeltaEF; // corrected Fermi energy (14.02.09) + Real G = 1.0_rt + EF; // electron Lorentz-factor + + Real PF, F, DF, P, DP; + + if (EF > 1.e-5_rt) { // relativistic expansion (Yak.&Shal.'89) + PF = std::sqrt(G * G - 1.0_rt); // Fermi momentum [rel.un. = mc] + F = (PF * (1.0_rt + 2.0_rt * PF * PF) * G - PF * PF * PF / .375_rt - std::log(PF + G)) / 8.0_rt / PI2; // F/V + DF = -TEMR * TEMR * PF * G / 6.0_rt; // thermal correction to F/V + P = (PF * G * (PF * PF / 1.5_rt - 1.0_rt) + std::log(PF + G)) / 8.0_rt / PI2; // P(T = 0) + DP = TEMR * TEMR * PF * (PF * PF + 2.0_rt) / G / 18.0_rt; // thermal correction to P + CVE = PI2 * TEMR * G / (PF * PF); + } + else { // nonrelativistic limit + PF = std::sqrt(2.0_rt * EF); + F = (PF * PF * PF * PF * PF) * 0.1_rt / PI2; + DF = -TEMR * TEMR * PF / 6.0_rt; + P = F / 1.5_rt; + DP = TEMR * TEMR * PF / 9.0_rt; + CVE = PI2 * TEMR / EF / 2.0_rt; + } + + F = F + DF; + P = P + DP; + Real S = -2.0_rt * DF; // entropy per unit volume [rel.un.] + Real U = F + S; + CHIRE = (PF * PF * PF * PF * PF) / (9.0_rt * PI2 * P * G); + CHITE = 2.0_rt * DP / P; + Real DENR = PF * PF * PF / 3.0_rt / PI2; // n_e [rel.un. = \Compton^{-3}] + DENS = DENR * BOHR3; // conversion to a.u.( = \Bohr_radius^{-3}) + + // derivatives over chi at constant T and T at constant chi: + Real TPI = TEMR * std::sqrt(2.0_rt * TEMR) / PI2; // common pre-factor + + Real W0, W0DX, W0DT, W0DXX, W0DTT, W0DXT; + Real W1, W1DX, W1DT, W1DXX, W1DTT, W1DXT; + Real W2, W2DX, W2DT, W2DXX, W2DTT, W2DXT; + Real W0XXX, W0XTT, W0XXT; + + sommerf(TEMR, CHI, + W0, W0DX, W0DT, W0DXX, W0DTT, W0DXT, + W1, W1DX, W1DT, W1DXX, W1DTT, W1DXT, + W2, W2DX, W2DT, W2DXX, W2DTT, W2DXT, + W0XXX, W0XTT, W0XXT); + + Real dndH = TPI * (W0DX + TEMR * W1DX); // (d n_e/d\chi)_T + Real dndT = TPI * (1.5_rt * W0 / TEMR + 2.5 * W1 + W0DT + TEMR * W1DT); // (d n_e/dT)_\chi + Real dndHH = TPI * (W0DXX + TEMR * W1DXX); // (d^2 n_e/d\chi)_T + Real dndTT = TPI * (0.75_rt * W0 / TEMR * TEMR + 3. * W0DT / TEMR + W0DTT + + 3.75 * W1 / TEMR + 5. * W1DT + TEMR * W1DTT); + Real dndHT = TPI * (1.5_rt * W0DX / TEMR + W0DXT + 2.5 * W1DX + TEMR * W1DXT); + + DlnDH = dndH / DENR; // (d ln n_e/d\chi)_T + DlnDT = dndT * TEMR / DENR; // (d ln n_e/d ln T)_\chi + DlnDHH = dndHH / DENR - DlnDH * DlnDH; // (d^2 ln n_e/d\chi^2)_T + DlnDTT = TEMR * TEMR / DENR * dndTT + DlnDT - DlnDT * DlnDT; // d^2 ln n_e/d ln T^2 + DlnDHT = TEMR / DENR * (dndHT - dndT * DlnDH); // d^2 ln n_e/d\chi d ln T + + Real DT = DENR * TEMR; + PEid = P / DT; + UEid = U / DT; + FEid = F / DT; + SEid = S / DT; + + // Empirical corrections of 16.02.09: + Real D1 = DeltaEF / EF; + Real D2 = D1 * (4.0_rt - 2.0_rt * (PF / G)); + CVE = CVE / (1.0_rt + D2); + SEid = SEid / (1.0_rt + D1); + CHITE = CHITE / (1.0_rt + D2); + } } From bb37d62ce9dc73b474d4452c15fb9844a16b1577 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Sun, 17 Oct 2021 23:59:59 -0700 Subject: [PATCH 45/70] elect11a to C++ --- EOS/pc/eos17.f90 | 70 ++++++------------------------------------------ EOS/pc/eos_c.cpp | 63 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 71 insertions(+), 62 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 2f15d7a866..7a08284074 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -1256,6 +1256,14 @@ subroutine fermi10(X,XMAX,FP,FM) bind(C, name="fermi10") double precision, intent(in), value :: X, XMAX double precision, intent(inout) :: FP, FM end subroutine fermi10 + subroutine elect11a(TEMP,CHI, & + DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & + DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) bind(C, name="elect11a") + implicit none + double precision, intent(in), value:: TEMP,CHI + double precision :: DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & + DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT + end subroutine elect11a subroutine elect11b(TEMP,CHI, & DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) bind(C, name="elect11b") @@ -1303,65 +1311,3 @@ end subroutine elect11b endif return end - - subroutine ELECT11a(TEMP,CHI, & - DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & - DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) -! Version 16.11.11 -! This is THE FIRST PART of ELECT9 v.04.03.09. - implicit double precision (A-H), double precision (O-Z) - save - parameter (BOHR=137.036,PI=3.141592653d0) - parameter (PI2=PI**2,BOHR2=BOHR**2,BOHR3=BOHR2*BOHR) !cleaned 15/6 - interface - subroutine blin9(TEMR,CHI, & - W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & - W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & - W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & - W0XXX,W0XTT,W0XXT) bind(C, name="blin9") - implicit none - double precision, intent(in), value :: TEMR, CHI - double precision :: W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & - W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & - W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & - W0XXX,W0XTT,W0XXT - end subroutine blin9 - end interface - TEMR=TEMP/BOHR2 ! T in rel.units (=T/mc^2) - call BLIN9(TEMR,CHI, & - W0,W0DX,W0DT,W0DXX,W0DTT,W0DXT, & - W1,W1DX,W1DT,W1DXX,W1DTT,W1DXT, & - W2,W2DX,W2DT,W2DXX,W2DTT,W2DXT, & - W0XXX,W0XTT,W0XXT) - TPI=TEMR*dsqrt(2.d0*TEMR)/PI2 ! common pre-factor - DENR=TPI*(W1*TEMR+W0) - PR=TEMR*TPI/3.*(W2*TEMR+2.*W1) - U=TEMR*TPI*(W2*TEMR+W1) -! (these are density, pressure, and internal energy in the rel.units) - PEid=PR/(DENR*TEMR) - UEid=U/(DENR*TEMR) - FEid=CHI-PEid - DENS=DENR*BOHR3 ! converts from rel.units to a.u. - SEid=UEid-FEid -! derivatives over T at constant chi: - dndT=TPI*(1.5*W0/TEMR+2.5*W1+W0DT+TEMR*W1DT) ! (d n_e/dT)_\chi - dPdT=TPI/3.*(5.*W1+2.*TEMR*W1DT+3.5*TEMR*W2+TEMR**2*W2DT)!dP/dT - dUdT=TPI*(2.5*W1+TEMR*W1DT+3.5*TEMR*W2+TEMR**2*W2DT)!dU/dT_\chi -! derivatives over chi at constant T and second derivatives: - dndH=TPI*(W0DX+TEMR*W1DX) ! (d n_e/d\chi)_T - dndHH=TPI*(W0DXX+TEMR*W1DXX) ! (d^2 n_e/d\chi)_T - dndTT=TPI*(.75*W0/TEMR**2+3.*W0DT/TEMR+W0DTT+ & - 3.75*W1/TEMR+5.*W1DT+TEMR*W1DTT) - dndHT=TPI*(1.5*W0DX/TEMR+W0DXT+2.5*W1DX+TEMR*W1DXT) - DlnDH=dndH/DENR ! (d ln n_e/d\chi)_T - DlnDT=dndT*TEMR/DENR ! (d ln n_e/d ln T)_\chi - DlnDHH=dndHH/DENR-DlnDH**2 ! (d^2 ln n_e/d\chi^2)_T - DlnDTT=TEMR**2/DENR*dndTT+DlnDT-DlnDT**2 ! d^2 ln n_e/d ln T^2 - DlnDHT=TEMR/DENR*(dndHT-dndT*DlnDH) ! d^2 ln n_e/d\chi d ln T - dPdH=TPI/3.*TEMR*(2.*W1DX+TEMR*W2DX) ! (d P_e/d\chi)_T - dUdH=TPI*TEMR*(W1DX+TEMR*W2DX) ! (d U_e/d\chi)_T - CVE=(dUdT-dUdH*dndT/dndH)/DENR - CHITE=TEMR/PR*(dPdT-dPdH*dndT/dndH) - CHIRE=DENR/PR*dPdH/dndH ! (dndH*TEMR*PEid) ! DENS/PRE*dPdH/dndH - return - end diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index f9472650d8..f85b95082a 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -1185,4 +1185,67 @@ extern "C" SEid = SEid / (1.0_rt + D1); CHITE = CHITE / (1.0_rt + D2); } + + void elect11a(Real TEMP, Real CHI, + Real& DENS, Real& FEid, Real& PEid, Real& UEid, + Real& SEid, Real& CVE, Real& CHITE, Real& CHIRE, + Real& DlnDH, Real& DlnDT, Real& DlnDHH, Real& DlnDTT, + Real& DlnDHT) + { + // Version 16.11.11 + // This is THE FIRST PART of ELECT9 v.04.03.09. + const Real BOHR = 137.036_rt; + const Real PI = 3.141592653_rt; + const Real PI2 = PI * PI; + const Real BOHR2 = BOHR * BOHR; + const Real BOHR3 = BOHR2 * BOHR; // cleaned 15/6 + + Real TEMR = TEMP / BOHR2; // T in rel.units (=T/mc^2) + + Real W0, W0DX, W0DT, W0DXX, W0DTT, W0DXT; + Real W1, W1DX, W1DT, W1DXX, W1DTT, W1DXT; + Real W2, W2DX, W2DT, W2DXX, W2DTT, W2DXT; + Real W0XXX, W0XTT, W0XXT; + + blin9(TEMR, CHI, + W0, W0DX, W0DT, W0DXX, W0DTT, W0DXT, + W1, W1DX, W1DT, W1DXX, W1DTT, W1DXT, + W2, W2DX, W2DT, W2DXX, W2DTT, W2DXT, + W0XXX, W0XTT, W0XXT); + + Real TPI = TEMR * std::sqrt(2.0_rt * TEMR) / PI2; // common pre-factor + Real DENR = TPI * (W1 * TEMR + W0); + Real PR = TEMR * TPI / 3.0_rt * (W2 * TEMR + 2.0_rt * W1); + Real U = TEMR * TPI * (W2 * TEMR + W1); + + // (these are density, pressure, and internal energy in the rel.units) + PEid = PR / (DENR * TEMR); + UEid = U / (DENR * TEMR); + FEid = CHI - PEid; + DENS = DENR * BOHR3; // converts from rel.units to a.u. + SEid = UEid - FEid; + + // derivatives over T at constant chi: + Real dndT = TPI * (1.5_rt * W0 / TEMR + 2.5_rt * W1 + W0DT + TEMR * W1DT); // (d n_e/dT)_\chi + Real dPdT = TPI / 3.0_rt * (5.0_rt * W1 + 2.0_rt * TEMR * W1DT + 3.5_rt * TEMR * W2 + TEMR * TEMR * W2DT); //dP/dT + Real dUdT = TPI * (2.5_rt * W1 + TEMR * W1DT + 3.5_rt * TEMR * W2 + TEMR * TEMR * W2DT); //dU/dT_\chi + + // derivatives over chi at constant T and second derivatives: + Real dndH = TPI * (W0DX + TEMR * W1DX); // (d n_e/d\chi)_T + Real dndHH = TPI * (W0DXX + TEMR * W1DXX); // (d^2 n_e/d\chi)_T + Real dndTT = TPI * (0.75_rt * W0 / TEMR * TEMR + 3.0_rt * W0DT / TEMR + W0DTT + + 3.75_rt * W1 / TEMR + 5.0_rt * W1DT + TEMR * W1DTT); + Real dndHT = TPI * (1.5_rt * W0DX / TEMR + W0DXT + 2.5_rt * W1DX + TEMR * W1DXT); + + DlnDH = dndH / DENR; // (d ln n_e/d\chi)_T + DlnDT = dndT * TEMR / DENR; // (d ln n_e/d ln T)_\chi + DlnDHH = dndHH / DENR - DlnDH * DlnDH; // (d^2 ln n_e/d\chi^2)_T + DlnDTT = TEMR * TEMR / DENR * dndTT + DlnDT - DlnDT * DlnDT; // d^2 ln n_e/d ln T^2 + DlnDHT = TEMR / DENR * (dndHT - dndT * DlnDH); // d^2 ln n_e/d\chi d ln T + Real dPdH = TPI / 3.0_rt * TEMR * (2.0_rt * W1DX + TEMR * W2DX); // (d P_e/d\chi)_T + Real dUdH = TPI * TEMR * (W1DX + TEMR * W2DX); // (d U_e/d\chi)_T + CVE = (dUdT - dUdH * dndT / dndH) / DENR; + CHITE = TEMR / PR * (dPdT - dPdH * dndT / dndH); + CHIRE = DENR / PR * dPdH / dndH; // (dndH * TEMR * PEid) // DENS / PRE * dPdH / dndH + } } From 519c97d05d692f079cba59c384431fcf198e0f9a Mon Sep 17 00:00:00 2001 From: Max Katz Date: Mon, 18 Oct 2021 00:08:03 -0700 Subject: [PATCH 46/70] elect11 to C++ --- EOS/pc/eos17.f90 | 100 ++++------------------------------------------- EOS/pc/eos_c.cpp | 83 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 91 insertions(+), 92 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 7a08284074..b434191ca1 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -386,6 +386,14 @@ subroutine chemfit(dens, temp, chi) bind(C, name='chemfit') double precision, intent(in), value :: dens, temp double precision, intent(inout) :: chi end subroutine chemfit + subroutine elect11(TEMP,CHI, & + DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & + DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) bind(C, name="elect11") + implicit none + double precision, intent(in), value :: TEMP,CHI + double precision :: DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & + DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT + end subroutine elect11 end interface if (RHO.lt.1.e-19.or.RHO.gt.1.e15) then print *, 'MELANGE: RHO out of range' @@ -1219,95 +1227,3 @@ subroutine CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, & PDRMIX=PMIX+UDG/9. return end - -! =================== IDEAL ELECTRON GAS =========================== ! - subroutine ELECT11(TEMP,CHI, & - DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & - DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) -! Version 17.11.11 -! safeguard against huge (-CHI) values is added 27.05.17 -! ELECT9 v.04.03.09 + smooth match of two fits at chi >> 1 + add.outputs -! Compared to ELECTRON v.06.07.00, this S/R is completely rewritten: -! numerical differentiation is avoided now. -! Compared to ELECT7 v.06.06.07, -! - call BLIN7 is changed to call BLIN9, -! - Sommerfeld expansion is used at chi >~ 28 i.o. 1.e4 -! - Sommerfeld expansion is corrected: introduced DeltaEF, D1 and D2. -! Ideal electron-gas EOS. -! Input: TEMP - T [a.u.], CHI=\mu/T -! Output: DENS - electron number density n_e [a.u.], -! FEid - free energy / N_e kT, UEid - internal energy / N_e kT, -! PEid - pressure (P_e) / n_e kT, SEid - entropy / N_e k, -! CVE - heat capacity / N_e k, -! CHITE=(d ln P_e/d ln T)_V, CHIRE=(d ln P_e/d ln n_e)_T -! DlnDH=(d ln n_e/d CHI)_T = (T/n_e) (d n_e/d\mu)_T -! DlnDT=(d ln n_e/d ln T)_CHI -! DlnDHH=(d^2 ln n_e/d CHI^2)_T -! DlnDTT=(d^2 ln n_e/d (ln T)^2)_CHI -! DlnDHT=d^2 ln n_e/d (ln T) d CHI - implicit double precision (A-H), double precision (O-Z) - save - parameter (CHI2=28.d0,XMAX=20.d0) - parameter (DCHI2=CHI2-1.d0) - parameter (XSCAL2=XMAX/DCHI2) - interface - subroutine fermi10(X,XMAX,FP,FM) bind(C, name="fermi10") - implicit none - double precision, intent(in), value :: X, XMAX - double precision, intent(inout) :: FP, FM - end subroutine fermi10 - subroutine elect11a(TEMP,CHI, & - DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & - DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) bind(C, name="elect11a") - implicit none - double precision, intent(in), value:: TEMP,CHI - double precision :: DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & - DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT - end subroutine elect11a - subroutine elect11b(TEMP,CHI, & - DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & - DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) bind(C, name="elect11b") - implicit none - double precision, intent(in), value:: TEMP,CHI - double precision :: DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & - DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT - end subroutine elect11b - end interface - - if (CHI.lt.-1.d2) then - print *, 'ELECT11: too large negative CHI' ! 27.05.17 - stop - end if - X2=(CHI-CHI2)*XSCAL2 - if (X2.lt.-XMAX) then - call ELECT11a(TEMP,CHI, & - DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & - DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) - elseif (X2.gt.XMAX) then - call ELECT11b(TEMP,CHI, & - DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & - DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) - else - call FERMI10(X2,XMAX,FP,FM) - call ELECT11a(TEMP,CHI, & - DENSa,FEida,PEida,UEida,SEida,CVEa,CHITEa,CHIREa, & - DlnDHa,DlnDTa,DlnDHHa,DlnDTTa,DlnDHTa) - call ELECT11b(TEMP,CHI, & - DENSb,FEidb,PEidb,UEidb,SEidb,CVEb,CHITEb,CHIREb, & - DlnDHb,DlnDTb,DlnDHHb,DlnDTTb,DlnDHTb) - DENS=DENSa*FP+DENSb*FM - FEid=FEida*FP+FEidb*FM - PEid=PEida*FP+PEidb*FM - UEid=UEida*FP+UEidb*FM - SEid=SEida*FP+SEidb*FM - CVE=CVEa*FP+CVEb*FM - CHITE=CHITEa*FP+CHITEb*FM - CHIRE=CHIREa*FP+CHIREb*FM - DlnDH=DlnDHa*FP+DlnDHb*FM - DlnDT=DlnDTa*FP+DlnDTb*FM - DlnDHH=DlnDHHa*FP+DlnDHHb*FM - DlnDHT=DlnDHTa*FP+DlnDHTb*FM - DlnDTT=DlnDTTa*FP+DlnDTTb*FM - endif - return - end diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index f85b95082a..bdf1fa8ae2 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -1248,4 +1248,87 @@ extern "C" CHITE = TEMR / PR * (dPdT - dPdH * dndT / dndH); CHIRE = DENR / PR * dPdH / dndH; // (dndH * TEMR * PEid) // DENS / PRE * dPdH / dndH } + + void elect11 (double TEMP, double CHI, + Real& DENS, Real& FEid, Real& PEid, Real& UEid, + Real& SEid, Real& CVE, Real& CHITE, Real& CHIRE, + Real& DlnDH, Real& DlnDT, Real& DlnDHH, Real& DlnDTT, + Real& DlnDHT) + { + // Version 17.11.11 + // safeguard against huge (-CHI) values is added 27.05.17 + // ELECT9 v.04.03.09 + smooth match of two fits at chi >> 1 + add.outputs + // Compared to ELECTRON v.06.07.00, this S/R is completely rewritten: + // numerical differentiation is avoided now. + // Compared to ELECT7 v.06.06.07, + // - call BLIN7 is changed to call BLIN9, + // - Sommerfeld expansion is used at chi >~ 28 i.o. 1.e4 + // - Sommerfeld expansion is corrected: introduced DeltaEF, D1 and D2. + // Ideal electron-gas EOS. + // Input: TEMP - T [a.u.], CHI=\mu/T + // Output: DENS - electron number density n_e [a.u.], + // FEid - free energy / N_e kT, UEid - internal energy / N_e kT, + // PEid - pressure (P_e) / n_e kT, SEid - entropy / N_e k, + // CVE - heat capacity / N_e k, + // CHITE=(d ln P_e/d ln T)_V, CHIRE=(d ln P_e/d ln n_e)_T + // DlnDH=(d ln n_e/d CHI)_T = (T/n_e) (d n_e/d\mu)_T + // DlnDT=(d ln n_e/d ln T)_CHI + // DlnDHH=(d^2 ln n_e/d CHI^2)_T + // DlnDTT=(d^2 ln n_e/d (ln T)^2)_CHI + // DlnDHT=d^2 ln n_e/d (ln T) d CHI + + const Real CHI2 = 28.0_rt; + const Real XMAX = 20.0_rt; + const Real DCHI2 = CHI2 - 1.0_rt; + const Real XSCAL2 = XMAX / DCHI2; + + if (CHI < -1.e2_rt) { + printf("ELECT11: too large negative CHI\n"); // 27.05.17 + exit(1); + } + + Real X2 = (CHI - CHI2) * XSCAL2; + if (X2 < -XMAX) { + elect11a(TEMP, CHI, + DENS, FEid, PEid, UEid, SEid, CVE, CHITE, CHIRE, + DlnDH, DlnDT, DlnDHH, DlnDTT, DlnDHT); + } + else if (X2 > XMAX) { + elect11b(TEMP, CHI, + DENS, FEid, PEid, UEid, SEid, CVE, CHITE, CHIRE, + DlnDH, DlnDT, DlnDHH, DlnDTT, DlnDHT); + } + else { + Real FP, FM; + fermi10(X2, XMAX, FP, FM); + + Real DENSa, FEida, PEida, UEida, SEida, CVEa, CHITEa, CHIREa; + Real DlnDHa, DlnDTa, DlnDHHa, DlnDTTa, DlnDHTa; + + elect11a(TEMP, CHI, + DENSa, FEida, PEida, UEida, SEida, CVEa, CHITEa, CHIREa, + DlnDHa, DlnDTa, DlnDHHa, DlnDTTa, DlnDHTa); + + Real DENSb, FEidb, PEidb, UEidb, SEidb, CVEb, CHITEb, CHIREb; + Real DlnDHb, DlnDTb, DlnDHHb, DlnDTTb, DlnDHTb; + + elect11b(TEMP, CHI, + DENSb, FEidb, PEidb, UEidb, SEidb, CVEb, CHITEb, CHIREb, + DlnDHb, DlnDTb, DlnDHHb, DlnDTTb, DlnDHTb); + + DENS = DENSa * FP + DENSb * FM; + FEid = FEida * FP + FEidb * FM; + PEid = PEida * FP + PEidb * FM; + UEid = UEida * FP + UEidb * FM; + SEid = SEida * FP + SEidb * FM; + CVE = CVEa * FP + CVEb * FM; + CHITE = CHITEa * FP + CHITEb * FM; + CHIRE = CHIREa * FP + CHIREb * FM; + DlnDH = DlnDHa * FP + DlnDHb * FM; + DlnDT = DlnDTa * FP + DlnDTb * FM; + DlnDHH = DlnDHHa * FP + DlnDHHb * FM; + DlnDHT = DlnDHTa * FP + DlnDHTb * FM; + DlnDTT = DlnDTTa * FP + DlnDTTb * FM; + } + } } From 9d36f1302725d96c5b5b6687bf286a8acef6e472 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Mon, 18 Oct 2021 00:48:12 -0700 Subject: [PATCH 47/70] fscrsol8 to C++ --- EOS/pc/eos17.f90 | 150 +---------------- EOS/pc/eos_c.cpp | 411 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 417 insertions(+), 144 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index b434191ca1..acb5e29f58 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -575,6 +575,12 @@ subroutine excor7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) bind(C, name="excor7 double precision, intent(in), value :: RS, GAME double precision :: FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC end subroutine excor7 + subroutine fscrsol8(RS,GAMI,Zion,TPT, & + FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR) bind(C, name="fscrsol8") + implicit none + double precision, intent(in), value :: RS, GAMI, Zion, TPT + double precision :: FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR + end subroutine fscrsol8 end interface if (LIQSOL.ne.1.and.LIQSOL.ne.0) then @@ -835,150 +841,6 @@ subroutine FSCRliq8(RS,GAME,Zion, & end ! ============== SUBROUTINES FOR THE SOLID STATE ================= ! - subroutine FSCRsol8(RS,GAMI,ZNUCL,TPT, & - FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR) -! Version 28.05.08 -! undefined zero variable Q1DXG is wiped out 21.06.10 -! accuracy-loss safeguard added 10.08.16 -! safequard against Zion < 1 added 27.05.17 -! Fit to the el.-ion screening in bcc or fcc Coulomb solid -! Stems from FSCRsol8 v.09.06.07. Included a check for RS=0. -! INPUT: RS - el. density parameter, GAMI - ion coupling parameter, -! ZNUCL - ion charge, TPT=T_p/T - ion quantum parameter -! OUTPUT: FSCR - screening (e-i) free energy per kT per 1 ion, -! USCR - internal energy per kT per 1 ion (screen.contrib.) -! PSCR - pressure divided by (n_i kT) (screen.contrib.) -! S_SCR - screening entropy contribution / (N_i k) -! CVSCR - heat capacity per 1 ion (screen.contrib.) -! PDTSCR,PDRSCR = PSCR + d PSCR / d ln(T,\rho) - implicit double precision(A-H),double precision(O-Z) - save - dimension AP(4) ! parameters of the fit - parameter (C13=1.d0/3.d0,ENAT=2.7182818285d0,TINY=1.d-19) - data AP/1.1866,.684,17.9,41.5/,PX/.205/ ! for bcc lattice - if (RS.lt.0.) then - print *, 'FSCRliq8: RS < 0' - stop - end if - if (RS.lt.TINY) then - FSCR=0. - USCR=0. - PSCR=0. - S_SCR=0. - CVSCR=0. - PDTSCR=0. - PDRSCR=0. - return - endif - Zion=ZNUCL - if (Zion.lt.1.d0) then ! 27.05.17 - print*,'FSCRsol8 WARNING: Z =',Zion,' < 1.' - Zion=1.d0 - endif - XSR=.0140047/RS ! relativity parameter - Z13=Zion**C13 - P1=.00352*(1.-AP(1)/Zion**.267+.27/Zion) - P2=1.d0+2.25/Z13* & - (1.+AP(2)*Zion**5+.222*Zion**6)/(1.+.222*Zion**6) - ZLN=dlog(Zion) - Finf=sqrt(P2/XSR**2+1.)*Z13**2*P1 ! The TF limit - FinfX=-P2/((P2+XSR**2)*XSR) - FinfDX=Finf*FinfX - FinfDXX=FinfDX*FinfX-FinfDX*(P2+3.*XSR**2)/((P2+XSR**2)*XSR) - R1=AP(4)/(1.+ZLN) - R2=.395*ZLN+.347/Zion/sqrt(Zion) - R3=1.d0/(1.d0+ZLN*sqrt(ZLN)*.01+.097/Zion**2) - Q1U=R1+AP(3)*XSR**2 - Q1D=1.d0+R2*XSR**2 - Q1=Q1U/Q1D - Q1X=2.*XSR*(AP(3)/Q1U-R2/Q1D) - Q1XDX=Q1X/XSR+4.*XSR**2*((R2/Q1D)**2-(AP(3)/Q1U)**2) - Q1DX=Q1*Q1X - Q1DXX=Q1DX*Q1X+Q1*Q1XDX -! New quantum factor, in order to suppress CVSCR at TPT >> 1 - if (TPT.lt.6./PX) then - Y0=(PX*TPT)**2 - Y0DX=Y0/XSR - Y0DG=2.*Y0/GAMI - Y0DXX=0. - Y0DGG=Y0DG/GAMI - Y0DXG=Y0DG/XSR - Y1=dexp(Y0) - Y1DX=Y1*Y0DX - Y1DG=Y1*Y0DG - Y1DXX=Y1*(Y0DX**2+Y0DXX) - Y1DGG=Y1*(Y0DG**2+Y0DGG) - Y1DXG=Y1*(Y0DX*Y0DG+Y0DXG) - SA=1.d0+Y1 - SUPA=dlog(SA) - SUPADX=Y1DX/SA - SUPADG=Y1DG/SA - SUPADXX=(Y1DXX-Y1DX**2/SA)/SA - SUPADGG=(Y1DGG-Y1DG**2/SA)/SA - SUPADXG=(Y1DXG-Y1DX*Y1DG/SA)/SA - EM2=ENAT-2.d0 - SB=ENAT-EM2/Y1 - SUPB=dlog(SB) - EM2Y1=EM2/(Y1**2*SB) - SUPBDX=EM2Y1*Y1DX - SUPBDG=EM2Y1*Y1DG - SUPBDXX=EM2Y1*(Y1DXX-2.d0*Y1DX**2/Y1-Y1DX*SUPBDX) - SUPBDGG=EM2Y1*(Y1DGG-2.d0*Y1DG**2/Y1-Y1DG*SUPBDG) - SUPBDXG=EM2Y1*(Y1DXG-2.d0*Y1DX*Y1DG/Y1-Y1DG*SUPBDX) - SUP=dsqrt(SUPA/SUPB) - SUPX=.5d0*(SUPADX/SUPA-SUPBDX/SUPB) - SUPDX=SUP*SUPX - SUPG=.5d0*(SUPADG/SUPA-SUPBDG/SUPB) - SUPDG=SUP*SUPG - SUPDXX=SUPDX*SUPX+ & - SUP*.5d0*(SUPADXX/SUPA-(SUPADX/SUPA)**2- & - SUPBDXX/SUPB+(SUPBDX/SUPB)**2) - SUPDGG=SUPDG*SUPG+ & - SUP*.5d0*(SUPADGG/SUPA-(SUPADG/SUPA)**2- & - SUPBDGG/SUPB+(SUPBDG/SUPB)**2) - SUPDXG=SUPDX*SUPG+ & - SUP*.5d0*((SUPADXG-SUPADX*SUPADG/SUPA)/SUPA- & - (SUPBDXG-SUPBDX*SUPBDG/SUPB)/SUPB) - else - SUP=PX*TPT - SUPDX=.5d0*PX*TPT/XSR - SUPDG=PX*TPT/GAMI - SUPDXX=-.5d0*SUPDX/XSR - SUPDGG=0. - SUPDXG=SUPDX/GAMI - endif - GR3=(GAMI/SUP)**R3 - GR3X=-R3*SUPDX/SUP - GR3DX=GR3*GR3X - GR3DXX=GR3DX*GR3X-R3*GR3*(SUPDXX/SUP-(SUPDX/SUP)**2) - GR3G=R3*(1.d0/GAMI-SUPDG/SUP) - GR3DG=GR3*GR3G - GR3DGG=GR3DG*GR3G+GR3*R3*((SUPDG/SUP)**2-SUPDGG/SUP-1.d0/GAMI**2) - GR3DXG=GR3DG*GR3X+GR3*R3*(SUPDX*SUPDG/SUP**2-SUPDXG/SUP) - W=1.d0+Q1/GR3 - WDX=Q1DX/GR3-Q1*GR3DX/GR3**2 - WDG=-Q1*GR3DG/GR3**2 - WDXX=Q1DXX/GR3- & - (2.d0*Q1DX*GR3DX+Q1*(GR3DXX-2.d0*GR3DX**2/GR3))/GR3**2 - WDGG=Q1*(2.d0*GR3DG**2/GR3-GR3DGG)/GR3**2 - WDXG=-(Q1DX*GR3DG+Q1*(GR3DXG-2.d0*GR3DX*GR3DG/GR3))/GR3**2 - FSCR=-GAMI*Finf*W - FDX=-GAMI*(FinfDX*W+Finf*WDX) - FDXX=-GAMI*(FinfDXX*W+2.d0*FinfDX*WDX+Finf*WDXX) - FDG=-Finf*W-GAMI*Finf*WDG - FDGG=-2.d0*Finf*WDG-GAMI*Finf*WDGG - if (dabs(FDGG).lt.TINY) FDGG=0. ! 10.08.16: roundoff err.safeguard - FDXG=-FinfDX*W-Finf*WDX-GAMI*(FinfDX*WDG+Finf*WDXG) - S_SCR=-GAMI**2*Finf*WDG - USCR=S_SCR+FSCR - CVSCR=-GAMI**2*FDGG - PSCR=(XSR*FDX+GAMI*FDG)/3.d0 - PDTSCR=GAMI**2*(XSR*Finf*(FinfX*WDG+WDXG)-FDGG)/3.d0 - PDRSCR=(12.d0*PSCR+XSR**2*FDXX+2.d0*XSR*GAMI*FDXG+ & - GAMI**2*FDGG)/9.d0 - return - end - subroutine ANHARM8(GAMI,TPT,Fah,Uah,Pah,CVah,PDTah,PDRah) ! ANHARMONIC free energy Version 27.07.07 ! cleaned 16.06.09 diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index bdf1fa8ae2..370a53d8e0 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -1331,4 +1331,415 @@ extern "C" DlnDTT = DlnDTTa * FP + DlnDTTb * FM; } } + + void fscrsol8 (Real RS, Real GAMI, Real ZNUCL, Real TPT, + Real& FSCR, Real& USCR, Real& PSCR, Real& S_SCR, + Real& CVSCR, Real& PDTSCR, Real& PDRSCR) + { + // Version 28.05.08 + // undefined zero variable Q1DXG is wiped out 21.06.10 + // accuracy-loss safeguard added 10.08.16 + // safequard against Zion < 1 added 27.05.17 + // Fit to the el.-ion screening in bcc or fcc Coulomb solid + // Stems from FSCRsol8 v.09.06.07. Included a check for RS = 0. + // INPUT: RS - el. density parameter, GAMI - ion coupling parameter, + // ZNUCL - ion charge, TPT = T_p/T - ion quantum parameter + // OUTPUT: FSCR - screening (e-i) free energy per kT per 1 ion, + // USCR - internal energy per kT per 1 ion (screen.contrib.) + // PSCR - pressure divided by (n_i kT) (screen.contrib.) + // S_SCR - screening entropy contribution / (N_i k) + // CVSCR - heat capacity per 1 ion (screen.contrib.) + // PDTSCR,PDRSCR = PSCR + d PSCR / d ln(T,\rho) + + const Real C13 = 1.0_rt / 3.0_rt; + const Real ENAT = 2.7182818285_rt; + const Real TINY = 1.e-19_rt; + + const Real AP[4] = {1.1866_rt, 0.684_rt, 17.9_rt, 41.5_rt}; + const Real PX = 0.205_rt; // for bcc lattice + + if (RS < 0.0_rt) { + printf("FSCRliq8: RS < 0\n"); + exit(1); + } + + if (RS < TINY) { + FSCR = 0.0_rt; + USCR = 0.0_rt; + PSCR = 0.0_rt; + S_SCR = 0.0_rt; + CVSCR = 0.0_rt; + PDTSCR = 0.0_rt; + PDRSCR = 0.0_rt; + return; + } + + Real Zion = ZNUCL; + if (Zion < 1.0_rt) { // 27.05.17 + Zion = 1.0_rt; + } + + Real XSR = 0.0140047_rt / RS; // relativity parameter + Real Z13 = std::pow(Zion, C13); + Real P1 = 0.00352_rt * (1.0_rt - AP[0] / std::pow(Zion, 0.267_rt) + 0.27_rt / Zion); + Real P2 = 1.0_rt + 2.25_rt / Z13 * + (1.0_rt + AP[1] * (Zion * Zion * Zion * Zion * Zion) + + 0.222_rt * (Zion * Zion * Zion * Zion * Zion * Zion)) / + (1.0_rt + .222 * Zion * Zion * Zion * Zion * Zion * Zion); + Real ZLN = std::log(Zion); + Real Finf = std::sqrt(P2 / (XSR * XSR) + 1.0_rt) * Z13 * Z13 * P1; // The TF limit + Real FinfX = -P2 / ((P2 + XSR * XSR) * XSR); + Real FinfDX = Finf * FinfX; + Real FinfDXX = FinfDX * FinfX - FinfDX * (P2 + 3.0_rt * XSR * XSR) / ((P2 + XSR * XSR) * XSR); + Real R1 = AP[3] / (1.0_rt + ZLN); + Real R2 = 0.395_rt * ZLN + .347 / Zion / std::sqrt(Zion); + Real R3 = 1.0_rt / (1.0_rt + ZLN * std::sqrt(ZLN) * 0.01_rt + 0.097_rt / (Zion * Zion)); + Real Q1U = R1 + AP[2] * XSR * XSR; + Real Q1D = 1.0_rt + R2 * XSR * XSR; + Real Q1 = Q1U / Q1D; + Real Q1X = 2.0_rt * XSR * (AP[2] / Q1U - R2 / Q1D); + Real Q1XDX = Q1X / XSR + 4.0_rt * XSR * XSR * ((R2 / Q1D) * (R2 / Q1D) - (AP[2] / Q1U) * (AP[2] / Q1U)); + Real Q1DX = Q1 * Q1X; + Real Q1DXX = Q1DX * Q1X + Q1 * Q1XDX; + + Real SUP, SUPDX, SUPDG, SUPDXX, SUPDGG, SUPDXG; + + // New quantum factor, in order to suppress CVSCR at TPT >> 1 + if (TPT < 6.0_rt / PX) { + Real Y0 = (PX * TPT) * (PX * TPT); + Real Y0DX = Y0 / XSR; + Real Y0DG = 2.0_rt * Y0 / GAMI; + Real Y0DXX = 0.0_rt; + Real Y0DGG = Y0DG / GAMI; + Real Y0DXG = Y0DG / XSR; + Real Y1 = std::exp(Y0); + Real Y1DX = Y1 * Y0DX; + Real Y1DG = Y1 * Y0DG; + Real Y1DXX = Y1 * (Y0DX * Y0DX + Y0DXX); + Real Y1DGG = Y1 * (Y0DG * Y0DG + Y0DGG); + Real Y1DXG = Y1 * (Y0DX * Y0DG + Y0DXG); + Real SA = 1.0_rt + Y1; + Real SUPA = std::log(SA); + Real SUPADX = Y1DX / SA; + Real SUPADG = Y1DG / SA; + Real SUPADXX = (Y1DXX - Y1DX * Y1DX / SA) / SA; + Real SUPADGG = (Y1DGG - Y1DG * Y1DG / SA) / SA; + Real SUPADXG = (Y1DXG - Y1DX * Y1DG / SA) / SA; + Real EM2 = ENAT - 2.0_rt; + Real SB = ENAT - EM2 / Y1; + Real SUPB = std::log(SB); + Real EM2Y1 = EM2 / (Y1 * Y1 * SB); + Real SUPBDX = EM2Y1 * Y1DX; + Real SUPBDG = EM2Y1 * Y1DG; + Real SUPBDXX = EM2Y1 * (Y1DXX - 2.0_rt * Y1DX * Y1DX / Y1 - Y1DX * SUPBDX); + Real SUPBDGG = EM2Y1 * (Y1DGG - 2.0_rt * Y1DG * Y1DG / Y1 - Y1DG * SUPBDG); + Real SUPBDXG = EM2Y1 * (Y1DXG - 2.0_rt * Y1DX * Y1DG / Y1 - Y1DG * SUPBDX); + + SUP = std::sqrt(SUPA / SUPB); + Real SUPX = 0.5_rt * (SUPADX / SUPA - SUPBDX / SUPB); + SUPDX = SUP * SUPX; + Real SUPG = 0.5_rt * (SUPADG / SUPA - SUPBDG / SUPB); + SUPDG = SUP * SUPG; + SUPDXX = SUPDX * SUPX + + SUP * 0.5_rt * (SUPADXX / SUPA - (SUPADX / SUPA) * (SUPADX / SUPA) - + SUPBDXX / SUPB + (SUPBDX / SUPB) * (SUPBDX / SUPB)); + SUPDGG = SUPDG * SUPG + + SUP * 0.5_rt * (SUPADGG / SUPA - (SUPADG / SUPA) * (SUPADG / SUPA) - + SUPBDGG / SUPB + (SUPBDG / SUPB) * (SUPBDG / SUPB)); + SUPDXG = SUPDX * SUPG + + SUP * 0.5_rt * ((SUPADXG - SUPADX * SUPADG / SUPA) / SUPA - + (SUPBDXG - SUPBDX * SUPBDG / SUPB) / SUPB); + } + else { + SUP = PX * TPT; + SUPDX = 0.5_rt * PX * TPT / XSR; + SUPDG = PX * TPT / GAMI; + SUPDXX = - 0.5_rt * SUPDX / XSR; + SUPDGG = 0.0_rt; + SUPDXG = SUPDX / GAMI; + } + + Real GR3 = std::pow(GAMI / SUP, R3); + Real GR3X = -R3 * SUPDX / SUP; + Real GR3DX = GR3 * GR3X; + Real GR3DXX = GR3DX * GR3X - R3 * GR3 * (SUPDXX / SUP - (SUPDX / SUP) * (SUPDX / SUP)); + Real GR3G = R3 * (1.0_rt / GAMI - SUPDG / SUP); + Real GR3DG = GR3 * GR3G; + Real GR3DGG = GR3DG * GR3G + GR3 * R3 * ((SUPDG / SUP) * (SUPDG / SUP) - SUPDGG / SUP - 1.0_rt / (GAMI * GAMI)); + Real GR3DXG = GR3DG * GR3X + GR3 * R3 * (SUPDX * SUPDG / (SUP * SUP) - SUPDXG / SUP); + Real W = 1.0_rt + Q1 / GR3; + Real WDX = Q1DX / GR3 - Q1 * GR3DX / (GR3 * GR3); + Real WDG = -Q1 * GR3DG / (GR3 * GR3); + Real WDXX = Q1DXX / GR3 - + (2.0_rt * Q1DX * GR3DX + Q1 * (GR3DXX - 2.0_rt * GR3DX * GR3DX / GR3)) / (GR3 * GR3); + Real WDGG = Q1 * (2.0_rt * GR3DG * GR3DG / GR3 - GR3DGG) / (GR3 * GR3); + Real WDXG = -(Q1DX * GR3DG + Q1 * (GR3DXG - 2.0_rt * GR3DX * GR3DG / GR3)) / (GR3 * GR3); + FSCR = -GAMI * Finf * W; + Real FDX = -GAMI * (FinfDX * W + Finf * WDX); + Real FDXX = -GAMI * (FinfDXX * W + 2.0_rt * FinfDX * WDX + Finf * WDXX); + Real FDG = -Finf * W - GAMI * Finf * WDG; + Real FDGG = -2.0_rt * Finf * WDG - GAMI * Finf * WDGG; + if (std::abs(FDGG) < TINY) { + FDGG = 0.0_rt; // 10.08.16: roundoff err.safeguard + } + Real FDXG = -FinfDX * W - Finf * WDX - GAMI * (FinfDX * WDG + Finf * WDXG); + S_SCR = -GAMI * GAMI * Finf * WDG; + USCR = S_SCR + FSCR; + CVSCR = -GAMI * GAMI * FDGG; + PSCR = (XSR * FDX + GAMI * FDG) / 3.0_rt; + PDTSCR = GAMI * GAMI * (XSR * Finf * (FinfX * WDG + WDXG) - FDGG) / 3.0_rt; + PDRSCR = (12.0_rt * PSCR + XSR * XSR * FDXX + 2.0_rt * XSR * GAMI * FDXG + + GAMI * GAMI * FDGG) / 9.0_rt; + } + + /* + subroutine ANHARM8(GAMI,TPT,Fah,Uah,Pah,CVah,PDTah,PDRah) +// ANHARMONIC free energy Version 27.07.07 +// cleaned 16.06.09 +// Stems from ANHARM8b. Difference: AC = 0., B1 = .12 (.1217 - over accuracy) +// Input: GAMI - ionic Gamma, TPT = Tp/T - ionic quantum parameter +// Output: anharm.free en. Fah = F_{AH}/(N_i kT), internal energy Uah, +// pressure Pah = P_{AH}/(n_i kT), specific heat CVah = C_{V,AH}/(N_i k), +// PDTah = Pah + d Pah / d ln T, PDRah = Pah + d Pah / d ln\rho + implicit double precision (A-H), double precision (O-Z) + save + parameter(NM = 3) + dimension AA(NM) + data AA/10.9,247.,1.765d5/ // Farouki & Hamaguchi'93 + data B1/.12/ // coeff.at \eta^2/\Gamma at T = 0 + CK = B1 / AA[0] // fit coefficient + TPT2 = TPT * TPT + TPT4 = TPT2 * TPT2 + TQ = B1 * TPT2 / GAMI // quantum dependence + TK2 = CK * TPT2 + SUP = std::exp(-TK2) // suppress.factor of class.anharmonicity + Fah = 0. + Uah = 0. + Pah = 0. + CVah = 0. + PDTah = 0. + PDRah = 0. + SUPGN = SUP + do N = 1,NM + CN = N + SUPGN = SUPGN / GAMI // SUP/Gamma^n + ACN = AA(N) + Fah = Fah - ACN / CN * SUPGN + Uah = Uah + (ACN * (1.0_rt + 2.0_rt * TK2 / CN)) * SUPGN + PN = AA(N) / 3.0_rt + TK2 * AA(N) / CN + Pah = Pah + PN * SUPGN + CVah = CVah + ((CN + 1.0_rt) * AA(N) + (4.0_rt - 2.0_rt / CN) * AA(N) * TK2 + & + 4.0_rt * AA(N) * CK * CK / CN * TPT4) * SUPGN + PDTah = PDTah + (PN * (1.0_rt + CN + 2.0_rt * TK2) - 2.0_rt / CN * AA(N) * TK2) * SUPGN + PDRah = PDRah + (PN * (1.0_rt - CN / 3.0_rt - TK2) + AA(N) / CN * TK2) * SUPGN + enddo + Fah = Fah - TQ + Uah = Uah - TQ + Pah = Pah - TQ / 1.5 + PDRah = PDRah - TQ / 4.5 + return + end + + subroutine FHARM12(GAMI,TPT, & + Fharm,Uharm,Pharm,CVth,Sth,PDTharm,PDRharm) +// Thermodynamic functions of a harmonic crystal, incl.stat.Coul.lattice +// +// Version 27.04.12 +// Stems from FHARM8 v.15.02.08 +// Replaced HLfit8 with HLfit12: rearranged output. +// Input: GAMI - ionic Gamma, TPT = T_{p,i}/T +// Output: Fharm = F/(N_i T), Uharm = U/(N_i T), Pharm = P/(n_i T), +// CVth = C_V/N_i, Sharm = S/N_i +// PDTharm = Pharm + d Pharm / d ln T, PDRharm = Pharm + d Pharm/d ln\rho + implicit double precision (A-H), double precision (O-Z) + save + parameter(CM = .895929256d0) // Madelung + call HLfit12(TPT,F,U,CVth,Sth,U1,CW,1) + U0 = -CM * GAMI // perfect lattice + E0 = 1.5d0 * U1 * TPT // zero-point energy + Uth = U + E0 + Fth = F + E0 + Uharm = U0 + Uth + Fharm = U0 + Fth + Pharm = U0 / 3.0_rt + Uth / 2.0_rt + PDTharm = 0.5_rt * CVth + PDRharm = U0 / 2.25d0 + .75d0 * Uth - .25d0 * CVth + return + end + + subroutine HLfit12(eta,F,U,CV,S,U1,CW,LATTICE) +// Version 24.04.12 +// Stems from HLfit8 v.03.12.08; +// differences: E0 excluded from U and F; +// U1 and d(CV)/d\ln(T) are added on the output. +// Fit to thermal part of the thermodynamic functions. +// Baiko, Potekhin, & Yakovlev (2001). +// Zero-point lattice quantum energy 1.5u_1\eta EXCLUDED (unlike HLfit8). +// Input: eta = Tp/T, LATTICE = 1 for bcc, 2 for fcc +// Output: F and U (normalized to NkT) - due to phonon excitations, +// CV and S (normalized to Nk) in the HL model, +// U1 - the 1st phonon moment, +// CW = d(CV)/d\ln(T) + implicit double precision (A-H), double precision (O-Z) + save + parameter(EPS = 1.d-5,TINY = 1.d-99) + if (LATTICE.eq.1) { // bcc lattice + CLM = -2.49389d0 // 3 * ln<\omega/\omega_p> + U1 = .5113875d0 + ALPHA = .265764d0 + BETA = .334547d0 + GAMMA = .932446d0 + A1 = .1839d0 + A2 = .593586d0 + A3 = .0054814d0 + A4 = 5.01813d-4 + A6 = 3.9247d-7 + A8 = 5.8356d-11 + B0 = 261.66d0 + B2 = 7.07997d0 + B4 = .0409484d0 + B5 = .000397355d0 + B6 = 5.11148d-5 + B7 = 2.19749d-6 + C9 = .004757014d0 + C11 = .0047770935d0 + elseif (LATTICE.eq.2) { // fcc lattice + CLM = -2.45373d0 + U1 = .513194d0 + ALPHA = .257591d0 + BETA = .365284d0 + GAMMA = .9167070d0 + A1 = .0 + A2 = .532535d0 + A3 = .0 + A4 = 3.76545d-4 + A6 = 2.63013d-7 + A8 = 6.6318d-11 + B0 = 303.20d0 + B2 = 7.7255d0 + B4 = .0439597d0 + B5 = .000114295d0 + B6 = 5.63434d-5 + B7 = 1.36488d-6 + C9 = .00492387d0 + C11 = .00437506d0 + else + print * , 'HLfit: unknown lattice type' + stop + endif + if (eta.gt.1.0_rt / EPS) { // asymptote of Eq.(13) of BPY'01 + U = 3.0_rt / (C11 * eta * eta * eta) + F = -U / 3.0_rt + CV = 4.0_rt * U + S = U - F + return + elseif (eta < EPS) { // Eq.(17) of BPY'01 + if (eta < TINY) { + print * , 'HLfit: eta is too small' + stop + end if + F = 3.0_rt * std::log(eta) + CLM - 1.5 * U1 * eta + eta * eta / 24. + U = 3.0_rt - 1.5 * U1 * eta + eta * eta / 12. + CV = 3.0_rt - eta * eta / 12. + S = U - F + return + endif + eta2 = eta * eta + eta3 = eta2 * eta + eta4 = eta3 * eta + eta5 = eta4 * eta + eta6 = eta5 * eta + eta7 = eta6 * eta + eta8 = eta7 * eta + B9 = A6 * C9 + B11 = A8 * C11 + UP = 1.0_rt + A1 * eta + A2 * eta2 + A3 * eta3 + A4 * eta4 + A6 * eta6 + A8 * eta8 + DN = B0 + B2 * eta2 + B4 * eta4 + B5 * eta5 + B6 * eta6 + & + B7 * eta7 + eta8 * (B9 * eta + B11 * eta3) + EA = std::exp(-ALPHA * eta) + EB = std::exp(-BETA * eta) + EG = std::exp(-GAMMA * eta) + F = std::log(1.0_rt - EA) + std::log(1.0_rt - EB) + std::log(1.0_rt - EG) - UP / DN // F_{thermal}/NT + UP1 = A1 + & + 2.0_rt * A2 * eta + 3.0_rt * A3 * eta2 + 4.0_rt * A4 * eta3 + 6.0_rt * A6 * eta5 + 8. * A8 * eta7 + UP2 = 2.0_rt * A2 + 6.0_rt * A3 * eta + 12. * A4 * eta2 + 30. * A6 * eta4 + 56.0_rt * A8 * eta6 + UP3 = 6.0_rt * A3 + 24. * A4 * eta + 120. * A6 * eta3 + 336 * A8 * eta5 + DN1 = 2.0_rt * B2 * eta + 4.0_rt * B4 * eta3 + 5. * B5 * eta4 + 6.0_rt * B6 * eta5 + & + 7. * B7 * eta6 + eta8 * (9. * B9 + 11. * B11 * eta2) + DN2 = 2.0_rt * B2 + 12. * B4 * eta2 + 20. * B5 * eta3 + 30. * B6 * eta4 + & + 42. * B7 * eta5 + 72. * B9 * eta7 + 110. * B11 * eta8 * eta + DN3 = 24. * B4 * eta + 60. * B5 * eta2 + 120. * B6 * eta3 + & + 210. * B7 * eta4 + 504. * B9 * eta6 + 990. * B11 * eta8 + DF1 = ALPHA * EA / (1.0_rt - EA) + BETA * EB / (1.0_rt - EB) + GAMMA * EG / (1.0_rt - EG) - & + (UP1 * DN - DN1 * UP) / (DN * DN) // int.en./NT/eta = df/d\eta + DF2 = ALPHA * ALPHA * EA / ((1.0_rt - EA) * (1.0_rt - EA) + BETA * BETA * EB / ((1.0_rt - EB) * (1.0_rt - EB) + & + GAMMA * GAMMA * EG / ((1.0_rt - EG) * (1.0_rt - EG) + & + ((UP2 * DN - DN2 * UP) * DN - 2.0_rt * (UP1 * DN - DN1 * UP) * DN1) / (DN * DN * DN) // -d2f/d\eta^2 + U = DF1 * eta + CV = DF2 * eta2 + DF3 = -ALPHA * ALPHA * ALPHA * EA / std::pow(1.0_rt - EA, 3) * (1.0_rt + EA) - & + BETA * BETA * BETA * EB / std::pow(1.0_rt - EB, 3) * (1.0_rt + EB) - & + GAMMA * GAMMA * GAMMA * EG / std::pow(1.0_rt - EG, 3) * (1.0_rt + EG) + & + UP3 / DN - (3.0_rt * UP2 * DN1 + 3.0_rt * UP1 * DN2 + UP * DN3) / (DN * DN) + & + 6.0_rt * DN1 * (UP1 * DN1 + UP * DN2) / (DN * DN * DN) - 6.0_rt * UP * DN1 * DN1 * DN1 / (DN * DN * DN * DN) // -d3f/d\eta^3 + CW = -2.0_rt * CV - eta3 * DF3 + S = U - F + return + end + + subroutine CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, & + FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) +// Version 02.07.09 +// Correction to the linear mixing rule for moderate to small Gamma +// Input: RS = r_s (if RS = 0, then OCP, otherwise EIP) +// GAME = \Gamma_e +// Zmean = (average Z of all ions, without electrons) +// Z2mean = , Z52 = , Z53 = , Z321 = +// Output: FMIX = \Delta f - corr.to the reduced free energy f = F/N_{ion}kT +// UMIX = \Delta u - corr.to the reduced internal energy u +// PMIX = \Delta u - corr.to the reduced pressure P = P/n_{ion}kT +// CVMIX = \Delta c - corr.to the reduced heat capacity c_V +// PDTMIX = (1/n_{ion}kT)d\Delta P / d ln T +// = \Delta p + d \Delta p / d ln T +// PDRMIX = (1/n_{ion}kT)d\Delta P / d ln n_e +// (composition is assumed fixed: Zmean,Z2mean,Z52,Z53 = constant) + implicit double precision (A-H), double precision (O-Z) + parameter (TINY = 1.d-9) + GAMImean = GAME * Z53 + if (RS < TINY) { // OCP + Dif0 = Z52 - std::sqrt(Z2mean * Z2mean * Z2mean / Zmean) + else + Dif0 = Z321 - std::sqrt(std::pow(Z2mean + Zmean, 3) / Zmean) + endif + DifR = Dif0 / Z52 + DifFDH = Dif0 * GAME * std::sqrt(GAME / 3.0_rt) // F_DH - F_LM(DH) + D = Z2mean / (Zmean * Zmean) + if (std::abs(D - 1.0_rt) < TINY) { // no correction + FMIX = 0. + UMIX = 0. + PMIX = 0. + CVMIX = 0. + PDTMIX = 0. + PDRMIX = 0. + return + endif + P3 = std::pow(D, -0.2_rt) + D0 = (2.6 * DifR + 14. * DifR * DifR * DifR) / (1.0_rt - P3) + GP = D0 * std::pow(GAMImean, P3) + FMIX0 = DifFDH / (1.0_rt + GP) + Q = D * D * .0117 + R = 1.5 / P3 - 1.0_rt + GQ = Q * GP + FMIX = FMIX0 / std::pow(1.0_rt + GQ, R) + G = 1.5 - P3 * GP / (1.0_rt + GP) - R * P3 * GQ / (1.0_rt + GQ) + UMIX = FMIX * G + PMIX = UMIX / 3.0_rt + GDG = -P3 * P3 * (GP / ((1.0_rt + GP) * (1.0_rt + GP)) + R * GQ / ((1.0_rt + GQ) * (1.0_rt + GQ)) // d G /d ln Gamma + UDG = UMIX * G + FMIX * GDG // d u_mix /d ln Gamma + CVMIX = UMIX - UDG + PDTMIX = PMIX - UDG / 3.0_rt + PDRMIX = PMIX + UDG / 9. + return + end +*/ } From b78eeebcd445c0d2ed07a1054035429a3655af8e Mon Sep 17 00:00:00 2001 From: Max Katz Date: Mon, 18 Oct 2021 01:01:00 -0700 Subject: [PATCH 48/70] anharm8 to C++ --- EOS/pc/eos17.f90 | 52 +++---------------------- EOS/pc/eos_c.cpp | 99 +++++++++++++++++++++++++----------------------- 2 files changed, 57 insertions(+), 94 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index acb5e29f58..75c3f3c154 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -581,6 +581,11 @@ subroutine fscrsol8(RS,GAMI,Zion,TPT, & double precision, intent(in), value :: RS, GAMI, Zion, TPT double precision :: FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR end subroutine fscrsol8 + subroutine anharm8(GAMI,TPT,Fah,Uah,Pah,CVah,PDTah,PDRah) bind(C, name="anharm8") + implicit none + double precision, intent(in), value :: GAMI,TPT + double precision :: Fah,Uah,Pah,CVah,PDTah,PDRah + end subroutine anharm8 end interface if (LIQSOL.ne.1.and.LIQSOL.ne.0) then @@ -841,53 +846,6 @@ subroutine FSCRliq8(RS,GAME,Zion, & end ! ============== SUBROUTINES FOR THE SOLID STATE ================= ! - subroutine ANHARM8(GAMI,TPT,Fah,Uah,Pah,CVah,PDTah,PDRah) -! ANHARMONIC free energy Version 27.07.07 -! cleaned 16.06.09 -! Stems from ANHARM8b. Difference: AC=0., B1=.12 (.1217 - over accuracy) -! Input: GAMI - ionic Gamma, TPT=Tp/T - ionic quantum parameter -! Output: anharm.free en. Fah=F_{AH}/(N_i kT), internal energy Uah, -! pressure Pah=P_{AH}/(n_i kT), specific heat CVah = C_{V,AH}/(N_i k), -! PDTah = Pah + d Pah / d ln T, PDRah = Pah + d Pah / d ln\rho - implicit double precision (A-H), double precision (O-Z) - save - parameter(NM=3) - dimension AA(NM) - data AA/10.9,247.,1.765d5/ ! Farouki & Hamaguchi'93 - data B1/.12/ ! coeff.at \eta^2/\Gamma at T=0 - CK=B1/AA(1) ! fit coefficient - TPT2=TPT**2 - TPT4=TPT2**2 - TQ=B1*TPT2/GAMI ! quantum dependence - TK2=CK*TPT2 - SUP=dexp(-TK2) ! suppress.factor of class.anharmonicity - Fah=0. - Uah=0. - Pah=0. - CVah=0. - PDTah=0. - PDRah=0. - SUPGN=SUP - do N=1,NM - CN=N - SUPGN=SUPGN/GAMI ! SUP/Gamma^n - ACN=AA(N) - Fah=Fah-ACN/CN*SUPGN - Uah=Uah+(ACN*(1.+2.*TK2/CN))*SUPGN - PN=AA(N)/3.+TK2*AA(N)/CN - Pah=Pah+PN*SUPGN - CVah=CVah+((CN+1.)*AA(N)+(4.-2./CN)*AA(N)*TK2+ & - 4.*AA(N)*CK**2/CN*TPT4)*SUPGN - PDTah=PDTah+(PN*(1.+CN+2.*TK2)-2./CN*AA(N)*TK2)*SUPGN - PDRah=PDRah+(PN*(1.-CN/3.-TK2)+AA(N)/CN*TK2)*SUPGN - enddo - Fah=Fah-TQ - Uah=Uah-TQ - Pah=Pah-TQ/1.5 - PDRah=PDRah-TQ/4.5 - return - end - subroutine FHARM12(GAMI,TPT, & Fharm,Uharm,Pharm,CVth,Sth,PDTharm,PDRharm) ! Thermodynamic functions of a harmonic crystal, incl.stat.Coul.lattice diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 370a53d8e0..1b430d3e38 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -1492,54 +1492,59 @@ extern "C" GAMI * GAMI * FDGG) / 9.0_rt; } - /* - subroutine ANHARM8(GAMI,TPT,Fah,Uah,Pah,CVah,PDTah,PDRah) -// ANHARMONIC free energy Version 27.07.07 -// cleaned 16.06.09 -// Stems from ANHARM8b. Difference: AC = 0., B1 = .12 (.1217 - over accuracy) -// Input: GAMI - ionic Gamma, TPT = Tp/T - ionic quantum parameter -// Output: anharm.free en. Fah = F_{AH}/(N_i kT), internal energy Uah, -// pressure Pah = P_{AH}/(n_i kT), specific heat CVah = C_{V,AH}/(N_i k), -// PDTah = Pah + d Pah / d ln T, PDRah = Pah + d Pah / d ln\rho - implicit double precision (A-H), double precision (O-Z) - save - parameter(NM = 3) - dimension AA(NM) - data AA/10.9,247.,1.765d5/ // Farouki & Hamaguchi'93 - data B1/.12/ // coeff.at \eta^2/\Gamma at T = 0 - CK = B1 / AA[0] // fit coefficient - TPT2 = TPT * TPT - TPT4 = TPT2 * TPT2 - TQ = B1 * TPT2 / GAMI // quantum dependence - TK2 = CK * TPT2 - SUP = std::exp(-TK2) // suppress.factor of class.anharmonicity - Fah = 0. - Uah = 0. - Pah = 0. - CVah = 0. - PDTah = 0. - PDRah = 0. - SUPGN = SUP - do N = 1,NM - CN = N - SUPGN = SUPGN / GAMI // SUP/Gamma^n - ACN = AA(N) - Fah = Fah - ACN / CN * SUPGN - Uah = Uah + (ACN * (1.0_rt + 2.0_rt * TK2 / CN)) * SUPGN - PN = AA(N) / 3.0_rt + TK2 * AA(N) / CN - Pah = Pah + PN * SUPGN - CVah = CVah + ((CN + 1.0_rt) * AA(N) + (4.0_rt - 2.0_rt / CN) * AA(N) * TK2 + & - 4.0_rt * AA(N) * CK * CK / CN * TPT4) * SUPGN - PDTah = PDTah + (PN * (1.0_rt + CN + 2.0_rt * TK2) - 2.0_rt / CN * AA(N) * TK2) * SUPGN - PDRah = PDRah + (PN * (1.0_rt - CN / 3.0_rt - TK2) + AA(N) / CN * TK2) * SUPGN - enddo - Fah = Fah - TQ - Uah = Uah - TQ - Pah = Pah - TQ / 1.5 - PDRah = PDRah - TQ / 4.5 - return - end + void anharm8 (double GAMI, double TPT, + double& Fah, double& Uah, double& Pah, + double& CVah, double& PDTah, double& PDRah) + { + // ANHARMONIC free energy + // Version 27.07.07 + // cleaned 16.06.09 + // Stems from ANHARM8b. Difference: AC = 0., B1 = .12 (.1217 - over accuracy) + // Input: GAMI - ionic Gamma, TPT = Tp/T - ionic quantum parameter + // Output: anharm.free en. Fah = F_{AH}/(N_i kT), internal energy Uah, + // pressure Pah = P_{AH}/(n_i kT), specific heat CVah = C_{V,AH}/(N_i k), + // PDTah = Pah + d Pah / d ln T, PDRah = Pah + d Pah / d ln\rho + + const int NM = 3; + const Real AA[NM] = {10.9_rt, 247.0_rt, 1.765e5_rt}; // Farouki & Hamaguchi'93 + const Real B1 = 0.12_rt; // coeff.at \eta^2/\Gamma at T = 0 + + Real CK = B1 / AA[0]; // fit coefficient + Real TPT2 = TPT * TPT; + Real TPT4 = TPT2 * TPT2; + Real TQ = B1 * TPT2 / GAMI; // quantum dependence + Real TK2 = CK * TPT2; + Real SUP = std::exp(-TK2); // suppress.factor of class.anharmonicity + + Fah = 0.0_rt; + Uah = 0.0_rt; + Pah = 0.0_rt; + CVah = 0.0_rt; + PDTah = 0.0_rt; + PDRah = 0.0_rt; + + Real SUPGN = SUP; + for (int N = 1; N <= NM; ++N) { + Real CN = (Real) N; + SUPGN = SUPGN / GAMI; // SUP/Gamma^n + Real ACN = AA[N-1]; + Fah = Fah - ACN / CN * SUPGN; + Uah = Uah + (ACN * (1.0_rt + 2.0_rt * TK2 / CN)) * SUPGN; + Real PN = AA[N-1] / 3.0_rt + TK2 * AA[N-1] / CN; + Pah = Pah + PN * SUPGN; + CVah = CVah + ((CN + 1.0_rt) * AA[N-1] + (4.0_rt - 2.0_rt / CN) * AA[N-1] * TK2 + + 4.0_rt * AA[N-1] * CK * CK / CN * TPT4) * SUPGN; + PDTah = PDTah + (PN * (1.0_rt + CN + 2.0_rt * TK2) - 2.0_rt / CN * AA[N-1] * TK2) * SUPGN; + PDRah = PDRah + (PN * (1.0_rt - CN / 3.0_rt - TK2) + AA[N-1] / CN * TK2) * SUPGN; + } + Fah = Fah - TQ; + Uah = Uah - TQ; + Pah = Pah - TQ / 1.5_rt; + PDRah = PDRah - TQ / 4.5_rt; + } + + /* subroutine FHARM12(GAMI,TPT, & Fharm,Uharm,Pharm,CVth,Sth,PDTharm,PDRharm) // Thermodynamic functions of a harmonic crystal, incl.stat.Coul.lattice From 8561cef0324de667bab9e452028fba7e6f2921cf Mon Sep 17 00:00:00 2001 From: Max Katz Date: Mon, 18 Oct 2021 13:22:21 -0700 Subject: [PATCH 49/70] hlfit12 to C++ --- EOS/pc/eos17.f90 | 128 ++---------------------- EOS/pc/eos_c.cpp | 252 +++++++++++++++++++++++++---------------------- 2 files changed, 141 insertions(+), 239 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 75c3f3c154..1c89abe72f 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -860,6 +860,14 @@ subroutine FHARM12(GAMI,TPT, & implicit double precision (A-H), double precision (O-Z) save parameter(CM=.895929256d0) ! Madelung + interface + subroutine hlfit12(TPT,F,U,CVth,Sth,U1,CW,LATTICE) bind(C, name="hlfit12") + implicit none + double precision, intent(in), value :: TPT + integer, intent(in), value :: LATTICE + double precision :: F,U,CVth,Sth,U1,CW + end subroutine hlfit12 + end interface call HLfit12(TPT,F,U,CVth,Sth,U1,CW,1) U0=-CM*GAMI ! perfect lattice E0=1.5d0*U1*TPT ! zero-point energy @@ -873,126 +881,6 @@ subroutine FHARM12(GAMI,TPT, & return end - subroutine HLfit12(eta,F,U,CV,S,U1,CW,LATTICE) -! Version 24.04.12 -! Stems from HLfit8 v.03.12.08; -! differences: E0 excluded from U and F; -! U1 and d(CV)/d\ln(T) are added on the output. -! Fit to thermal part of the thermodynamic functions. -! Baiko, Potekhin, & Yakovlev (2001). -! Zero-point lattice quantum energy 1.5u_1\eta EXCLUDED (unlike HLfit8). -! Input: eta=Tp/T, LATTICE=1 for bcc, 2 for fcc -! Output: F and U (normalized to NkT) - due to phonon excitations, -! CV and S (normalized to Nk) in the HL model, -! U1 - the 1st phonon moment, -! CW=d(CV)/d\ln(T) - implicit double precision (A-H), double precision (O-Z) - save - parameter(EPS=1.d-5,TINY=1.d-99) - if (LATTICE.eq.1) then ! bcc lattice - CLM=-2.49389d0 ! 3*ln<\omega/\omega_p> - U1=.5113875d0 - ALPHA=.265764d0 - BETA=.334547d0 - GAMMA=.932446d0 - A1=.1839d0 - A2=.593586d0 - A3=.0054814d0 - A4=5.01813d-4 - A6=3.9247d-7 - A8=5.8356d-11 - B0=261.66d0 - B2=7.07997d0 - B4=.0409484d0 - B5=.000397355d0 - B6=5.11148d-5 - B7=2.19749d-6 - C9=.004757014d0 - C11=.0047770935d0 - elseif (LATTICE.eq.2) then ! fcc lattice - CLM=-2.45373d0 - U1=.513194d0 - ALPHA=.257591d0 - BETA=.365284d0 - GAMMA=.9167070d0 - A1=.0 - A2=.532535d0 - A3=.0 - A4=3.76545d-4 - A6=2.63013d-7 - A8=6.6318d-11 - B0=303.20d0 - B2=7.7255d0 - B4=.0439597d0 - B5=.000114295d0 - B6=5.63434d-5 - B7=1.36488d-6 - C9=.00492387d0 - C11=.00437506d0 - else - print *, 'HLfit: unknown lattice type' - stop - endif - if (eta.gt.1./EPS) then ! asymptote of Eq.(13) of BPY'01 - U=3./(C11*eta**3) - F=-U/3. - CV=4.*U - S=U-F - return - elseif (eta.lt.EPS) then ! Eq.(17) of BPY'01 - if (eta.lt.TINY) then - print *, 'HLfit: eta is too small' - stop - end if - F=3.*dlog(eta)+CLM-1.5*U1*eta+eta**2/24. - U=3.-1.5*U1*eta+eta**2/12. - CV=3.-eta**2/12. - S=U-F - return - endif - eta2=eta**2 - eta3=eta2*eta - eta4=eta3*eta - eta5=eta4*eta - eta6=eta5*eta - eta7=eta6*eta - eta8=eta7*eta - B9=A6*C9 - B11=A8*C11 - UP=1.+A1*eta+A2*eta2+A3*eta3+A4*eta4+A6*eta6+A8*eta8 - DN=B0+B2*eta2+B4*eta4+B5*eta5+B6*eta6+ & - B7*eta7+eta8*(B9*eta+B11*eta3) - EA=dexp(-ALPHA*eta) - EB=dexp(-BETA*eta) - EG=dexp(-GAMMA*eta) - F=dlog(1.d0-EA)+dlog(1.d0-EB)+dlog(1.-EG)-UP/DN ! F_{thermal}/NT - UP1=A1+ & - 2.*A2*eta+3.*A3*eta2+4.*A4*eta3+6.*A6*eta5+8.*A8*eta7 - UP2=2.*A2+6.*A3*eta+12.*A4*eta2+30.*A6*eta4+56.*A8*eta6 - UP3=6.*A3+24.*A4*eta+120.*A6*eta3+336*A8*eta5 - DN1=2.*B2*eta+4.*B4*eta3+5.*B5*eta4+6.*B6*eta5+ & - 7.*B7*eta6+eta8*(9.*B9+11.*B11*eta2) - DN2=2.*B2+12.*B4*eta2+20.*B5*eta3+30.*B6*eta4+ & - 42.*B7*eta5+72.*B9*eta7+110.*B11*eta8*eta - DN3=24.*B4*eta+60.*B5*eta2+120.*B6*eta3+ & - 210.*B7*eta4+504.*B9*eta6+990.*B11*eta8 - DF1=ALPHA*EA/(1.d0-EA)+BETA*EB/(1.d0-EB)+GAMMA*EG/(1.d0-EG)- & - (UP1*DN-DN1*UP)/DN**2 ! int.en./NT/eta = df/d\eta - DF2=ALPHA**2*EA/(1.d0-EA)**2+BETA**2*EB/(1.d0-EB)**2+ & - GAMMA**2*EG/(1.d0-EG)**2+ & - ((UP2*DN-DN2*UP)*DN-2.*(UP1*DN-DN1*UP)*DN1)/DN**3 ! -d2f/d\eta^2 - U=DF1*eta - CV=DF2*eta2 - DF3=-ALPHA**3*EA/(1.d0-EA)**3*(1.+EA)- & - BETA**3*EB/(1.d0-EB)**3*(1.+EB)- & - GAMMA**3*EG/(1.d0-EG)**3*(1.+EG)+ & - UP3/DN-(3.*UP2*DN1+3.*UP1*DN2+UP*DN3)/DN**2+ & - 6.*DN1*(UP1*DN1+UP*DN2)/DN**3-6.*UP*DN1**3/DN**4 ! -d3f/d\eta^3 - CW=-2.*CV-eta3*DF3 - S=U-F - return - end - subroutine CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, & FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) ! Version 02.07.09 diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 1b430d3e38..5047470a6b 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -1544,6 +1544,139 @@ extern "C" PDRah = PDRah - TQ / 4.5_rt; } + void hlfit12 (Real eta, + Real& F, Real& U, Real& CV, Real& S, + Real& U1, Real& CW, int LATTICE) + { + // Version 24.04.12 + // Stems from HLfit8 v.03.12.08; + // differences: E0 excluded from U and F; + // U1 and d(CV)/d\ln(T) are added on the output. + // Fit to thermal part of the thermodynamic functions. + // Baiko, Potekhin, & Yakovlev (2001). + // Zero-point lattice quantum energy 1.5u_1\eta EXCLUDED (unlike HLfit8). + // Input: eta = Tp/T, LATTICE = 1 for bcc, 2 for fcc + // Output: F and U (normalized to NkT) - due to phonon excitations, + // CV and S (normalized to Nk) in the HL model, + // U1 - the 1st phonon moment, + // CW = d(CV)/d\ln(T) + + const Real EPS = 1.e-5_rt; + const Real TINY = 1.e-99_rt; + + Real CLM, ALPHA, BETA, GAMMA; + Real A1, A2, A3, A4, A6, A8; + Real B0, B2, B4, B5, B6, B7, C9, C11; + + if (LATTICE == 1) { // bcc lattice + CLM = -2.49389_rt; // 3 * ln<\omega/\omega_p> + U1 = 0.5113875_rt; + ALPHA = 0.265764_rt; + BETA = 0.334547_rt; + GAMMA = 0.932446_rt; + A1 = 0.1839_rt; + A2 = 0.593586_rt; + A3 = 0.0054814_rt; + A4 = 5.01813e-4_rt; + A6 = 3.9247e-7_rt; + A8 = 5.8356e-11_rt; + B0 = 261.66_rt; + B2 = 7.07997_rt; + B4 = 0.0409484_rt; + B5 = 0.000397355_rt; + B6 = 5.11148e-5_rt; + B7 = 2.19749e-6_rt; + C9 = 0.004757014_rt; + C11 = 0.0047770935_rt; + } + else if (LATTICE == 2) { // fcc lattice + CLM = -2.45373_rt; + U1 = 0.513194_rt; + ALPHA = 0.257591_rt; + BETA = 0.365284_rt; + GAMMA = 0.9167070_rt; + A1 = 0.0_rt; + A2 = 0.532535_rt; + A3 = 0.0_rt; + A4 = 3.76545e-4_rt; + A6 = 2.63013e-7_rt; + A8 = 6.6318e-11_rt; + B0 = 303.20_rt; + B2 = 7.7255_rt; + B4 = 0.0439597_rt; + B5 = 0.000114295_rt; + B6 = 5.63434e-5_rt; + B7 = 1.36488e-6_rt; + C9 = 0.00492387_rt; + C11 = 0.00437506_rt; + } + else { + printf("HLfit: unknown lattice type\n"); + exit(1); + } + + if (eta > 1.0_rt / EPS) { // asymptote of Eq.(13) of BPY'01 + U = 3.0_rt / (C11 * eta * eta * eta); + F = -U / 3.0_rt; + CV = 4.0_rt * U; + S = U - F; + return; + } + else if (eta < EPS) { // Eq.(17) of BPY'01 + if (eta < TINY) { + printf("HLfit: eta is too small\n"); + exit(1); + } + F = 3.0_rt * std::log(eta) + CLM - 1.5_rt * U1 * eta + eta * eta / 24.0_rt; + U = 3.0_rt - 1.5_rt * U1 * eta + eta * eta / 12.0_rt; + CV = 3.0_rt - eta * eta / 12.0_rt; + S = U - F; + return; + } + + Real eta2 = eta * eta; + Real eta3 = eta2 * eta; + Real eta4 = eta3 * eta; + Real eta5 = eta4 * eta; + Real eta6 = eta5 * eta; + Real eta7 = eta6 * eta; + Real eta8 = eta7 * eta; + Real B9 = A6 * C9; + Real B11 = A8 * C11; + Real UP = 1.0_rt + A1 * eta + A2 * eta2 + A3 * eta3 + A4 * eta4 + A6 * eta6 + A8 * eta8; + Real DN = B0 + B2 * eta2 + B4 * eta4 + B5 * eta5 + B6 * eta6 + + B7 * eta7 + eta8 * (B9 * eta + B11 * eta3); + Real EA = std::exp(-ALPHA * eta); + Real EB = std::exp(-BETA * eta); + Real EG = std::exp(-GAMMA * eta); + F = std::log(1.0_rt - EA) + std::log(1.0_rt - EB) + std::log(1.0_rt - EG) - UP / DN; // F_{thermal}/NT + Real UP1 = A1 + 2.0_rt * A2 * eta + 3.0_rt * A3 * eta2 + 4.0_rt * A4 * eta3 + + 6.0_rt * A6 * eta5 + 8. * A8 * eta7; + Real UP2 = 2.0_rt * A2 + 6.0_rt * A3 * eta + 12.0_rt * A4 * eta2 + 30.0_rt * A6 * eta4 + 56.0_rt * A8 * eta6; + Real UP3 = 6.0_rt * A3 + 24.0_rt * A4 * eta + 120.0_rt * A6 * eta3 + 336.0_rt * A8 * eta5; + Real DN1 = 2.0_rt * B2 * eta + 4.0_rt * B4 * eta3 + 5.0_rt * B5 * eta4 + 6.0_rt * B6 * eta5 + + 7.0_rt * B7 * eta6 + eta8 * (9.0_rt * B9 + 11.0_rt * B11 * eta2); + Real DN2 = 2.0_rt * B2 + 12.0_rt * B4 * eta2 + 20. * B5 * eta3 + 30.0_rt * B6 * eta4 + + 42.0_rt * B7 * eta5 + 72.0_rt * B9 * eta7 + 110.0_rt * B11 * eta8 * eta; + Real DN3 = 24.0_rt * B4 * eta + 60.0_rt * B5 * eta2 + 120.0_rt * B6 * eta3 + + 210.0_rt * B7 * eta4 + 504.0_rt * B9 * eta6 + 990.0_rt * B11 * eta8; + Real DF1 = ALPHA * EA / (1.0_rt - EA) + BETA * EB / (1.0_rt - EB) + GAMMA * EG / (1.0_rt - EG) - + (UP1 * DN - DN1 * UP) / (DN * DN); // int.en./NT/eta = df/d\eta + Real DF2 = ALPHA * ALPHA * EA / ((1.0_rt - EA) * (1.0_rt - EA)) + BETA * BETA * EB / + ((1.0_rt - EB) * (1.0_rt - EB)) + GAMMA * GAMMA * EG / ((1.0_rt - EG) * (1.0_rt - EG)) + + ((UP2 * DN - DN2 * UP) * DN - 2.0_rt * (UP1 * DN - DN1 * UP) * DN1) / (DN * DN * DN); // -d2f/d\eta^2 + U = DF1 * eta; + CV = DF2 * eta2; + Real DF3 = -ALPHA * ALPHA * ALPHA * EA / std::pow(1.0_rt - EA, 3) * (1.0_rt + EA) - + BETA * BETA * BETA * EB / std::pow(1.0_rt - EB, 3) * (1.0_rt + EB) - + GAMMA * GAMMA * GAMMA * EG / std::pow(1.0_rt - EG, 3) * (1.0_rt + EG) + + UP3 / DN - (3.0_rt * UP2 * DN1 + 3.0_rt * UP1 * DN2 + UP * DN3) / (DN * DN) + + 6.0_rt * DN1 * (UP1 * DN1 + UP * DN2) / (DN * DN * DN) - + 6.0_rt * UP * DN1 * DN1 * DN1 / (DN * DN * DN * DN); // -d3f/d\eta^3 + CW = -2.0_rt * CV - eta3 * DF3; + S = U - F; + } + /* subroutine FHARM12(GAMI,TPT, & Fharm,Uharm,Pharm,CVth,Sth,PDTharm,PDRharm) @@ -1572,125 +1705,6 @@ extern "C" return end - subroutine HLfit12(eta,F,U,CV,S,U1,CW,LATTICE) -// Version 24.04.12 -// Stems from HLfit8 v.03.12.08; -// differences: E0 excluded from U and F; -// U1 and d(CV)/d\ln(T) are added on the output. -// Fit to thermal part of the thermodynamic functions. -// Baiko, Potekhin, & Yakovlev (2001). -// Zero-point lattice quantum energy 1.5u_1\eta EXCLUDED (unlike HLfit8). -// Input: eta = Tp/T, LATTICE = 1 for bcc, 2 for fcc -// Output: F and U (normalized to NkT) - due to phonon excitations, -// CV and S (normalized to Nk) in the HL model, -// U1 - the 1st phonon moment, -// CW = d(CV)/d\ln(T) - implicit double precision (A-H), double precision (O-Z) - save - parameter(EPS = 1.d-5,TINY = 1.d-99) - if (LATTICE.eq.1) { // bcc lattice - CLM = -2.49389d0 // 3 * ln<\omega/\omega_p> - U1 = .5113875d0 - ALPHA = .265764d0 - BETA = .334547d0 - GAMMA = .932446d0 - A1 = .1839d0 - A2 = .593586d0 - A3 = .0054814d0 - A4 = 5.01813d-4 - A6 = 3.9247d-7 - A8 = 5.8356d-11 - B0 = 261.66d0 - B2 = 7.07997d0 - B4 = .0409484d0 - B5 = .000397355d0 - B6 = 5.11148d-5 - B7 = 2.19749d-6 - C9 = .004757014d0 - C11 = .0047770935d0 - elseif (LATTICE.eq.2) { // fcc lattice - CLM = -2.45373d0 - U1 = .513194d0 - ALPHA = .257591d0 - BETA = .365284d0 - GAMMA = .9167070d0 - A1 = .0 - A2 = .532535d0 - A3 = .0 - A4 = 3.76545d-4 - A6 = 2.63013d-7 - A8 = 6.6318d-11 - B0 = 303.20d0 - B2 = 7.7255d0 - B4 = .0439597d0 - B5 = .000114295d0 - B6 = 5.63434d-5 - B7 = 1.36488d-6 - C9 = .00492387d0 - C11 = .00437506d0 - else - print * , 'HLfit: unknown lattice type' - stop - endif - if (eta.gt.1.0_rt / EPS) { // asymptote of Eq.(13) of BPY'01 - U = 3.0_rt / (C11 * eta * eta * eta) - F = -U / 3.0_rt - CV = 4.0_rt * U - S = U - F - return - elseif (eta < EPS) { // Eq.(17) of BPY'01 - if (eta < TINY) { - print * , 'HLfit: eta is too small' - stop - end if - F = 3.0_rt * std::log(eta) + CLM - 1.5 * U1 * eta + eta * eta / 24. - U = 3.0_rt - 1.5 * U1 * eta + eta * eta / 12. - CV = 3.0_rt - eta * eta / 12. - S = U - F - return - endif - eta2 = eta * eta - eta3 = eta2 * eta - eta4 = eta3 * eta - eta5 = eta4 * eta - eta6 = eta5 * eta - eta7 = eta6 * eta - eta8 = eta7 * eta - B9 = A6 * C9 - B11 = A8 * C11 - UP = 1.0_rt + A1 * eta + A2 * eta2 + A3 * eta3 + A4 * eta4 + A6 * eta6 + A8 * eta8 - DN = B0 + B2 * eta2 + B4 * eta4 + B5 * eta5 + B6 * eta6 + & - B7 * eta7 + eta8 * (B9 * eta + B11 * eta3) - EA = std::exp(-ALPHA * eta) - EB = std::exp(-BETA * eta) - EG = std::exp(-GAMMA * eta) - F = std::log(1.0_rt - EA) + std::log(1.0_rt - EB) + std::log(1.0_rt - EG) - UP / DN // F_{thermal}/NT - UP1 = A1 + & - 2.0_rt * A2 * eta + 3.0_rt * A3 * eta2 + 4.0_rt * A4 * eta3 + 6.0_rt * A6 * eta5 + 8. * A8 * eta7 - UP2 = 2.0_rt * A2 + 6.0_rt * A3 * eta + 12. * A4 * eta2 + 30. * A6 * eta4 + 56.0_rt * A8 * eta6 - UP3 = 6.0_rt * A3 + 24. * A4 * eta + 120. * A6 * eta3 + 336 * A8 * eta5 - DN1 = 2.0_rt * B2 * eta + 4.0_rt * B4 * eta3 + 5. * B5 * eta4 + 6.0_rt * B6 * eta5 + & - 7. * B7 * eta6 + eta8 * (9. * B9 + 11. * B11 * eta2) - DN2 = 2.0_rt * B2 + 12. * B4 * eta2 + 20. * B5 * eta3 + 30. * B6 * eta4 + & - 42. * B7 * eta5 + 72. * B9 * eta7 + 110. * B11 * eta8 * eta - DN3 = 24. * B4 * eta + 60. * B5 * eta2 + 120. * B6 * eta3 + & - 210. * B7 * eta4 + 504. * B9 * eta6 + 990. * B11 * eta8 - DF1 = ALPHA * EA / (1.0_rt - EA) + BETA * EB / (1.0_rt - EB) + GAMMA * EG / (1.0_rt - EG) - & - (UP1 * DN - DN1 * UP) / (DN * DN) // int.en./NT/eta = df/d\eta - DF2 = ALPHA * ALPHA * EA / ((1.0_rt - EA) * (1.0_rt - EA) + BETA * BETA * EB / ((1.0_rt - EB) * (1.0_rt - EB) + & - GAMMA * GAMMA * EG / ((1.0_rt - EG) * (1.0_rt - EG) + & - ((UP2 * DN - DN2 * UP) * DN - 2.0_rt * (UP1 * DN - DN1 * UP) * DN1) / (DN * DN * DN) // -d2f/d\eta^2 - U = DF1 * eta - CV = DF2 * eta2 - DF3 = -ALPHA * ALPHA * ALPHA * EA / std::pow(1.0_rt - EA, 3) * (1.0_rt + EA) - & - BETA * BETA * BETA * EB / std::pow(1.0_rt - EB, 3) * (1.0_rt + EB) - & - GAMMA * GAMMA * GAMMA * EG / std::pow(1.0_rt - EG, 3) * (1.0_rt + EG) + & - UP3 / DN - (3.0_rt * UP2 * DN1 + 3.0_rt * UP1 * DN2 + UP * DN3) / (DN * DN) + & - 6.0_rt * DN1 * (UP1 * DN1 + UP * DN2) / (DN * DN * DN) - 6.0_rt * UP * DN1 * DN1 * DN1 / (DN * DN * DN * DN) // -d3f/d\eta^3 - CW = -2.0_rt * CV - eta3 * DF3 - S = U - F - return - end subroutine CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, & FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) From db2dbf67ab7acff11e694258655c1264c766920e Mon Sep 17 00:00:00 2001 From: Max Katz Date: Mon, 18 Oct 2021 13:35:13 -0700 Subject: [PATCH 50/70] cormix to C++ --- EOS/pc/eos17.f90 | 61 +++---------------------- EOS/pc/eos_c.cpp | 114 ++++++++++++++++++++++++----------------------- 2 files changed, 65 insertions(+), 110 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 1c89abe72f..ad67cb6b09 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -394,6 +394,12 @@ subroutine elect11(TEMP,CHI, & double precision :: DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT end subroutine elect11 + subroutine CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, & + FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) bind(C, name="cormix") + implicit none + double precision, value :: RS,GAME,Zmean,Z2mean,Z52,Z53,Z321 + double precision :: FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX + end subroutine CORMIX end interface if (RHO.lt.1.e-19.or.RHO.gt.1.e15) then print *, 'MELANGE: RHO out of range' @@ -880,58 +886,3 @@ end subroutine hlfit12 PDRharm=U0/2.25d0+.75d0*Uth-.25d0*CVth return end - - subroutine CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, & - FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) -! Version 02.07.09 -! Correction to the linear mixing rule for moderate to small Gamma -! Input: RS=r_s (if RS=0, then OCP, otherwise EIP) -! GAME=\Gamma_e -! Zmean= (average Z of all ions, without electrons) -! Z2mean=, Z52=, Z53=, Z321= -! Output: FMIX=\Delta f - corr.to the reduced free energy f=F/N_{ion}kT -! UMIX=\Delta u - corr.to the reduced internal energy u -! PMIX=\Delta u - corr.to the reduced pressure P=P/n_{ion}kT -! CVMIX=\Delta c - corr.to the reduced heat capacity c_V -! PDTMIX=(1/n_{ion}kT)d\Delta P / d ln T -! = \Delta p + d \Delta p / d ln T -! PDRMIX=(1/n_{ion}kT)d\Delta P / d ln n_e -! (composition is assumed fixed: Zmean,Z2mean,Z52,Z53=constant) - implicit double precision (A-H), double precision (O-Z) - parameter (TINY=1.d-9) - GAMImean=GAME*Z53 - if (RS.lt.TINY) then ! OCP - Dif0=Z52-dsqrt(Z2mean**3/Zmean) - else - Dif0=Z321-dsqrt((Z2mean+Zmean)**3/Zmean) - endif - DifR=Dif0/Z52 - DifFDH=Dif0*GAME*sqrt(GAME/3.) ! F_DH - F_LM(DH) - D=Z2mean/Zmean**2 - if (dabs(D-1.d0).lt.TINY) then ! no correction - FMIX=0. - UMIX=0. - PMIX=0. - CVMIX=0. - PDTMIX=0. - PDRMIX=0. - return - endif - P3=D**(-0.2) - D0=(2.6*DifR+14.*DifR**3)/(1.d0-P3) - GP=D0*GAMImean**P3 - FMIX0=DifFDH/(1.+GP) - Q=D**2*.0117 - R=1.5/P3-1. - GQ=Q*GP - FMIX=FMIX0/(1.+GQ)**R - G=1.5-P3*GP/(1.+GP)-R*P3*GQ/(1.+GQ) - UMIX=FMIX*G - PMIX=UMIX/3.d0 - GDG=-P3**2*(GP/(1.d0+GP)**2+R*GQ/(1.d0+GQ)**2) ! d G /d ln Gamma - UDG=UMIX*G+FMIX*GDG ! d u_mix /d ln Gamma - CVMIX=UMIX-UDG - PDTMIX=PMIX-UDG/3. - PDRMIX=PMIX+UDG/9. - return - end diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 5047470a6b..72f9c0bdca 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -1704,61 +1704,65 @@ extern "C" PDRharm = U0 / 2.25d0 + .75d0 * Uth - .25d0 * CVth return end + */ + void cormix (Real RS, Real GAME, Real Zmean, Real Z2mean, Real Z52, Real Z53, Real Z321, + Real& FMIX, Real& UMIX, Real& PMIX, Real& CVMIX, Real& PDTMIX, Real& PDRMIX) + { + // Version 02.07.09 + // Correction to the linear mixing rule for moderate to small Gamma + // Input: RS = r_s (if RS = 0, then OCP, otherwise EIP) + // GAME = \Gamma_e + // Zmean = (average Z of all ions, without electrons) + // Z2mean = , Z52 = , Z53 = , Z321 = + // Output: FMIX = \Delta f - corr.to the reduced free energy f = F/N_{ion}kT + // UMIX = \Delta u - corr.to the reduced internal energy u + // PMIX = \Delta u - corr.to the reduced pressure P = P/n_{ion}kT + // CVMIX = \Delta c - corr.to the reduced heat capacity c_V + // PDTMIX = (1/n_{ion}kT)d\Delta P / d ln T + // = \Delta p + d \Delta p / d ln T + // PDRMIX = (1/n_{ion}kT)d\Delta P / d ln n_e + // (composition is assumed fixed: Zmean,Z2mean,Z52,Z53 = constant) + + const Real TINY = 1.e-9_rt; + Real GAMImean = GAME * Z53; + + Real Dif0; + if (RS < TINY) { // OCP + Dif0 = Z52 - std::sqrt(Z2mean * Z2mean * Z2mean / Zmean); + } + else { + Dif0 = Z321 - std::sqrt(std::pow(Z2mean + Zmean, 3) / Zmean); + } - subroutine CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, & - FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) -// Version 02.07.09 -// Correction to the linear mixing rule for moderate to small Gamma -// Input: RS = r_s (if RS = 0, then OCP, otherwise EIP) -// GAME = \Gamma_e -// Zmean = (average Z of all ions, without electrons) -// Z2mean = , Z52 = , Z53 = , Z321 = -// Output: FMIX = \Delta f - corr.to the reduced free energy f = F/N_{ion}kT -// UMIX = \Delta u - corr.to the reduced internal energy u -// PMIX = \Delta u - corr.to the reduced pressure P = P/n_{ion}kT -// CVMIX = \Delta c - corr.to the reduced heat capacity c_V -// PDTMIX = (1/n_{ion}kT)d\Delta P / d ln T -// = \Delta p + d \Delta p / d ln T -// PDRMIX = (1/n_{ion}kT)d\Delta P / d ln n_e -// (composition is assumed fixed: Zmean,Z2mean,Z52,Z53 = constant) - implicit double precision (A-H), double precision (O-Z) - parameter (TINY = 1.d-9) - GAMImean = GAME * Z53 - if (RS < TINY) { // OCP - Dif0 = Z52 - std::sqrt(Z2mean * Z2mean * Z2mean / Zmean) - else - Dif0 = Z321 - std::sqrt(std::pow(Z2mean + Zmean, 3) / Zmean) - endif - DifR = Dif0 / Z52 - DifFDH = Dif0 * GAME * std::sqrt(GAME / 3.0_rt) // F_DH - F_LM(DH) - D = Z2mean / (Zmean * Zmean) - if (std::abs(D - 1.0_rt) < TINY) { // no correction - FMIX = 0. - UMIX = 0. - PMIX = 0. - CVMIX = 0. - PDTMIX = 0. - PDRMIX = 0. - return - endif - P3 = std::pow(D, -0.2_rt) - D0 = (2.6 * DifR + 14. * DifR * DifR * DifR) / (1.0_rt - P3) - GP = D0 * std::pow(GAMImean, P3) - FMIX0 = DifFDH / (1.0_rt + GP) - Q = D * D * .0117 - R = 1.5 / P3 - 1.0_rt - GQ = Q * GP - FMIX = FMIX0 / std::pow(1.0_rt + GQ, R) - G = 1.5 - P3 * GP / (1.0_rt + GP) - R * P3 * GQ / (1.0_rt + GQ) - UMIX = FMIX * G - PMIX = UMIX / 3.0_rt - GDG = -P3 * P3 * (GP / ((1.0_rt + GP) * (1.0_rt + GP)) + R * GQ / ((1.0_rt + GQ) * (1.0_rt + GQ)) // d G /d ln Gamma - UDG = UMIX * G + FMIX * GDG // d u_mix /d ln Gamma - CVMIX = UMIX - UDG - PDTMIX = PMIX - UDG / 3.0_rt - PDRMIX = PMIX + UDG / 9. - return - end -*/ + Real DifR = Dif0 / Z52; + Real DifFDH = Dif0 * GAME * std::sqrt(GAME / 3.0_rt); // F_DH - F_LM(DH) + Real D = Z2mean / (Zmean * Zmean); + if (std::abs(D - 1.0_rt) < TINY) { // no correction + FMIX = 0.0_rt; + UMIX = 0.0_rt; + PMIX = 0.0_rt; + CVMIX = 0.0_rt; + PDTMIX = 0.0_rt; + PDRMIX = 0.0_rt; + return; + } + + Real P3 = std::pow(D, -0.2_rt); + Real D0 = (2.6_rt * DifR + 14.0_rt * DifR * DifR * DifR) / (1.0_rt - P3); + Real GP = D0 * std::pow(GAMImean, P3); + Real FMIX0 = DifFDH / (1.0_rt + GP); + Real Q = D * D * 0.0117_rt; + Real R = 1.5_rt / P3 - 1.0_rt; + Real GQ = Q * GP; + FMIX = FMIX0 / std::pow(1.0_rt + GQ, R); + Real G = 1.5_rt - P3 * GP / (1.0_rt + GP) - R * P3 * GQ / (1.0_rt + GQ); + UMIX = FMIX * G; + PMIX = UMIX / 3.0_rt; + Real GDG = -P3 * P3 * (GP / ((1.0_rt + GP) * (1.0_rt + GP)) + R * GQ / ((1.0_rt + GQ) * (1.0_rt + GQ))); // d G /d ln Gamma + Real UDG = UMIX * G + FMIX * GDG; // d u_mix /d ln Gamma + CVMIX = UMIX - UDG; + PDTMIX = PMIX - UDG / 3.0_rt; + PDRMIX = PMIX + UDG / 9.0_rt; + } } From a63dff56d6c236a7345f5c92abfa50bc61a6262d Mon Sep 17 00:00:00 2001 From: Max Katz Date: Mon, 18 Oct 2021 20:41:22 -0700 Subject: [PATCH 51/70] fharm12 to C++ --- EOS/pc/eos17.f90 | 42 +++++------------------------------ EOS/pc/eos_c.cpp | 57 ++++++++++++++++++++++++------------------------ 2 files changed, 35 insertions(+), 64 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index ad67cb6b09..720c6bd671 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -592,6 +592,12 @@ subroutine anharm8(GAMI,TPT,Fah,Uah,Pah,CVah,PDTah,PDRah) bind(C, name="anharm8" double precision, intent(in), value :: GAMI,TPT double precision :: Fah,Uah,Pah,CVah,PDTah,PDRah end subroutine anharm8 + subroutine fharm12(GAMI,TPT, & + Fharm,Uharm,Pharm,CVharm,Sharm,PDTharm,PDRharm) bind(C, name="fharm12") + implicit none + double precision, intent(in), value :: GAMI,TPT + double precision :: Fharm,Uharm,Pharm,CVharm,Sharm,PDTharm,PDRharm + end subroutine fharm12 end interface if (LIQSOL.ne.1.and.LIQSOL.ne.0) then @@ -850,39 +856,3 @@ subroutine FSCRliq8(RS,GAME,Zion, & PDRSCR=(12.*PSCR+X**2*FDXX+2.*X*GAME*FDXG+GAME**2*FDGG)/9. return end - -! ============== SUBROUTINES FOR THE SOLID STATE ================= ! - subroutine FHARM12(GAMI,TPT, & - Fharm,Uharm,Pharm,CVth,Sth,PDTharm,PDRharm) -! Thermodynamic functions of a harmonic crystal, incl.stat.Coul.lattice -! -! Version 27.04.12 -! Stems from FHARM8 v.15.02.08 -! Replaced HLfit8 with HLfit12: rearranged output. -! Input: GAMI - ionic Gamma, TPT=T_{p,i}/T -! Output: Fharm=F/(N_i T), Uharm=U/(N_i T), Pharm=P/(n_i T), -! CVth=C_V/N_i, Sharm=S/N_i -! PDTharm = Pharm + d Pharm / d ln T, PDRharm = Pharm + d Pharm/d ln\rho - implicit double precision (A-H), double precision (O-Z) - save - parameter(CM=.895929256d0) ! Madelung - interface - subroutine hlfit12(TPT,F,U,CVth,Sth,U1,CW,LATTICE) bind(C, name="hlfit12") - implicit none - double precision, intent(in), value :: TPT - integer, intent(in), value :: LATTICE - double precision :: F,U,CVth,Sth,U1,CW - end subroutine hlfit12 - end interface - call HLfit12(TPT,F,U,CVth,Sth,U1,CW,1) - U0=-CM*GAMI ! perfect lattice - E0=1.5d0*U1*TPT ! zero-point energy - Uth=U+E0 - Fth=F+E0 - Uharm=U0+Uth - Fharm=U0+Fth - Pharm=U0/3.d0+Uth/2.d0 - PDTharm=.5d0*CVth - PDRharm=U0/2.25d0+.75d0*Uth-.25d0*CVth - return - end diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 72f9c0bdca..bb1448dc95 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -1677,34 +1677,35 @@ extern "C" S = U - F; } - /* - subroutine FHARM12(GAMI,TPT, & - Fharm,Uharm,Pharm,CVth,Sth,PDTharm,PDRharm) -// Thermodynamic functions of a harmonic crystal, incl.stat.Coul.lattice -// -// Version 27.04.12 -// Stems from FHARM8 v.15.02.08 -// Replaced HLfit8 with HLfit12: rearranged output. -// Input: GAMI - ionic Gamma, TPT = T_{p,i}/T -// Output: Fharm = F/(N_i T), Uharm = U/(N_i T), Pharm = P/(n_i T), -// CVth = C_V/N_i, Sharm = S/N_i -// PDTharm = Pharm + d Pharm / d ln T, PDRharm = Pharm + d Pharm/d ln\rho - implicit double precision (A-H), double precision (O-Z) - save - parameter(CM = .895929256d0) // Madelung - call HLfit12(TPT,F,U,CVth,Sth,U1,CW,1) - U0 = -CM * GAMI // perfect lattice - E0 = 1.5d0 * U1 * TPT // zero-point energy - Uth = U + E0 - Fth = F + E0 - Uharm = U0 + Uth - Fharm = U0 + Fth - Pharm = U0 / 3.0_rt + Uth / 2.0_rt - PDTharm = 0.5_rt * CVth - PDRharm = U0 / 2.25d0 + .75d0 * Uth - .25d0 * CVth - return - end - */ + void fharm12(Real GAMI, Real TPT, + Real& Fharm, Real& Uharm, Real& Pharm, Real& CVth, + Real& Sth, Real& PDTharm, Real& PDRharm) + { + // Thermodynamic functions of a harmonic crystal, incl.stat.Coul.lattice + // + // Version 27.04.12 + // Stems from FHARM8 v.15.02.08 + // Replaced HLfit8 with HLfit12: rearranged output. + // Input: GAMI - ionic Gamma, TPT = T_{p,i}/T + // Output: Fharm = F/(N_i T), Uharm = U/(N_i T), Pharm = P/(n_i T), + // CVth = C_V/N_i, Sharm = S/N_i + // PDTharm = Pharm + d Pharm / d ln T, PDRharm = Pharm + d Pharm/d ln\rho + + const Real CM = 0.895929256_rt; // Madelung + + Real F, U, U1, CW; + hlfit12(TPT, F, U, CVth, Sth, U1, CW, 1); + + Real U0 = -CM * GAMI; // perfect lattice + Real E0 = 1.5_rt * U1 * TPT; // zero-point energy + Real Uth = U + E0; + Real Fth = F + E0; + Uharm = U0 + Uth; + Fharm = U0 + Fth; + Pharm = U0 / 3.0_rt + Uth / 2.0_rt; + PDTharm = 0.5_rt * CVth; + PDRharm = U0 / 2.25_rt + 0.75_rt * Uth - 0.25_rt * CVth; + } void cormix (Real RS, Real GAME, Real Zmean, Real Z2mean, Real Z52, Real Z53, Real Z321, Real& FMIX, Real& UMIX, Real& PMIX, Real& CVMIX, Real& PDTMIX, Real& PDRMIX) From c7af45962b5ca021a09620caf6b7a06b06ea87d0 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Mon, 18 Oct 2021 21:18:55 -0700 Subject: [PATCH 52/70] fscrliq8 to C++ --- EOS/pc/eos17.f90 | 136 +----------- EOS/pc/eos_c.cpp | 561 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 567 insertions(+), 130 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 720c6bd671..d0af170837 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -598,6 +598,12 @@ subroutine fharm12(GAMI,TPT, & double precision, intent(in), value :: GAMI,TPT double precision :: Fharm,Uharm,Pharm,CVharm,Sharm,PDTharm,PDRharm end subroutine fharm12 + subroutine fscrliq8(RS,GAME,Zion, & + FSCR,USCR,PSCR,CVSCR,PDTSCR,PDRSCR) bind(C, name="fscrliq8") + implicit none + double precision, value :: RS, GAME, Zion + double precision :: FSCR,USCR,PSCR,CVSCR,PDTSCR,PDRSCR + end subroutine fscrliq8 end interface if (LIQSOL.ne.1.and.LIQSOL.ne.0) then @@ -726,133 +732,3 @@ subroutine FITION9(GAMI,FION,UION,PION,CVii,PDTii,PDRii) PDTii=CVii/3. ! p_{ii} + d p_{ii} / d ln T return end - - subroutine FSCRliq8(RS,GAME,Zion, & - FSCR,USCR,PSCR,CVSCR,PDTSCR,PDRSCR) ! fit to the el.-ion scr. -! Version 11.09.08 -! cleaned 16.06.09 -! Stems from FSCRliq7 v. 09.06.07. Included a check for RS=0. -! INPUT: RS - density parameter, GAME - electron Coulomb parameter, -! Zion - ion charge number, -! OUTPUT: FSCR - screening (e-i) free energy per kT per 1 ion, -! USCR - internal energy per kT per 1 ion (screen.contrib.) -! PSCR - pressure divided by (n_i kT) (screen.contrib.) -! CVSCR - heat capacity per 1 ion (screen.contrib.) -! PDTSCR,PDRSCR = PSCR + d PSCR / d ln(T,\rho) - implicit double precision(A-H),double precision(O-Z) - save - parameter(XRS=.0140047,TINY=1.d-19) - if (RS.lt.0.) then - print *, 'FSCRliq8: RS < 0' - stop - end if - if (RS.lt.TINY) then - FSCR=0. - USCR=0. - PSCR=0. - CVSCR=0. - PDTSCR=0. - PDRSCR=0. - return - endif - SQG=sqrt(GAME) - SQR=sqrt(RS) - SQZ1=dsqrt(1.+Zion) - SQZ=dsqrt(Zion) - CDH0=Zion/1.73205 ! 1.73205=sqrt(3.) - CDH=CDH0*(SQZ1**3-SQZ**3-1.) - SQG=sqrt(GAME) - ZLN=dlog(Zion) - Z13=exp(ZLN/3.) ! Zion**(1./3.) - X=XRS/RS ! relativity parameter - CTF=Zion**2*.2513*(Z13-1.+.2/sqrt(Z13)) -! Thomas-Fermi constant; .2513=(18/175)(12/\pi)^{2/3} - P01=1.11*exp(.475*ZLN) - P03=0.2+0.078*ZLN**2 - PTX=1.16+.08*ZLN - TX=GAME**PTX - TXDG=PTX*TX/GAME - TXDGG=(PTX-1.)*TXDG/GAME - TY1=1./(1.d-3*Zion**2+2.*GAME) - TY1DG=-2.*TY1**2 - TY1DGG=-4.*TY1*TY1DG - TY2=1.+6.*RS**2 - TY2DX=-12.*RS**2/X - TY2DXX=-3.*TY2DX/X - TY=RS**3/TY2*(1.+TY1) - TYX=3./X+TY2DX/TY2 - TYDX=-TY*TYX - TYDG=RS**3*TY1DG/TY2 - P1=(Zion-1.)/9. - COR1=1.+P1*TY - COR1DX=P1*TYDX - COR1DG=P1*TYDG - COR1DXX=P1*(TY*(3./X**2+(TY2DX/TY2)**2-TY2DXX/TY2)-TYDX*TYX) - COR1DGG=P1*RS**3*TY1DGG/TY2 - COR1DXG=-P1*TYDG*TYX - U0=.78*sqrt(GAME/Zion)*RS**3 - U0DX=-3.*U0/X - U0DG=.5*U0/GAME - U0DXX=-4.*U0DX/X - U0DGG=-.5*U0DG/GAME - U0DXG=-3.*U0DG/X - D0DG=Zion**3 - D0=GAME*D0DG+21.*RS**3 - D0DX=-63.*RS**3/X - D0DXX=252.*RS**3/X**2 - COR0=1.+U0/D0 - COR0DX=(U0DX-U0*D0DX/D0)/D0 - COR0DG=(U0DG-U0*D0DG/D0)/D0 - COR0DXX=(U0DXX-(2.*U0DX*D0DX+U0*D0DXX)/D0+2.*(D0DX/D0)**2)/D0 - COR0DGG=(U0DGG-2.*U0DG*D0DG/D0+2.*U0*(D0DG/D0)**2)/D0 - COR0DXG=(U0DXG-(U0DX*D0DG+U0DG*D0DX)/D0+2.*U0*D0DX*D0DG/D0**2)/D0 -! Relativism: - RELE=dsqrt(1.d0+X**2) - Q1=.18/dsqrt(dsqrt(Zion)) - Q2=.2+.37/dsqrt(Zion) - H1U=1.+X**2/5. - H1D=1.+Q1*X+Q2*X**2 - H1=H1U/H1D - H1X=.4*X/H1U-(Q1+2.*Q2*X)/H1D - H1DX=H1*H1X - H1DXX=H1DX*H1X+ & - H1*(.4/H1U-(.4*X/H1U)**2-2.*Q2/H1D+((Q1+2.*Q2*X)/H1D)**2) - UP=CDH*SQG+P01*CTF*TX*COR0*H1 - UPDX=P01*CTF*TX*(COR0DX*H1+COR0*H1DX) - UPDG=.5*CDH/SQG+P01*CTF*(TXDG*COR0+TX*COR0DG)*H1 - UPDXX=P01*CTF*TX*(COR0DXX*H1+2.*COR0DX*H1DX+COR0*H1DXX) - UPDGG=-.25*CDH/(SQG*GAME)+ & - P01*CTF*(TXDGG*COR0+2.*TXDG*COR0DG+TX*COR0DGG)*H1 - UPDXG=P01*CTF*(TXDG*(COR0DX*H1+COR0*H1DX)+ & - TX*(COR0DXG*H1+COR0DG*H1DX)) - DN1=P03*SQG+P01/RS*TX*COR1 - DN1DX=P01*TX*(COR1/XRS+COR1DX/RS) - DN1DG=.5*P03/SQG+P01/RS*(TXDG*COR1+TX*COR1DG) - DN1DXX=P01*TX/XRS*(2.*COR1DX+X*COR1DXX) - DN1DGG=-.25*P03/(GAME*SQG)+ & - P01/RS*(TXDGG*COR1+2.*TXDG*COR1DG+TX*COR1DGG) - DN1DXG=P01*(TXDG*(COR1/XRS+COR1DX/RS)+TX*(COR1DG/XRS+COR1DXG/RS)) - DN=1.+DN1/RELE - DNDX=DN1DX/RELE-X*DN1/RELE**3 - DNDXX=(DN1DXX-((2.*X*DN1DX+DN1)-3.*X**2*DN1/RELE**2)/RELE**2)/RELE - DNDG=DN1DG/RELE - DNDGG=DN1DGG/RELE - DNDXG=DN1DXG/RELE-X*DN1DG/RELE**3 - FSCR=-UP/DN*GAME - FX=(UP*DNDX/DN-UPDX)/DN - FXDG=((UPDG*DNDX+UPDX*DNDG+UP*DNDXG-2.*UP*DNDX*DNDG/DN)/DN- & - UPDXG)/DN - FDX=FX*GAME - FG=(UP*DNDG/DN-UPDG)/DN - FDG=FG*GAME-UP/DN - FDGDH=SQG*DNDG/DN**2 ! d FDG / d CDH - FDXX=((UP*DNDXX+2.*(UPDX*DNDX-UP*DNDX**2/DN))/DN-UPDXX)/DN*GAME - FDGG=2.*FG+GAME*((2.*DNDG*(UPDG-UP*DNDG/DN)+UP*DNDGG)/DN-UPDGG)/DN - FDXG=FX+GAME*FXDG - USCR=GAME*FDG - CVSCR=-GAME**2*FDGG - PSCR=(X*FDX+GAME*FDG)/3. - PDTSCR=-GAME**2*(X*FXDG+FDGG)/3. - PDRSCR=(12.*PSCR+X**2*FDXX+2.*X*GAME*FDXG+GAME**2*FDGG)/9. - return - end diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index bb1448dc95..f40adbf704 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -1766,4 +1766,565 @@ extern "C" PDTMIX = PMIX - UDG / 3.0_rt; PDRMIX = PMIX + UDG / 9.0_rt; } + + void fscrliq8 (Real RS, Real GAME, Real Zion, + Real& FSCR, Real& USCR, Real& PSCR, + Real& CVSCR, Real& PDTSCR, Real& PDRSCR) + { + // fit to the el.-ion scr. + // Version 11.09.08 + // cleaned 16.06.09 + // Stems from FSCRliq7 v. 09.06.07. Included a check for RS=0. + // INPUT: RS - density parameter, GAME - electron Coulomb parameter, + // Zion - ion charge number, + // OUTPUT: FSCR - screening (e-i) free energy per kT per 1 ion, + // USCR - internal energy per kT per 1 ion (screen.contrib.) + // PSCR - pressure divided by (n_i kT) (screen.contrib.) + // CVSCR - heat capacity per 1 ion (screen.contrib.) + // PDTSCR,PDRSCR = PSCR + d PSCR / d ln(T,\rho) + + const Real XRS = 0.0140047_rt; + const Real TINY = 1.e-19_rt; + + if (RS < 0.0_rt) { + printf("FSCRliq8: RS < 0\n"); + exit(1); + } + + if (RS < TINY) { + FSCR = 0.0_rt; + USCR = 0.0_rt; + PSCR = 0.0_rt; + CVSCR = 0.0_rt; + PDTSCR = 0.0_rt; + PDRSCR = 0.0_rt; + return; + } + + Real SQG = std::sqrt(GAME); + Real SQR = std::sqrt(RS); + Real SQZ1 = std::sqrt(1.0_rt + Zion); + Real SQZ = std::sqrt(Zion); + Real CDH0 = Zion / 1.73205_rt; // 1.73205 = std::sqrt(3.0_rt) + Real CDH = CDH0 * (SQZ1 * SQZ1 * SQZ1 - SQZ * SQZ * SQZ - 1.0_rt); + Real ZLN = std::log(Zion); + Real Z13 = std::exp(ZLN / 3.0_rt); // Zion**(1.0_rt / 3.0_rt) + Real X = XRS / RS; // relativity parameter + Real CTF = Zion * Zion * 0.2513_rt * (Z13 - 1.0_rt + 0.2_rt / std::sqrt(Z13)); + // Thomas - Fermi constant; .2513 = (18 / 175)(12 / \pi)^{2 / 3} + Real P01 = 1.11_rt * std::exp(0.475_rt * ZLN); + Real P03 = 0.2_rt + 0.078_rt * ZLN * ZLN; + Real PTX = 1.16_rt + 0.08_rt * ZLN; + Real TX = std::pow(GAME, PTX); + Real TXDG = PTX * TX / GAME; + Real TXDGG = (PTX - 1.0_rt) * TXDG / GAME; + Real TY1 = 1.0_rt / (1.e-3_rt * Zion * Zion + 2.0_rt * GAME); + Real TY1DG = -2.0_rt * TY1 * TY1; + Real TY1DGG = -4.0_rt * TY1 * TY1DG; + Real TY2 = 1.0_rt + 6.0_rt * RS * RS; + Real TY2DX = -12.0_rt * RS * RS / X; + Real TY2DXX = -3.0_rt * TY2DX / X; + Real TY = RS * RS * RS / TY2 * (1.0_rt + TY1); + Real TYX = 3.0_rt / X + TY2DX / TY2; + Real TYDX = -TY * TYX; + Real TYDG = RS * RS * RS * TY1DG / TY2; + Real P1 = (Zion - 1.0_rt) / 9.0_rt; + Real COR1 = 1.0_rt + P1 * TY; + Real COR1DX = P1 * TYDX; + Real COR1DG = P1 * TYDG; + Real COR1DXX = P1 * (TY * (3.0_rt / (X * X) + (TY2DX / TY2) * (TY2DX / TY2) - TY2DXX / TY2) - TYDX * TYX); + Real COR1DGG = P1 * RS * RS * RS * TY1DGG / TY2; + Real COR1DXG = -P1 * TYDG * TYX; + Real U0 = 0.78_rt * std::sqrt(GAME / Zion) * RS * RS * RS; + Real U0DX = -3.0_rt * U0 / X; + Real U0DG = 0.5_rt * U0 / GAME; + Real U0DXX = -4.0_rt * U0DX / X; + Real U0DGG = -0.5_rt * U0DG / GAME; + Real U0DXG = -3.0_rt * U0DG / X; + Real D0DG = Zion * Zion * Zion; + Real D0 = GAME * D0DG + 21.0_rt * RS * RS * RS; + Real D0DX = -63.0_rt * RS * RS * RS / X; + Real D0DXX = 252.0_rt * RS * RS * RS / (X * X); + Real COR0 = 1.0_rt + U0 / D0; + Real COR0DX = (U0DX - U0 * D0DX / D0) / D0; + Real COR0DG = (U0DG - U0 * D0DG / D0) / D0; + Real COR0DXX = (U0DXX - (2.0_rt * U0DX * D0DX + U0 * D0DXX) / D0 + 2.0_rt * (D0DX / D0) * (D0DX / D0)) / D0; + Real COR0DGG = (U0DGG - 2.0_rt * U0DG * D0DG / D0 + 2.0_rt * U0 * (D0DG / D0) * (D0DG / D0)) / D0; + Real COR0DXG = (U0DXG - (U0DX * D0DG + U0DG * D0DX) / D0 + 2.0_rt * U0 * D0DX * D0DG / (D0 * D0)) / D0; + // Relativism: + Real RELE = std::sqrt(1.0_rt + X * X); + Real Q1 = 0.18_rt / std::sqrt(std::sqrt(Zion)); + Real Q2 = 0.2_rt + 0.37_rt / std::sqrt(Zion); + Real H1U = 1.0_rt + X * X / 5.0_rt; + Real H1D = 1.0_rt + Q1 * X + Q2 * X * X; + Real H1 = H1U / H1D; + Real H1X = 0.4_rt * X / H1U - (Q1 + 2.0_rt * Q2 * X) / H1D; + Real H1DX = H1 * H1X; + Real H1DXX = H1DX * H1X + + H1 * (0.4_rt / H1U - (0.4_rt * X / H1U) * (0.4_rt * X / H1U) - 2.0_rt * Q2 / H1D + + std::pow((Q1 + 2.0_rt * Q2 * X) / H1D, 2.0_rt)); + Real UP = CDH * SQG + P01 * CTF * TX * COR0 * H1; + Real UPDX = P01 * CTF * TX * (COR0DX * H1 + COR0 * H1DX); + Real UPDG = 0.5_rt * CDH / SQG + P01 * CTF * (TXDG * COR0 + TX * COR0DG) * H1; + Real UPDXX = P01 * CTF * TX * (COR0DXX * H1 + 2.0_rt * COR0DX * H1DX + COR0 * H1DXX); + Real UPDGG = -0.25_rt * CDH / (SQG * GAME) + + P01 * CTF * (TXDGG * COR0 + 2.0_rt * TXDG * COR0DG + TX * COR0DGG) * H1; + Real UPDXG = P01 * CTF * (TXDG * (COR0DX * H1 + COR0 * H1DX) + + TX * (COR0DXG * H1 + COR0DG * H1DX)); + Real DN1 = P03 * SQG + P01 / RS * TX * COR1; + Real DN1DX = P01 * TX * (COR1 / XRS + COR1DX / RS); + Real DN1DG = 0.5_rt * P03 / SQG + P01 / RS * (TXDG * COR1 + TX * COR1DG); + Real DN1DXX = P01 * TX / XRS * (2.0_rt * COR1DX + X * COR1DXX); + Real DN1DGG = -0.25_rt * P03 / (GAME * SQG) + + P01 / RS * (TXDGG * COR1 + 2.0_rt * TXDG * COR1DG + TX * COR1DGG); + Real DN1DXG = P01 * (TXDG * (COR1 / XRS + COR1DX / RS) + TX * (COR1DG / XRS + COR1DXG / RS)); + Real DN = 1.0_rt + DN1 / RELE; + Real DNDX = DN1DX / RELE - X * DN1 / (RELE * RELE * RELE); + Real DNDXX = (DN1DXX - ((2.0_rt * X * DN1DX + DN1) - 3.0_rt * X * X * DN1 / (RELE * RELE)) / (RELE * RELE)) / RELE; + Real DNDG = DN1DG / RELE; + Real DNDGG = DN1DGG / RELE; + Real DNDXG = DN1DXG / RELE - X * DN1DG / (RELE * RELE * RELE); + FSCR = -UP / DN * GAME; + Real FX = (UP * DNDX / DN - UPDX) / DN; + Real FXDG = ((UPDG * DNDX + UPDX * DNDG + UP * DNDXG - 2.0_rt * UP * DNDX * DNDG / DN) / DN - + UPDXG) / DN; + Real FDX = FX * GAME; + Real FG = (UP * DNDG / DN - UPDG) / DN; + Real FDG = FG * GAME - UP / DN; + Real FDGDH = SQG * DNDG / (DN * DN); // d FDG / d CDH + Real FDXX = ((UP * DNDXX + 2.0_rt * (UPDX * DNDX - UP * DNDX * DNDX / DN)) / DN - UPDXX) / DN * GAME; + Real FDGG = 2.0_rt * FG + GAME * ((2.0_rt * DNDG * (UPDG - UP * DNDG / DN) + UP * DNDGG) / DN - UPDGG) / DN; + Real FDXG = FX + GAME * FXDG; + USCR = GAME * FDG; + CVSCR = -GAME * GAME * FDGG; + PSCR = (X * FDX + GAME * FDG) / 3.0_rt; + PDTSCR = -GAME * GAME * (X * FXDG + FDGG) / 3.0_rt; + PDRSCR = (12.0_rt * PSCR + X * X * FDXX + 2.0_rt * X * GAME * FDXG + GAME * GAME * FDGG) / 9.0_rt; + } + + /* + subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, & + DENS,Zmean,CMImean,Z2mean,GAMImean,CHI,TPT,LIQSOL, & + PnkT,UNkT,SNk,CV,CHIR,CHIT) +// Version 18.04.20 +// Difference from v.10.12.14: included switch - off of WK correction +// Stems from MELANGE8 v.26.12.09. +// Difference: output PRADnkT instead of input KRAD +// + EOS of fully ionized electron - ion plasma mixture. +// Limitations: +// (a) inapplicable in the regimes of +// (1) bound - state formation, +// (2) quantum liquid, +// (3) presence of positrons; +// (b) for the case of a composition gradually depending on RHO or TEMP, +// second - order functions (CV,CHIR,CHIT in output) should not be trusted +// Choice of the liquid or solid regime - criterion GAMI [because the +// choice based on comparison of total (non - OCP) free energies can be +// sometimes dangerous because of the fit uncertainties ("Local field +// correction" in solid and quantum effects in liquid are unknown)]. +// Input: AY - their partial number densities, +// AZion and ACMI - their charge and mass numbers, +// RHO - total mass density [g / cc] +// TEMP - temperature [in a.u. = 2Ryd = 3.1577e5 K]. +// NB: instead of RHO, a true input is CHI, defined below +// Hence, disagreement between RHO and DENS is the fit error (<0.4%) +// Output: +// AY - rescaled so that to sum up to 1 and resorted (by AZion) +// AZion - resorted in ascending order +// ACMI - resorted in agreement with AZion +// DENS - electron number density [in a.u. = 6.7483346e24 cm^{ - 3}] +// Zmean = , CMImean = - mean ion charge and mass numbers, +// Z2mean = - mean - square ion charge number +// GAMImean - effective ion - ion Coulomb coupling constant +// CHI = mu_e / kT, where mu_e is the electron chem.potential +// TPT - effective ionic quantum parameter (T_p / T) +// LIQSOL = 0 / 1 for liquid / solid +// SNk - dimensionless entropy per 1 ion +// UNkT - internal energy per kT per ion +// PnkT - pressure / n_i kT, where n_i is the ion number density +// PRADnkT - radiative pressure / n_i kT +// CV - heat capacity per ion, div. by Boltzmann const. +// CHIR - inverse compressibility - (d ln P / d ln V)_T ("\chi_r") +// CHIT = (d ln P / d ln T)_V ("\chi_T") + //implicit double precision (A - H), double precision (O - Z) + implicit none + save + integer, parameter :: NMIX = 2 + + double precision, intent(in) :: RHO, TEMP + double precision, intent(in) :: AY(NMIX), AZion(NMIX), ACMI(NMIX) + double precision, intent(inout) :: DENS, Zmean, Z2mean, GAMImean + double precision, intent(inout) :: CHI, TPT + integer, intent(inout) :: LIQSOL + double precision, intent(inout) :: SNk, UnkT, PnkT, PRADnkT + double precision, intent(inout) :: CV, CHIR, CHIT + + double precision, parameter :: CWK = 1.0_rt // Turn on Wigner corrections + double precision, parameter :: TINY = 1.d - 7 + double precision, parameter :: PI = 3.141592653d0 + double precision, parameter :: C53 = 5.d0 / 3.d0 + double precision, parameter :: C13 = 1.0_rt / 3.d0 + double precision, parameter :: AUM = 1822.888d0 // a.m.u. / m_e + double precision, parameter :: GAMIMELT = 175. // OCP value of Gamma_i for melting + double precision, parameter :: RSIMELT = 140. // ion density parameter of quantum melting + double precision, parameter :: RAD = 2.554d - 7 // Radiation constant ( = 4\sigma / c) (in a.u.) + double precision :: Z52, Z53, Z73, Z321, CMImean, CMI + double precision :: Zion, Z13, X, X1, X2 + double precision :: UWK, UINTRAD, UMIX, UINTE, UINT, UEid, UC2,UC1 + double precision :: CHIRE, CHITE, CTP, CV1, CV2, CVE, CVMIX, CVtot + double precision :: DeltaG, DENSI, DNI, DTE, FC1, FC2, FEid, FMIX + double precision :: DlnDH, DlnDT, DlnDHH, DlnDHT, DlnDTT + double precision :: FWK, GAME, GAMI + integer :: i, ix, j + double precision :: PC1, PC2, PDLR, PDLT, PDR1, PDR2, PDRMIX + double precision :: PDT1, PDT2, PDTMIX, PEid, PMIX, PRESS, PRESSE + double precision :: PRESSI, PRESSRAD, PRI, RS, RSI, RZ, SC1, SC2 + double precision :: SEid, Stot, TPT2 + interface + subroutine chemfit(dens, temp, chi) bind(C, name = 'chemfit') + implicit none + double precision, intent(in), value :: dens, temp + double precision, intent(inout) :: chi + end subroutine chemfit + subroutine elect11(TEMP,CHI, & + DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & + DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) bind(C, name = "elect11") + implicit none + double precision, intent(in), value :: TEMP,CHI + double precision :: DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & + DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT + end subroutine elect11 + subroutine CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, & + FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) bind(C, name = "cormix") + implicit none + double precision, value :: RS,GAME,Zmean,Z2mean,Z52,Z53,Z321 + double precision :: FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX + end subroutine CORMIX + end interface + if (RHO.lt.1.e - 19.or.RHO.gt.1.e15) then + print * , 'MELANGE: RHO out of range' + stop + end if + // Calculation of average values: + Zmean = 0.0_rt + Z2mean = 0.0_rt + Z52 = 0.0_rt + Z53 = 0.0_rt + Z73 = 0.0_rt + Z321 = 0.0_rt // corr.26.12.09 + CMImean = 0.0_rt + do IX = 1,NMIX + Zmean = Zmean + AY(IX) * AZion(IX) + Z2mean = Z2mean + AY(IX) * AZion(IX) * AZion(IX) + Z13 = std::pow(AZion(IX), C13) + Z53 = Z53 + AY(IX) * std::pow(Z13, 5) + Z73 = Z73 + AY(IX) * std::pow(Z13, 7) + Z52 = Z52 + AY(IX) * std::pow(AZion(IX), 2.5_rt) + Z321 = Z321 + AY(IX) * AZion(IX) * std::pow(AZion(IX) + 1.0_rt, 1.5_rt) // 26.12.09 + CMImean = CMImean + AY(IX) * ACMI(IX) + enddo + // (0) Photons: + UINTRAD = RAD * TEMP * TEMP * TEMP * TEMP + PRESSRAD = UINTRAD / 3.0_rt + // (1) ideal electron gas (including relativity and degeneracy) + DENS = RHO / 11.20587 * Zmean / CMImean // number density of electrons [au] + call CHEMFIT(DENS,TEMP,CHI) + // NB: CHI can be used as true input instead of RHO or DENS + call ELECT11(TEMP,CHI, & + DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & + DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) + // NB: at this point DENS is redefined (the difference can be ~0.1%) + DTE = DENS * TEMP + PRESSE = PEid * DTE // P_e [a.u.] + UINTE = UEid * DTE // U_e / V [a.u.] + // (2) non - ideal Coulomb EIP + RS = std::pow(0.75_rt / PI / DENS, C13); // r_s - electron density parameter + RSI = RS * CMImean * Z73 * AUM // R_S - ion density parameter + GAME = 1.0_rt / RS / TEMP // electron Coulomb parameter Gamma_e + GAMImean = Z53 * GAME // effective Gamma_i - ion Coulomb parameter + if (GAMImean.lt.GAMIMELT.or.RSI.lt.RSIMELT) then + LIQSOL = 0 // liquid regime + else + LIQSOL = 1 // solid regime + endif + // Calculate partial thermodynamic quantities and combine them together: + UINT = UINTE + PRESS = PRESSE + CVtot = CVE * DENS + Stot = SEid * DENS + PDLT = PRESSE * CHITE // d P_e[a.u.] / d ln T + PDLR = PRESSE * CHIRE // d P_e[a.u.] / d ln\rho + DENSI = DENS / Zmean // number density of all ions + PRESSI = DENSI * TEMP // ideal - ions total pressure (normalization) + TPT2 = 0.0_rt + CTP = 4.d0 * PI / AUM / (TEMP * TEMP); // common coefficient for TPT2.10.12.14 + // Add Coulomb + xc nonideal contributions, and ideal free energy: + do IX = 1,NMIX + if (AY(IX).ge.TINY) then + Zion = AZion(IX) + CMI = ACMI(IX) + GAMI = std::pow(Zion, C53) * GAME // Gamma_i for given ion species + DNI = DENSI * AY(IX) // number density of ions of given type + PRI = DNI * TEMP // = ideal - ions partial pressure (normalization) + call EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, & + FC1,UC1,PC1,SC1,CV1,PDT1,PDR1, & + FC2,UC2,PC2,SC2,CV2,PDT2,PDR2) + // First - order TD functions: + UINT = UINT + UC2 * PRI // internal energy density (e + i + Coul.) + Stot = Stot + DNI * (SC2 - std::log(AY(IX))) //entropy per unit volume[a.u.] + PRESS = PRESS + PC2 * PRI // pressure (e + i + Coul.) [a.u.] + // Second - order functions (they take into account compositional changes): + CVtot = CVtot + DNI * CV2 // C_V (e + i + Coul.) / V (optim.10.12.14) + PDLT = PDLT + PRI * PDT2 // d P / d ln T + PDLR = PDLR + PRI * PDR2 // d P / d ln\rho + TPT2 = TPT2 + CTP * DNI / ACMI(IX) * AZion(IX) * AZion(IX) // opt.10.12.14 + end if + enddo // next IX + // Wigner - Kirkwood perturbative correction for liquid: + TPT = std::sqrt(TPT2) // effective T_p / T - ion quantum parameter + // (in the case of a mixture, this estimate is crude) + if (LIQSOL.eq.0) then + FWK = TPT2 / 24.d0 * CWK // Wigner - Kirkwood (quantum diffr.) term + if (FWK.gt..7.and.CWK.gt.0.0_rt) then + print * ,'MELANGE9: strong quantum effects in liquid//' + read( * ,'(A)') + endif + UWK = 2.d0 * FWK + UINT = UINT + UWK * PRESSI + Stot = Stot + FWK * DENSI // corrected 28.05.15 + PRESS = PRESS + FWK * PRESSI + CVtot = CVtot - UWK * DENSI // corrected 18.04.20 + PDLT = PDLT - FWK * PRESSI + PDLR = PDLR + UWK * PRESSI + endif + // Corrections to the linear mixing rule: + if (LIQSOL.eq.0) then // liquid phase + call CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, & + FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) + else // solid phase (only Madelung contribution) [22.12.12] + FMIX = 0.0_rt + do I = 1,NMIX + do J = I + 1,NMIX + RZ = AZion(J) / AZion(I) + X2 = AY(J) / (AY(I) + AY(J)) + X1 = dim(1.0_rt,X2) + if (X1.lt.TINY) then + cycle // 27.01.19 + end if + if (X2.lt.TINY) then + cycle + end if + X = X2 / RZ + (1.0_rt - 1.0_rt / RZ) * std::pow(X2, RZ) + GAMI = std::pow(AZion(I), C53) * GAME // Gamma_i corrected 14.05.13 + DeltaG = .012 * (1.0_rt - 1.0_rt / (RZ * RZ)) * (X1 + X2 * std::pow(RZ, C53)) + DeltaG = DeltaG * X / X2 * dim(1.0_rt,X) / X1 + FMIX = FMIX + AY(I) * AY(J) * GAMI * DeltaG + enddo + enddo + UMIX = FMIX + PMIX = FMIX / 3.d0 + CVMIX = 0.0_rt + PDTMIX = 0.0_rt + PDRMIX = FMIX / 2.25d0 + endif + UINT = UINT + UMIX * PRESSI + Stot = Stot + DENSI * (UMIX - FMIX) + PRESS = PRESS + PMIX * PRESSI + CVtot = CVtot + DENSI * CVMIX + PDLT = PDLT + PRESSI * PDTMIX + PDLR = PDLR + PRESSI * PDRMIX + // First - order: + PRADnkT = PRESSRAD / PRESSI // radiative pressure / n_i k T + PnkT = PRESS / PRESSI // P / n_i k T + UNkT = UINT / PRESSI // U / N_i k T + SNk = Stot / DENSI // S / N_i k + // Second - order: + CV = CVtot / DENSI // C_V per ion + CHIR = PDLR / PRESS // d ln P / d ln\rho + CHIT = PDLT / PRESS // d ln P / d ln T + return + end + + subroutine EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, & + FC1,UC1,PC1,SC1,CV1,PDT1,PDR1, & + FC2,UC2,PC2,SC2,CV2,PDT2,PDR2) +// Version 16.09.08 +// call FHARM8 has been replaced by call FHARM12 27.04.12 +// Wigner - Kirkwood correction excluded 20.05.13 +// slight cleaning 10.12.14 +// Non - ideal parts of thermodynamic functions in the fully ionized plasma +// Stems from EOSFI5 and EOSFI05 v.04.10.05 +// Input: LIQSOL = 0 / 1(liquid / solid), +// Zion,CMI - ion charge and mass numbers, +// RS = r_s (electronic density parameter), +// GAMI = Gamma_i (ion coupling), +// Output: FC1 and UC1 - non - ideal "ii + ie + ee" contribution to the +// free and internal energies (per ion per kT), +// PC1 - analogous contribution to pressure divided by (n_i kT), +// CV1 - "ii + ie + ee" heat capacity per ion [units of k] +// PDT1 = (1 / n_i kT) * (d P_C / d ln T)_V +// PDR1 = (1 / n_i kT) * (d P_C / d ln\rho)_T +// FC2,UC2,PC2,SC2,CV2 - analogous to FC1,UC1,PC1,SC1,CV1, but including +// the part corresponding to the ideal ion gas. This is useful for +// preventing accuracy loss in some cases (e.g., when SC2 << SC1). +// FC2 does not take into account the entropy of mixing S_{mix}: in a +// mixture, S_{mix} / (N_i k) has to be added externally (see MELANGE9). +// FC2 does not take into account the ion spin degeneracy either. +// When needed, the spin term must be added to the entropy externally. + implicit double precision (A - H), double precision (O - Z) + save + parameter(C53 = 5.d0 / 3.d0,C76 = 7.d0 / 6.d0) // TINY excl.10.12.14 + parameter (AUM = 1822.888d0) // a.m.u / m_e + interface + subroutine excor7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) bind(C, name = "excor7") + implicit none + double precision, intent(in), value :: RS, GAME + double precision :: FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC + end subroutine excor7 + subroutine fscrsol8(RS,GAMI,Zion,TPT, & + FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR) bind(C, name = "fscrsol8") + implicit none + double precision, intent(in), value :: RS, GAMI, Zion, TPT + double precision :: FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR + end subroutine fscrsol8 + subroutine anharm8(GAMI,TPT,Fah,Uah,Pah,CVah,PDTah,PDRah) bind(C, name = "anharm8") + implicit none + double precision, intent(in), value :: GAMI,TPT + double precision :: Fah,Uah,Pah,CVah,PDTah,PDRah + end subroutine anharm8 + subroutine fharm12(GAMI,TPT, & + Fharm,Uharm,Pharm,CVharm,Sharm,PDTharm,PDRharm) bind(C, name = "fharm12") + implicit none + double precision, intent(in), value :: GAMI,TPT + double precision :: Fharm,Uharm,Pharm,CVharm,Sharm,PDTharm,PDRharm + end subroutine fharm12 + end interface + + if (LIQSOL.ne.1.0_rtand.LIQSOL.ne.0) then + print * , 'EOSFI8: invalid LIQSOL' + stop + end if + if (CMI.le..1) then + print * , 'EOSFI8: too small CMI' + stop + end if + if (Zion.le..1) then + print * , 'EOSFI8: too small Zion' + stop + end if + if (RS.le..0) then + print * , 'EOSFI8: invalid RS' + stop + end if + if (GAMI.le..0) then + print * , 'EOSFI8: invalid GAMI' + stop + end if + GAME = GAMI / std::pow(Zion, C53); + call EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) // "ee"("xc") +// Calculate "ii" part: + COTPT = std::sqrt(3.d0 / AUM / CMI) / std::pow(Zion, C76); // auxiliary coefficient + TPT = GAMI / std::sqrt(RS) * COTPT // = T_p / T in the OCP + FidION = 1.5 * std::log(TPT * TPT / GAMI) - 1.323515 +// 1.3235 = 1 + 0.5 * ln(6 / pi); FidION = F_{id.ion gas} / (N_i kT), but without +// the term x_i ln x_i = - S_{mix} / (N_i k). + if (LIQSOL.eq.0) then // liquid + call FITION9(GAMI, & + FION,UION,PION,CVii,PDTii,PDRii) + FItot = FION + FidION + UItot = UION + 1.5 + PItot = PION + 1.0_rt + CVItot = CVii + 1.5d0 + SCItot = UItot - FItot + PDTi = PDTii + 1.0_rt + PDRi = PDRii + 1.0_rt + else // solid + call FHARM12(GAMI,TPT, & + Fharm,Uharm,Pharm,CVharm,Sharm,PDTharm,PDRharm) // harm."ii" + call ANHARM8(GAMI,TPT,Fah,Uah,Pah,CVah,PDTah,PDRah) // anharm. + FItot = Fharm + Fah + FION = FItot - FidION + UItot = Uharm + Uah + UION = UItot - 1.5d0 // minus 1.5 = ideal - gas, in order to get "ii" + PItot = Pharm + Pah + PION = PItot - 1.0_rt // minus 1 = ideal - gas + PDTi = PDTharm + PDTah + PDRi = PDRharm + PDRah + PDTii = PDTi - 1.0_rt // minus 1 = ideal - gas + PDRii = PDRi - 1.0_rt // minus 1 = ideal - gas + CVItot = CVharm + CVah + SCItot = Sharm + Uah - Fah + CVii = CVItot - 1.5d0 // minus 1.5 = ideal - gas + endif +// Calculate "ie" part: + if (LIQSOL.eq.1) then + call FSCRsol8(RS,GAMI,Zion,TPT, & + FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR) + else + call FSCRliq8(RS,GAME,Zion, & + FSCR,USCR,PSCR,CVSCR,PDTSCR,PDRSCR) + S_SCR = USCR - FSCR + endif +// Total excess quantities ("ii" + "ie" + "ee", per ion): + FC0 = FSCR + Zion * FXC + UC0 = USCR + Zion * UXC + PC0 = PSCR + Zion * PXC + SC0 = S_SCR + Zion * SXC + CV0 = CVSCR + Zion * CVXC + PDT0 = PDTSCR + Zion * PDTXC + PDR0 = PDRSCR + Zion * PDRXC + FC1 = FION + FC0 + UC1 = UION + UC0 + PC1 = PION + PC0 + SC1 = (UION - FION) + SC0 + CV1 = CVii + CV0 + PDT1 = PDTii + PDT0 + PDR1 = PDRii + PDR0 +// Total excess + ideal - ion quantities + FC2 = FItot + FC0 + UC2 = UItot + UC0 + PC2 = PItot + PC0 + SC2 = SCItot + SC0 + CV2 = CVItot + CV0 + PDT2 = PDTi + PDT0 + PDR2 = PDRi + PDR0 + return + end + +// = = = = = = = = = = = = = = = = = = ELECTRON - ION COULOMB LIQUID = = = = = = = = = = = = = = = = = = = // + subroutine FITION9(GAMI,FION,UION,PION,CVii,PDTii,PDRii) +// Version 11.09.08 +// Dummy argument Zion is deleted in 2009. +// Non - ideal contributions to thermodynamic functions of classical OCP. +// Stems from FITION00 v.24.05.00. +// Input: GAMI - ion coupling parameter +// Output: FION - ii free energy / N_i kT +// UION - ii internal energy / N_i kT +// PION - ii pressure / n_i kT +// CVii - ii heat capacity / N_i k +// PDTii = PION + d(PION) / d ln T = (1 / N_i kT) * (d P_{ii} / d ln T) +// PDRii = PION + d(PION) / d ln\rho +// Parameters adjusted to Caillol (1999). + implicit double precision (A - H),double precision (O - Z) + save + parameter (A1 = - .907347d0,A2 = .62849d0,C1 = .004500d0,G1 = 170.0, & + C2 = - 8.4d - 5,G2 = .0037,SQ32 = .8660254038d0) // SQ32 = std::sqrt(3) / 2 + A3 = - SQ32 - A1 / std::sqrt(A2) + F0 = A1 * (std::sqrt(GAMI * (A2 + GAMI)) - & + A2 * std::log(std::sqrt(GAMI / A2) + std::sqrt(1.0_rt + GAMI / A2))) + & + 2.0_rt * A3 * (std::sqrt(GAMI) - datan(std::sqrt(GAMI))) + U0 = std::pow(GAMI, 1.5_rt) * (A1 / std::sqrt(A2 + GAMI) + A3 / (1.0_rt + GAMI)) +// This is the zeroth approximation. Correction: + UION = U0 + C1 * GAMI * GAMI / (G1 + GAMI) + C2 * GAMI * GAMI / (G2 + GAMI * GAMI) + FION = F0 + C1 * (GAMI - G1 * std::log(1.0_rt + GAMI / G1)) + & + C2 / 2.0_rt * std::log(1.0_rt + GAMI * GAMI / G2) + CVii = - 0.5 * std::pow(GAMI, 1.5_rt) * (A1 * A2 / std::pow(A2 + GAMI, 1.5_rt) + & + A3 * (1.0_rt - GAMI) / (1.0_rt + GAMI) * (1.0_rt + GAMI)) - & + GAMI * GAMI * (C1 * G1 / (G1 + GAMI) * (G1 + GAMI) + C2 * (G2 - GAMI * GAMI) / ((G2 + GAMI * GAMI) * (G2 + GAMI * GAMI)); + PION = UION / 3.0_rt + PDRii = (4. * UION - CVii) / 9. // p_{ii} + d p_{ii} / d ln\rho + PDTii = CVii / 3.0_rt // p_{ii} + d p_{ii} / d ln T + return + end + */ } From 4472016a9b5c822b55d4e9054c621fda6083a5f2 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Mon, 18 Oct 2021 21:31:51 -0700 Subject: [PATCH 53/70] fition9 to C++ --- EOS/pc/eos17.f90 | 42 ++++---------------------- EOS/pc/eos_c.cpp | 78 ++++++++++++++++++++++++++---------------------- 2 files changed, 48 insertions(+), 72 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index d0af170837..0295ab5179 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -604,6 +604,12 @@ subroutine fscrliq8(RS,GAME,Zion, & double precision, value :: RS, GAME, Zion double precision :: FSCR,USCR,PSCR,CVSCR,PDTSCR,PDRSCR end subroutine fscrliq8 + subroutine fition9(GAMI, & + FION,UION,PION,CVii,PDTii,PDRii) bind(C, name="fition9") + implicit none + double precision, value :: GAMI + double precision :: FION,UION,PION,CVii,PDTii,PDRii + end subroutine fition9 end interface if (LIQSOL.ne.1.and.LIQSOL.ne.0) then @@ -696,39 +702,3 @@ end subroutine fscrliq8 PDR2=PDRi+PDR0 return end - -! ================== ELECTRON-ION COULOMB LIQUID =================== ! - subroutine FITION9(GAMI,FION,UION,PION,CVii,PDTii,PDRii) -! Version 11.09.08 -! Dummy argument Zion is deleted in 2009. -! Non-ideal contributions to thermodynamic functions of classical OCP. -! Stems from FITION00 v.24.05.00. -! Input: GAMI - ion coupling parameter -! Output: FION - ii free energy / N_i kT -! UION - ii internal energy / N_i kT -! PION - ii pressure / n_i kT -! CVii - ii heat capacity / N_i k -! PDTii = PION + d(PION)/d ln T = (1/N_i kT)*(d P_{ii}/d ln T) -! PDRii = PION + d(PION)/d ln\rho -! Parameters adjusted to Caillol (1999). - implicit double precision (A-H),double precision (O-Z) - save - parameter (A1=-.907347d0,A2=.62849d0,C1=.004500d0,G1=170.0, & - C2=-8.4d-5,G2=.0037,SQ32=.8660254038d0) ! SQ32=sqrt(3)/2 - A3=-SQ32-A1/dsqrt(A2) - F0=A1*(dsqrt(GAMI*(A2+GAMI))- & - A2*dlog(dsqrt(GAMI/A2)+dsqrt(1.+GAMI/A2)))+ & - 2.*A3*(dsqrt(GAMI)-datan(dsqrt(GAMI))) - U0=dsqrt(GAMI)**3*(A1/dsqrt(A2+GAMI)+A3/(1.d0+GAMI)) -! This is the zeroth approximation. Correction: - UION=U0+C1*GAMI**2/(G1+GAMI)+C2*GAMI**2/(G2+GAMI**2) - FION=F0+C1*(GAMI-G1*dlog(1.d0+GAMI/G1))+ & - C2/2.*dlog(1.d0+GAMI**2/G2) - CVii=-0.5*dsqrt(GAMI)**3*(A1*A2/dsqrt(A2+GAMI)**3+ & - A3*(1.d0-GAMI)/(1.d0+GAMI)**2) - & - GAMI**2*(C1*G1/(G1+GAMI)**2+C2*(G2-GAMI**2)/(G2+GAMI**2)**2) - PION=UION/3. - PDRii=(4.*UION-CVii)/9. ! p_{ii} + d p_{ii} / d ln\rho - PDTii=CVii/3. ! p_{ii} + d p_{ii} / d ln T - return - end diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index f40adbf704..b03f8b5842 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -1902,6 +1902,47 @@ extern "C" PDRSCR = (12.0_rt * PSCR + X * X * FDXX + 2.0_rt * X * GAME * FDXG + GAME * GAME * FDGG) / 9.0_rt; } + void fition9 (Real GAMI, Real& FION, Real& UION, Real& PION, + Real& CVii, Real& PDTii, Real& PDRii) + { + // Version 11.09.08 + // Dummy argument Zion is deleted in 2009. + // Non - ideal contributions to thermodynamic functions of classical OCP. + // Stems from FITION00 v.24.05.00. + // Input: GAMI - ion coupling parameter + // Output: FION - ii free energy / N_i kT + // UION - ii internal energy / N_i kT + // PION - ii pressure / n_i kT + // CVii - ii heat capacity / N_i k + // PDTii = PION + d(PION) / d ln T = (1 / N_i kT) * (d P_{ii} / d ln T) + // PDRii = PION + d(PION) / d ln\rho + // Parameters adjusted to Caillol (1999). + + const Real A1 = -0.907347_rt; + const Real A2 = 0.62849_rt; + const Real C1 = 0.004500_rt; + const Real G1 = 170.0_rt; + const Real C2 = -8.4e-5_rt; + const Real G2 = 0.0037_rt; + const Real SQ32 = 0.8660254038_rt; // SQ32 = sqrt(3) / 2 + Real A3 = -SQ32 - A1 / std::sqrt(A2); + Real F0 = A1 * (std::sqrt(GAMI * (A2 + GAMI)) - + A2 * std::log(std::sqrt(GAMI / A2) + std::sqrt(1.0_rt + GAMI / A2))) + + 2.0_rt * A3 * (std::sqrt(GAMI) - std::atan(std::sqrt(GAMI))); + Real U0 = std::pow(GAMI, 1.5_rt) * (A1 / std::sqrt(A2 + GAMI) + A3 / (1.0_rt + GAMI)); + // This is the zeroth approximation. Correction: + UION = U0 + C1 * GAMI * GAMI / (G1 + GAMI) + C2 * GAMI * GAMI / (G2 + GAMI * GAMI); + FION = F0 + C1 * (GAMI - G1 * std::log(1.0_rt + GAMI / G1)) + + C2 / 2.0_rt * std::log(1.0_rt + GAMI * GAMI / G2); + CVii = -0.5_rt * std::pow(GAMI, 1.5_rt) * (A1 * A2 / std::pow(A2 + GAMI, 1.5_rt) + + A3 * (1.0_rt - GAMI) / ((1.0_rt + GAMI) * (1.0_rt + GAMI))) - + GAMI * GAMI * (C1 * G1 / ((G1 + GAMI) * (G1 + GAMI)) + + C2 * (G2 - GAMI * GAMI) / ((G2 + GAMI * GAMI) * (G2 + GAMI * GAMI))); + PION = UION / 3.0_rt; + PDRii = (4.0_rt * UION - CVii) / 9.0_rt; // p_{ii} + d p_{ii} / d ln\rho + PDTii = CVii / 3.0_rt; // p_{ii} + d p_{ii} / d ln T + } + /* subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, & DENS,Zmean,CMImean,Z2mean,GAMImean,CHI,TPT,LIQSOL, & @@ -2290,41 +2331,6 @@ extern "C" PDR2 = PDRi + PDR0 return end +*/ -// = = = = = = = = = = = = = = = = = = ELECTRON - ION COULOMB LIQUID = = = = = = = = = = = = = = = = = = = // - subroutine FITION9(GAMI,FION,UION,PION,CVii,PDTii,PDRii) -// Version 11.09.08 -// Dummy argument Zion is deleted in 2009. -// Non - ideal contributions to thermodynamic functions of classical OCP. -// Stems from FITION00 v.24.05.00. -// Input: GAMI - ion coupling parameter -// Output: FION - ii free energy / N_i kT -// UION - ii internal energy / N_i kT -// PION - ii pressure / n_i kT -// CVii - ii heat capacity / N_i k -// PDTii = PION + d(PION) / d ln T = (1 / N_i kT) * (d P_{ii} / d ln T) -// PDRii = PION + d(PION) / d ln\rho -// Parameters adjusted to Caillol (1999). - implicit double precision (A - H),double precision (O - Z) - save - parameter (A1 = - .907347d0,A2 = .62849d0,C1 = .004500d0,G1 = 170.0, & - C2 = - 8.4d - 5,G2 = .0037,SQ32 = .8660254038d0) // SQ32 = std::sqrt(3) / 2 - A3 = - SQ32 - A1 / std::sqrt(A2) - F0 = A1 * (std::sqrt(GAMI * (A2 + GAMI)) - & - A2 * std::log(std::sqrt(GAMI / A2) + std::sqrt(1.0_rt + GAMI / A2))) + & - 2.0_rt * A3 * (std::sqrt(GAMI) - datan(std::sqrt(GAMI))) - U0 = std::pow(GAMI, 1.5_rt) * (A1 / std::sqrt(A2 + GAMI) + A3 / (1.0_rt + GAMI)) -// This is the zeroth approximation. Correction: - UION = U0 + C1 * GAMI * GAMI / (G1 + GAMI) + C2 * GAMI * GAMI / (G2 + GAMI * GAMI) - FION = F0 + C1 * (GAMI - G1 * std::log(1.0_rt + GAMI / G1)) + & - C2 / 2.0_rt * std::log(1.0_rt + GAMI * GAMI / G2) - CVii = - 0.5 * std::pow(GAMI, 1.5_rt) * (A1 * A2 / std::pow(A2 + GAMI, 1.5_rt) + & - A3 * (1.0_rt - GAMI) / (1.0_rt + GAMI) * (1.0_rt + GAMI)) - & - GAMI * GAMI * (C1 * G1 / (G1 + GAMI) * (G1 + GAMI) + C2 * (G2 - GAMI * GAMI) / ((G2 + GAMI * GAMI) * (G2 + GAMI * GAMI)); - PION = UION / 3.0_rt - PDRii = (4. * UION - CVii) / 9. // p_{ii} + d p_{ii} / d ln\rho - PDTii = CVii / 3.0_rt // p_{ii} + d p_{ii} / d ln T - return - end - */ } From 636e71bef1df787c9f322bf06d8d0d00cf134177 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Mon, 18 Oct 2021 21:54:34 -0700 Subject: [PATCH 54/70] eosfi8 to C++ --- EOS/pc/eos17.f90 | 167 ++------------------------ EOS/pc/eos_c.cpp | 305 +++++++++++++++++++++++------------------------ 2 files changed, 159 insertions(+), 313 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 0295ab5179..cf55c07611 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -400,6 +400,15 @@ subroutine CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, & double precision, value :: RS,GAME,Zmean,Z2mean,Z52,Z53,Z321 double precision :: FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX end subroutine CORMIX + subroutine EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, & + FC1,UC1,PC1,SC1,CV1,PDT1,PDR1, & + FC2,UC2,PC2,SC2,CV2,PDT2,PDR2) bind(C, name="eosfi8") + implicit none + integer, value :: LIQSOL + double precision, value :: CMI,Zion,RS,GAMI + double precision :: FC1,UC1,PC1,SC1,CV1,PDT1,PDR1, & + FC2,UC2,PC2,SC2,CV2,PDT2,PDR2 + end subroutine EOSFI8 end interface if (RHO.lt.1.e-19.or.RHO.gt.1.e15) then print *, 'MELANGE: RHO out of range' @@ -544,161 +553,3 @@ end subroutine CORMIX CHIT=PDLT/PRESS ! d ln P / d ln T return end - - subroutine EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, & - FC1,UC1,PC1,SC1,CV1,PDT1,PDR1, & - FC2,UC2,PC2,SC2,CV2,PDT2,PDR2) -! Version 16.09.08 -! call FHARM8 has been replaced by call FHARM12 27.04.12 -! Wigner-Kirkwood correction excluded 20.05.13 -! slight cleaning 10.12.14 -! Non-ideal parts of thermodynamic functions in the fully ionized plasma -! Stems from EOSFI5 and EOSFI05 v.04.10.05 -! Input: LIQSOL=0/1(liquid/solid), -! Zion,CMI - ion charge and mass numbers, -! RS=r_s (electronic density parameter), -! GAMI=Gamma_i (ion coupling), -! Output: FC1 and UC1 - non-ideal "ii+ie+ee" contribution to the -! free and internal energies (per ion per kT), -! PC1 - analogous contribution to pressure divided by (n_i kT), -! CV1 - "ii+ie+ee" heat capacity per ion [units of k] -! PDT1=(1/n_i kT)*(d P_C/d ln T)_V -! PDR1=(1/n_i kT)*(d P_C/d ln\rho)_T -! FC2,UC2,PC2,SC2,CV2 - analogous to FC1,UC1,PC1,SC1,CV1, but including -! the part corresponding to the ideal ion gas. This is useful for -! preventing accuracy loss in some cases (e.g., when SC2 << SC1). -! FC2 does not take into account the entropy of mixing S_{mix}: in a -! mixture, S_{mix}/(N_i k) has to be added externally (see MELANGE9). -! FC2 does not take into account the ion spin degeneracy either. -! When needed, the spin term must be added to the entropy externally. - implicit double precision (A-H), double precision (O-Z) - save - parameter(C53=5.d0/3.d0,C76=7.d0/6.d0) ! TINY excl.10.12.14 - parameter (AUM=1822.888d0) ! a.m.u/m_e - interface - subroutine excor7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) bind(C, name="excor7") - implicit none - double precision, intent(in), value :: RS, GAME - double precision :: FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC - end subroutine excor7 - subroutine fscrsol8(RS,GAMI,Zion,TPT, & - FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR) bind(C, name="fscrsol8") - implicit none - double precision, intent(in), value :: RS, GAMI, Zion, TPT - double precision :: FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR - end subroutine fscrsol8 - subroutine anharm8(GAMI,TPT,Fah,Uah,Pah,CVah,PDTah,PDRah) bind(C, name="anharm8") - implicit none - double precision, intent(in), value :: GAMI,TPT - double precision :: Fah,Uah,Pah,CVah,PDTah,PDRah - end subroutine anharm8 - subroutine fharm12(GAMI,TPT, & - Fharm,Uharm,Pharm,CVharm,Sharm,PDTharm,PDRharm) bind(C, name="fharm12") - implicit none - double precision, intent(in), value :: GAMI,TPT - double precision :: Fharm,Uharm,Pharm,CVharm,Sharm,PDTharm,PDRharm - end subroutine fharm12 - subroutine fscrliq8(RS,GAME,Zion, & - FSCR,USCR,PSCR,CVSCR,PDTSCR,PDRSCR) bind(C, name="fscrliq8") - implicit none - double precision, value :: RS, GAME, Zion - double precision :: FSCR,USCR,PSCR,CVSCR,PDTSCR,PDRSCR - end subroutine fscrliq8 - subroutine fition9(GAMI, & - FION,UION,PION,CVii,PDTii,PDRii) bind(C, name="fition9") - implicit none - double precision, value :: GAMI - double precision :: FION,UION,PION,CVii,PDTii,PDRii - end subroutine fition9 - end interface - - if (LIQSOL.ne.1.and.LIQSOL.ne.0) then - print *, 'EOSFI8: invalid LIQSOL' - stop - end if - if (CMI.le..1) then - print *, 'EOSFI8: too small CMI' - stop - end if - if (Zion.le..1) then - print *, 'EOSFI8: too small Zion' - stop - end if - if (RS.le..0) then - print *, 'EOSFI8: invalid RS' - stop - end if - if (GAMI.le..0) then - print *, 'EOSFI8: invalid GAMI' - stop - end if - GAME=GAMI/Zion**C53 - call EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) ! "ee"("xc") -! Calculate "ii" part: - COTPT=dsqrt(3.d0/AUM/CMI)/Zion**C76 ! auxiliary coefficient - TPT=GAMI/dsqrt(RS)*COTPT ! = T_p/T in the OCP - FidION=1.5*dlog(TPT**2/GAMI)-1.323515 -! 1.3235=1+0.5*ln(6/pi); FidION = F_{id.ion gas}/(N_i kT), but without -! the term x_i ln x_i = -S_{mix}/(N_i k). - if (LIQSOL.eq.0) then ! liquid - call FITION9(GAMI, & - FION,UION,PION,CVii,PDTii,PDRii) - FItot=FION+FidION - UItot=UION+1.5 - PItot=PION+1.d0 - CVItot=CVii+1.5d0 - SCItot=UItot-FItot - PDTi=PDTii+1.d0 - PDRi=PDRii+1.d0 - else ! solid - call FHARM12(GAMI,TPT, & - Fharm,Uharm,Pharm,CVharm,Sharm,PDTharm,PDRharm) ! harm."ii" - call ANHARM8(GAMI,TPT,Fah,Uah,Pah,CVah,PDTah,PDRah) ! anharm. - FItot=Fharm+Fah - FION=FItot-FidION - UItot=Uharm+Uah - UION=UItot-1.5d0 ! minus 1.5=ideal-gas, in order to get "ii" - PItot=Pharm+Pah - PION=PItot-1.d0 ! minus 1=ideal-gas - PDTi=PDTharm+PDTah - PDRi=PDRharm+PDRah - PDTii=PDTi-1.d0 ! minus 1=ideal-gas - PDRii=PDRi-1.d0 ! minus 1=ideal-gas - CVItot=CVharm+CVah - SCItot=Sharm+Uah-Fah - CVii=CVItot-1.5d0 ! minus 1.5=ideal-gas - endif -! Calculate "ie" part: - if (LIQSOL.eq.1) then - call FSCRsol8(RS,GAMI,Zion,TPT, & - FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR) - else - call FSCRliq8(RS,GAME,Zion, & - FSCR,USCR,PSCR,CVSCR,PDTSCR,PDRSCR) - S_SCR=USCR-FSCR - endif -! Total excess quantities ("ii"+"ie"+"ee", per ion): - FC0=FSCR+Zion*FXC - UC0=USCR+Zion*UXC - PC0=PSCR+Zion*PXC - SC0=S_SCR+Zion*SXC - CV0=CVSCR+Zion*CVXC - PDT0=PDTSCR+Zion*PDTXC - PDR0=PDRSCR+Zion*PDRXC - FC1=FION+FC0 - UC1=UION+UC0 - PC1=PION+PC0 - SC1=(UION-FION)+SC0 - CV1=CVii+CV0 - PDT1=PDTii+PDT0 - PDR1=PDRii+PDR0 -! Total excess + ideal-ion quantities - FC2=FItot+FC0 - UC2=UItot+UC0 - PC2=PItot+PC0 - SC2=SCItot+SC0 - CV2=CVItot+CV0 - PDT2=PDTi+PDT0 - PDR2=PDRi+PDR0 - return - end diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index b03f8b5842..fb5a369b0a 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -1943,6 +1943,147 @@ extern "C" PDTii = CVii / 3.0_rt; // p_{ii} + d p_{ii} / d ln T } + void eosfi8(int LIQSOL, Real CMI, Real Zion, Real RS, Real GAMI, + Real& FC1, Real& UC1, Real& PC1, Real& SC1, Real& CV1, + Real& PDT1, Real& PDR1, Real& FC2, Real& UC2, Real& PC2, + Real& SC2, Real& CV2, Real& PDT2, Real& PDR2) + { + // Version 16.09.08 + // call FHARM8 has been replaced by call FHARM12 27.04.12 + // Wigner - Kirkwood correction excluded 20.05.13 + // slight cleaning 10.12.14 + // Non - ideal parts of thermodynamic functions in the fully ionized plasma + // Stems from EOSFI5 and EOSFI05 v.04.10.05 + // Input: LIQSOL = 0 / 1(liquid / solid), + // Zion,CMI - ion charge and mass numbers, + // RS = r_s (electronic density parameter), + // GAMI = Gamma_i (ion coupling), + // Output: FC1 and UC1 - non - ideal "ii + ie + ee" contribution to the + // free and internal energies (per ion per kT), + // PC1 - analogous contribution to pressure divided by (n_i kT), + // CV1 - "ii + ie + ee" heat capacity per ion [units of k] + // PDT1 = (1 / n_i kT) * (d P_C / d ln T)_V + // PDR1 = (1 / n_i kT) * (d P_C / d ln\rho)_T + // FC2,UC2,PC2,SC2,CV2 - analogous to FC1,UC1,PC1,SC1,CV1, but including + // the part corresponding to the ideal ion gas. This is useful for + // preventing accuracy loss in some cases (e.g., when SC2 << SC1). + // FC2 does not take into account the entropy of mixing S_{mix}: in a + // mixture, S_{mix} / (N_i k) has to be added externally (see MELANGE9). + // FC2 does not take into account the ion spin degeneracy either. + // When needed, the spin term must be added to the entropy externally. + + const Real C53 = 5.0_rt / 3.0_rt; + const Real C76 = 7.0_rt / 6.0_rt; // TINY excl.10.12.14 + const Real AUM = 1822.888_rt; // a.m.u / m_e + + if (LIQSOL != 1 && LIQSOL != 0) { + printf("EOSFI8: invalid LIQSOL\n"); + exit(1); + } + if (CMI <= 0.1_rt) { + printf("EOSFI8: too small CMI\n"); + exit(1); + } + if (Zion <= 0.1_rt) { + printf("EOSFI8: too small Zion\n"); + exit(1); + } + if (RS <= 0.0_rt) { + printf("EOSFI8: invalid RS\n"); + exit(1); + } + if (GAMI <= 0.0_rt) { + printf("EOSFI8: invalid GAMI\n"); + exit(1); + } + + Real GAME = GAMI / std::pow(Zion, C53); + Real FXC, UXC, PXC, CVXC, SXC, PDTXC, PDRXC; + excor7(RS, GAME, FXC, UXC, PXC, CVXC, SXC, PDTXC, PDRXC); // "ee"("xc") + + // Calculate "ii" part: + Real COTPT = std::sqrt(3.0_rt / AUM / CMI) / std::pow(Zion, C76); // auxiliary coefficient + Real TPT = GAMI / std::sqrt(RS) * COTPT; // = T_p / T in the OCP + Real FidION = 1.5_rt * std::log(TPT * TPT / GAMI) - 1.323515_rt; + // 1.3235 = 1 + 0.5 * ln(6 / pi); FidION = F_{id.ion gas} / (N_i kT), but without + // the term x_i ln x_i = - S_{mix} / (N_i k). + + Real FItot, UItot, PItot, CVItot, SCItot, PDTi, PDRi; + Real FION, UION, PION, CVii, PDTii, PDRii; + + if (LIQSOL == 0) { // liquid + fition9(GAMI, FION, UION, PION, CVii, PDTii, PDRii); + FItot = FION + FidION; + UItot = UION + 1.5_rt; + PItot = PION + 1.0_rt; + CVItot = CVii + 1.5_rt; + SCItot = UItot - FItot; + PDTi = PDTii + 1.0_rt; + PDRi = PDRii + 1.0_rt; + } + else { // solid + Real Fharm, Uharm, Pharm, CVharm, Sharm, PDTharm, PDRharm; + fharm12(GAMI, TPT, Fharm, Uharm, Pharm, + CVharm, Sharm, PDTharm, PDRharm); // harm."ii" + + Real Fah, Uah, Pah, CVah, PDTah, PDRah; + anharm8(GAMI, TPT, Fah, Uah, Pah, CVah, PDTah, PDRah); // anharm. + + FItot = Fharm + Fah; + FION = FItot - FidION; + UItot = Uharm + Uah; + UION = UItot - 1.5_rt; // minus 1.5 = ideal - gas, in order to get "ii" + PItot = Pharm + Pah; + PION = PItot - 1.0_rt; // minus 1 = ideal - gas + PDTi = PDTharm + PDTah; + PDRi = PDRharm + PDRah; + PDTii = PDTi - 1.0_rt; // minus 1 = ideal - gas + PDRii = PDRi - 1.0_rt; // minus 1 = ideal - gas + CVItot = CVharm + CVah; + SCItot = Sharm + Uah - Fah; + CVii = CVItot - 1.5_rt; // minus 1.5 = ideal - gas + } + + // Calculate "ie" part: + + Real FSCR, USCR, PSCR, S_SCR, CVSCR, PDTSCR, PDRSCR; + if (LIQSOL == 1) { + fscrsol8(RS, GAMI, Zion, TPT, + FSCR, USCR, PSCR, S_SCR, CVSCR, PDTSCR, PDRSCR); + } + else { + fscrliq8(RS, GAME, Zion, + FSCR, USCR, PSCR, CVSCR, PDTSCR, PDRSCR); + S_SCR = USCR - FSCR; + } + + // Total excess quantities ("ii" + "ie" + "ee", per ion): + Real FC0 = FSCR + Zion * FXC; + Real UC0 = USCR + Zion * UXC; + Real PC0 = PSCR + Zion * PXC; + Real SC0 = S_SCR + Zion * SXC; + Real CV0 = CVSCR + Zion * CVXC; + Real PDT0 = PDTSCR + Zion * PDTXC; + Real PDR0 = PDRSCR + Zion * PDRXC; + + FC1 = FION + FC0; + UC1 = UION + UC0; + PC1 = PION + PC0; + SC1 = (UION - FION) + SC0; + CV1 = CVii + CV0; + PDT1 = PDTii + PDT0; + PDR1 = PDRii + PDR0; + + // Total excess + ideal - ion quantities + FC2 = FItot + FC0; + UC2 = UItot + UC0; + PC2 = PItot + PC0; + SC2 = SCItot + SC0; + CV2 = CVItot + CV0; + PDT2 = PDTi + PDT0; + PDR2 = PDRi + PDR0; + } + /* subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, & DENS,Zmean,CMImean,Z2mean,GAMImean,CHI,TPT,LIQSOL, & @@ -2002,10 +2143,10 @@ extern "C" double precision, parameter :: CWK = 1.0_rt // Turn on Wigner corrections double precision, parameter :: TINY = 1.d - 7 - double precision, parameter :: PI = 3.141592653d0 - double precision, parameter :: C53 = 5.d0 / 3.d0 - double precision, parameter :: C13 = 1.0_rt / 3.d0 - double precision, parameter :: AUM = 1822.888d0 // a.m.u. / m_e + double precision, parameter :: PI = 3.141592653_rt + double precision, parameter :: C53 = 5.0_rt / 3.0_rt + double precision, parameter :: C13 = 1.0_rt / 3.0_rt + double precision, parameter :: AUM = 1822.888_rt // a.m.u. / m_e double precision, parameter :: GAMIMELT = 175. // OCP value of Gamma_i for melting double precision, parameter :: RSIMELT = 140. // ion density parameter of quantum melting double precision, parameter :: RAD = 2.554d - 7 // Radiation constant ( = 4\sigma / c) (in a.u.) @@ -2098,7 +2239,7 @@ extern "C" DENSI = DENS / Zmean // number density of all ions PRESSI = DENSI * TEMP // ideal - ions total pressure (normalization) TPT2 = 0.0_rt - CTP = 4.d0 * PI / AUM / (TEMP * TEMP); // common coefficient for TPT2.10.12.14 + CTP = 4.0_rt * PI / AUM / (TEMP * TEMP); // common coefficient for TPT2.10.12.14 // Add Coulomb + xc nonideal contributions, and ideal free energy: do IX = 1,NMIX if (AY(IX).ge.TINY) then @@ -2125,12 +2266,12 @@ extern "C" TPT = std::sqrt(TPT2) // effective T_p / T - ion quantum parameter // (in the case of a mixture, this estimate is crude) if (LIQSOL.eq.0) then - FWK = TPT2 / 24.d0 * CWK // Wigner - Kirkwood (quantum diffr.) term + FWK = TPT2 / 24.0_rt * CWK // Wigner - Kirkwood (quantum diffr.) term if (FWK.gt..7.and.CWK.gt.0.0_rt) then print * ,'MELANGE9: strong quantum effects in liquid//' read( * ,'(A)') endif - UWK = 2.d0 * FWK + UWK = 2.0_rt * FWK UINT = UINT + UWK * PRESSI Stot = Stot + FWK * DENSI // corrected 28.05.15 PRESS = PRESS + FWK * PRESSI @@ -2163,10 +2304,10 @@ extern "C" enddo enddo UMIX = FMIX - PMIX = FMIX / 3.d0 + PMIX = FMIX / 3.0_rt CVMIX = 0.0_rt PDTMIX = 0.0_rt - PDRMIX = FMIX / 2.25d0 + PDRMIX = FMIX / 2.25_rt endif UINT = UINT + UMIX * PRESSI Stot = Stot + DENSI * (UMIX - FMIX) @@ -2185,152 +2326,6 @@ extern "C" CHIT = PDLT / PRESS // d ln P / d ln T return end - - subroutine EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, & - FC1,UC1,PC1,SC1,CV1,PDT1,PDR1, & - FC2,UC2,PC2,SC2,CV2,PDT2,PDR2) -// Version 16.09.08 -// call FHARM8 has been replaced by call FHARM12 27.04.12 -// Wigner - Kirkwood correction excluded 20.05.13 -// slight cleaning 10.12.14 -// Non - ideal parts of thermodynamic functions in the fully ionized plasma -// Stems from EOSFI5 and EOSFI05 v.04.10.05 -// Input: LIQSOL = 0 / 1(liquid / solid), -// Zion,CMI - ion charge and mass numbers, -// RS = r_s (electronic density parameter), -// GAMI = Gamma_i (ion coupling), -// Output: FC1 and UC1 - non - ideal "ii + ie + ee" contribution to the -// free and internal energies (per ion per kT), -// PC1 - analogous contribution to pressure divided by (n_i kT), -// CV1 - "ii + ie + ee" heat capacity per ion [units of k] -// PDT1 = (1 / n_i kT) * (d P_C / d ln T)_V -// PDR1 = (1 / n_i kT) * (d P_C / d ln\rho)_T -// FC2,UC2,PC2,SC2,CV2 - analogous to FC1,UC1,PC1,SC1,CV1, but including -// the part corresponding to the ideal ion gas. This is useful for -// preventing accuracy loss in some cases (e.g., when SC2 << SC1). -// FC2 does not take into account the entropy of mixing S_{mix}: in a -// mixture, S_{mix} / (N_i k) has to be added externally (see MELANGE9). -// FC2 does not take into account the ion spin degeneracy either. -// When needed, the spin term must be added to the entropy externally. - implicit double precision (A - H), double precision (O - Z) - save - parameter(C53 = 5.d0 / 3.d0,C76 = 7.d0 / 6.d0) // TINY excl.10.12.14 - parameter (AUM = 1822.888d0) // a.m.u / m_e - interface - subroutine excor7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) bind(C, name = "excor7") - implicit none - double precision, intent(in), value :: RS, GAME - double precision :: FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC - end subroutine excor7 - subroutine fscrsol8(RS,GAMI,Zion,TPT, & - FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR) bind(C, name = "fscrsol8") - implicit none - double precision, intent(in), value :: RS, GAMI, Zion, TPT - double precision :: FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR - end subroutine fscrsol8 - subroutine anharm8(GAMI,TPT,Fah,Uah,Pah,CVah,PDTah,PDRah) bind(C, name = "anharm8") - implicit none - double precision, intent(in), value :: GAMI,TPT - double precision :: Fah,Uah,Pah,CVah,PDTah,PDRah - end subroutine anharm8 - subroutine fharm12(GAMI,TPT, & - Fharm,Uharm,Pharm,CVharm,Sharm,PDTharm,PDRharm) bind(C, name = "fharm12") - implicit none - double precision, intent(in), value :: GAMI,TPT - double precision :: Fharm,Uharm,Pharm,CVharm,Sharm,PDTharm,PDRharm - end subroutine fharm12 - end interface - - if (LIQSOL.ne.1.0_rtand.LIQSOL.ne.0) then - print * , 'EOSFI8: invalid LIQSOL' - stop - end if - if (CMI.le..1) then - print * , 'EOSFI8: too small CMI' - stop - end if - if (Zion.le..1) then - print * , 'EOSFI8: too small Zion' - stop - end if - if (RS.le..0) then - print * , 'EOSFI8: invalid RS' - stop - end if - if (GAMI.le..0) then - print * , 'EOSFI8: invalid GAMI' - stop - end if - GAME = GAMI / std::pow(Zion, C53); - call EXCOR7(RS,GAME,FXC,UXC,PXC,CVXC,SXC,PDTXC,PDRXC) // "ee"("xc") -// Calculate "ii" part: - COTPT = std::sqrt(3.d0 / AUM / CMI) / std::pow(Zion, C76); // auxiliary coefficient - TPT = GAMI / std::sqrt(RS) * COTPT // = T_p / T in the OCP - FidION = 1.5 * std::log(TPT * TPT / GAMI) - 1.323515 -// 1.3235 = 1 + 0.5 * ln(6 / pi); FidION = F_{id.ion gas} / (N_i kT), but without -// the term x_i ln x_i = - S_{mix} / (N_i k). - if (LIQSOL.eq.0) then // liquid - call FITION9(GAMI, & - FION,UION,PION,CVii,PDTii,PDRii) - FItot = FION + FidION - UItot = UION + 1.5 - PItot = PION + 1.0_rt - CVItot = CVii + 1.5d0 - SCItot = UItot - FItot - PDTi = PDTii + 1.0_rt - PDRi = PDRii + 1.0_rt - else // solid - call FHARM12(GAMI,TPT, & - Fharm,Uharm,Pharm,CVharm,Sharm,PDTharm,PDRharm) // harm."ii" - call ANHARM8(GAMI,TPT,Fah,Uah,Pah,CVah,PDTah,PDRah) // anharm. - FItot = Fharm + Fah - FION = FItot - FidION - UItot = Uharm + Uah - UION = UItot - 1.5d0 // minus 1.5 = ideal - gas, in order to get "ii" - PItot = Pharm + Pah - PION = PItot - 1.0_rt // minus 1 = ideal - gas - PDTi = PDTharm + PDTah - PDRi = PDRharm + PDRah - PDTii = PDTi - 1.0_rt // minus 1 = ideal - gas - PDRii = PDRi - 1.0_rt // minus 1 = ideal - gas - CVItot = CVharm + CVah - SCItot = Sharm + Uah - Fah - CVii = CVItot - 1.5d0 // minus 1.5 = ideal - gas - endif -// Calculate "ie" part: - if (LIQSOL.eq.1) then - call FSCRsol8(RS,GAMI,Zion,TPT, & - FSCR,USCR,PSCR,S_SCR,CVSCR,PDTSCR,PDRSCR) - else - call FSCRliq8(RS,GAME,Zion, & - FSCR,USCR,PSCR,CVSCR,PDTSCR,PDRSCR) - S_SCR = USCR - FSCR - endif -// Total excess quantities ("ii" + "ie" + "ee", per ion): - FC0 = FSCR + Zion * FXC - UC0 = USCR + Zion * UXC - PC0 = PSCR + Zion * PXC - SC0 = S_SCR + Zion * SXC - CV0 = CVSCR + Zion * CVXC - PDT0 = PDTSCR + Zion * PDTXC - PDR0 = PDRSCR + Zion * PDRXC - FC1 = FION + FC0 - UC1 = UION + UC0 - PC1 = PION + PC0 - SC1 = (UION - FION) + SC0 - CV1 = CVii + CV0 - PDT1 = PDTii + PDT0 - PDR1 = PDRii + PDR0 -// Total excess + ideal - ion quantities - FC2 = FItot + FC0 - UC2 = UItot + UC0 - PC2 = PItot + PC0 - SC2 = SCItot + SC0 - CV2 = CVItot + CV0 - PDT2 = PDTi + PDT0 - PDR2 = PDRi + PDR0 - return - end */ } From ae487ed47e5291ca79d5626082edc59c8539d210 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Mon, 18 Oct 2021 22:43:14 -0700 Subject: [PATCH 55/70] melange9 to C++ --- EOS/pc/eos17.f90 | 266 ++------------------------- EOS/pc/eos_c.cpp | 466 +++++++++++++++++++++++------------------------ 2 files changed, 238 insertions(+), 494 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index cf55c07611..23467f7e9d 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -118,6 +118,21 @@ program main integer :: LIQSOL double precision :: x, diff, max_diff, T_arr(3), rho_arr(2) integer :: i, j + interface + subroutine melange9(AY,AZion,ACMI,RHO,TEMP, & ! input + PRADnkT, & ! additional output - radiative pressure + DENS,Zmean,CMImean,Z2mean,GAMI,CHI,TPT,LIQSOL, & ! output param. + PnkT,UNkT,SNk,CV,CHIR,CHIT) bind(C, name="melange9") + implicit none + double precision :: AY(2), AZion(2), ACMI(2) + double precision, value :: RHO,TEMP ! input + double precision :: PRADnkT, & ! additional output - radiative pressure + DENS,Zmean,CMImean,Z2mean,GAMI,CHI,TPT, & ! output param. + PnkT,UNkT,SNk,CV,CHIR,CHIT + integer :: LIQSOL + end subroutine melange9 + end interface + AZion(1) = 6.0d0 AZion(2) = 8.0d0 ACMI(1) = 12.0d0 @@ -302,254 +317,3 @@ program main print *, "max diff = ", max_diff end program main - - subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, & - DENS,Zmean,CMImean,Z2mean,GAMImean,CHI,TPT,LIQSOL, & - PnkT,UNkT,SNk,CV,CHIR,CHIT) -! Version 18.04.20 -! Difference from v.10.12.14: included switch-off of WK correction -! Stems from MELANGE8 v.26.12.09. -! Difference: output PRADnkT instead of input KRAD -! + EOS of fully ionized electron-ion plasma mixture. -! Limitations: -! (a) inapplicable in the regimes of -! (1) bound-state formation, -! (2) quantum liquid, -! (3) presence of positrons; -! (b) for the case of a composition gradually depending on RHO or TEMP, -! second-order functions (CV,CHIR,CHIT in output) should not be trusted -! Choice of the liquid or solid regime - criterion GAMI [because the -! choice based on comparison of total (non-OCP) free energies can be -! sometimes dangerous because of the fit uncertainties ("Local field -! correction" in solid and quantum effects in liquid are unknown)]. -! Input: AY - their partial number densities, -! AZion and ACMI - their charge and mass numbers, -! RHO - total mass density [g/cc] -! TEMP - temperature [in a.u.=2Ryd=3.1577e5 K]. -! NB: instead of RHO, a true input is CHI, defined below -! Hence, disagreement between RHO and DENS is the fit error (<0.4%) -! Output: -! AY - rescaled so that to sum up to 1 and resorted (by AZion) -! AZion - resorted in ascending order -! ACMI - resorted in agreement with AZion -! DENS - electron number density [in a.u.=6.7483346e24 cm^{-3}] -! Zmean=, CMImean= - mean ion charge and mass numbers, -! Z2mean= - mean-square ion charge number -! GAMImean - effective ion-ion Coulomb coupling constant -! CHI = mu_e/kT, where mu_e is the electron chem.potential -! TPT - effective ionic quantum parameter (T_p/T) -! LIQSOL=0/1 for liquid/solid -! SNk - dimensionless entropy per 1 ion -! UNkT - internal energy per kT per ion -! PnkT - pressure / n_i kT, where n_i is the ion number density -! PRADnkT - radiative pressure / n_i kT -! CV - heat capacity per ion, div. by Boltzmann const. -! CHIR - inverse compressibility -(d ln P / d ln V)_T ("\chi_r") -! CHIT = (d ln P / d ln T)_V ("\chi_T") - !implicit double precision (A-H), double precision (O-Z) - implicit none - save - integer, parameter :: NMIX = 2 - - double precision, intent(in) :: RHO, TEMP - double precision, intent(in) :: AY(NMIX), AZion(NMIX), ACMI(NMIX) - double precision, intent(inout) :: DENS, Zmean, Z2mean, GAMImean - double precision, intent(inout) :: CHI, TPT - integer, intent(inout) :: LIQSOL - double precision, intent(inout) :: SNk, UnkT, PnkT, PRADnkT - double precision, intent(inout) :: CV, CHIR, CHIT - - double precision, parameter :: CWK = 1.d0 ! Turn on Wigner corrections - double precision, parameter :: TINY = 1.d-7 - double precision, parameter :: PI = 3.141592653d0 - double precision, parameter :: C53 = 5.d0/3.d0 - double precision, parameter :: C13 = 1.d0/3.d0 - double precision, parameter :: AUM=1822.888d0 ! a.m.u./m_e - double precision, parameter :: GAMIMELT=175. ! OCP value of Gamma_i for melting - double precision, parameter :: RSIMELT=140. ! ion density parameter of quantum melting - double precision, parameter :: RAD=2.554d-7 ! Radiation constant (=4\sigma/c) (in a.u.) - double precision :: Z52, Z53, Z73, Z321, CMImean, CMI - double precision :: Zion, Z13, X, X1, X2 - double precision :: UWK, UINTRAD, UMIX, UINTE, UINT, UEid, UC2,UC1 - double precision :: CHIRE, CHITE, CTP, CV1, CV2, CVE, CVMIX, CVtot - double precision :: DeltaG, DENSI, DNI, DTE, FC1, FC2, FEid, FMIX - double precision :: DlnDH, DlnDT, DlnDHH, DlnDHT, DlnDTT - double precision :: FWK, GAME, GAMI - integer :: i, ix, j - double precision :: PC1, PC2, PDLR, PDLT, PDR1, PDR2, PDRMIX - double precision :: PDT1, PDT2, PDTMIX, PEid, PMIX, PRESS, PRESSE - double precision :: PRESSI, PRESSRAD, PRI, RS, RSI, RZ, SC1, SC2 - double precision :: SEid, Stot, TPT2 - interface - subroutine chemfit(dens, temp, chi) bind(C, name='chemfit') - implicit none - double precision, intent(in), value :: dens, temp - double precision, intent(inout) :: chi - end subroutine chemfit - subroutine elect11(TEMP,CHI, & - DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & - DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) bind(C, name="elect11") - implicit none - double precision, intent(in), value :: TEMP,CHI - double precision :: DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & - DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT - end subroutine elect11 - subroutine CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, & - FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) bind(C, name="cormix") - implicit none - double precision, value :: RS,GAME,Zmean,Z2mean,Z52,Z53,Z321 - double precision :: FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX - end subroutine CORMIX - subroutine EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, & - FC1,UC1,PC1,SC1,CV1,PDT1,PDR1, & - FC2,UC2,PC2,SC2,CV2,PDT2,PDR2) bind(C, name="eosfi8") - implicit none - integer, value :: LIQSOL - double precision, value :: CMI,Zion,RS,GAMI - double precision :: FC1,UC1,PC1,SC1,CV1,PDT1,PDR1, & - FC2,UC2,PC2,SC2,CV2,PDT2,PDR2 - end subroutine EOSFI8 - end interface - if (RHO.lt.1.e-19.or.RHO.gt.1.e15) then - print *, 'MELANGE: RHO out of range' - stop - end if - ! Calculation of average values: - Zmean=0. - Z2mean=0. - Z52=0. - Z53=0. - Z73=0. - Z321=0. ! corr.26.12.09 - CMImean=0. - do IX=1,NMIX - Zmean=Zmean+AY(IX)*AZion(IX) - Z2mean=Z2mean+AY(IX)*AZion(IX)**2 - Z13=AZion(IX)**C13 - Z53=Z53+AY(IX)*Z13**5 - Z73=Z73+AY(IX)*Z13**7 - Z52=Z52+AY(IX)*dsqrt(AZion(IX))**5 - Z321=Z321+AY(IX)*AZion(IX)*dsqrt(AZion(IX)+1.d0)**3 ! 26.12.09 - CMImean=CMImean+AY(IX)*ACMI(IX) - enddo - ! (0) Photons: - UINTRAD=RAD*TEMP**4 - PRESSRAD=UINTRAD/3. - ! (1) ideal electron gas (including relativity and degeneracy) - DENS=RHO/11.20587*Zmean/CMImean ! number density of electrons [au] - call CHEMFIT(DENS,TEMP,CHI) - ! NB: CHI can be used as true input instead of RHO or DENS - call ELECT11(TEMP,CHI, & - DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & - DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) - ! NB: at this point DENS is redefined (the difference can be ~0.1%) - DTE=DENS*TEMP - PRESSE=PEid*DTE ! P_e [a.u.] - UINTE=UEid*DTE ! U_e / V [a.u.] - ! (2) non-ideal Coulomb EIP - RS=(.75d0/PI/DENS)**C13 ! r_s - electron density parameter - RSI=RS*CMImean*Z73*AUM ! R_S - ion density parameter - GAME=1.d0/RS/TEMP ! electron Coulomb parameter Gamma_e - GAMImean=Z53*GAME ! effective Gamma_i - ion Coulomb parameter - if (GAMImean.lt.GAMIMELT.or.RSI.lt.RSIMELT) then - LIQSOL=0 ! liquid regime - else - LIQSOL=1 ! solid regime - endif - ! Calculate partial thermodynamic quantities and combine them together: - UINT=UINTE - PRESS=PRESSE - CVtot=CVE*DENS - Stot=SEid*DENS - PDLT=PRESSE*CHITE ! d P_e[a.u.] / d ln T - PDLR=PRESSE*CHIRE ! d P_e[a.u.] / d ln\rho - DENSI=DENS/Zmean ! number density of all ions - PRESSI=DENSI*TEMP ! ideal-ions total pressure (normalization) - TPT2=0. - CTP=4.d0*PI/AUM/TEMP**2 ! common coefficient for TPT2.10.12.14 - ! Add Coulomb+xc nonideal contributions, and ideal free energy: - do IX=1,NMIX - if (AY(IX).ge.TINY) then - Zion=AZion(IX) - CMI=ACMI(IX) - GAMI=Zion**C53*GAME ! Gamma_i for given ion species - DNI=DENSI*AY(IX) ! number density of ions of given type - PRI=DNI*TEMP ! = ideal-ions partial pressure (normalization) - call EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, & - FC1,UC1,PC1,SC1,CV1,PDT1,PDR1, & - FC2,UC2,PC2,SC2,CV2,PDT2,PDR2) - ! First-order TD functions: - UINT=UINT+UC2*PRI ! internal energy density (e+i+Coul.) - Stot=Stot+DNI*(SC2-dlog(AY(IX))) !entropy per unit volume[a.u.] - PRESS=PRESS+PC2*PRI ! pressure (e+i+Coul.) [a.u.] - ! Second-order functions (they take into account compositional changes): - CVtot=CVtot+DNI*CV2 ! C_V (e+i+Coul.)/ V (optim.10.12.14) - PDLT=PDLT+PRI*PDT2 ! d P / d ln T - PDLR=PDLR+PRI*PDR2 ! d P / d ln\rho - TPT2=TPT2+CTP*DNI/ACMI(IX)*AZion(IX)**2 ! opt.10.12.14 - end if - enddo ! next IX - ! Wigner-Kirkwood perturbative correction for liquid: - TPT=dsqrt(TPT2) ! effective T_p/T - ion quantum parameter - ! (in the case of a mixture, this estimate is crude) - if (LIQSOL.eq.0) then - FWK=TPT2/24.d0*CWK ! Wigner-Kirkwood (quantum diffr.) term - if (FWK.gt..7.and.CWK.gt.0.) then - print*,'MELANGE9: strong quantum effects in liquid!' - read(*,'(A)') - endif - UWK=2.d0*FWK - UINT=UINT+UWK*PRESSI - Stot=Stot+FWK*DENSI ! corrected 28.05.15 - PRESS=PRESS+FWK*PRESSI - CVtot=CVtot-UWK*DENSI ! corrected 18.04.20 - PDLT=PDLT-FWK*PRESSI - PDLR=PDLR+UWK*PRESSI - endif - ! Corrections to the linear mixing rule: - if (LIQSOL.eq.0) then ! liquid phase - call CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, & - FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) - else ! solid phase (only Madelung contribution) [22.12.12] - FMIX=0. - do I=1,NMIX - do J=I+1,NMIX - RZ=AZion(J)/AZion(I) - X2=AY(J)/(AY(I)+AY(J)) - X1=dim(1.d0,X2) - if (X1.lt.TINY) then - cycle ! 27.01.19 - end if - if (X2.lt.TINY) then - cycle - end if - X=X2/RZ+(1.d0-1.d0/RZ)*X2**RZ - GAMI=AZion(I)**C53*GAME ! Gamma_i corrected 14.05.13 - DeltaG=.012*(1.d0-1.d0/RZ**2)*(X1+X2*RZ**C53) - DeltaG=DeltaG*X/X2*dim(1.d0,X)/X1 - FMIX=FMIX+AY(I)*AY(J)*GAMI*DeltaG - enddo - enddo - UMIX=FMIX - PMIX=FMIX/3.d0 - CVMIX=0. - PDTMIX=0. - PDRMIX=FMIX/2.25d0 - endif - UINT=UINT+UMIX*PRESSI - Stot=Stot+DENSI*(UMIX-FMIX) - PRESS=PRESS+PMIX*PRESSI - CVtot=CVtot+DENSI*CVMIX - PDLT=PDLT+PRESSI*PDTMIX - PDLR=PDLR+PRESSI*PDRMIX - ! First-order: - PRADnkT=PRESSRAD/PRESSI ! radiative pressure / n_i k T - PnkT=PRESS/PRESSI ! P / n_i k T - UNkT=UINT/PRESSI ! U / N_i k T - SNk=Stot/DENSI ! S / N_i k - ! Second-order: - CV=CVtot/DENSI ! C_V per ion - CHIR=PDLR/PRESS ! d ln P / d ln\rho - CHIT=PDLT/PRESS ! d ln P / d ln T - return - end diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index fb5a369b0a..ea8e02a6c5 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -5,6 +5,7 @@ #include typedef double Real; +const int NumSpec = 2; inline namespace literals { constexpr Real @@ -2084,248 +2085,227 @@ extern "C" PDR2 = PDRi + PDR0; } - /* - subroutine MELANGE9(AY,AZion,ACMI,RHO,TEMP,PRADnkT, & - DENS,Zmean,CMImean,Z2mean,GAMImean,CHI,TPT,LIQSOL, & - PnkT,UNkT,SNk,CV,CHIR,CHIT) -// Version 18.04.20 -// Difference from v.10.12.14: included switch - off of WK correction -// Stems from MELANGE8 v.26.12.09. -// Difference: output PRADnkT instead of input KRAD -// + EOS of fully ionized electron - ion plasma mixture. -// Limitations: -// (a) inapplicable in the regimes of -// (1) bound - state formation, -// (2) quantum liquid, -// (3) presence of positrons; -// (b) for the case of a composition gradually depending on RHO or TEMP, -// second - order functions (CV,CHIR,CHIT in output) should not be trusted -// Choice of the liquid or solid regime - criterion GAMI [because the -// choice based on comparison of total (non - OCP) free energies can be -// sometimes dangerous because of the fit uncertainties ("Local field -// correction" in solid and quantum effects in liquid are unknown)]. -// Input: AY - their partial number densities, -// AZion and ACMI - their charge and mass numbers, -// RHO - total mass density [g / cc] -// TEMP - temperature [in a.u. = 2Ryd = 3.1577e5 K]. -// NB: instead of RHO, a true input is CHI, defined below -// Hence, disagreement between RHO and DENS is the fit error (<0.4%) -// Output: -// AY - rescaled so that to sum up to 1 and resorted (by AZion) -// AZion - resorted in ascending order -// ACMI - resorted in agreement with AZion -// DENS - electron number density [in a.u. = 6.7483346e24 cm^{ - 3}] -// Zmean = , CMImean = - mean ion charge and mass numbers, -// Z2mean = - mean - square ion charge number -// GAMImean - effective ion - ion Coulomb coupling constant -// CHI = mu_e / kT, where mu_e is the electron chem.potential -// TPT - effective ionic quantum parameter (T_p / T) -// LIQSOL = 0 / 1 for liquid / solid -// SNk - dimensionless entropy per 1 ion -// UNkT - internal energy per kT per ion -// PnkT - pressure / n_i kT, where n_i is the ion number density -// PRADnkT - radiative pressure / n_i kT -// CV - heat capacity per ion, div. by Boltzmann const. -// CHIR - inverse compressibility - (d ln P / d ln V)_T ("\chi_r") -// CHIT = (d ln P / d ln T)_V ("\chi_T") - //implicit double precision (A - H), double precision (O - Z) - implicit none - save - integer, parameter :: NMIX = 2 - - double precision, intent(in) :: RHO, TEMP - double precision, intent(in) :: AY(NMIX), AZion(NMIX), ACMI(NMIX) - double precision, intent(inout) :: DENS, Zmean, Z2mean, GAMImean - double precision, intent(inout) :: CHI, TPT - integer, intent(inout) :: LIQSOL - double precision, intent(inout) :: SNk, UnkT, PnkT, PRADnkT - double precision, intent(inout) :: CV, CHIR, CHIT - - double precision, parameter :: CWK = 1.0_rt // Turn on Wigner corrections - double precision, parameter :: TINY = 1.d - 7 - double precision, parameter :: PI = 3.141592653_rt - double precision, parameter :: C53 = 5.0_rt / 3.0_rt - double precision, parameter :: C13 = 1.0_rt / 3.0_rt - double precision, parameter :: AUM = 1822.888_rt // a.m.u. / m_e - double precision, parameter :: GAMIMELT = 175. // OCP value of Gamma_i for melting - double precision, parameter :: RSIMELT = 140. // ion density parameter of quantum melting - double precision, parameter :: RAD = 2.554d - 7 // Radiation constant ( = 4\sigma / c) (in a.u.) - double precision :: Z52, Z53, Z73, Z321, CMImean, CMI - double precision :: Zion, Z13, X, X1, X2 - double precision :: UWK, UINTRAD, UMIX, UINTE, UINT, UEid, UC2,UC1 - double precision :: CHIRE, CHITE, CTP, CV1, CV2, CVE, CVMIX, CVtot - double precision :: DeltaG, DENSI, DNI, DTE, FC1, FC2, FEid, FMIX - double precision :: DlnDH, DlnDT, DlnDHH, DlnDHT, DlnDTT - double precision :: FWK, GAME, GAMI - integer :: i, ix, j - double precision :: PC1, PC2, PDLR, PDLT, PDR1, PDR2, PDRMIX - double precision :: PDT1, PDT2, PDTMIX, PEid, PMIX, PRESS, PRESSE - double precision :: PRESSI, PRESSRAD, PRI, RS, RSI, RZ, SC1, SC2 - double precision :: SEid, Stot, TPT2 - interface - subroutine chemfit(dens, temp, chi) bind(C, name = 'chemfit') - implicit none - double precision, intent(in), value :: dens, temp - double precision, intent(inout) :: chi - end subroutine chemfit - subroutine elect11(TEMP,CHI, & - DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & - DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) bind(C, name = "elect11") - implicit none - double precision, intent(in), value :: TEMP,CHI - double precision :: DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & - DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT - end subroutine elect11 - subroutine CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, & - FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) bind(C, name = "cormix") - implicit none - double precision, value :: RS,GAME,Zmean,Z2mean,Z52,Z53,Z321 - double precision :: FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX - end subroutine CORMIX - end interface - if (RHO.lt.1.e - 19.or.RHO.gt.1.e15) then - print * , 'MELANGE: RHO out of range' - stop - end if - // Calculation of average values: - Zmean = 0.0_rt - Z2mean = 0.0_rt - Z52 = 0.0_rt - Z53 = 0.0_rt - Z73 = 0.0_rt - Z321 = 0.0_rt // corr.26.12.09 - CMImean = 0.0_rt - do IX = 1,NMIX - Zmean = Zmean + AY(IX) * AZion(IX) - Z2mean = Z2mean + AY(IX) * AZion(IX) * AZion(IX) - Z13 = std::pow(AZion(IX), C13) - Z53 = Z53 + AY(IX) * std::pow(Z13, 5) - Z73 = Z73 + AY(IX) * std::pow(Z13, 7) - Z52 = Z52 + AY(IX) * std::pow(AZion(IX), 2.5_rt) - Z321 = Z321 + AY(IX) * AZion(IX) * std::pow(AZion(IX) + 1.0_rt, 1.5_rt) // 26.12.09 - CMImean = CMImean + AY(IX) * ACMI(IX) - enddo - // (0) Photons: - UINTRAD = RAD * TEMP * TEMP * TEMP * TEMP - PRESSRAD = UINTRAD / 3.0_rt - // (1) ideal electron gas (including relativity and degeneracy) - DENS = RHO / 11.20587 * Zmean / CMImean // number density of electrons [au] - call CHEMFIT(DENS,TEMP,CHI) - // NB: CHI can be used as true input instead of RHO or DENS - call ELECT11(TEMP,CHI, & - DENS,FEid,PEid,UEid,SEid,CVE,CHITE,CHIRE, & - DlnDH,DlnDT,DlnDHH,DlnDTT,DlnDHT) - // NB: at this point DENS is redefined (the difference can be ~0.1%) - DTE = DENS * TEMP - PRESSE = PEid * DTE // P_e [a.u.] - UINTE = UEid * DTE // U_e / V [a.u.] - // (2) non - ideal Coulomb EIP - RS = std::pow(0.75_rt / PI / DENS, C13); // r_s - electron density parameter - RSI = RS * CMImean * Z73 * AUM // R_S - ion density parameter - GAME = 1.0_rt / RS / TEMP // electron Coulomb parameter Gamma_e - GAMImean = Z53 * GAME // effective Gamma_i - ion Coulomb parameter - if (GAMImean.lt.GAMIMELT.or.RSI.lt.RSIMELT) then - LIQSOL = 0 // liquid regime - else - LIQSOL = 1 // solid regime - endif - // Calculate partial thermodynamic quantities and combine them together: - UINT = UINTE - PRESS = PRESSE - CVtot = CVE * DENS - Stot = SEid * DENS - PDLT = PRESSE * CHITE // d P_e[a.u.] / d ln T - PDLR = PRESSE * CHIRE // d P_e[a.u.] / d ln\rho - DENSI = DENS / Zmean // number density of all ions - PRESSI = DENSI * TEMP // ideal - ions total pressure (normalization) - TPT2 = 0.0_rt - CTP = 4.0_rt * PI / AUM / (TEMP * TEMP); // common coefficient for TPT2.10.12.14 - // Add Coulomb + xc nonideal contributions, and ideal free energy: - do IX = 1,NMIX - if (AY(IX).ge.TINY) then - Zion = AZion(IX) - CMI = ACMI(IX) - GAMI = std::pow(Zion, C53) * GAME // Gamma_i for given ion species - DNI = DENSI * AY(IX) // number density of ions of given type - PRI = DNI * TEMP // = ideal - ions partial pressure (normalization) - call EOSFI8(LIQSOL,CMI,Zion,RS,GAMI, & - FC1,UC1,PC1,SC1,CV1,PDT1,PDR1, & - FC2,UC2,PC2,SC2,CV2,PDT2,PDR2) - // First - order TD functions: - UINT = UINT + UC2 * PRI // internal energy density (e + i + Coul.) - Stot = Stot + DNI * (SC2 - std::log(AY(IX))) //entropy per unit volume[a.u.] - PRESS = PRESS + PC2 * PRI // pressure (e + i + Coul.) [a.u.] - // Second - order functions (they take into account compositional changes): - CVtot = CVtot + DNI * CV2 // C_V (e + i + Coul.) / V (optim.10.12.14) - PDLT = PDLT + PRI * PDT2 // d P / d ln T - PDLR = PDLR + PRI * PDR2 // d P / d ln\rho - TPT2 = TPT2 + CTP * DNI / ACMI(IX) * AZion(IX) * AZion(IX) // opt.10.12.14 - end if - enddo // next IX - // Wigner - Kirkwood perturbative correction for liquid: - TPT = std::sqrt(TPT2) // effective T_p / T - ion quantum parameter - // (in the case of a mixture, this estimate is crude) - if (LIQSOL.eq.0) then - FWK = TPT2 / 24.0_rt * CWK // Wigner - Kirkwood (quantum diffr.) term - if (FWK.gt..7.and.CWK.gt.0.0_rt) then - print * ,'MELANGE9: strong quantum effects in liquid//' - read( * ,'(A)') - endif - UWK = 2.0_rt * FWK - UINT = UINT + UWK * PRESSI - Stot = Stot + FWK * DENSI // corrected 28.05.15 - PRESS = PRESS + FWK * PRESSI - CVtot = CVtot - UWK * DENSI // corrected 18.04.20 - PDLT = PDLT - FWK * PRESSI - PDLR = PDLR + UWK * PRESSI - endif - // Corrections to the linear mixing rule: - if (LIQSOL.eq.0) then // liquid phase - call CORMIX(RS,GAME,Zmean,Z2mean,Z52,Z53,Z321, & - FMIX,UMIX,PMIX,CVMIX,PDTMIX,PDRMIX) - else // solid phase (only Madelung contribution) [22.12.12] - FMIX = 0.0_rt - do I = 1,NMIX - do J = I + 1,NMIX - RZ = AZion(J) / AZion(I) - X2 = AY(J) / (AY(I) + AY(J)) - X1 = dim(1.0_rt,X2) - if (X1.lt.TINY) then - cycle // 27.01.19 - end if - if (X2.lt.TINY) then - cycle - end if - X = X2 / RZ + (1.0_rt - 1.0_rt / RZ) * std::pow(X2, RZ) - GAMI = std::pow(AZion(I), C53) * GAME // Gamma_i corrected 14.05.13 - DeltaG = .012 * (1.0_rt - 1.0_rt / (RZ * RZ)) * (X1 + X2 * std::pow(RZ, C53)) - DeltaG = DeltaG * X / X2 * dim(1.0_rt,X) / X1 - FMIX = FMIX + AY(I) * AY(J) * GAMI * DeltaG - enddo - enddo - UMIX = FMIX - PMIX = FMIX / 3.0_rt - CVMIX = 0.0_rt - PDTMIX = 0.0_rt - PDRMIX = FMIX / 2.25_rt - endif - UINT = UINT + UMIX * PRESSI - Stot = Stot + DENSI * (UMIX - FMIX) - PRESS = PRESS + PMIX * PRESSI - CVtot = CVtot + DENSI * CVMIX - PDLT = PDLT + PRESSI * PDTMIX - PDLR = PDLR + PRESSI * PDRMIX - // First - order: - PRADnkT = PRESSRAD / PRESSI // radiative pressure / n_i k T - PnkT = PRESS / PRESSI // P / n_i k T - UNkT = UINT / PRESSI // U / N_i k T - SNk = Stot / DENSI // S / N_i k - // Second - order: - CV = CVtot / DENSI // C_V per ion - CHIR = PDLR / PRESS // d ln P / d ln\rho - CHIT = PDLT / PRESS // d ln P / d ln T - return - end -*/ + void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real TEMP, + Real& PRADnkT, Real& DENS, Real& Zmean, Real& CMImean, Real& Z2mean, + Real& GAMImean, Real& CHI, Real& TPT, int& LIQSOL, + Real& PnkT, Real& UNkT, Real& SNk, Real& CV, Real& CHIR, Real& CHIT) + { + // Version 18.04.20 + // Difference from v.10.12.14: included switch - off of WK correction + // Stems from MELANGE8 v.26.12.09. + // Difference: output PRADnkT instead of input KRAD + // + EOS of fully ionized electron - ion plasma mixture. + // Limitations: + // (a) inapplicable in the regimes of + // (1) bound - state formation, + // (2) quantum liquid, + // (3) presence of positrons; + // (b) for the case of a composition gradually depending on RHO or TEMP, + // second - order functions (CV,CHIR,CHIT in output) should not be trusted + // Choice of the liquid or solid regime - criterion GAMI [because the + // choice based on comparison of total (non - OCP) free energies can be + // sometimes dangerous because of the fit uncertainties ("Local field + // correction" in solid and quantum effects in liquid are unknown)]. + // Input: AY - their partial number densities, + // AZion and ACMI - their charge and mass numbers, + // RHO - total mass density [g / cc] + // TEMP - temperature [in a.u. = 2Ryd = 3.1577e5 K]. + // NB: instead of RHO, a true input is CHI, defined below + // Hence, disagreement between RHO and DENS is the fit error (<0.4%) + // Output: + // AY - rescaled so that to sum up to 1 and resorted (by AZion) + // AZion - resorted in ascending order + // ACMI - resorted in agreement with AZion + // DENS - electron number density [in a.u. = 6.7483346e24 cm^{ - 3}] + // Zmean = , CMImean = - mean ion charge and mass numbers, + // Z2mean = - mean - square ion charge number + // GAMImean - effective ion - ion Coulomb coupling constant + // CHI = mu_e / kT, where mu_e is the electron chem.potential + // TPT - effective ionic quantum parameter (T_p / T) + // LIQSOL = 0 / 1 for liquid / solid + // SNk - dimensionless entropy per 1 ion + // UNkT - internal energy per kT per ion + // PnkT - pressure / n_i kT, where n_i is the ion number density + // PRADnkT - radiative pressure / n_i kT + // CV - heat capacity per ion, div. by Boltzmann const. + // CHIR - inverse compressibility - (d ln P / d ln V)_T ("\chi_r") + // CHIT = (d ln P / d ln T)_V ("\chi_T") + + const Real CWK = 1.0_rt; // Turn on Wigner corrections + const Real TINY = 1.e-7_rt; + const Real PI = 3.141592653_rt; + const Real C53 = 5.0_rt / 3.0_rt; + const Real C13 = 1.0_rt / 3.0_rt; + const Real AUM = 1822.888_rt; // a.m.u. / m_e + const Real GAMIMELT = 175.0_rt; // OCP value of Gamma_i for melting + const Real RSIMELT = 140.0_rt; // ion density parameter of quantum melting + const Real RAD = 2.554e-7_rt; // Radiation constant ( = 4\sigma / c) (in a.u.) + + if (RHO < 1.e-19_rt || RHO > 1.e15_rt) { + printf("MELANGE: RHO out of range\n"); + exit(1); + } + + // Calculation of average values: + Zmean = 0.0_rt; + Z2mean = 0.0_rt; + Real Z52 = 0.0_rt; + Real Z53 = 0.0_rt; + Real Z73 = 0.0_rt; + Real Z321 = 0.0_rt; // corr.26.12.09 + CMImean = 0.0_rt; + + for (int i = 0; i < NumSpec; ++i) { + Zmean = Zmean + AY[i] * AZion[i]; + Z2mean = Z2mean + AY[i] * AZion[i] * AZion[i]; + Real Z13 = std::pow(AZion[i], C13); + Z53 = Z53 + AY[i] * std::pow(Z13, 5); + Z73 = Z73 + AY[i] * std::pow(Z13, 7); + Z52 = Z52 + AY[i] * std::pow(AZion[i], 2.5_rt); + Z321 = Z321 + AY[i] * AZion[i] * std::pow(AZion[i] + 1.0_rt, 1.5_rt); // 26.12.09 + CMImean = CMImean + AY[i] * ACMI[i]; + } + + // (0) Photons: + Real UINTRAD = RAD * TEMP * TEMP * TEMP * TEMP; + Real PRESSRAD = UINTRAD / 3.0_rt; + + // (1) ideal electron gas (including relativity and degeneracy) + DENS = RHO / 11.20587 * Zmean / CMImean; // number density of electrons [au] + chemfit(DENS, TEMP, CHI); + + // NB: CHI can be used as true input instead of RHO or DENS + Real FEid, PEid, UEid, SEid, CVE, CHITE, CHIRE; + Real DlnDH, DlnDT, DlnDHH, DlnDTT, DlnDHT; + elect11(TEMP, CHI, + DENS, FEid, PEid, UEid, SEid, CVE, CHITE, CHIRE, + DlnDH, DlnDT, DlnDHH, DlnDTT, DlnDHT); + + // NB: at this point DENS is redefined (the difference can be ~0.1%) + Real DTE = DENS * TEMP; + Real PRESSE = PEid * DTE; // P_e [a.u.] + Real UINTE = UEid * DTE; // U_e / V [a.u.] + + // (2) non - ideal Coulomb EIP + Real RS = std::pow(0.75_rt / PI / DENS, C13); // r_s - electron density parameter + Real RSI = RS * CMImean * Z73 * AUM; // R_S - ion density parameter + Real GAME = 1.0_rt / RS / TEMP; // electron Coulomb parameter Gamma_e + GAMImean = Z53 * GAME; // effective Gamma_i - ion Coulomb parameter + + if (GAMImean < GAMIMELT || RSI < RSIMELT) { + LIQSOL = 0; // liquid regime + } + else { + LIQSOL = 1; // solid regime + } + + // Calculate partial thermodynamic quantities and combine them together: + Real UINT = UINTE; + Real PRESS = PRESSE; + Real CVtot = CVE * DENS; + Real Stot = SEid * DENS; + Real PDLT = PRESSE * CHITE; // d P_e[a.u.] / d ln T + Real PDLR = PRESSE * CHIRE; // d P_e[a.u.] / d ln\rho + Real DENSI = DENS / Zmean; // number density of all ions + Real PRESSI = DENSI * TEMP; // ideal - ions total pressure (normalization) + Real TPT2 = 0.0_rt; + Real CTP = 4.0_rt * PI / AUM / (TEMP * TEMP); // common coefficient for TPT2.10.12.14 + + // Add Coulomb + xc nonideal contributions, and ideal free energy: + for (int i = 0; i < NumSpec; ++i) { + if (AY[i] >= TINY) { + Real Zion = AZion[i]; + Real CMI = ACMI[i]; + Real GAMI = std::pow(Zion, C53) * GAME; // Gamma_i for given ion species + Real DNI = DENSI * AY[i]; // number density of ions of given type + Real PRI = DNI * TEMP; // = ideal - ions partial pressure (normalization) + + Real FC1, UC1, PC1, SC1, CV1, PDT1, PDR1; + Real FC2, UC2, PC2, SC2, CV2, PDT2, PDR2; + + eosfi8(LIQSOL, CMI, Zion, RS, GAMI, + FC1, UC1, PC1, SC1, CV1, PDT1, PDR1, + FC2, UC2, PC2, SC2, CV2, PDT2, PDR2); + + // First - order TD functions: + UINT = UINT + UC2 * PRI; // internal energy density (e + i + Coul.) + Stot = Stot + DNI * (SC2 - std::log(AY[i])); //entropy per unit volume[a.u.] + PRESS = PRESS + PC2 * PRI; // pressure (e + i + Coul.) [a.u.] + + // Second - order functions (they take into account compositional changes): + CVtot = CVtot + DNI * CV2; // C_V (e + i + Coul.) / V (optim.10.12.14) + PDLT = PDLT + PRI * PDT2; // d P / d ln T + PDLR = PDLR + PRI * PDR2; // d P / d ln\rho + TPT2 = TPT2 + CTP * DNI / ACMI[i] * AZion[i] * AZion[i]; // opt.10.12.14 + } + } + // Wigner - Kirkwood perturbative correction for liquid: + TPT = std::sqrt(TPT2); // effective T_p / T - ion quantum parameter + // (in the case of a mixture, this estimate is crude) + if (LIQSOL == 0) { + Real FWK = TPT2 / 24.0_rt * CWK; // Wigner - Kirkwood (quantum diffr.) term + Real UWK = 2.0_rt * FWK; + UINT = UINT + UWK * PRESSI; + Stot = Stot + FWK * DENSI; // corrected 28.05.15 + PRESS = PRESS + FWK * PRESSI; + CVtot = CVtot - UWK * DENSI; // corrected 18.04.20 + PDLT = PDLT - FWK * PRESSI; + PDLR = PDLR + UWK * PRESSI; + } + + // Corrections to the linear mixing rule: + Real FMIX, UMIX, PMIX, CVMIX, PDTMIX, PDRMIX; + if (LIQSOL == 0) { // liquid phase + cormix(RS, GAME, Zmean, Z2mean, Z52, Z53, Z321, + FMIX, UMIX, PMIX, CVMIX, PDTMIX, PDRMIX); + } + else { // solid phase (only Madelung contribution) [22.12.12] + FMIX = 0.0_rt; + for (int i = 0; i < NumSpec; ++i) { + for (int j = i+1; j < NumSpec; ++j) { + Real RZ = AZion[j] / AZion[i]; + Real X2 = AY[j] / (AY[i] + AY[j]); + Real X1 = std::max(0.0, 1.0_rt - X2); + + if (X1 < TINY) { + continue; // 27.01.19 + } + if (X2 < TINY) { + continue; + } + + Real X = X2 / RZ + (1.0_rt - 1.0_rt / RZ) * std::pow(X2, RZ); + Real GAMI = std::pow(AZion[i], C53) * GAME; // Gamma_i corrected 14.05.13 + Real DeltaG = 0.012_rt * (1.0_rt - 1.0_rt / (RZ * RZ)) * (X1 + X2 * std::pow(RZ, C53)); + DeltaG = DeltaG * X / X2 * std::max(0.0_rt, 1.0_rt - X) / X1; + FMIX = FMIX + AY[i] * AY[j] * GAMI * DeltaG; + } + } + + UMIX = FMIX; + PMIX = FMIX / 3.0_rt; + CVMIX = 0.0_rt; + PDTMIX = 0.0_rt; + PDRMIX = FMIX / 2.25_rt; + } + + UINT = UINT + UMIX * PRESSI; + Stot = Stot + DENSI * (UMIX - FMIX); + PRESS = PRESS + PMIX * PRESSI; + CVtot = CVtot + DENSI * CVMIX; + PDLT = PDLT + PRESSI * PDTMIX; + PDLR = PDLR + PRESSI * PDRMIX; + + // First - order: + PRADnkT = PRESSRAD / PRESSI; // radiative pressure / n_i k T + PnkT = PRESS / PRESSI; // P / n_i k T + UNkT = UINT / PRESSI; // U / N_i k T + SNk = Stot / DENSI; // S / N_i k + + // Second - order: + CV = CVtot / DENSI; // C_V per ion + CHIR = PDLR / PRESS; // d ln P / d ln\rho + CHIT = PDLT / PRESS; // d ln P / d ln T + } } From abb98e7232c2847f831165f387795387cf8e9005 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Mon, 18 Oct 2021 22:44:30 -0700 Subject: [PATCH 56/70] Trailing whitespace --- EOS/pc/eos_c.cpp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index ea8e02a6c5..c5ef4ce7b7 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -1955,7 +1955,7 @@ extern "C" // slight cleaning 10.12.14 // Non - ideal parts of thermodynamic functions in the fully ionized plasma // Stems from EOSFI5 and EOSFI05 v.04.10.05 - // Input: LIQSOL = 0 / 1(liquid / solid), + // Input: LIQSOL = 0 / 1(liquid / solid), // Zion,CMI - ion charge and mass numbers, // RS = r_s (electronic density parameter), // GAMI = Gamma_i (ion coupling), @@ -1966,7 +1966,7 @@ extern "C" // PDT1 = (1 / n_i kT) * (d P_C / d ln T)_V // PDR1 = (1 / n_i kT) * (d P_C / d ln\rho)_T // FC2,UC2,PC2,SC2,CV2 - analogous to FC1,UC1,PC1,SC1,CV1, but including - // the part corresponding to the ideal ion gas. This is useful for + // the part corresponding to the ideal ion gas. This is useful for // preventing accuracy loss in some cases (e.g., when SC2 << SC1). // FC2 does not take into account the entropy of mixing S_{mix}: in a // mixture, S_{mix} / (N_i k) has to be added externally (see MELANGE9). @@ -2094,7 +2094,7 @@ extern "C" // Difference from v.10.12.14: included switch - off of WK correction // Stems from MELANGE8 v.26.12.09. // Difference: output PRADnkT instead of input KRAD - // + EOS of fully ionized electron - ion plasma mixture. + // + EOS of fully ionized electron - ion plasma mixture. // Limitations: // (a) inapplicable in the regimes of // (1) bound - state formation, From a41490d9182980d1ebb0a9266afa11c76e8832c7 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Mon, 18 Oct 2021 22:59:04 -0700 Subject: [PATCH 57/70] Move main to C++ --- EOS/pc/eos17.f90 | 319 --------------------------------------------- EOS/pc/eos_c.cpp | 330 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 330 insertions(+), 319 deletions(-) diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 index 23467f7e9d..e69de29bb2 100755 --- a/EOS/pc/eos17.f90 +++ b/EOS/pc/eos17.f90 @@ -1,319 +0,0 @@ -!! Equation of state for fully ionized electron-ion plasmas (EOS EIP) -! A.Y.Potekhin & G.Chabrier, Contrib. Plasma Phys., 50 (2010) 82, -! and references therein -! Please communicate comments/suggestions to Alexander Potekhin: -! palex@astro.ioffe.ru -! Previously distributed versions (obsolete): -! eos2000, eos2002, eos2004, eos2006, eos2007, eos2009, eos10, eos11, -! eos13, and eos14. -! Last update: 04.03.21. All updates since 2008 are listed below. -!! L I S T O F S U B R O U T I N E S : -! MAIN (normally commented-out) - example driving routine. -! MELANGE9 - for arbitrary ionic mixture, renders total (ion+electron) -! pressure, internal energy, entropy, heat capacity (all -! normalized to the ionic ideal-gas values), logarithmic -! derivatives of pressure over temperature and density. -! EOSFI8 - nonideal (ion-ion + ion-electron + electron-electron) -! contributions to the free and internal energies, pressure, -! entropy, heat capacity, derivatives of pressure over -! logarithm of temperature and over logarithm of density (all -! normalized to the ionic ideal-gas values) for one ionic -! component in a mixture. -! FITION9 - ion-ion interaction contributions to the free and internal -! energies, pressure, entropy, heat capacity, derivatives of -! pressure over logarithms of temperature and density. -! FSCRliq8 - ion-electron (screening) contributions to the free and -! internal energies, pressure, entropy, heat capacity, -! derivatives of pressure over logarithms of temperature and -! density in the liquid phase for one ionic component in a -! mixture. -! FSCRsol8 - ion-electron (screening) contributions to the free and -! internal energies, pressure, entropy, heat capacity, -! derivatives of pressure over logarithms of temperature and -! density for monoionic solid. -! FHARM12 - harmonic (including static-lattice and zero-point) -! contributions to the free and internal energies, pressure, -! entropy, heat capacity, derivatives of pressure over -! logarithms of temperature and density for solid OCP. -! HLfit12 - the same as FHARM12, but only for thermal contributions -! ANHARM8 - anharmonic contributions to the free and internal energies, -! pressure, entropy, heat capacity, derivatives of pressure -! over logarithms of temperature and density for solid OCP. -! CORMIX - correction to the linear mixing rule for the Coulomb -! contributions to the thermodynamic functions in the liquid. -! ELECT11 - for an ideal electron gas of arbitrary degeneracy and -! relativity at given temperature and electron chemical -! potential, renders number density (in atomic units), free -! energy, pressure, internal energy, entropy, heat capacity -! (normalized to the electron ideal-gas values), logarithmic -! derivatives of pressure over temperature and density. -! EXCOR7 - electron-electron (exchange-correlation) contributions to -! the free and internal energies, pressure, entropy, heat -! capacity, derivatives of pressure over logarithm of -! temperature and over logarithm of density (all normalized -! to the classical electron ideal-gas values). -! FERINV7 - inverse non-relativistic Fermi integrals of orders -1/2, -! 1/2, 3/2, 5/2, and their first and second derivatives. -! BLIN9 - relativistic Fermi-Dirac integrals of orders 1/2, 3/2, 5/2, -! and their first, second, and some third derivatives. -! CHEMFIT7 - electron chemical potential at given density and -! temperature, and its first derivatives over density and -! temperature and the second derivative over temperature. -!! I M P R O V E M E N T S S I N C E 2 0 0 8 : -! FHARM8 uses a fit HLfit8 to the thermal free energy of the harmonic -! Coulomb lattice, which is more accurate than its predecessor FHARM7. -! Resulting corrections amount up to 20% for the ion heat capacity. -! Accordingly, S/R D3fit and FthCHA7 deleted (not used anymore). -! BLIN7 upgraded to BLIN8: -! - cleaned (a never-reached if-else branch deleted); -! - Sommerfeld (high-\chi) expansion improved; -! - some third derivatives added. -! CORMIX added (and MELANGE7 upgraded to MELANGE8 accordingly). -! ANHARM7 upgraded to ANHARM8, more consistent with Wigner-Kirkwood. -! Since the T- and rho-dependences of individual Z values in a mixture -! are not considered, the corresponding inputs (AYLR, AYLT) are -! excluded from MELANGE8 (and EOSFI7 changed to EOSFI8 accordingly). -! ELECT7 upgraded to ELECT9 (high-degeneracy behaviour is improved) -!! P O S T - P U B L I C A T I O N (2 0 1 0 +) IMPROVEMENTS : -! ELECT9 upgraded (smooth match of two fits at chi >> 1) -! BLIN8 replaced by BLIN9 - smooth fit interfaces at chi=0.6 and 14. -! MELANGE8 replaced by MELANGE9 - slightly modified input/output -! 08.08.11 - corrected mistake (unlikely to have an effect) in CHEMFIT7 -! 16.11.11 - ELECT9 upgraded to ELECT11 (additional output) -! 20.04.12 - FHARM8 and HLfit8 upgraded to FHARM12 and HLfit12: -! output of HLfit12 does not include zero-point vibr., but provides U1 -! 22.12.12 - MELANGE9 now includes a correction to the linear mixing -! rule (LMR) for the Madelung energy in the random bcc multi-ion -! lattice. -! 14.05.13 - an accidental error in programming the newly introduced -! correction to the LMR is fixed. -! 20.05.13 - calculation of the Wigner-Kirkwood quantum diffraction term -! for the liquid plasma is moved from EOSFI8 into MELANGE9. -! 10.12.14 - slight cleaning of the text (no effect on the results) -! 28.05.15 - an accidental error in Wigner-Kirkwood entropy correction -! is fixed (it was in the line "Stot=Stot+FWK*DENSI" since 20.05.13) -! 29.08.15 - eliminated underflow of exp(-THETA) in CHEMFIT7 -! 10.08.16 - modified criteria to avoid accuracy loss (round-off errors) -! 07.02.17 - included possibility to switch off the WK (Wigner) terms -! 27.05.17 - safeguard against Zion < 1 is added in FSCRsol8; -! safeguard against huge (-CHI) values is added in ELECT11. -! 27.01.19 - safeguard against X1=0 in CORMIX. -! 18.04.20 - corrected Wigner-Kirkwood term for heat capacity. -! 04.03.21 - corrected SUBFERMJ: defined parameter EPS (was undefined). -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! MAIN program: Version 02.06.09 -! This driving routine allows one to compile and run this code "as is". -! In practice, however, one usually needs to link subroutines from this -! file to another (external) code, therefore the MAIN program is -! normally commented-out. - program main - implicit none - double precision, parameter :: UN_T6 = .3157746 - integer, parameter :: NMIX = 2 - double precision :: AY(NMIX), AZion(NMIX), ACMI(NMIX) - double precision :: RHO, RHOlg, T, Tlg, T6, Tnk, TEMP, DENS - double precision :: Zmean, CMImean, Z2mean, GAMI, P - double precision :: CHI, TPT, TEGRAD, PRADnkT - double precision :: PnkT, UNkT, SNk, CV, CHIR, CHIT - integer :: LIQSOL - double precision :: x, diff, max_diff, T_arr(3), rho_arr(2) - integer :: i, j - interface - subroutine melange9(AY,AZion,ACMI,RHO,TEMP, & ! input - PRADnkT, & ! additional output - radiative pressure - DENS,Zmean,CMImean,Z2mean,GAMI,CHI,TPT,LIQSOL, & ! output param. - PnkT,UNkT,SNk,CV,CHIR,CHIT) bind(C, name="melange9") - implicit none - double precision :: AY(2), AZion(2), ACMI(2) - double precision, value :: RHO,TEMP ! input - double precision :: PRADnkT, & ! additional output - radiative pressure - DENS,Zmean,CMImean,Z2mean,GAMI,CHI,TPT, & ! output param. - PnkT,UNkT,SNk,CV,CHIR,CHIT - integer :: LIQSOL - end subroutine melange9 - end interface - - AZion(1) = 6.0d0 - AZion(2) = 8.0d0 - ACMI(1) = 12.0d0 - ACMI(2) = 16.0d0 - AY(1) = 0.6d0 - AY(2) = 0.4d0 - T_arr(1) = 1.d9 - T_arr(2) = 5.d9 - T_arr(3) = 1.d6 - rho_arr(1) = 1.d7 - rho_arr(2) = 5.d9 - - max_diff = 0.0d0 - - do j = 1, 1 - do i = 1, 3 - print *, "iter ", i, j - T = T_arr(i) - RHO = RHO_arr(j) - RHOlg=dlog10(RHO) - Tlg=dlog10(T) - T6=10.d0**(Tlg-6.d0) - RHO=10.d0**RHOlg - TEMP=T6/UN_T6 ! T [au] - call MELANGE9(AY,AZion,ACMI,RHO,TEMP, & ! input - PRADnkT, & ! additional output - radiative pressure - DENS,Zmean,CMImean,Z2mean,GAMI,CHI,TPT,LIQSOL, & ! output param. - PnkT,UNkT,SNk,CV,CHIR,CHIT) ! output dimensionless TD functions - Tnk=8.31447d13/CMImean*RHO*T6 ! n_i kT [erg/cc] - P=PnkT*Tnk/1.d12 ! P [Mbar] - TEGRAD=CHIT/(CHIT**2+CHIR*CV/PnkT) ! from Maxwell relat. - ! -------------------- OUTPUT -------------------------------- * - ! Here in the output we have: - ! RHO - mass density in g/cc - ! P - total pressure in Mbar (i.e. in 1.e12 dyn/cm^2) - ! PnkT=P/nkT, where n is the number density of ions, T temperature - ! CV - heat capacity at constant volume, divided by number of ions, /k - ! CHIT - logarithmic derivative of pressure \chi_T - ! CHIR - logarithmic derivative of pressure \chi_\rho - ! UNkT - internal energy divided by NkT, N being the number of ions - ! SNk - entropy divided by number of ions, /k - ! GAMI - ionic Coulomb coupling parameter - ! TPT=T_p/T, where T_p is the ion plasma temperature - ! CHI - electron chemical potential, divided by kT - ! LIQSOL = 0 in the liquid state, = 1 in the solid state - - if (i == 1 .and. j == 1) then - x = 986087830999.01904d0 - else if (i == 2 .and. j == 1) then - x = 2495983700684.0181d0 - else if (i == 3 .and. j == 1) then - x = 826241619577.72607d0 - end if - - diff = abs(x - P) / P - max_diff = max(diff, max_diff) - print *, "P DIFF", diff - - if (i == 1 .and. j == 1) then - x = 16.129464056742833d0 - else if (i == 2 .and. j == 1) then - x = 8.1653739394820484d0 - else if (i == 3 .and. j == 1) then - x = 13514.855458323951d0 - end if - - diff = abs(x - PnkT) / PnkT - max_diff = max(diff, max_diff) - print *, "PnkT DIFF", diff - - if (i == 1 .and. j == 1) then - x = 8.5451229292858866d0 - else if (i == 2 .and. j == 1) then - x = 18.539323243568369d0 - else if (i == 3 .and. j == 1) then - x = 0.73822827392302692d0 - end if - - diff = abs(x - CV) / CV - max_diff = max(diff, max_diff) - print *, "CV DIFF", diff - - if (i == 1 .and. j == 1) then - x = 0.24165606904443493d0 - else if (i == 2 .and. j == 1) then - x = 0.88747950206022497d0 - else if (i == 3 .and. j == 1) then - x = 2.7120648074179433d-5 - end if - - diff = abs(x - CHIT) / CHIT - max_diff = max(diff, max_diff) - print *, "CHIT DIFF", diff - - if (i == 1 .and. j == 1) then - x = 1.3370085960654023d0 - else if (i == 2 .and. j == 1) then - x = 1.0433031714423413d0 - else if (i == 3 .and. j == 1) then - x = 1.4524787201645497d0 - end if - - diff = abs(x - CHIR) / CHIR - max_diff = max(diff, max_diff) - print *, "CHIR DIFF", diff - - if (i == 1 .and. j == 1) then - x = 30.712489657322770d0 - else if (i == 2 .and. j == 1) then - x = 18.110542903803580d0 - else if (i == 3 .and. j == 1) then - x = 25265.106328521317d0 - end if - - diff = abs(x - UNkT) / UNkT - max_diff = max(diff, max_diff) - print *, "UNkT DIFF", diff - - if (i == 1 .and. j == 1) then - x = 23.797925638433309d0 - else if (i == 2 .and. j == 1) then - x = 45.817442265862802d0 - else if (i == 3 .and. j == 1) then - x = 1.0215909624032917d0 - end if - - diff = abs(x - SNk) / SNk - max_diff = max(diff, max_diff) - print *, "SNk DIFF", diff - - if (i == 1 .and. j == 1) then - x = 0.96111630472601972d0 - else if (i == 2 .and. j == 1) then - x = 0.19172836887561015d0 - else if (i == 3 .and. j == 1) then - x = 960.24524371490861d0 - end if - - diff = abs(x - GAMI) / GAMI - max_diff = max(diff, max_diff) - print *, "GAMI DIFF", diff - - if (i == 1 .and. j == 1) then - x = 1.2400526419152945d-2 - else if (i == 2 .and. j == 1) then - x = 2.4705336474828152d-3 - else if (i == 3 .and. j == 1) then - x = 12.383672318439324d0 - end if - - diff = abs(x - TPT) / TPT - max_diff = max(diff, max_diff) - print *, "TPT DIFF", diff - - if (i == 1 .and. j == 1) then - x = 5.5745494145734744d0 - else if (i == 2 .and. j == 1) then - x = -0.43436266588208006d0 - else if (i == 3 .and. j == 1) then - x = 5894.2025691009021d0 - end if - - diff = abs(x - CHI) / CHI - max_diff = max(diff, max_diff) - print *, "CHI DIFF", diff - - if (i == 1 .and. j == 1) then - x = 0 - else if (i == 2 .and. j == 1) then - x = 0 - else if (i == 3 .and. j == 1) then - x = 1 - end if - - diff = abs(x - LIQSOL) - max_diff = max(diff, max_diff) - print *, "LIQSOL DIFF", diff - - end do - end do - - print *, "max diff = ", max_diff - - end program main diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index c5ef4ce7b7..1542e021ea 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -21,6 +21,116 @@ inline namespace literals { } } + +// Equation of state for fully ionized electron-ion plasmas (EOS EIP) +// A.Y.Potekhin & G.Chabrier, Contrib. Plasma Phys., 50 (2010) 82, +// and references therein +// Please communicate comments/suggestions to Alexander Potekhin: +// palex@astro.ioffe.ru +// Previously distributed versions (obsolete): +// eos2000, eos2002, eos2004, eos2006, eos2007, eos2009, eos10, eos11, +// eos13, and eos14. +// Last update: 04.03.21. All updates since 2008 are listed below. +//// L I S T O F S U B R O U T I N E S : +// MAIN (normally commented-out) - example driving routine. +// MELANGE9 - for arbitrary ionic mixture, renders total (ion+electron) +// pressure, internal energy, entropy, heat capacity (all +// normalized to the ionic ideal-gas values), logarithmic +// derivatives of pressure over temperature and density. +// EOSFI8 - nonideal (ion-ion + ion-electron + electron-electron) +// contributions to the free and internal energies, pressure, +// entropy, heat capacity, derivatives of pressure over +// logarithm of temperature and over logarithm of density (all +// normalized to the ionic ideal-gas values) for one ionic +// component in a mixture. +// FITION9 - ion-ion interaction contributions to the free and internal +// energies, pressure, entropy, heat capacity, derivatives of +// pressure over logarithms of temperature and density. +// FSCRliq8 - ion-electron (screening) contributions to the free and +// internal energies, pressure, entropy, heat capacity, +// derivatives of pressure over logarithms of temperature and +// density in the liquid phase for one ionic component in a +// mixture. +// FSCRsol8 - ion-electron (screening) contributions to the free and +// internal energies, pressure, entropy, heat capacity, +// derivatives of pressure over logarithms of temperature and +// density for monoionic solid. +// FHARM12 - harmonic (including static-lattice and zero-point) +// contributions to the free and internal energies, pressure, +// entropy, heat capacity, derivatives of pressure over +// logarithms of temperature and density for solid OCP. +// HLfit12 - the same as FHARM12, but only for thermal contributions +// ANHARM8 - anharmonic contributions to the free and internal energies, +// pressure, entropy, heat capacity, derivatives of pressure +// over logarithms of temperature and density for solid OCP. +// CORMIX - correction to the linear mixing rule for the Coulomb +// contributions to the thermodynamic functions in the liquid. +// ELECT11 - for an ideal electron gas of arbitrary degeneracy and +// relativity at given temperature and electron chemical +// potential, renders number density (in atomic units), free +// energy, pressure, internal energy, entropy, heat capacity +// (normalized to the electron ideal-gas values), logarithmic +// derivatives of pressure over temperature and density. +// EXCOR7 - electron-electron (exchange-correlation) contributions to +// the free and internal energies, pressure, entropy, heat +// capacity, derivatives of pressure over logarithm of +// temperature and over logarithm of density (all normalized +// to the classical electron ideal-gas values). +// FERINV7 - inverse non-relativistic Fermi integrals of orders -1/2, +// 1/2, 3/2, 5/2, and their first and second derivatives. +// BLIN9 - relativistic Fermi-Dirac integrals of orders 1/2, 3/2, 5/2, +// and their first, second, and some third derivatives. +// CHEMFIT7 - electron chemical potential at given density and +// temperature, and its first derivatives over density and +// temperature and the second derivative over temperature. +//// I M P R O V E M E N T S S I N C E 2 0 0 8 : +// FHARM8 uses a fit HLfit8 to the thermal free energy of the harmonic +// Coulomb lattice, which is more accurate than its predecessor FHARM7. +// Resulting corrections amount up to 20% for the ion heat capacity. +// Accordingly, S/R D3fit and FthCHA7 deleted (not used anymore). +// BLIN7 upgraded to BLIN8: +// - cleaned (a never-reached if-else branch deleted); +// - Sommerfeld (high-\chi) expansion improved; +// - some third derivatives added. +// CORMIX added (and MELANGE7 upgraded to MELANGE8 accordingly). +// ANHARM7 upgraded to ANHARM8, more consistent with Wigner-Kirkwood. +// Since the T- and rho-dependences of individual Z values in a mixture +// are not considered, the corresponding inputs (AYLR, AYLT) are +// excluded from MELANGE8 (and EOSFI7 changed to EOSFI8 accordingly). +// ELECT7 upgraded to ELECT9 (high-degeneracy behaviour is improved) +//// P O S T - P U B L I C A T I O N (2 0 1 0 +) IMPROVEMENTS : +// ELECT9 upgraded (smooth match of two fits at chi >> 1) +// BLIN8 replaced by BLIN9 - smooth fit interfaces at chi=0.6 and 14. +// MELANGE8 replaced by MELANGE9 - slightly modified input/output +// 08.08.11 - corrected mistake (unlikely to have an effect) in CHEMFIT7 +// 16.11.11 - ELECT9 upgraded to ELECT11 (additional output) +// 20.04.12 - FHARM8 and HLfit8 upgraded to FHARM12 and HLfit12: +// output of HLfit12 does not include zero-point vibr., but provides U1 +// 22.12.12 - MELANGE9 now includes a correction to the linear mixing +// rule (LMR) for the Madelung energy in the random bcc multi-ion +// lattice. +// 14.05.13 - an accidental error in programming the newly introduced +// correction to the LMR is fixed. +// 20.05.13 - calculation of the Wigner-Kirkwood quantum diffraction term +// for the liquid plasma is moved from EOSFI8 into MELANGE9. +// 10.12.14 - slight cleaning of the text (no effect on the results) +// 28.05.15 - an accidental error in Wigner-Kirkwood entropy correction +// is fixed (it was in the line "Stot=Stot+FWK*DENSI" since 20.05.13) +// 29.08.15 - eliminated underflow of exp(-THETA) in CHEMFIT7 +// 10.08.16 - modified criteria to avoid accuracy loss (round-off errors) +// 07.02.17 - included possibility to switch off the WK (Wigner) terms +// 27.05.17 - safeguard against Zion < 1 is added in FSCRsol8; +// safeguard against huge (-CHI) values is added in ELECT11. +// 27.01.19 - safeguard against X1=0 in CORMIX. +// 18.04.20 - corrected Wigner-Kirkwood term for heat capacity. +// 04.03.21 - corrected SUBFERMJ: defined parameter EPS (was undefined). +//////////////////////////////////////////////////////////////////////// +// MAIN program: Version 02.06.09 +// This driving routine allows one to compile and run this code "as is". +// In practice, however, one usually needs to link subroutines from this +// file to another (external) code, therefore the MAIN program is +// normally commented-out. + extern "C" { // Inverse Fermi integral with q=1/2 @@ -2308,4 +2418,224 @@ extern "C" CHIR = PDLR / PRESS; // d ln P / d ln\rho CHIT = PDLT / PRESS; // d ln P / d ln T } + +} + +int main() { + + const Real UN_T6 = 0.3157746_rt; + Real AY[NumSpec], AZion[NumSpec], ACMI[NumSpec]; + Real RHO, RHOlg, T, Tlg, T6, Tnk, TEMP, DENS; + Real Zmean, CMImean, Z2mean, GAMI, P; + Real CHI, TPT, TEGRAD, PRADnkT; + Real PnkT, UNkT, SNk, CV, CHIR, CHIT; + int LIQSOL; + Real x, diff, max_diff, T_arr[3], rho_arr[2]; + + AZion[0] = 6.0_rt; + AZion[1] = 8.0_rt; + ACMI[0] = 12.0_rt; + ACMI[1] = 16.0_rt; + AY[0] = 0.6_rt; + AY[1] = 0.4_rt; + T_arr[0] = 1.e9_rt; + T_arr[1] = 5.e9_rt; + T_arr[2] = 1.e6_rt; + rho_arr[0] = 1.e7_rt; + rho_arr[1] = 5.e9_rt; + + max_diff = 0.0_rt; + + for (int j = 0; j <= 0; ++j) { + for (int i = 0; i < 3; ++i) { + std::cout << "iter " << i << " " << j << std::endl; + T = T_arr[i]; + RHO = rho_arr[j]; + RHOlg = std::log10(RHO); + Tlg = std::log10(T); + T6 = std::pow(10.0_rt, Tlg - 6.0_rt); + RHO = std::pow(10.0_rt, RHOlg); + TEMP = T6 / UN_T6; // T [au] + + melange9(AY, AZion, ACMI, RHO, TEMP, // input + PRADnkT, // additional output - radiative pressure + DENS, Zmean, CMImean, Z2mean, GAMI, CHI, TPT, LIQSOL, // output param. + PnkT, UNkT, SNk, CV, CHIR, CHIT); // output dimensionless TD functions + + Tnk = 8.31447e13_rt / CMImean * RHO * T6; // n_i kT [erg/cc] + P = PnkT * Tnk / 1.e12_rt; // P [Mbar] + TEGRAD = CHIT / (CHIT * CHIT + CHIR * CV / PnkT); // from Maxwell relat. + // -------------------- OUTPUT -------------------------------- + // Here in the output we have: + // RHO - mass density in g/cc + // P - total pressure in Mbar (i.e. in 1.e12 dyn/cm^2) + // PnkT=P/nkT, where n is the number density of ions, T temperature + // CV - heat capacity at constant volume, divided by number of ions, /k + // CHIT - logarithmic derivative of pressure \chi_T + // CHIR - logarithmic derivative of pressure \chi_\rho + // UNkT - internal energy divided by NkT, N being the number of ions + // SNk - entropy divided by number of ions, /k + // GAMI - ionic Coulomb coupling parameter + // TPT=T_p/T, where T_p is the ion plasma temperature + // CHI - electron chemical potential, divided by kT + // LIQSOL = 0 in the liquid state, = 1 in the solid state + + if (i == 0 && j == 0) { + x = 986087830999.01904_rt; + } + else if (i == 1 && j == 0) { + x = 2495983700684.0181_rt; + } + else if (i == 2 && j == 0) { + x = 826241619577.72607_rt; + } + + diff = std::abs(x - P) / P; + max_diff = std::max(diff, max_diff); + std::cout << "P DIFF " << diff << std::endl; + + if (i == 0 && j == 0) { + x = 16.129464056742833_rt; + } + else if (i == 1 && j == 0) { + x = 8.1653739394820484_rt; + } + else if (i == 2 && j == 0) { + x = 13514.855458323951_rt; + } + + diff = std::abs(x - PnkT) / PnkT; + max_diff = std::max(diff, max_diff); + std::cout << "PnkT DIFF " << diff << std::endl; + + if (i == 0 && j == 0) { + x = 8.5451229292858866_rt; + } + else if (i == 1 && j == 0) { + x = 18.539323243568369_rt; + } + else if (i == 2 && j == 0) { + x = 0.73822827392302692_rt; + } + + diff = std::abs(x - CV) / CV; + max_diff = std::max(diff, max_diff); + std::cout << "CV DIFF " << diff << std::endl; + + if (i == 0 && j == 0) { + x = 0.24165606904443493_rt; + } + else if (i == 1 && j == 0) { + x = 0.88747950206022497_rt; + } + else if (i == 2 && j == 0) { + x = 2.7120648074179433e-5_rt; + } + + diff = std::abs(x - CHIT) / CHIT; + max_diff = std::max(diff, max_diff); + std::cout << "CHIT DIFF " << diff << std::endl; + + if (i == 0 && j == 0) { + x = 1.3370085960654023_rt; + } + else if (i == 1 && j == 0) { + x = 1.0433031714423413_rt; + } + else if (i == 2 && j == 0) { + x = 1.4524787201645497_rt; + } + + diff = std::abs(x - CHIR) / CHIR; + max_diff = std::max(diff, max_diff); + std::cout << "CHIR DIFF " << diff << std::endl; + + if (i == 0 && j == 0) { + x = 30.712489657322770_rt; + } + else if (i == 1 && j == 0) { + x = 18.110542903803580_rt; + } + else if (i == 2 && j == 0) { + x = 25265.106328521317_rt; + } + + diff = std::abs(x - UNkT) / UNkT; + max_diff = std::max(diff, max_diff); + std::cout << "UNkT DIFF " << diff << std::endl; + + if (i == 0 && j == 0) { + x = 23.797925638433309_rt; + } + else if (i == 1 && j == 0) { + x = 45.817442265862802_rt; + } + else if (i == 2 && j == 0) { + x = 1.0215909624032917_rt; + } + + diff = std::abs(x - SNk) / SNk; + max_diff = std::max(diff, max_diff); + std::cout << "SNk DIFF " << diff << std::endl; + + if (i == 0 && j == 0) { + x = 0.96111630472601972_rt; + } + else if (i == 1 && j == 0) { + x = 0.19172836887561015_rt; + } + else if (i == 2 && j == 0) { + x = 960.24524371490861_rt; + } + + diff = std::abs(x - GAMI) / GAMI; + max_diff = std::max(diff, max_diff); + std::cout << "GAMI DIFF " << diff << std::endl; + + if (i == 0 && j == 0) { + x = 1.2400526419152945e-2_rt; + } + else if (i == 1 && j == 0) { + x = 2.4705336474828152e-3_rt; + } + else if (i == 2 && j == 0) { + x = 12.383672318439324_rt; + } + + diff = std::abs(x - TPT) / TPT; + max_diff = std::max(diff, max_diff); + std::cout << "TPT DIFF " << diff << std::endl; + + if (i == 0 && j == 0) { + x = 5.5745494145734744_rt; + } + else if (i == 1 && j == 0) { + x = -0.43436266588208006_rt; + } + else if (i == 2 && j == 0) { + x = 5894.2025691009021_rt; + } + + diff = std::abs(x - CHI) / CHI; + max_diff = std::max(diff, max_diff); + std::cout << "CHI DIFF " << diff << std::endl; + + if (i == 0 && j == 0) { + x = 0; + } + else if (i == 1 && j == 0) { + x = 0; + } + else if (i == 2 && j == 0) { + x = 1; + } + + diff = std::abs(x - LIQSOL); + max_diff = std::max(diff, max_diff); + std::cout << "LIQSOL DIFF " << diff << std::endl; + + } + } + + std::cout << "max diff = " << max_diff << std::endl; } From 6268669c87e41ea764f08f35b2bd010718691450 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Mon, 18 Oct 2021 22:59:57 -0700 Subject: [PATCH 58/70] Remove fortran --- EOS/pc/Makefile | 5 ++--- EOS/pc/eos17.f90 | 0 2 files changed, 2 insertions(+), 3 deletions(-) delete mode 100755 EOS/pc/eos17.f90 diff --git a/EOS/pc/Makefile b/EOS/pc/Makefile index d0e5e4376a..e0d0c1b77f 100644 --- a/EOS/pc/Makefile +++ b/EOS/pc/Makefile @@ -1,6 +1,5 @@ -test: eos17.f90 eos_c.cpp - g++ -o eos_c.o -c eos_c.cpp - gfortran -o test eos_c.o eos17.f90 -lstdc++ +test: eos_c.cpp + g++ -o test eos_c.cpp run: ./test diff --git a/EOS/pc/eos17.f90 b/EOS/pc/eos17.f90 deleted file mode 100755 index e69de29bb2..0000000000 From dbb0ace5c46a8218a46acfa4ca6bbaa6e1702846 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Mon, 18 Oct 2021 23:15:45 -0700 Subject: [PATCH 59/70] Remove correctness check --- EOS/pc/eos_c.cpp | 161 +---------------------------------------------- 1 file changed, 1 insertion(+), 160 deletions(-) diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 1542e021ea..8dc39fc204 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -2430,7 +2430,7 @@ int main() { Real CHI, TPT, TEGRAD, PRADnkT; Real PnkT, UNkT, SNk, CV, CHIR, CHIT; int LIQSOL; - Real x, diff, max_diff, T_arr[3], rho_arr[2]; + Real T_arr[3], rho_arr[2]; AZion[0] = 6.0_rt; AZion[1] = 8.0_rt; @@ -2444,11 +2444,8 @@ int main() { rho_arr[0] = 1.e7_rt; rho_arr[1] = 5.e9_rt; - max_diff = 0.0_rt; - for (int j = 0; j <= 0; ++j) { for (int i = 0; i < 3; ++i) { - std::cout << "iter " << i << " " << j << std::endl; T = T_arr[i]; RHO = rho_arr[j]; RHOlg = std::log10(RHO); @@ -2480,162 +2477,6 @@ int main() { // CHI - electron chemical potential, divided by kT // LIQSOL = 0 in the liquid state, = 1 in the solid state - if (i == 0 && j == 0) { - x = 986087830999.01904_rt; - } - else if (i == 1 && j == 0) { - x = 2495983700684.0181_rt; - } - else if (i == 2 && j == 0) { - x = 826241619577.72607_rt; - } - - diff = std::abs(x - P) / P; - max_diff = std::max(diff, max_diff); - std::cout << "P DIFF " << diff << std::endl; - - if (i == 0 && j == 0) { - x = 16.129464056742833_rt; - } - else if (i == 1 && j == 0) { - x = 8.1653739394820484_rt; - } - else if (i == 2 && j == 0) { - x = 13514.855458323951_rt; - } - - diff = std::abs(x - PnkT) / PnkT; - max_diff = std::max(diff, max_diff); - std::cout << "PnkT DIFF " << diff << std::endl; - - if (i == 0 && j == 0) { - x = 8.5451229292858866_rt; - } - else if (i == 1 && j == 0) { - x = 18.539323243568369_rt; - } - else if (i == 2 && j == 0) { - x = 0.73822827392302692_rt; - } - - diff = std::abs(x - CV) / CV; - max_diff = std::max(diff, max_diff); - std::cout << "CV DIFF " << diff << std::endl; - - if (i == 0 && j == 0) { - x = 0.24165606904443493_rt; - } - else if (i == 1 && j == 0) { - x = 0.88747950206022497_rt; - } - else if (i == 2 && j == 0) { - x = 2.7120648074179433e-5_rt; - } - - diff = std::abs(x - CHIT) / CHIT; - max_diff = std::max(diff, max_diff); - std::cout << "CHIT DIFF " << diff << std::endl; - - if (i == 0 && j == 0) { - x = 1.3370085960654023_rt; - } - else if (i == 1 && j == 0) { - x = 1.0433031714423413_rt; - } - else if (i == 2 && j == 0) { - x = 1.4524787201645497_rt; - } - - diff = std::abs(x - CHIR) / CHIR; - max_diff = std::max(diff, max_diff); - std::cout << "CHIR DIFF " << diff << std::endl; - - if (i == 0 && j == 0) { - x = 30.712489657322770_rt; - } - else if (i == 1 && j == 0) { - x = 18.110542903803580_rt; - } - else if (i == 2 && j == 0) { - x = 25265.106328521317_rt; - } - - diff = std::abs(x - UNkT) / UNkT; - max_diff = std::max(diff, max_diff); - std::cout << "UNkT DIFF " << diff << std::endl; - - if (i == 0 && j == 0) { - x = 23.797925638433309_rt; - } - else if (i == 1 && j == 0) { - x = 45.817442265862802_rt; - } - else if (i == 2 && j == 0) { - x = 1.0215909624032917_rt; - } - - diff = std::abs(x - SNk) / SNk; - max_diff = std::max(diff, max_diff); - std::cout << "SNk DIFF " << diff << std::endl; - - if (i == 0 && j == 0) { - x = 0.96111630472601972_rt; - } - else if (i == 1 && j == 0) { - x = 0.19172836887561015_rt; - } - else if (i == 2 && j == 0) { - x = 960.24524371490861_rt; - } - - diff = std::abs(x - GAMI) / GAMI; - max_diff = std::max(diff, max_diff); - std::cout << "GAMI DIFF " << diff << std::endl; - - if (i == 0 && j == 0) { - x = 1.2400526419152945e-2_rt; - } - else if (i == 1 && j == 0) { - x = 2.4705336474828152e-3_rt; - } - else if (i == 2 && j == 0) { - x = 12.383672318439324_rt; - } - - diff = std::abs(x - TPT) / TPT; - max_diff = std::max(diff, max_diff); - std::cout << "TPT DIFF " << diff << std::endl; - - if (i == 0 && j == 0) { - x = 5.5745494145734744_rt; - } - else if (i == 1 && j == 0) { - x = -0.43436266588208006_rt; - } - else if (i == 2 && j == 0) { - x = 5894.2025691009021_rt; - } - - diff = std::abs(x - CHI) / CHI; - max_diff = std::max(diff, max_diff); - std::cout << "CHI DIFF " << diff << std::endl; - - if (i == 0 && j == 0) { - x = 0; - } - else if (i == 1 && j == 0) { - x = 0; - } - else if (i == 2 && j == 0) { - x = 1; - } - - diff = std::abs(x - LIQSOL); - max_diff = std::max(diff, max_diff); - std::cout << "LIQSOL DIFF " << diff << std::endl; - } } - - std::cout << "max diff = " << max_diff << std::endl; } From 093506ec9bd62b6e070bfddb3111e77cc422b11b Mon Sep 17 00:00:00 2001 From: Max Katz Date: Mon, 18 Oct 2021 23:24:12 -0700 Subject: [PATCH 60/70] Pass in real temperature --- EOS/pc/eos_c.cpp | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 8dc39fc204..882c8fdec3 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -2195,7 +2195,7 @@ extern "C" PDR2 = PDRi + PDR0; } - void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real TEMP, + void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real T, Real& PRADnkT, Real& DENS, Real& Zmean, Real& CMImean, Real& Z2mean, Real& GAMImean, Real& CHI, Real& TPT, int& LIQSOL, Real& PnkT, Real& UNkT, Real& SNk, Real& CV, Real& CHIR, Real& CHIT) @@ -2219,7 +2219,7 @@ extern "C" // Input: AY - their partial number densities, // AZion and ACMI - their charge and mass numbers, // RHO - total mass density [g / cc] - // TEMP - temperature [in a.u. = 2Ryd = 3.1577e5 K]. + // TEMP - temperature // NB: instead of RHO, a true input is CHI, defined below // Hence, disagreement between RHO and DENS is the fit error (<0.4%) // Output: @@ -2241,6 +2241,12 @@ extern "C" // CHIR - inverse compressibility - (d ln P / d ln V)_T ("\chi_r") // CHIT = (d ln P / d ln T)_V ("\chi_T") + // Convert temperature to a.u. = 2Ryd = 3.1577e5 K. + const Real UN_T6 = 0.3157746_rt; + Real Tlg = std::log10(T); + Real T6 = std::pow(10.0_rt, Tlg - 6.0_rt); + Real TEMP = T6 / UN_T6; // T [au] + const Real CWK = 1.0_rt; // Turn on Wigner corrections const Real TINY = 1.e-7_rt; const Real PI = 3.141592653_rt; @@ -2454,7 +2460,7 @@ int main() { RHO = std::pow(10.0_rt, RHOlg); TEMP = T6 / UN_T6; // T [au] - melange9(AY, AZion, ACMI, RHO, TEMP, // input + melange9(AY, AZion, ACMI, RHO, T, // input PRADnkT, // additional output - radiative pressure DENS, Zmean, CMImean, Z2mean, GAMI, CHI, TPT, LIQSOL, // output param. PnkT, UNkT, SNk, CV, CHIR, CHIT); // output dimensionless TD functions From bdc44ad5d0ba3b89fb582f2f28dd5968abe7d6a6 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Mon, 18 Oct 2021 23:33:21 -0700 Subject: [PATCH 61/70] Convert P back to CGS --- EOS/pc/eos_c.cpp | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 882c8fdec3..516940c89a 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -2198,7 +2198,7 @@ extern "C" void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real T, Real& PRADnkT, Real& DENS, Real& Zmean, Real& CMImean, Real& Z2mean, Real& GAMImean, Real& CHI, Real& TPT, int& LIQSOL, - Real& PnkT, Real& UNkT, Real& SNk, Real& CV, Real& CHIR, Real& CHIT) + Real& P, Real& UNkT, Real& SNk, Real& CV, Real& CHIR, Real& CHIT) { // Version 18.04.20 // Difference from v.10.12.14: included switch - off of WK correction @@ -2415,7 +2415,7 @@ extern "C" // First - order: PRADnkT = PRESSRAD / PRESSI; // radiative pressure / n_i k T - PnkT = PRESS / PRESSI; // P / n_i k T + Real PnkT = PRESS / PRESSI; // P / n_i k T UNkT = UINT / PRESSI; // U / N_i k T SNk = Stot / DENSI; // S / N_i k @@ -2423,6 +2423,10 @@ extern "C" CV = CVtot / DENSI; // C_V per ion CHIR = PDLR / PRESS; // d ln P / d ln\rho CHIT = PDLT / PRESS; // d ln P / d ln T + + // Convert to CGS + Real Tnk = 8.31447e13_rt / CMImean * RHO * T6; // n_i kT [erg/cc] + P = PnkT * Tnk; } } @@ -2432,9 +2436,9 @@ int main() { const Real UN_T6 = 0.3157746_rt; Real AY[NumSpec], AZion[NumSpec], ACMI[NumSpec]; Real RHO, RHOlg, T, Tlg, T6, Tnk, TEMP, DENS; - Real Zmean, CMImean, Z2mean, GAMI, P; + Real Zmean, CMImean, Z2mean, GAMI; Real CHI, TPT, TEGRAD, PRADnkT; - Real PnkT, UNkT, SNk, CV, CHIR, CHIT; + Real P, UNkT, SNk, CV, CHIR, CHIT; int LIQSOL; Real T_arr[3], rho_arr[2]; @@ -2463,11 +2467,9 @@ int main() { melange9(AY, AZion, ACMI, RHO, T, // input PRADnkT, // additional output - radiative pressure DENS, Zmean, CMImean, Z2mean, GAMI, CHI, TPT, LIQSOL, // output param. - PnkT, UNkT, SNk, CV, CHIR, CHIT); // output dimensionless TD functions + P, UNkT, SNk, CV, CHIR, CHIT); // output dimensionless TD functions Tnk = 8.31447e13_rt / CMImean * RHO * T6; // n_i kT [erg/cc] - P = PnkT * Tnk / 1.e12_rt; // P [Mbar] - TEGRAD = CHIT / (CHIT * CHIT + CHIR * CV / PnkT); // from Maxwell relat. // -------------------- OUTPUT -------------------------------- // Here in the output we have: // RHO - mass density in g/cc From 43e561559b71bdec21e917d019c8a47bd471b539 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Tue, 19 Oct 2021 00:00:16 -0700 Subject: [PATCH 62/70] Don't need to return Zbar and Abar --- EOS/pc/eos_c.cpp | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 516940c89a..ad41f4663f 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -2196,7 +2196,7 @@ extern "C" } void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real T, - Real& PRADnkT, Real& DENS, Real& Zmean, Real& CMImean, Real& Z2mean, + Real& PRADnkT, Real& DENS, Real& GAMImean, Real& CHI, Real& TPT, int& LIQSOL, Real& P, Real& UNkT, Real& SNk, Real& CV, Real& CHIR, Real& CHIT) { @@ -2227,8 +2227,6 @@ extern "C" // AZion - resorted in ascending order // ACMI - resorted in agreement with AZion // DENS - electron number density [in a.u. = 6.7483346e24 cm^{ - 3}] - // Zmean = , CMImean = - mean ion charge and mass numbers, - // Z2mean = - mean - square ion charge number // GAMImean - effective ion - ion Coulomb coupling constant // CHI = mu_e / kT, where mu_e is the electron chem.potential // TPT - effective ionic quantum parameter (T_p / T) @@ -2263,13 +2261,13 @@ extern "C" } // Calculation of average values: - Zmean = 0.0_rt; - Z2mean = 0.0_rt; + Real Zmean = 0.0_rt; + Real Z2mean = 0.0_rt; Real Z52 = 0.0_rt; Real Z53 = 0.0_rt; Real Z73 = 0.0_rt; Real Z321 = 0.0_rt; // corr.26.12.09 - CMImean = 0.0_rt; + Real CMImean = 0.0_rt; for (int i = 0; i < NumSpec; ++i) { Zmean = Zmean + AY[i] * AZion[i]; @@ -2436,7 +2434,7 @@ int main() { const Real UN_T6 = 0.3157746_rt; Real AY[NumSpec], AZion[NumSpec], ACMI[NumSpec]; Real RHO, RHOlg, T, Tlg, T6, Tnk, TEMP, DENS; - Real Zmean, CMImean, Z2mean, GAMI; + Real GAMI; Real CHI, TPT, TEGRAD, PRADnkT; Real P, UNkT, SNk, CV, CHIR, CHIT; int LIQSOL; @@ -2466,10 +2464,9 @@ int main() { melange9(AY, AZion, ACMI, RHO, T, // input PRADnkT, // additional output - radiative pressure - DENS, Zmean, CMImean, Z2mean, GAMI, CHI, TPT, LIQSOL, // output param. + DENS, GAMI, CHI, TPT, LIQSOL, // output param. P, UNkT, SNk, CV, CHIR, CHIT); // output dimensionless TD functions - Tnk = 8.31447e13_rt / CMImean * RHO * T6; // n_i kT [erg/cc] // -------------------- OUTPUT -------------------------------- // Here in the output we have: // RHO - mass density in g/cc From 1430a34b161b883d2a963e7c82d3b8cbe3e74f25 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Tue, 19 Oct 2021 00:02:36 -0700 Subject: [PATCH 63/70] Use more familiar abar and zbar names --- EOS/pc/eos_c.cpp | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index ad41f4663f..6f0d1fa17f 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -2261,23 +2261,23 @@ extern "C" } // Calculation of average values: - Real Zmean = 0.0_rt; - Real Z2mean = 0.0_rt; + Real zbar = 0.0_rt; + Real z2bar = 0.0_rt; Real Z52 = 0.0_rt; Real Z53 = 0.0_rt; Real Z73 = 0.0_rt; Real Z321 = 0.0_rt; // corr.26.12.09 - Real CMImean = 0.0_rt; + Real abar = 0.0_rt; for (int i = 0; i < NumSpec; ++i) { - Zmean = Zmean + AY[i] * AZion[i]; - Z2mean = Z2mean + AY[i] * AZion[i] * AZion[i]; + zbar = zbar + AY[i] * AZion[i]; + z2bar = z2bar + AY[i] * AZion[i] * AZion[i]; Real Z13 = std::pow(AZion[i], C13); Z53 = Z53 + AY[i] * std::pow(Z13, 5); Z73 = Z73 + AY[i] * std::pow(Z13, 7); Z52 = Z52 + AY[i] * std::pow(AZion[i], 2.5_rt); Z321 = Z321 + AY[i] * AZion[i] * std::pow(AZion[i] + 1.0_rt, 1.5_rt); // 26.12.09 - CMImean = CMImean + AY[i] * ACMI[i]; + abar = abar + AY[i] * ACMI[i]; } // (0) Photons: @@ -2285,7 +2285,7 @@ extern "C" Real PRESSRAD = UINTRAD / 3.0_rt; // (1) ideal electron gas (including relativity and degeneracy) - DENS = RHO / 11.20587 * Zmean / CMImean; // number density of electrons [au] + DENS = RHO / 11.20587 * zbar / abar; // number density of electrons [au] chemfit(DENS, TEMP, CHI); // NB: CHI can be used as true input instead of RHO or DENS @@ -2302,7 +2302,7 @@ extern "C" // (2) non - ideal Coulomb EIP Real RS = std::pow(0.75_rt / PI / DENS, C13); // r_s - electron density parameter - Real RSI = RS * CMImean * Z73 * AUM; // R_S - ion density parameter + Real RSI = RS * abar * Z73 * AUM; // R_S - ion density parameter Real GAME = 1.0_rt / RS / TEMP; // electron Coulomb parameter Gamma_e GAMImean = Z53 * GAME; // effective Gamma_i - ion Coulomb parameter @@ -2320,7 +2320,7 @@ extern "C" Real Stot = SEid * DENS; Real PDLT = PRESSE * CHITE; // d P_e[a.u.] / d ln T Real PDLR = PRESSE * CHIRE; // d P_e[a.u.] / d ln\rho - Real DENSI = DENS / Zmean; // number density of all ions + Real DENSI = DENS / zbar; // number density of all ions Real PRESSI = DENSI * TEMP; // ideal - ions total pressure (normalization) Real TPT2 = 0.0_rt; Real CTP = 4.0_rt * PI / AUM / (TEMP * TEMP); // common coefficient for TPT2.10.12.14 @@ -2371,7 +2371,7 @@ extern "C" // Corrections to the linear mixing rule: Real FMIX, UMIX, PMIX, CVMIX, PDTMIX, PDRMIX; if (LIQSOL == 0) { // liquid phase - cormix(RS, GAME, Zmean, Z2mean, Z52, Z53, Z321, + cormix(RS, GAME, zbar, z2bar, Z52, Z53, Z321, FMIX, UMIX, PMIX, CVMIX, PDTMIX, PDRMIX); } else { // solid phase (only Madelung contribution) [22.12.12] @@ -2423,7 +2423,7 @@ extern "C" CHIT = PDLT / PRESS; // d ln P / d ln T // Convert to CGS - Real Tnk = 8.31447e13_rt / CMImean * RHO * T6; // n_i kT [erg/cc] + Real Tnk = 8.31447e13_rt / abar * RHO * T6; // n_i kT [erg/cc] P = PnkT * Tnk; } From bedb3c7accfb4b9a35c6fbf4081c9a6b130bb11b Mon Sep 17 00:00:00 2001 From: Max Katz Date: Tue, 19 Oct 2021 00:20:51 -0700 Subject: [PATCH 64/70] Convert internal energy to cgs --- EOS/pc/eos_c.cpp | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 6f0d1fa17f..f376e63865 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -2198,7 +2198,7 @@ extern "C" void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real T, Real& PRADnkT, Real& DENS, Real& GAMImean, Real& CHI, Real& TPT, int& LIQSOL, - Real& P, Real& UNkT, Real& SNk, Real& CV, Real& CHIR, Real& CHIT) + Real& P, Real& U, Real& SNk, Real& CV, Real& CHIR, Real& CHIT) { // Version 18.04.20 // Difference from v.10.12.14: included switch - off of WK correction @@ -2232,8 +2232,8 @@ extern "C" // TPT - effective ionic quantum parameter (T_p / T) // LIQSOL = 0 / 1 for liquid / solid // SNk - dimensionless entropy per 1 ion - // UNkT - internal energy per kT per ion - // PnkT - pressure / n_i kT, where n_i is the ion number density + // U - internal energy + // P - pressure // PRADnkT - radiative pressure / n_i kT // CV - heat capacity per ion, div. by Boltzmann const. // CHIR - inverse compressibility - (d ln P / d ln V)_T ("\chi_r") @@ -2414,7 +2414,7 @@ extern "C" // First - order: PRADnkT = PRESSRAD / PRESSI; // radiative pressure / n_i k T Real PnkT = PRESS / PRESSI; // P / n_i k T - UNkT = UINT / PRESSI; // U / N_i k T + Real UNkT = UINT / PRESSI; // U / N_i k T SNk = Stot / DENSI; // S / N_i k // Second - order: @@ -2424,7 +2424,12 @@ extern "C" // Convert to CGS Real Tnk = 8.31447e13_rt / abar * RHO * T6; // n_i kT [erg/cc] + Real avo_eos = 6.0221417930e23_rt; + Real N = avo_eos / abar; + Real k_B = 1.3806488e-16_rt; + P = PnkT * Tnk; + U = UNkT * N * k_B * T; } } From 383ea1deca1de6c118e86f581cfcef7d63f36f94 Mon Sep 17 00:00:00 2001 From: Max Katz Date: Tue, 19 Oct 2021 00:21:59 -0700 Subject: [PATCH 65/70] entropy to CGS --- EOS/pc/eos_c.cpp | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index f376e63865..34f407b4d5 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -2198,7 +2198,7 @@ extern "C" void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real T, Real& PRADnkT, Real& DENS, Real& GAMImean, Real& CHI, Real& TPT, int& LIQSOL, - Real& P, Real& U, Real& SNk, Real& CV, Real& CHIR, Real& CHIT) + Real& P, Real& U, Real& S, Real& CV, Real& CHIR, Real& CHIT) { // Version 18.04.20 // Difference from v.10.12.14: included switch - off of WK correction @@ -2231,7 +2231,7 @@ extern "C" // CHI = mu_e / kT, where mu_e is the electron chem.potential // TPT - effective ionic quantum parameter (T_p / T) // LIQSOL = 0 / 1 for liquid / solid - // SNk - dimensionless entropy per 1 ion + // S - entropy // U - internal energy // P - pressure // PRADnkT - radiative pressure / n_i kT @@ -2415,7 +2415,7 @@ extern "C" PRADnkT = PRESSRAD / PRESSI; // radiative pressure / n_i k T Real PnkT = PRESS / PRESSI; // P / n_i k T Real UNkT = UINT / PRESSI; // U / N_i k T - SNk = Stot / DENSI; // S / N_i k + Real SNk = Stot / DENSI; // S / N_i k // Second - order: CV = CVtot / DENSI; // C_V per ion @@ -2430,6 +2430,7 @@ extern "C" P = PnkT * Tnk; U = UNkT * N * k_B * T; + S = SNk * N * k_B; } } @@ -2441,7 +2442,7 @@ int main() { Real RHO, RHOlg, T, Tlg, T6, Tnk, TEMP, DENS; Real GAMI; Real CHI, TPT, TEGRAD, PRADnkT; - Real P, UNkT, SNk, CV, CHIR, CHIT; + Real P, U, S, CV, CHIR, CHIT; int LIQSOL; Real T_arr[3], rho_arr[2]; @@ -2470,7 +2471,7 @@ int main() { melange9(AY, AZion, ACMI, RHO, T, // input PRADnkT, // additional output - radiative pressure DENS, GAMI, CHI, TPT, LIQSOL, // output param. - P, UNkT, SNk, CV, CHIR, CHIT); // output dimensionless TD functions + P, U, S, CV, CHIR, CHIT); // output dimensionless TD functions // -------------------- OUTPUT -------------------------------- // Here in the output we have: From 3d915828fe3a0317c64b47d9cfd468bd07569c9e Mon Sep 17 00:00:00 2001 From: Max Katz Date: Wed, 20 Oct 2021 20:45:59 -0700 Subject: [PATCH 66/70] Don't need to return pradnkt --- EOS/pc/eos_c.cpp | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp index 34f407b4d5..1d8ec920ec 100644 --- a/EOS/pc/eos_c.cpp +++ b/EOS/pc/eos_c.cpp @@ -2196,7 +2196,7 @@ extern "C" } void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real T, - Real& PRADnkT, Real& DENS, + Real& DENS, Real& GAMImean, Real& CHI, Real& TPT, int& LIQSOL, Real& P, Real& U, Real& S, Real& CV, Real& CHIR, Real& CHIT) { @@ -2234,7 +2234,6 @@ extern "C" // S - entropy // U - internal energy // P - pressure - // PRADnkT - radiative pressure / n_i kT // CV - heat capacity per ion, div. by Boltzmann const. // CHIR - inverse compressibility - (d ln P / d ln V)_T ("\chi_r") // CHIT = (d ln P / d ln T)_V ("\chi_T") @@ -2412,7 +2411,7 @@ extern "C" PDLR = PDLR + PRESSI * PDRMIX; // First - order: - PRADnkT = PRESSRAD / PRESSI; // radiative pressure / n_i k T + Real PRADnkT = PRESSRAD / PRESSI; // radiative pressure / n_i k T Real PnkT = PRESS / PRESSI; // P / n_i k T Real UNkT = UINT / PRESSI; // U / N_i k T Real SNk = Stot / DENSI; // S / N_i k @@ -2441,7 +2440,7 @@ int main() { Real AY[NumSpec], AZion[NumSpec], ACMI[NumSpec]; Real RHO, RHOlg, T, Tlg, T6, Tnk, TEMP, DENS; Real GAMI; - Real CHI, TPT, TEGRAD, PRADnkT; + Real CHI, TPT; Real P, U, S, CV, CHIR, CHIT; int LIQSOL; Real T_arr[3], rho_arr[2]; @@ -2469,7 +2468,6 @@ int main() { TEMP = T6 / UN_T6; // T [au] melange9(AY, AZion, ACMI, RHO, T, // input - PRADnkT, // additional output - radiative pressure DENS, GAMI, CHI, TPT, LIQSOL, // output param. P, U, S, CV, CHIR, CHIT); // output dimensionless TD functions From 0d80c4b60fd41563e2ce0bc58b83a55420a0e28b Mon Sep 17 00:00:00 2001 From: Max Katz Date: Wed, 20 Oct 2021 21:06:01 -0700 Subject: [PATCH 67/70] Move into AMReX infrastructure --- EOS/pc/Make.package | 0 EOS/pc/Makefile | 8 - EOS/pc/actual_eos.H | 2474 ++++++++++++++++++++++++++++++++++++++++++ EOS/pc/eos_c.cpp | 2491 ------------------------------------------- 4 files changed, 2474 insertions(+), 2499 deletions(-) create mode 100644 EOS/pc/Make.package delete mode 100644 EOS/pc/Makefile create mode 100644 EOS/pc/actual_eos.H delete mode 100644 EOS/pc/eos_c.cpp diff --git a/EOS/pc/Make.package b/EOS/pc/Make.package new file mode 100644 index 0000000000..e69de29bb2 diff --git a/EOS/pc/Makefile b/EOS/pc/Makefile deleted file mode 100644 index e0d0c1b77f..0000000000 --- a/EOS/pc/Makefile +++ /dev/null @@ -1,8 +0,0 @@ -test: eos_c.cpp - g++ -o test eos_c.cpp - -run: - ./test - -clean: - rm -f *.o ./test diff --git a/EOS/pc/actual_eos.H b/EOS/pc/actual_eos.H new file mode 100644 index 0000000000..a882434a0b --- /dev/null +++ b/EOS/pc/actual_eos.H @@ -0,0 +1,2474 @@ +#ifndef actual_eos_H +#define actual_eos_H + +#include +#include +#include +#include +#include + +#include +#include + +#include + +// Equation of state for fully ionized electron-ion plasmas (EOS EIP) +// A.Y.Potekhin & G.Chabrier, Contrib. Plasma Phys., 50 (2010) 82, +// and references therein +// Please communicate comments/suggestions to Alexander Potekhin: +// palex@astro.ioffe.ru +// Previously distributed versions (obsolete): +// eos2000, eos2002, eos2004, eos2006, eos2007, eos2009, eos10, eos11, +// eos13, and eos14. +// Last update: 04.03.21. All updates since 2008 are listed below. +//// L I S T O F S U B R O U T I N E S : +// MAIN (normally commented-out) - example driving routine. +// MELANGE9 - for arbitrary ionic mixture, renders total (ion+electron) +// pressure, internal energy, entropy, heat capacity (all +// normalized to the ionic ideal-gas values), logarithmic +// derivatives of pressure over temperature and density. +// EOSFI8 - nonideal (ion-ion + ion-electron + electron-electron) +// contributions to the free and internal energies, pressure, +// entropy, heat capacity, derivatives of pressure over +// logarithm of temperature and over logarithm of density (all +// normalized to the ionic ideal-gas values) for one ionic +// component in a mixture. +// FITION9 - ion-ion interaction contributions to the free and internal +// energies, pressure, entropy, heat capacity, derivatives of +// pressure over logarithms of temperature and density. +// FSCRliq8 - ion-electron (screening) contributions to the free and +// internal energies, pressure, entropy, heat capacity, +// derivatives of pressure over logarithms of temperature and +// density in the liquid phase for one ionic component in a +// mixture. +// FSCRsol8 - ion-electron (screening) contributions to the free and +// internal energies, pressure, entropy, heat capacity, +// derivatives of pressure over logarithms of temperature and +// density for monoionic solid. +// FHARM12 - harmonic (including static-lattice and zero-point) +// contributions to the free and internal energies, pressure, +// entropy, heat capacity, derivatives of pressure over +// logarithms of temperature and density for solid OCP. +// HLfit12 - the same as FHARM12, but only for thermal contributions +// ANHARM8 - anharmonic contributions to the free and internal energies, +// pressure, entropy, heat capacity, derivatives of pressure +// over logarithms of temperature and density for solid OCP. +// CORMIX - correction to the linear mixing rule for the Coulomb +// contributions to the thermodynamic functions in the liquid. +// ELECT11 - for an ideal electron gas of arbitrary degeneracy and +// relativity at given temperature and electron chemical +// potential, renders number density (in atomic units), free +// energy, pressure, internal energy, entropy, heat capacity +// (normalized to the electron ideal-gas values), logarithmic +// derivatives of pressure over temperature and density. +// EXCOR7 - electron-electron (exchange-correlation) contributions to +// the free and internal energies, pressure, entropy, heat +// capacity, derivatives of pressure over logarithm of +// temperature and over logarithm of density (all normalized +// to the classical electron ideal-gas values). +// FERINV7 - inverse non-relativistic Fermi integrals of orders -1/2, +// 1/2, 3/2, 5/2, and their first and second derivatives. +// BLIN9 - relativistic Fermi-Dirac integrals of orders 1/2, 3/2, 5/2, +// and their first, second, and some third derivatives. +// CHEMFIT7 - electron chemical potential at given density and +// temperature, and its first derivatives over density and +// temperature and the second derivative over temperature. +//// I M P R O V E M E N T S S I N C E 2 0 0 8 : +// FHARM8 uses a fit HLfit8 to the thermal free energy of the harmonic +// Coulomb lattice, which is more accurate than its predecessor FHARM7. +// Resulting corrections amount up to 20% for the ion heat capacity. +// Accordingly, S/R D3fit and FthCHA7 deleted (not used anymore). +// BLIN7 upgraded to BLIN8: +// - cleaned (a never-reached if-else branch deleted); +// - Sommerfeld (high-\chi) expansion improved; +// - some third derivatives added. +// CORMIX added (and MELANGE7 upgraded to MELANGE8 accordingly). +// ANHARM7 upgraded to ANHARM8, more consistent with Wigner-Kirkwood. +// Since the T- and rho-dependences of individual Z values in a mixture +// are not considered, the corresponding inputs (AYLR, AYLT) are +// excluded from MELANGE8 (and EOSFI7 changed to EOSFI8 accordingly). +// ELECT7 upgraded to ELECT9 (high-degeneracy behaviour is improved) +//// P O S T - P U B L I C A T I O N (2 0 1 0 +) IMPROVEMENTS : +// ELECT9 upgraded (smooth match of two fits at chi >> 1) +// BLIN8 replaced by BLIN9 - smooth fit interfaces at chi=0.6 and 14. +// MELANGE8 replaced by MELANGE9 - slightly modified input/output +// 08.08.11 - corrected mistake (unlikely to have an effect) in CHEMFIT7 +// 16.11.11 - ELECT9 upgraded to ELECT11 (additional output) +// 20.04.12 - FHARM8 and HLfit8 upgraded to FHARM12 and HLfit12: +// output of HLfit12 does not include zero-point vibr., but provides U1 +// 22.12.12 - MELANGE9 now includes a correction to the linear mixing +// rule (LMR) for the Madelung energy in the random bcc multi-ion +// lattice. +// 14.05.13 - an accidental error in programming the newly introduced +// correction to the LMR is fixed. +// 20.05.13 - calculation of the Wigner-Kirkwood quantum diffraction term +// for the liquid plasma is moved from EOSFI8 into MELANGE9. +// 10.12.14 - slight cleaning of the text (no effect on the results) +// 28.05.15 - an accidental error in Wigner-Kirkwood entropy correction +// is fixed (it was in the line "Stot=Stot+FWK*DENSI" since 20.05.13) +// 29.08.15 - eliminated underflow of exp(-THETA) in CHEMFIT7 +// 10.08.16 - modified criteria to avoid accuracy loss (round-off errors) +// 07.02.17 - included possibility to switch off the WK (Wigner) terms +// 27.05.17 - safeguard against Zion < 1 is added in FSCRsol8; +// safeguard against huge (-CHI) values is added in ELECT11. +// 27.01.19 - safeguard against X1=0 in CORMIX. +// 18.04.20 - corrected Wigner-Kirkwood term for heat capacity. +// 04.03.21 - corrected SUBFERMJ: defined parameter EPS (was undefined). + +const std::string eos_name = "pc"; + +// Inverse Fermi integral with q=1/2 +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void ferinv7 (Real F, Real& X) +{ + // Version 24.05.07 + // X_q(f)=F^{-1}_q(f) : H.M.Antia 93 ApJS 84, 101 + // Input: F + // Output: X = X_q + // Relative error: + // for X: 4.2e-9 + + const Real A[6] = { 1.999266880833e4_rt, 5.702479099336e3_rt, 6.610132843877e2_rt, + 3.818838129486e1_rt, 1.0_rt, 0.0_rt}; + const Real B[7] = { 1.771804140488e4_rt, -2.014785161019e3_rt, 9.130355392717e1_rt, + -1.670718177489e0_rt, 0.0_rt, 0.0_rt, + 0.0_rt}; + const Real C[7] = {-1.277060388085e-2_rt, 7.187946804945e-2_rt, -4.262314235106e-1_rt, + 4.997559426872e-1_rt, -1.285579118012e0_rt, -3.930805454272e-1_rt, + 1.0_rt}; + const Real D[7] = {-9.745794806288e-3_rt, 5.485432756838e-2_rt, -3.29946624326e-1_rt, + 4.077841975923e-1_rt, -1.145531476975e0_rt, -6.067091689181e-2_rt, + 0.0_rt}; + const int LA = 4; + const int LB = 3; + const int LD = 5; + + const int N = 1; + + if (F <= 0.0_rt) { + printf("ferinv7: Non-positive argument\n"); + exit(1); + } + if (F < 4.0_rt) { + Real T = F; + Real UP = 0.0_rt; + Real DOWN = 0.0_rt; + for (int i = LA; i >= 0; --i) { + UP = UP * T + A[i]; + } + for (int i = LB; i >= 0; --i) { + DOWN = DOWN * T + B[i]; + } + X = std::log(T * UP / DOWN); + } + else { + Real P = -1.0_rt / (0.5_rt + (Real) N); // = -1/(1+\nu) = power index + Real T = std::pow(F, P); // t - argument of the rational fraction + Real UP = 0.0_rt; + Real DOWN = 0.0_rt; + for (int i = 6; i >= 0; --i) { + UP = UP * T + C[i]; + } + for (int i = LD; i >= 0; --i) { + DOWN = DOWN * T + D[i]; + } + Real R = UP / DOWN; + X = R / T; + } +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void chemfit (Real DENS, Real TEMP, Real& CHI) +{ + // Version 29.08.15 + // Fit to the chemical potential of free electron gas described in: + // G.Chabrier & A.Y.Potekhin, Phys.Rev.E 58, 4941 (1998) + // Stems from CHEMFIT v.10.10.96. The main difference - derivatives. + // Input: DENS - electron density [a.u.=6.7483346e24 cm^{-3}], + // TEMP - temperature [a.u.=2Ryd=3.1577e5 K] + // Output: CHI = CMU1 / TEMR, where CMU1 = \mu-1 - chem.pot.w/o rest-energy + + const Real C13 = 1.0_rt / 3.0_rt; + const Real PARA = 1.612_rt; + const Real PARB = 6.192_rt; + const Real PARC = 0.0944_rt; + const Real PARF = 5.535_rt; + const Real PARG = 0.698_rt; + const Real XEPST = 228.0_rt; // the largest argument of e^{-X} + + Real DENR = DENS / 2.5733806e6_rt; // n_e in rel.un.=\lambda_{Compton}^{-3} + Real TEMR = TEMP / 1.8778865e4_rt; // T in rel.un.=(mc^2/k)=5.93e9 K + + Real PF0 = std::pow(29.6088132_rt * DENR, C13); // Classical Fermi momentum + Real TF; + if (PF0 > 1.e-4_rt) { + TF = std::sqrt(1.0_rt + PF0 * PF0) - 1.0_rt; // Fermi temperature + } + else { + TF = 0.5_rt * PF0 * PF0; + } + + Real THETA = TEMR / TF; + Real THETA32 = THETA * std::sqrt(THETA); + Real Q2 = 12.0_rt + 8.0_rt / THETA32; + Real T1 = 0.0_rt; + if (THETA < XEPST) { + T1 = std::exp(-THETA); + } + Real U3 = T1 * T1 + PARA; + Real THETAC = std::pow(THETA, PARC); + Real THETAG = std::pow(THETA, PARG); + Real D3 = PARB * THETAC * T1 * T1 + PARF * THETAG; + Real Q3 = 1.365568127_rt - U3 / D3; // 1.365...=2/\pi^{1/3} + Real Q1; + if (THETA > 1.e-5_rt) { + Q1 = 1.5_rt * T1 / (1.0_rt - T1); + } + else { + Q1 = 1.5 / THETA; + } + Real SQT = std::sqrt(TEMR); + Real G = (1.0_rt + Q2 * TEMR * Q3 + Q1 * SQT) * TEMR; + Real H = (1.0_rt + 0.5 * TEMR / THETA) * (1.0_rt + Q2 * TEMR); + Real CT = 1.0_rt + G / H; + Real F = 2.0_rt * C13 / THETA32; + Real X; + ferinv7(F, X); + CHI = X // Non-relativistic result + - 1.5_rt * std::log(CT); // Relativistic fit +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void blin9a (Real TEMP, Real CHI, + Real& W0, Real& W0DX, Real& W0DT, Real& W0DXX, + Real& W0DTT, Real& W0DXT, + Real& W1, Real& W1DX, Real& W1DT, Real& W1DXX, + Real& W1DTT, Real& W1DXT, + Real& W2, Real& W2DX, Real& W2DT, Real& W2DXX, + Real& W2DTT, Real& W2DXT, + Real& W0XXX, Real& W0XTT, Real& W0XXT) +{ + // Version 19.01.10 + // First part of blin9: small CHI. Stems from blin9 v.24.12.08 + const Real AC[3][5] = {{0.37045057_rt, 0.41258437_rt, + 9.777982e-2_rt, 5.3734153e-3_rt, 3.8746281e-5_rt}, // c_i^0 + {0.39603109_rt, 0.69468795_rt, + 0.22322760_rt, 1.5262934e-2_rt, 1.3081939e-4_rt}, // c_i^1 + {0.76934619_rt, 1.7891437_rt, + 0.70754974_rt, 5.6755672e-2_rt, 5.5571480e-4_rt}}; // c_i^2 + + const Real AU[3][5] = {{0.43139881_rt, 1.7597537_rt, + 4.10446540_rt, 7.7467038_rt, 13.457678_rt}, // \chi_i^0 + {0.81763176_rt, 2.4723339_rt, + 5.11600610_rt, 9.0441465_rt, 15.049882_rt}, // \chi_i^1 + {1.25584610_rt, 3.2070406_rt, + 6.12390820_rt, 10.3161260_rt, 16.597079_rt}}; // \chi_i^2 + + const Real AA[3][5] = {{std::exp(-AU[0][0]), std::exp(-AU[0][1]), + std::exp(-AU[0][2]), std::exp(-AU[0][3]), std::exp(-AU[0][4])}, // \chi_i^0 + {std::exp(-AU[1][0]), std::exp(-AU[1][1]), + std::exp(-AU[1][2]), std::exp(-AU[1][3]), std::exp(-AU[1][4])}, // \chi_i^1 + {std::exp(-AU[2][0]), std::exp(-AU[2][1]), + std::exp(-AU[2][2]), std::exp(-AU[2][3]), std::exp(-AU[2][4])}}; // \chi_i^2 + + for (int k = 0; k <= 2; ++k) { + Real W = 0.0; + Real WDX = 0.0; + Real WDT = 0.0; + Real WDXX = 0.0; + Real WDTT = 0.0; + Real WDXT = 0.0; + Real WDXXX = 0.0; + Real WDXTT = 0.0; + Real WDXXT = 0.0; + Real ECHI = std::exp(-CHI); + + for (int i = 0; i <= 4; ++i) { + Real SQ = std::sqrt(1.0_rt + AU[k][i] * TEMP / 2.0_rt); + Real DN = AA[k][i] + ECHI; // e^{-\chi_i}+e^{-\chi}) + + W = W + AC[k][i] * SQ / DN; + WDX = WDX + AC[k][i] * SQ / (DN * DN); + WDT = WDT + AC[k][i] * AU[k][i] / (SQ * DN); + WDXX = WDXX + AC[k][i] * SQ * (ECHI - AA[k][i]) / (DN * DN * DN); + WDTT = WDTT - AC[k][i] * AU[k][i] * AU[k][i] / (DN * SQ * SQ * SQ); + WDXT = WDXT + AC[k][i] * AU[k][i] / (SQ * DN * DN); + WDXXX = WDXXX + AC[k][i] * SQ * + (ECHI * ECHI - 4.0_rt * ECHI * AA[k][i] + AA[k][i] * AA[k][i]) / + (DN * DN * DN * DN); + WDXTT = WDXTT - AC[k][i] * AU[k][i] * AU[k][i] / (DN * DN * SQ * SQ * SQ); + WDXXT = WDXXT + AC[k][i] * AU[k][i] * (ECHI - AA[k][i]) / (SQ * DN * DN * DN); + } + + WDX = WDX * ECHI; + WDT = WDT / 4.0_rt; + WDXX = WDXX * ECHI; + WDTT = WDTT / 16.0_rt; + WDXT = WDXT / 4.0_rt * ECHI; + WDXXX = WDXXX * ECHI; + WDXTT = WDXTT * ECHI / 16.0_rt; + WDXXT = WDXXT / 4.0_rt * ECHI; + + if (k == 0) { + W0 = W; + W0DX = WDX; + W0DT = WDT; + W0DXX = WDXX; + W0DTT = WDTT; + W0DXT = WDXT; + W0XXX = WDXXX; + W0XTT = WDXTT; + W0XXT = WDXXT; + } + else if (k == 1) { + W1 = W; + W1DX = WDX; + W1DT = WDT; + W1DXX = WDXX; + W1DTT = WDTT; + W1DXT = WDXT; + } + else { + W2 = W; + W2DX = WDX; + W2DT = WDT; + W2DXX = WDXX; + W2DTT = WDTT; + W2DXT = WDXT; + } + } +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void blin9b(Real TEMP, Real CHI, + Real& W0, Real& W0DX, Real& W0DT, Real& W0DXX, + Real& W0DTT, Real& W0DXT, + Real& W1, Real& W1DX, Real& W1DT, Real& W1DXX, + Real& W1DTT, Real& W1DXT, + Real& W2, Real& W2DX, Real& W2DT, Real& W2DXX, + Real& W2DTT, Real& W2DXT, + Real& W0XXX, Real& W0XTT, Real& W0XXT) +{ + // Version 19.01.10 + // Small syntax fix 15.03.13 + // Second part of BILN9: intermediate CHI. Stems from BLIN8 v.24.12.08 + const Real EPS = 1.e-3; + + const Real AX[5] = {7.265351e-2_rt, 0.2694608_rt, + 0.533122_rt, 0.7868801_rt, 0.9569313_rt}; // x_i + const Real AXI[5] = {0.26356032_rt, 1.4134031_rt, + 3.59642580_rt, 7.0858100_rt, 12.640801_rt}; // \xi_i + const Real AH[5] = {3.818735e-2_rt, 0.1256732_rt, + 0.1986308_rt, 0.1976334_rt, 0.1065420_rt}; // H_i + const Real AV[5] = {0.29505869_rt, 0.32064856_rt, + 7.3915570e-2_rt, 3.6087389e-3_rt, 2.3369894e-5_rt}; // \bar{V}_i + + if (CHI < EPS) { + printf("BLIN9b: CHI is too small\n"); + exit(1); + } + + for (int k = 0; k <= 2; ++k) { + Real W = 0.0; + Real WDX = 0.0; + Real WDT = 0.0; + Real WDXX = 0.0; + Real WDTT = 0.0; + Real WDXT = 0.0; + Real WDXXX = 0.0; + Real WDXTT = 0.0; + Real WDXXT = 0.0; + Real SQCHI = std::sqrt(CHI); + + for (int i = 0; i <= 4; ++i) { + Real CE = AX[i] - 1.0_rt; + Real ECHI = std::exp(CE * CHI); + Real DE = 1.0_rt + ECHI; + Real D = 1.0_rt + AX[i] * CHI * TEMP / 2.0_rt; + Real H = std::pow(CHI, k + 1) * SQCHI * std::sqrt(D) / DE; + Real HX = (k + 1.5_rt) / CHI + 0.25_rt * AX[i] * TEMP / D - ECHI * CE / DE; + Real HDX = H * HX; + Real HXX = (k + 1.5_rt) / (CHI * CHI) + 0.125_rt * (AX[i] * TEMP / D) * (AX[i] * TEMP / D) + + ECHI * (CE / DE) * (CE / DE); + Real HDXX = HDX * HX - H * HXX; + Real HT = 0.25_rt * AX[i] * CHI / D; + Real HDT = H * HT; + Real HDTT = -H * HT * HT; + Real HTX = 1.0_rt / CHI - 0.5_rt * AX[i] * TEMP / D; + Real HDXT = HDX * HT + HDT * HTX; + Real HDXXT = HDXX * HT + HDX * HT * HTX + HDXT * HTX + + HDT * (0.25_rt * (AX[i] * TEMP / D) * (AX[i] * TEMP / D) - + 1.0_rt / (CHI * CHI)); + Real HDXTT = HDXT * HT - HDX * 0.125_rt * (AX[i] * CHI / D) * (AX[i] * CHI / D) + HDTT * HTX + + HDT * 0.5_rt * AX[i] * (TEMP * 0.5_rt * AX[i] * CHI / (D * D) - 1.0_rt / D); + Real HXXX = (2 * k + 3) / (CHI * CHI * CHI) + 0.125_rt * (AX[i] * TEMP / D) * (AX[i] * TEMP / D) * + (AX[i] * TEMP / D) - ECHI * (1.0_rt - ECHI) * (CE / DE) * (CE / DE) * (CE / DE); + Real HDXXX = HDXX * HX - 2.0_rt * HDX * HXX + H * HXXX; + Real XICHI = AXI[i] + CHI; + Real DXI = 1.0_rt + XICHI * TEMP / 2.0_rt; + Real V = std::pow(XICHI, k) * std::sqrt(XICHI * DXI); + Real VX= (k + 0.5_rt) / XICHI + 0.25_rt * TEMP / DXI; + Real VDX = V * VX; + Real VT = 0.25_rt * XICHI / DXI; + Real VDT = V * VT; + Real VXX = (k + 0.5_rt) / (XICHI * XICHI) + 0.125_rt * (TEMP / DXI) * (TEMP / DXI); + Real VDXX = VDX * VX - V * VXX; + Real VDXXX = VDXX * VX - 2.0_rt * VDX * VXX + + V * ((2 * k + 1) / (XICHI * XICHI * XICHI) + + 0.125_rt * (TEMP / DXI) * (TEMP / DXI) * (TEMP / DXI)); + Real VXXT = (1.0_rt - 0.5_rt * TEMP * XICHI / DXI) / DXI; + Real VDTT = -V * VT * VT; + Real VXT = 1.0_rt / XICHI - 0.5_rt * TEMP / DXI; + Real VDXT = VDT * VXT + VDX * VT; + Real VDXXT = VDXT * VX + VDX * 0.25_rt * VXXT - VDT * VXX - V * 0.25_rt * TEMP / DXI * VXXT; + Real VDXTT = VDTT * VXT - VDT * 0.5_rt * VXXT + VDXT * VT - + VDX * 0.125_rt * (XICHI / DXI) * (XICHI / DXI); + W = W + AH[i] * std::pow(AX[i], k) * H + AV[i] * V; + WDX = WDX + AH[i] * std::pow(AX[i], k) * HDX + AV[i] * VDX; + WDT = WDT + AH[i] * std::pow(AX[i], k) * HDT + AV[i] * VDT; + WDXX = WDXX + AH[i] * std::pow(AX[i], k) * HDXX + AV[i] * VDXX; + WDTT = WDTT + AH[i] * std::pow(AX[i], k) * HDTT + AV[i] * VDTT; + WDXT = WDXT + AH[i] * std::pow(AX[i], k) * HDXT + AV[i] * VDXT; + WDXXX = WDXXX + AH[i] * std::pow(AX[i], k) * HDXXX + AV[i] * VDXXX; + WDXTT = WDXTT + AH[i] * std::pow(AX[i], k) * HDXTT + AV[i] * VDXTT; + WDXXT = WDXXT + AH[i] * std::pow(AX[i], k) * HDXXT + AV[i] * VDXXT; + } + + if (k == 0) { + W0 = W; + W0DX = WDX; + W0DT = WDT; + W0DXX = WDXX; + W0DTT = WDTT; + W0DXT = WDXT; + W0XXX = WDXXX; + W0XTT = WDXTT; + W0XXT = WDXXT; + } + else if (k == 1) { + W1 = W; + W1DX = WDX; + W1DT = WDT; + W1DXX = WDXX; + W1DTT = WDTT; + W1DXT = WDXT; + } + else { + W2 = W; + W2DX = WDX; + W2DT = WDT; + W2DXX = WDXX; + W2DTT = WDTT; + W2DXT = WDXT; + } + } +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void blin9c (Real TEMP, Real CHI, + Real& W0, Real& W0DX, Real& W0DT, Real& W0DXX, Real& W0DTT, Real& W0DXT, + Real& W1, Real& W1DX, Real& W1DT, Real& W1DXX, Real& W1DTT, Real& W1DXT, + Real& W2, Real& W2DX, Real& W2DT, Real& W2DXX, Real& W2DTT, Real& W2DXT, + Real& W0XXX, Real& W0XTT, Real& W0XXT) +{ + // Version 19.01.10 + // Third part of BILN9: large CHI. Stems from BLIN8 v.24.12.08 + const Real PI = 3.141592653_rt; + const Real PI26 = PI * PI / 6.0; + + Real AM[3], AMDX[3], AMDT[3], AMDXX[3], AMDTT[3], AMDXT[3]; + + if (CHI * TEMP < 0.1_rt) { + + for (int k = 0; k <= 2; ++k) { + Real W = 0.0_rt; + Real WDX = 0.0_rt; + Real WDT = 0.0_rt; + Real WDXX = 0.0_rt; + Real WDTT = 0.0_rt; + Real WDXT = 0.0_rt; + Real WDXXX = 0.0_rt; + Real WDXTT = 0.0_rt; + Real WDXXT = 0.0_rt; + + Real C; + + for (int j = 0; j <= 4; ++j) { // for nonrel.Fermi integrals from k+1/2 to k+4.5 + Real CNU = k + j + 0.5_rt; // nonrelativistic Fermi integral index \nu + Real CHINU = std::pow(CHI, k + j) * std::sqrt(CHI); // \chi^\nu + Real F = CHINU * (CHI / (CNU + 1.0_rt) + PI26 * CNU / CHI + // nonrel.Fermi + 0.7_rt * PI26 * PI26 * CNU * (CNU - 1.0_rt) * + (CNU - 2.0_rt) / (CHI * CHI * CHI)); + Real FDX = CHINU * (1.0_rt + PI26 * CNU * (CNU - 1.0_rt) / (CHI * CHI) + + 0.7_rt * PI26 * PI26 * CNU * (CNU - 1.0_rt) * (CNU - 2.0_rt) + * (CNU - 3.0_rt) / (CHI * CHI * CHI * CHI)); + Real FDXX = CHINU / CHI * CNU * + (1.0_rt + PI26 * (CNU - 1.0_rt) * + (CNU - 2.0_rt) / (CHI * CHI) + + 0.7_rt * PI26 * PI26 * (CNU - 1.0_rt) * (CNU - 2.0_rt) * + (CNU - 3.0_rt) * (CNU - 4.0_rt) / (CHI * CHI * CHI * CHI)); + Real FDXXX = CHINU / (CHI * CHI) * CNU * (CNU - 1.0_rt) * + (1.0_rt + PI26 * (CNU - 2.0_rt) * (CNU - 3.0_rt) / (CHI * CHI) + + 0.7_rt * PI26 * PI26 * (CNU - 2.0_rt) * (CNU - 3.0_rt) * + (CNU - 4.0_rt) * (CNU - 5.0_rt) / (CHI * CHI * CHI * CHI)); + + if (j == 0) { + W = F; + WDX = FDX; + WDXX = FDXX; + WDXXX = FDXXX; + } + else if (j == 1) { + C = 0.25_rt * TEMP; + W = W + C * F; // Fermi-Dirac, expressed through Fermi + WDX = WDX + C * FDX; + WDXX = WDXX + C * FDXX; + WDT = F / 4.0_rt; + WDXT = FDX / 4.0_rt; + WDTT = 0.0_rt; + WDXXX = WDXXX + C * FDXXX; + WDXXT = FDXX / 4.0_rt; + WDXTT = 0.0_rt; + } + else { + C = -C / j * (2 * j - 3) / 4.0_rt * TEMP; + W = W + C * F; + WDX = WDX + C * FDX; + WDT = WDT + C * j / TEMP * F; + WDXX = WDXX + C * FDXX; + WDTT = WDTT + C * j * (j - 1) / (TEMP * TEMP) * F; + WDXT = WDXT + C * j / TEMP * FDX; + WDXXX = WDXXX + C * FDXXX; + WDXTT = WDXTT + C * j * (j - 1) / (TEMP * TEMP) * FDX; + WDXXT = WDXXT + C * j / TEMP * FDXX; + } + } + + if (k == 0) { + W0 = W; + W0DX = WDX; + W0DT = WDT; + W0DXX = WDXX; + W0DTT = WDTT; + W0DXT = WDXT; + W0XXX = WDXXX; + W0XTT = WDXTT; + W0XXT = WDXXT; + } + else if (k == 1) { + W1 = W; + W1DX = WDX; + W1DT = WDT; + W1DXX = WDXX; + W1DTT = WDTT; + W1DXT = WDXT; + } + else { + W2 = W; + W2DX = WDX; + W2DT = WDT; + W2DXX = WDXX; + W2DTT = WDTT; + W2DXT = WDXT; + } + } + + } + else { // CHI > 14, CHI * TEMP > 0.1: general high-\chi expansion + + Real D = 1.0_rt + CHI * TEMP / 2.0_rt; + Real R = std::sqrt(CHI * D); + Real RX = 0.5_rt / CHI + 0.25_rt * TEMP / D; + Real RDX = R * RX; + Real RDT = 0.25_rt * CHI * CHI / R; + Real RXX = -0.5_rt / (CHI * CHI) - 0.125_rt * (TEMP / D) * (TEMP / D); + Real RDXX = RDX * RX + R * RXX; + Real RDTT = -0.25_rt * RDT * CHI / D; + Real RXT = 0.25_rt / D - 0.125_rt * CHI * TEMP / (D * D); + Real RDXT = RDT * RX + R * RXT; + Real RXXX = 1.0_rt / (CHI * CHI * CHI) + 0.125_rt * (TEMP / D) * (TEMP / D) * (TEMP / D); + Real RDXXX = RDXX * RX + 2.0_rt * RDX * RXX + R * RXXX; + Real RXTT = -0.25_rt / (D * D) * CHI + 0.125_rt * CHI * CHI * TEMP / (D * D * D); + Real RDXTT = RDTT * RX + 2.0_rt * RDT * RXT + R * RXTT; + Real RXXT = -RXT * TEMP / D; + Real RDXXT = RDXT * RX + RDX * RXT + RDT * RXX + R * RXXT; + + Real AMDXXX, AMDXTT, AMDXXT; + + for (int k = 0; k <= 2; ++k) { + Real DM = k + 0.5_rt + (k + 1.0_rt) * CHI * TEMP / 2.0_rt; + AM[k] = std::pow(CHI, k) * DM / R; + Real FMX1 = 0.5_rt * (k + 1.0_rt) * TEMP / DM; + Real FMX2 = 0.25_rt * TEMP / D; + Real FMX = (k - 0.5_rt) / CHI + FMX1 - FMX2; + AMDX[k] = AM[k] * FMX; + Real CkM = 0.5_rt * (k + 1.0_rt) / DM; + Real FMT1 = CkM * CHI; + Real FMT2 = 0.25_rt * CHI / D; + Real FMT = FMT1 - FMT2; + AMDT[k] = AM[k] * FMT; + Real FMXX = -(k - 0.5_rt) / (CHI * CHI) - FMX1 * FMX1 + 2.0_rt * FMX2 * FMX2; + AMDXX[k] = AMDX[k] * FMX + AM[k] * FMXX; + Real FMTT = 2.0_rt * FMT2 * FMT2 - FMT1 * FMT1; + AMDTT[k] = AMDT[k] * FMT + AM[k] * FMTT; + AMDXT[k] = AMDX[k] * FMT + AM[k] * (CkM * (1.0_rt - CkM * CHI * TEMP) - + 0.25_rt / D + 0.125_rt * CHI * TEMP / (D * D)); + + if (k == 0) { + Real FMXXX = (2 * k - 1) / (CHI * CHI * CHI) + 2.0_rt * FMX1 * FMX1 * FMX1 - + 8.0_rt * FMX2 * FMX2 * FMX2; + AMDXXX = AMDXX[k] * FMX + 2.0_rt * AMDX[k] * FMXX + AM[k] * FMXXX; + Real FMT1DX = CkM - TEMP * CHI * CkM * CkM; + Real FMT2DX = (0.25_rt - CHI * TEMP * 0.125_rt / D) / D; + Real FMXT = FMT1DX - FMT2DX; + Real FMTTX = 4.0_rt * FMT2 * FMT2DX - 2.0_rt * FMT1 * FMT1DX; + AMDXTT = AMDXT[k] * FMT + AMDT[k] * FMXT + AMDX[k] * FMTT + AM[k] * FMTTX; + Real FMX1DT = CkM - CHI * TEMP * CkM * CkM; + Real FMX2DT = 0.25_rt / D * (1.0_rt - 0.5_rt * CHI * TEMP / D); + Real FMXXT = 4.0_rt * FMX2 * FMX2DT - 2.0_rt * FMX1 * FMX1DT; + AMDXXT = AMDXT[k] * FMX + AMDX[k] * FMXT + AMDT[k] * FMXX + AM[k] * FMXXT; + } + } + + Real SQ2T = std::sqrt(2.0_rt * TEMP); + Real A = 1.0_rt + CHI * TEMP + SQ2T * R; + Real ADX = TEMP + SQ2T * RDX; + Real ADT = CHI + R / SQ2T + SQ2T * RDT; + Real ADXX = SQ2T * RDXX; + Real ADTT = -R / (SQ2T * SQ2T * SQ2T) + 2.0_rt / SQ2T * RDT + SQ2T * RDTT; + Real ADXT = 1.0_rt + RDX / SQ2T + SQ2T * RDXT; + Real ADXTT = -RDX / (SQ2T * SQ2T * SQ2T) + 2.0_rt / SQ2T * RDXT + SQ2T * RDXTT; + Real ADXXT = RDXX / SQ2T + SQ2T * RDXXT; + Real XT1 = CHI + 1.0_rt / TEMP; + Real Aln = std::log(A); + Real FJ0 = 0.5_rt * XT1 * R - Aln / (SQ2T * SQ2T * SQ2T); + Real ASQ3 = A * SQ2T * SQ2T * SQ2T; + Real ASQ3DX = ADX * SQ2T * SQ2T * SQ2T; + Real FJ0DX = 0.5_rt * (R + XT1 * RDX) - ADX / ASQ3; + Real FJ0DT = 0.5_rt * (XT1 * RDT - R / (TEMP * TEMP)) - ADT / ASQ3 + + 0.75_rt / (TEMP * TEMP * SQ2T) * Aln; + Real FJ0DXX = RDX + 0.5_rt * XT1 * RDXX + (ADX / A) * (ADX / A) / (SQ2T * SQ2T * SQ2T) - ADXX / ASQ3; + Real FJ0DTT = R / (TEMP * TEMP * TEMP) - RDT / (TEMP * TEMP) + 0.5_rt * XT1 * RDTT + + 3.0_rt / (ASQ3 * TEMP) * ADT + + (ADT / A) * (ADT / A) / (SQ2T * SQ2T * SQ2T) - ADTT / ASQ3 - + 1.875_rt / (TEMP * TEMP * TEMP * SQ2T) * Aln; + Real BXT = 1.5_rt / TEMP * ADX + ADX * ADT / A - ADXT; + Real BXXT = 1.5_rt / TEMP * ADXX + (ADXX * ADT + ADX * ADXT) / A - + (ADX / A) * (ADX / A) * ADT - ADXXT; + Real FJ0DXT = 0.5_rt * (RDT - RDX / (TEMP * TEMP) + XT1 * RDXT) + BXT / ASQ3; + Real FJ0XXX = RDXX * 1.5_rt + 0.5_rt * XT1 * RDXXX + + (2.0_rt * ADX * (ADXX / A - (ADX / A) * (ADX / A)) - + SQ2T * RDXXX + ADXX / ASQ3 * ASQ3DX) / ASQ3; + Real FJ0XTT = RDX / (TEMP * TEMP * TEMP) - RDXT / (TEMP * TEMP) + 0.5_rt * (RDTT + XT1 * RDXTT) + + 3.0_rt / TEMP * (ADXT - ADT / ASQ3 * ASQ3DX) / ASQ3 + + (2.0_rt * ADT * (ADXT / A - ADT * ADX / (A * A)) - + ADXTT + ADTT * ASQ3DX / ASQ3) / ASQ3 - 1.875_rt / (TEMP * TEMP * TEMP * SQ2T) * ADX / A; + Real FJ0XXT = 0.5_rt * (RDXT - RDXX / (TEMP * TEMP) + RDXT + XT1 * RDXXT) + + (BXXT - BXT * ASQ3DX / ASQ3) / ASQ3; + + W0 = FJ0 + PI26 * AM[0]; + W0DX = FJ0DX + PI26 * AMDX[0]; + W0DT = FJ0DT + PI26 * AMDT[0]; + W0DXX = FJ0DXX + PI26 * AMDXX[0]; + W0DTT = FJ0DTT + PI26 * AMDTT[0]; + W0DXT = FJ0DXT + PI26 * AMDXT[0]; + W0XXX = FJ0XXX + PI26 * AMDXXX; + W0XTT = FJ0XTT + PI26 * AMDXTT; + W0XXT = FJ0XXT + PI26 * AMDXXT; + + Real FJ1 = (R * R * R / 1.5_rt - FJ0) / TEMP; + Real FJ1DX = (2.0_rt * R * R * RDX - FJ0DX) / TEMP; + Real FJ1DT = (2.0_rt * R * R * RDT - FJ0DT - FJ1) / TEMP; + Real FJ1DXX = (4.0_rt * R * RDX * RDX + 2.0_rt * R * R * RDXX - FJ0DXX) / TEMP; + Real FJ1DTT = (4.0_rt * R * RDT * RDX + 2.0_rt * R * R * RDTT - FJ0DTT - 2.0_rt * FJ1DT) / TEMP; + Real FJ1DXT = (4.0_rt * R * RDX * RDT + 2.0_rt * R * R * RDXT - FJ0DXT - FJ1DX) / TEMP; + + W1 = FJ1 + PI26 * AM[1]; + W1DX = FJ1DX + PI26 * AMDX[1]; + W1DT = FJ1DT + PI26 * AMDT[1]; + W1DXX = FJ1DXX + PI26 * AMDXX[1]; + W1DTT = FJ1DTT + PI26 * AMDTT[1]; + W1DXT = FJ1DXT + PI26 * AMDXT[1]; + + Real FJ2 = (0.5_rt * CHI * R * R * R - 1.25_rt * FJ1) / TEMP; + Real FJ2DX = (0.5_rt * R * R * R + 1.5_rt * CHI * R * R * RDX - 1.25_rt * FJ1DX) / TEMP; + Real FJ2DT = (1.5_rt * CHI * R * R * RDT - 1.25_rt * FJ1DT - FJ2) / TEMP; + Real FJ2DXX = (3.0_rt * R * RDX * (R + CHI * RDX) + 1.5_rt * CHI * R * R * RDXX - + 1.25_rt * FJ1DXX) / TEMP; + Real FJ2DTT = (3.0_rt * CHI * R * (RDT * RDT + 0.5_rt * R * RDTT) - + 1.25_rt * FJ1DTT - 2.0_rt * FJ2DT) / TEMP; + Real FJ2DXT = (1.5_rt * R * RDT * (R + 2.0_rt * CHI * RDX) + 1.5_rt * CHI * R * R * RDXT - + 1.25_rt * FJ1DXT - FJ2DX) / TEMP; + + W2 = FJ2 + PI26 * AM[2]; + W2DX = FJ2DX + PI26 * AMDX[2]; + W2DT = FJ2DT + PI26 * AMDT[2]; + W2DXX = FJ2DXX + PI26 * AMDXX[2]; + W2DTT = FJ2DTT + PI26 * AMDTT[2]; + W2DXT = FJ2DXT + PI26 * AMDXT[2]; + } + +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void fermi10 (Real X, Real XMAX, Real& FP, Real& FM) +{ + // Version 20.01.10 + // Fermi distribution function and its 3 derivatives + // Input: X - argument f(x) + // XMAX - max|X| where it is assumed that 0 < f(x) < 1. + // Output: FP = f(x) + // FM = 1-f(x) + if (X > XMAX) { + FP = 0.0_rt; + FM = 1.0_rt; + } + else if (X < -XMAX) { + FP = 1.0_rt; + FM = 0.0_rt; + } + else { + FP = 1.0 / (std::exp(X) + 1.0_rt); + FM = 1.0 - FP; + } +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void blin9 (Real TEMP, Real CHI, + Real& W0, Real& W0DX, Real& W0DT, Real& W0DXX, Real& W0DTT, Real& W0DXT, + Real& W1, Real& W1DX, Real& W1DT, Real& W1DXX, Real& W1DTT, Real& W1DXT, + Real& W2, Real& W2DX, Real& W2DT, Real& W2DXX, Real& W2DTT, Real& W2DXT, + Real& W0XXX, Real& W0XTT, Real& W0XXT) +{ + // Version 21.01.10 + // Stems from BLIN8 v.24.12.08 + // Difference - smooth matching of different CHI ranges + // Input: TEMP=T/mc^2; CHI=(\mu-mc^2)/T + // Output: Wk - Fermi-Dirac integral of the order k+1/2 + // WkDX=dWk/dCHI, WkDT = dWk/dT, WkDXX=d^2 Wk / d CHI^2, + // WkDTT=d^2 Wk / d T^2, WkDXT=d^2 Wk /dCHIdT, + // W0XXX=d^3 W0 / d CHI^3, W0XTT=d^3 W0 /(d CHI d^2 T), + // W0XXT=d^3 W0 /dCHI^2 dT + + const Real CHI1 = 0.6_rt; + const Real CHI2 = 14.0_rt; + const Real XMAX = 30.0_rt; + const Real DCHI1 = 0.1_rt; + const Real DCHI2 = CHI2 - CHI1 - DCHI1; + const Real XSCAL1 = XMAX / DCHI1; + const Real XSCAL2 = XMAX / DCHI2; + + Real X1 = (CHI - CHI1) * XSCAL1; + Real X2 = (CHI - CHI2) * XSCAL2; + + if (X1 < - XMAX) { + + blin9a(TEMP, CHI, + W0, W0DX, W0DT, W0DXX, W0DTT, W0DXT, + W1, W1DX, W1DT, W1DXX, W1DTT, W1DXT, + W2, W2DX, W2DT, W2DXX, W2DTT, W2DXT, + W0XXX, W0XTT, W0XXT); + + } + else if (X2 < XMAX) { // match two fits + + Real W0a, W0DXa, W0DTa, W0DXXa, W0DTTa, W0DXTa, + W1a, W1DXa, W1DTa, W1DXXa, W1DTTa, W1DXTa, + W2a, W2DXa, W2DTa, W2DXXa, W2DTTa, W2DXTa, + W0XXXa, W0XTTa, W0XXTa; + + Real W0b, W0DXb, W0DTb, W0DXXb, W0DTTb, W0DXTb, + W1b, W1DXb, W1DTb, W1DXXb, W1DTTb, W1DXTb, + W2b, W2DXb, W2DTb, W2DXXb, W2DTTb, W2DXTb, + W0XXXb, W0XTTb, W0XXTb; + + Real FP, FM; + + if (X1 < XMAX) { // match fits "a" and "b" + + fermi10(X1, XMAX, FP, FM); + blin9a(TEMP, CHI, + W0a, W0DXa, W0DTa, W0DXXa, W0DTTa, W0DXTa, + W1a, W1DXa, W1DTa, W1DXXa, W1DTTa, W1DXTa, + W2a, W2DXa, W2DTa, W2DXXa, W2DTTa, W2DXTa, + W0XXXa, W0XTTa, W0XXTa); + blin9b(TEMP, CHI, + W0b, W0DXb, W0DTb, W0DXXb, W0DTTb, W0DXTb, + W1b, W1DXb, W1DTb, W1DXXb, W1DTTb, W1DXTb, + W2b, W2DXb, W2DTb, W2DXXb, W2DTTb, W2DXTb, + W0XXXb, W0XTTb, W0XXTb); + + } + else { // match fits "b" and "c" + + fermi10(X2, XMAX, FP, FM); + blin9b(TEMP, CHI, + W0a, W0DXa, W0DTa, W0DXXa, W0DTTa, W0DXTa, + W1a, W1DXa, W1DTa, W1DXXa, W1DTTa, W1DXTa, + W2a, W2DXa, W2DTa, W2DXXa, W2DTTa, W2DXTa, + W0XXXa, W0XTTa, W0XXTa); + blin9c(TEMP, CHI, + W0b, W0DXb, W0DTb, W0DXXb, W0DTTb, W0DXTb, + W1b, W1DXb, W1DTb, W1DXXb, W1DTTb, W1DXTb, + W2b, W2DXb, W2DTb, W2DXXb, W2DTTb, W2DXTb, + W0XXXb, W0XTTb, W0XXTb); + + } + + W0 = W0a * FP + W0b * FM; + W0DX = W0DXa * FP + W0DXb * FM; + W0DT = W0DTa * FP + W0DTb * FM; + W0DXX = W0DXXa * FP + W0DXXb * FM; + W0DTT = W0DTTa * FP + W0DTTb * FM; + W0DXT = W0DXTa * FP + W0DXTb * FM; + W0XXX = W0XXXa * FP + W0XXXb * FM; + W0XTT = W0XTTa * FP + W0XTTb * FM; + W0XXT = W0XXTa * FP + W0XXTb * FM; + W1 = W1a * FP + W1b * FM; + W1DX = W1DXa * FP + W1DXb * FM; + W1DT = W1DTa * FP + W1DTb * FM; + W1DXX = W1DXXa * FP + W1DXXb * FM; + W1DTT = W1DTTa * FP + W1DTTb * FM; + W1DXT = W1DXTa * FP + W1DXTb * FM; + W2 = W2a * FP + W2b * FM; + W2DX = W2DXa * FP + W2DXb * FM; + W2DT = W2DTa * FP + W2DTb * FM; + W2DXX = W2DXXa * FP + W2DXXb * FM; + W2DTT = W2DTTa * FP + W2DTTb * FM; + W2DXT = W2DXTa * FP + W2DXTb * FM; + + } + else { + + blin9c(TEMP, CHI, + W0, W0DX, W0DT, W0DXX, W0DTT, W0DXT, + W1, W1DX, W1DT, W1DXX, W1DTT, W1DXT, + W2, W2DX, W2DT, W2DXX, W2DTT, W2DXT, + W0XXX, W0XTT, W0XXT); + + } +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void excor7 (double RS, double GAME, + double& FXC, double& UXC, double& PXC, + double& CVXC, double& SXC, double& PDTXC, + double& PDRXC) +{ + // Version 09.06.07 + // Accuracy-loss cut-off modified on 10.08.16 + // Exchange-correlation contribution for the electron gas + // Stems from TANAKA1 v.03.03.96. Added derivatives. + // Input: RS - electron density parameter =electron-sphere radius in a.u. + // GAME - electron Coulomb coupling parameter + // Output: FXC - excess free energy of e-liquid per kT per one electron + // according to Tanaka & Ichimaru 85-87 and Ichimaru 93 + // UXC - internal energy contr.[per 1 electron, kT] + // PXC - pressure contribution divided by (n_e kT) + // CVXC - heat capacity divided by N_e k + // SXC - entropy divided by N_e k + // PDTXC,PDRXC = PXC + d PXC / d ln(T,\rho) + const Real EPS = 1.e-8_rt; // 10.08.16 + + Real THETA = 0.543_rt * RS / GAME; // non-relativistic degeneracy parameter + Real SQTH = std::sqrt(THETA); + Real THETA2 = THETA * THETA; + Real THETA3 = THETA2 * THETA; + Real THETA4 = THETA3 * THETA; + + Real T1, T1DH, T1DHH, T2, T2DH, T2DHH; + + if (THETA > .005_rt) { + Real CHT1 = std::cosh(1.0_rt / THETA); + Real SHT1 = std::sinh(1.0_rt / THETA); + Real CHT2 = std::cosh(1.0_rt / SQTH); + Real SHT2 = std::sinh(1.0_rt / SQTH); + T1 = SHT1 / CHT1; // tanh(1.0_rt / THETA) + T2 = SHT2 / CHT2; // tanh(1.0_rt / sqrt(THETA)) + T1DH = -1.0_rt / ((THETA * CHT1) * (THETA * CHT1)); // d T1 / d\theta + T1DHH = 2.0_rt / ((THETA * CHT1) * (THETA * CHT1) * (THETA * CHT1)) * + (CHT1 - SHT1 / THETA); + T2DH = -0.5_rt * SQTH / ((THETA * CHT2) * (THETA * CHT2)); + T2DHH = (0.75_rt * SQTH * CHT2 - 0.5_rt * SHT2) / + ((THETA * CHT2) * (THETA * CHT2) * (THETA * CHT2)); + } + else { + T1 = 1.0_rt; + T2 = 1.0_rt; + T1DH = 0.0_rt; + T2DH = 0.0_rt; + T1DHH = 0.0_rt; + T2DHH = 0.0_rt; + } + + Real A0 = 0.75_rt + 3.04363_rt * THETA2 - 0.09227_rt * THETA3 + 1.7035_rt * THETA4; + Real A0DH = 6.08726_rt * THETA - 0.27681_rt * THETA2 + 6.814_rt * THETA3; + Real A0DHH = 6.08726_rt - 0.55362_rt * THETA + 20.442_rt * THETA2; + Real A1 = 1.0_rt + 8.31051_rt * THETA2 + 5.1105_rt * THETA4; + Real A1DH = 16.62102_rt * THETA + 20.442_rt * THETA3; + Real A1DHH = 16.62102_rt + 61.326_rt * THETA2; + Real A = 0.610887_rt * A0 / A1 * T1; // HF fit of Perrot and Dharma - wardana + Real AH = A0DH / A0 - A1DH / A1 + T1DH / T1; + Real ADH = A * AH; + Real ADHH = ADH * AH + A * (A0DHH / A0 - (A0DH / A0) * (A0DH / A0) - + A1DHH / A1 + (A1DH / A1) * (A1DH / A1) + + T1DHH / T1 - (T1DH / T1) * (T1DH / T1)); + Real B0 = 0.341308_rt + 12.070873_rt * THETA2 + 1.148889_rt * THETA4; + Real B0DH = 24.141746_rt * THETA + 4.595556_rt * THETA3; + Real B0DHH = 24.141746_rt + 13.786668_rt * THETA2; + Real B1 = 1.0_rt + 10.495346_rt * THETA2 + 1.326623 * THETA4; + Real B1DH = 20.990692_rt * THETA + 5.306492 * THETA3; + Real B1DHH = 20.990692_rt + 15.919476_rt * THETA2; + Real B = SQTH * T2 * B0 / B1; + Real BH = 0.5_rt / THETA + T2DH / T2 + B0DH / B0 - B1DH / B1; + Real BDH = B * BH; + Real BDHH = BDH * BH + B * (-0.5_rt / THETA2 + T2DHH / T2 - (T2DH / T2) * (T2DH / T2) + + B0DHH / B0 - (B0DH / B0) * (B0DH / B0) - B1DHH / B1 + + (B1DH / B1) * (B1DH / B1)); + Real D0 = 0.614925_rt + 16.996055_rt * THETA2 + 1.489056_rt * THETA4; + Real D0DH = 33.99211_rt * THETA + 5.956224_rt * THETA3; + Real D0DHH = 33.99211_rt + 17.868672_rt * THETA2; + Real D1 = 1.0_rt + 10.10935_rt * THETA2 + 1.22184_rt * THETA4; + Real D1DH = 20.2187_rt * THETA + 4.88736_rt * THETA3; + Real D1DHH = 20.2187_rt + 14.66208_rt * THETA2; + Real D = SQTH * T2 * D0 / D1; + Real DH = 0.5_rt / THETA + T2DH / T2 + D0DH / D0 - D1DH / D1; + Real DDH = D * DH; + Real DDHH = DDH * DH + D * (-0.5_rt / THETA2 + T2DHH / T2 - (T2DH / T2) * (T2DH / T2) + + D0DHH / D0 - (D0DH / D0) * (D0DH / D0) - D1DHH / D1 + + (D1DH / D1) * (D1DH / D1)); + Real E0 = 0.539409_rt + 2.522206_rt * THETA2 + 0.178484_rt * THETA4; + Real E0DH = 5.044412_rt * THETA + 0.713936_rt * THETA3; + Real E0DHH = 5.044412_rt + 2.141808_rt * THETA2; + Real E1 = 1.0_rt + 2.555501_rt * THETA2 + 0.146319_rt * THETA4; + Real E1DH = 5.111002_rt * THETA + 0.585276_rt * THETA3; + Real E1DHH = 5.111002_rt + 1.755828_rt * THETA2; + Real E = THETA * T1 * E0 / E1; + Real EH = 1.0_rt / THETA + T1DH / T1 + E0DH / E0 - E1DH / E1; + Real EDH = E * EH; + Real EDHH = EDH * EH + E * (T1DHH / T1 - (T1DH / T1) * (T1DH / T1) + E0DHH / E0 - + (E0DH / E0) * (E0DH / E0) - + E1DHH / E1 + (E1DH / E1) * (E1DH / E1) - 1.0_rt / THETA2); + Real EXP1TH = std::exp(-1.0_rt / THETA); + Real C = (0.872496_rt + 0.025248_rt * EXP1TH) * E; + Real CDH = 0.025248_rt * EXP1TH / THETA2 * E + C * EDH / E; + Real CDHH = 0.025248_rt * EXP1TH / THETA2 * (EDH + (1.0_rt - 2.0_rt * THETA) / THETA2 * E) + + CDH * EDH / E + C * EDHH / E - C * (EDH / E) * (EDH / E); + Real DISCR = std::sqrt(4.0_rt * E - D * D); + Real DIDH = 0.5_rt / DISCR * (4.0_rt * EDH - 2.0_rt * D * DDH); + Real DIDHH = (-std::pow((2.0_rt * EDH - D * DDH) / DISCR, 2) + 2.0_rt * EDHH - + DDH * DDH - D * DDHH) / DISCR; + Real S1 = -C / E * GAME; + Real S1H = CDH / C - EDH / E; + Real S1DH = S1 * S1H; + Real S1DHH = S1DH * S1H + S1 * (CDHH / C - (CDH / C) * (CDH / C) - + EDHH / E + (EDH / E) * (EDH / E)); + Real S1DG = -C / E; // = > S1DGG = 0 + Real S1DHG = S1DG * (CDH / C - EDH / E); + Real B2 = B - C * D / E; + Real B2DH = BDH - (CDH * D + C * DDH) / E + C * D * EDH / (E * E); + Real B2DHH = BDHH - (CDHH * D + 2.0_rt * CDH * DDH + C * DDHH) / E + + (2.0_rt * (CDH * D + C * DDH - C * D * EDH / E) * EDH + + C * D * EDHH) / (E * E); + Real SQGE = std::sqrt(GAME); + Real S2 = -2.0_rt / E * B2 * SQGE; + Real S2H = B2DH / B2 - EDH / E; + Real S2DH = S2 * S2H; + Real S2DHH = S2DH * S2H + S2 * (B2DHH / B2 - (B2DH / B2) * (B2DH / B2) - + EDHH / E + (EDH / E) * (EDH / E)); + Real S2DG = 0.5_rt * S2 / GAME; + Real S2DGG = -0.5_rt * S2DG / GAME; + Real S2DHG = 0.5_rt * S2DH / GAME; + Real R3 = E * GAME + D * SQGE + 1.0_rt; + Real R3DH = EDH * GAME + DDH * SQGE; + Real R3DHH = EDHH * GAME + DDHH * SQGE; + Real R3DG = E + 0.5_rt * D / SQGE; + Real R3DGG = -0.25_rt * D / (GAME * SQGE); + Real R3DHG = EDH + 0.5_rt * DDH / SQGE; + Real B3 = A - C / E; + Real B3DH = ADH - CDH / E + C * EDH / (E * E); + Real B3DHH = ADHH - CDHH / E + (2.0_rt * CDH * EDH + C * EDHH) / (E * E) - + 2.0_rt * C * EDH * EDH / (E * E * E); + Real C3 = (D / E * B2 - B3) / E; // = D * B2 / (E * E) - B3 / E; + Real C3DH = (DDH * B2 + D * B2DH + B3 * EDH) / (E * E) - + 2.0_rt * D * B2 * EDH / (E * E * E) - B3DH / E; + Real C3DHH = (-B3DHH + + (DDHH * B2 + 2.0_rt * DDH * B2DH + D * B2DHH + + B3DH * EDH + B3 * EDHH + B3DH * EDH) / E - + 2.0_rt * ((DDH * B2 + D * B2DH + B3 * EDH + DDH * B2 + D * B2DH) * EDH + + D * B2 * EDHH) / (E * E) + + 6.0_rt * D * B2 * EDH * EDH / (E * E * E)) / E; + Real S3 = C3 * std::log(R3); + Real S3DH = S3 * C3DH / C3 + C3 * R3DH / R3; + Real S3DHH = (S3DH * C3DH + S3 * C3DHH) / C3 - S3 * (C3DH / C3) * (C3DH / C3) + + (C3DH * R3DH + C3 * R3DHH) / R3 - C3 * (R3DH / R3) * (R3DH / R3); + Real S3DG = C3 * R3DG / R3; + Real S3DGG = C3 * (R3DGG / R3 - (R3DG / R3) * (R3DG / R3)); + Real S3DHG = (C3DH * R3DG + C3 * R3DHG) / R3 - C3 * R3DG * R3DH / (R3 * R3); + Real B4 = 2.0_rt - D * D / E; + Real B4DH = EDH * (D / E) * (D / E) - 2.0_rt * D * DDH / E; + Real B4DHH = EDHH * (D / E) * (D / E) + 2.0_rt * EDH * (D / E) * (D / E) * (DDH / D - EDH / E) - + 2.0_rt * (DDH * DDH + D * DDHH) / E + 2.0_rt * D * DDH * EDH / (E * E); + Real C4 = 2.0_rt * E * SQGE + D; + Real C4DH = 2.0_rt * EDH * SQGE + DDH; + Real C4DHH = 2.0_rt * EDHH * SQGE + DDHH; + Real C4DG = E / SQGE; + Real C4DGG = -0.5_rt * E / (GAME * SQGE); + Real C4DHG = EDH / SQGE; + Real S4A = 2.0_rt / E / DISCR; + Real S4AH = EDH / E + DIDH / DISCR; + Real S4ADH = -S4A * S4AH; + Real S4ADHH = -S4ADH * S4AH - + S4A * (EDHH / E - (EDH / E) * (EDH / E) + DIDHH / DISCR - + (DIDH / DISCR) * (DIDH / DISCR)); + Real S4B = D * B3 + B4 * B2; + Real S4BDH = DDH * B3 + D * B3DH + B4DH * B2 + B4 * B2DH; + Real S4BDHH = DDHH * B3 + 2.0_rt * DDH * B3DH + D * B3DHH + B4DHH * B2 + + 2.0_rt * B4DH * B2DH + B4 * B2DHH; + Real S4C = std::atan(C4 / DISCR) - std::atan(D / DISCR); + Real UP1 = C4DH * DISCR - C4 * DIDH; + Real DN1 = DISCR * DISCR + C4 * C4; + Real UP2 = DDH * DISCR - D * DIDH; + Real DN2 = DISCR * DISCR + D * D; + Real S4CDH = UP1 / DN1 - UP2 / DN2; + Real S4CDHH = (C4DHH * DISCR - C4 * DIDHH) / DN1 - + UP1 * 2.0_rt * (DISCR * DIDH + C4 * C4DH) / (DN1 * DN1) - + (DDHH * DISCR - D * DIDHH) / DN2 + UP2 * 2.0_rt * + (DISCR * DIDH + D * DDH) / (DN2 * DN2); + Real S4CDG = C4DG * DISCR / DN1; + Real S4CDGG = C4DGG * DISCR / DN1 - 2.0_rt * C4 * DISCR * (C4DG / DN1) * (C4DG / DN1); + Real S4CDHG = (C4DHG * DISCR + C4DG * DIDH - + C4DG * DISCR / DN1 * 2.0_rt * (DISCR * DIDH + C4 * C4DH)) / DN1; + Real S4 = S4A * S4B * S4C; + Real S4DH = S4ADH * S4B * S4C + S4A * S4BDH * S4C + S4A * S4B * S4CDH; + Real S4DHH = S4ADHH * S4B * S4C + S4A * S4BDHH * S4C + S4A * S4B * S4CDHH + + 2.0_rt * (S4ADH * S4BDH * S4C + S4ADH * S4B * S4CDH + S4A * S4BDH * S4CDH); + Real S4DG = S4A * S4B * S4CDG; + Real S4DGG = S4A * S4B * S4CDGG; + Real S4DHG = S4A * S4B * S4CDHG + S4CDG * (S4ADH * S4B + S4A * S4BDH); + + FXC = S1 + S2 + S3 + S4; + Real FXCDH = S1DH + S2DH + S3DH + S4DH; + Real FXCDG = S1DG + S2DG + S3DG + S4DG; + Real FXCDHH = S1DHH + S2DHH + S3DHH + S4DHH; + Real FXCDGG = S2DGG + S3DGG + S4DGG; + Real FXCDHG = S1DHG + S2DHG + S3DHG + S4DHG; + PXC = (GAME * FXCDG - 2.0_rt * THETA * FXCDH) / 3.0_rt; + UXC = GAME * FXCDG - THETA * FXCDH; + SXC = (GAME * S2DG - S2 + GAME * S3DG - S3 + S4A * S4B * (GAME * S4CDG - S4C)) - + THETA * FXCDH; + if (std::abs(SXC) < EPS * std::abs(THETA * FXCDH)) { + SXC = 0.0_rt; // accuracy loss + } + CVXC = 2.0_rt * THETA * (GAME * FXCDHG - FXCDH) - THETA * THETA * FXCDHH - GAME * GAME * FXCDGG; + if (std::abs(CVXC) < EPS * std::abs(GAME * GAME * FXCDGG)) { + CVXC = 0.0_rt; // accuracy + } + Real PDLH = THETA * (GAME * FXCDHG - 2.0_rt * FXCDH - 2.0_rt * THETA * FXCDHH) / 3.0_rt; + Real PDLG = GAME * (FXCDG + GAME * FXCDGG - 2.0_rt * THETA * FXCDHG) / 3.0_rt; + PDRXC = PXC + (PDLG - 2.0_rt * PDLH) / 3.0_rt; + PDTXC = GAME * (THETA * FXCDHG - GAME * FXCDGG / 3.0_rt) - + THETA * (FXCDH / 0.75_rt + THETA * FXCDHH / 1.5_rt); +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void subfermj (Real CMU1, + Real& CJ00, Real& CJ10, Real& CJ20, + Real& CJ01, Real& CJ11, Real& CJ21, + Real& CJ02, Real& CJ12, Real& CJ22, + Real& CJ03, Real& CJ13, Real& CJ23, + Real& CJ04, Real& CJ14, Real& CJ24, Real& CJ05) +{ + // Version 17.11.11 + // corrected 04.03.21 + // Supplement to SOMMERF + const Real EPS = 1.e-4_rt; // inserted 04.03.21 + if (CMU1 <= 0.0_rt) { + printf("SUBFERMJ: small CHI\n"); + exit(1); + } + + Real CMU = 1.0_rt + CMU1; + Real X0 = std::sqrt(CMU1 * (2.0_rt + CMU1)); + Real X3 = X0 * X0 * X0; + Real X5 = X3 * X0 * X0; + Real X7 = X5 * X0 * X0; + if (X0 < EPS) { + CJ00 = X3 / 3.0_rt; + CJ10 = 0.1_rt * X5; + CJ20 = X7 / 28.0_rt; + } + else { + Real CL = std::log(X0 + CMU); + CJ00 = 0.5_rt * (X0 * CMU - CL); // J_{1/2}^0 + CJ10 = X3 / 3.0_rt - CJ00; // J_{3/2}^0 + CJ20 = (0.75_rt * CMU - 2.0_rt) / 3.0_rt * X3 + 1.25_rt * CJ00; // J_{5/2}^0 + } + + CJ01 = X0; // J_{1/2}^1 + CJ11 = CJ01 * CMU1; // J_{3/2}^1 + CJ21 = CJ11 * CMU1; // J_{5/2}^1 + Real RCJ02 = CMU / X0; // J_{1/2}^2 + CJ12 = CMU1 / X0 * (3.0_rt + 2.0_rt * CMU1); // J_{3/2}^2 + CJ22 = CMU1 * CMU1 / X0 * (5.0_rt + 3.0_rt * CMU1); // J_{5/2}^2 + CJ03 = -1.0_rt / X3; // J_{1/2}^3 + CJ13 = CMU1 / X3 * (2.0_rt * CMU1 * CMU1 + 6.0_rt * CMU1 + 3.0_rt); + CJ23 = CMU1 * CMU1 / X3 * (6.0_rt * CMU1 * CMU1 + 2.0e1_rt * CMU1 + 1.5e1_rt); + CJ04 = 3.0_rt * CMU / X5; + CJ14 = -3.0_rt * CMU1 / X5; + CJ24 = CMU1 * CMU1 / X5 * (6.0_rt * CMU1 * CMU1 * CMU1 + 3.0e1_rt * CMU1 * CMU1 + + 45.0_rt * CMU1 + 15.0_rt); + CJ05 = (-12.0_rt * CMU1 * CMU1 - 24.0_rt * CMU1 - 15.0_rt) / (X7); +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void sommerf (Real TEMR, Real CHI, + Real& W0, Real& W0DX, Real& W0DT, Real& W0DXX, Real& W0DTT, Real& W0DXT, + Real& W1, Real& W1DX, Real& W1DT, Real& W1DXX, Real& W1DTT, Real& W1DXT, + Real& W2, Real& W2DX, Real& W2DT, Real& W2DXX, Real& W2DTT, Real& W2DXT, + Real& W0XXX, Real& W0XTT, Real& W0XXT) +{ + // Version 17.11.11 + // Sommerfeld expansion for the Fermi-Dirac integrals + // Input: TEMR=T/mc^2; CHI=(\mu-mc^2)/T + // Output: Wk - Fermi-Dirac integral of the order k+1/2 + // WkDX=dWk/dCHI, WkDT = dWk/dT, WkDXX=d^2 Wk / d CHI^2, + // WkDTT=d^2 Wk / d T^2, WkDXT=d^2 Wk /dCHIdT, + // W0XXX=d^3 W0 / d CHI^3, W0XTT=d^3 W0 /(d CHI d^2 T), + // W0XXT=d^3 W0 /dCHI^2 dT + // [Draft source: yellow book pages 124-127] + + const Real PI = 3.141592653_rt; + const Real PI2 = PI * PI; + + if (CHI < 0.5_rt) { + printf("SOMMERF: non-degenerate (small CHI)\n"); + exit(1); + } + + if (TEMR <= 0.0_rt) { + printf("SOMMERF: T < 0\n"); + exit(1); + } + + Real CMU1 = CHI * TEMR; // chemical potential in rel.units + Real CMU = 1.0_rt + CMU1; + + Real CJ00, CJ10, CJ20; + Real CJ01, CJ11, CJ21; + Real CJ02, CJ12, CJ22; + Real CJ03, CJ13, CJ23; + Real CJ04, CJ14, CJ24; + Real CJ05; + + subfermj(CMU1, + CJ00, CJ10, CJ20, + CJ01, CJ11, CJ21, + CJ02, CJ12, CJ22, + CJ03, CJ13, CJ23, + CJ04, CJ14, CJ24, CJ05); + + Real PIT26 = (PI * TEMR)*(PI * TEMR) / 6.0_rt; + Real CN0 = std::sqrt(0.5_rt / TEMR) / TEMR; + Real CN1 = CN0 / TEMR; + Real CN2 = CN1 / TEMR; + W0 = CN0 * (CJ00 + PIT26 * CJ02); // + CN0 * PITAU4 * CJ04 + W1 = CN1 * (CJ10 + PIT26 * CJ12); // + CN1 * PITAU4 * CJ14 + W2 = CN2 * (CJ20 + PIT26 * CJ22); // + CN2 * PITAU4 * CJ24 + W0DX = CN0 * TEMR * (CJ01 + PIT26 * CJ03); // + CN0 * PITAU4 * CJ05 + W1DX = CN0 * (CJ11 + PIT26 * CJ13); + W2DX = CN1 * (CJ21 + PIT26 * CJ23); + W0DT = CN1 * (CMU1 * CJ01 - 1.5_rt * CJ00 + PIT26 * (CMU1 * CJ03 + 0.5_rt * CJ02)); + W1DT = CN2 * (CMU1 * CJ11 - 2.5_rt * CJ10 + PIT26 * (CMU1 * CJ13 - 0.5_rt * CJ12)); + W2DT = CN2 / TEMR * (CMU1 * CJ21 - 3.5_rt * CJ20 + PIT26 * (CMU1 * CJ23 - 1.5_rt * CJ22)); + W0DXX = CN0 * TEMR * TEMR * (CJ02 + PIT26 * CJ04); + W1DXX = CN0 * TEMR * (CJ12 + PIT26 * CJ14); + W2DXX = CN0 * (CJ22 + PIT26 * CJ24); + W0DXT = CN0 * (CMU1 * CJ02 - 0.5_rt * CJ01 + PIT26 * (CMU1 * CJ04 + 1.5_rt * CJ03)); + W1DXT = CN1 * (CMU1 * CJ12 - 1.5_rt * CJ11 + PIT26 * (CMU1 * CJ14 + 0.5_rt * CJ13)); + W2DXT = CN2 * (CMU1 * CJ22 - 2.5_rt * CJ21 + PIT26 * (CMU1 * CJ24 - 0.5_rt * CJ23)); + W0DTT = CN2 * (3.75_rt * CJ00 - 3.0_rt * CMU1 * CJ01 + CMU1 * CMU1 * CJ02 + + PIT26 * (-0.25_rt * CJ02 + CMU1 * CJ03 + CMU1 * CMU1 * CJ04)); + W1DTT = CN2 / TEMR * (8.75_rt * CJ10 - 5.0_rt * CMU1 * CJ11 + CMU1 * CMU1 * CJ12 + + PIT26 * (0.75_rt * CJ12 - CMU1 * CJ13 + CMU1 * CMU1 * CJ14)); + W2DTT = CN2 / TEMR * TEMR * (15.75_rt * CJ20 - 7.0_rt * CMU1 * CJ21 + CMU1 * CMU1 * CJ22 + + PIT26 * (3.75_rt * CJ22 - 3.0_rt * CMU1 * CJ23 + CMU1 * CMU1 * CJ24)); + W0XXX = CN0 * TEMR * TEMR * TEMR * (CJ03 + PIT26 * CJ05); + W0XXT = CN0 * TEMR * (CMU1 * CJ03 + 0.5_rt * CJ02 + PIT26 * (CMU1 * CJ05 + 2.5_rt * CJ04)); + W0XTT = CN1 * (0.75_rt * CJ01 - CMU1 * CJ02 + CMU1 * CMU1 * CJ03 + + PIT26 * (0.75_rt * CJ03 + 3.0_rt * CMU1 * CJ04 + CMU1 * CMU1 * CJ05)); +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void elect11b(Real TEMP, Real CHI, + Real& DENS, Real& FEid, Real& PEid, Real& UEid, + Real& SEid, Real& CVE, Real& CHITE, Real& CHIRE, + Real& DlnDH, Real& DlnDT, Real& DlnDHH, + Real& DlnDTT, Real& DlnDHT) +{ + // Version 17.11.11 + // Stems from ELECT9b v.19.01.10, Diff. - additional output. + // Sommerfeld expansion at very large CHI. + + const Real BOHR = 137.036_rt; + const Real PI = 3.141592653_rt; + const Real PI2 = PI * PI; + const Real BOHR2 = BOHR * BOHR; + const Real BOHR3 = BOHR2 * BOHR; // cleaned 15/6 + + Real TEMR = TEMP / BOHR2; // T in rel.units ( = T/mc^2) + Real EF = CHI * TEMR; // Fermi energy in mc^2 - zeroth aprox. = CMU1 + Real DeltaEF = PI2 * TEMR * TEMR / 6.0_rt * (1.0_rt + 2.0_rt * EF * (2.0_rt + EF)) / + (EF * (1.0_rt + EF) * (2.0_rt + EF)); // corr. [p.125, equiv.Eq.(6) of PC'10] + EF = EF + DeltaEF; // corrected Fermi energy (14.02.09) + Real G = 1.0_rt + EF; // electron Lorentz-factor + + Real PF, F, DF, P, DP; + + if (EF > 1.e-5_rt) { // relativistic expansion (Yak.&Shal.'89) + PF = std::sqrt(G * G - 1.0_rt); // Fermi momentum [rel.un. = mc] + F = (PF * (1.0_rt + 2.0_rt * PF * PF) * G - PF * PF * PF / .375_rt - std::log(PF + G)) / 8.0_rt / PI2; // F/V + DF = -TEMR * TEMR * PF * G / 6.0_rt; // thermal correction to F/V + P = (PF * G * (PF * PF / 1.5_rt - 1.0_rt) + std::log(PF + G)) / 8.0_rt / PI2; // P(T = 0) + DP = TEMR * TEMR * PF * (PF * PF + 2.0_rt) / G / 18.0_rt; // thermal correction to P + CVE = PI2 * TEMR * G / (PF * PF); + } + else { // nonrelativistic limit + PF = std::sqrt(2.0_rt * EF); + F = (PF * PF * PF * PF * PF) * 0.1_rt / PI2; + DF = -TEMR * TEMR * PF / 6.0_rt; + P = F / 1.5_rt; + DP = TEMR * TEMR * PF / 9.0_rt; + CVE = PI2 * TEMR / EF / 2.0_rt; + } + + F = F + DF; + P = P + DP; + Real S = -2.0_rt * DF; // entropy per unit volume [rel.un.] + Real U = F + S; + CHIRE = (PF * PF * PF * PF * PF) / (9.0_rt * PI2 * P * G); + CHITE = 2.0_rt * DP / P; + Real DENR = PF * PF * PF / 3.0_rt / PI2; // n_e [rel.un. = \Compton^{-3}] + DENS = DENR * BOHR3; // conversion to a.u.( = \Bohr_radius^{-3}) + + // derivatives over chi at constant T and T at constant chi: + Real TPI = TEMR * std::sqrt(2.0_rt * TEMR) / PI2; // common pre-factor + + Real W0, W0DX, W0DT, W0DXX, W0DTT, W0DXT; + Real W1, W1DX, W1DT, W1DXX, W1DTT, W1DXT; + Real W2, W2DX, W2DT, W2DXX, W2DTT, W2DXT; + Real W0XXX, W0XTT, W0XXT; + + sommerf(TEMR, CHI, + W0, W0DX, W0DT, W0DXX, W0DTT, W0DXT, + W1, W1DX, W1DT, W1DXX, W1DTT, W1DXT, + W2, W2DX, W2DT, W2DXX, W2DTT, W2DXT, + W0XXX, W0XTT, W0XXT); + + Real dndH = TPI * (W0DX + TEMR * W1DX); // (d n_e/d\chi)_T + Real dndT = TPI * (1.5_rt * W0 / TEMR + 2.5 * W1 + W0DT + TEMR * W1DT); // (d n_e/dT)_\chi + Real dndHH = TPI * (W0DXX + TEMR * W1DXX); // (d^2 n_e/d\chi)_T + Real dndTT = TPI * (0.75_rt * W0 / TEMR * TEMR + 3. * W0DT / TEMR + W0DTT + + 3.75 * W1 / TEMR + 5. * W1DT + TEMR * W1DTT); + Real dndHT = TPI * (1.5_rt * W0DX / TEMR + W0DXT + 2.5 * W1DX + TEMR * W1DXT); + + DlnDH = dndH / DENR; // (d ln n_e/d\chi)_T + DlnDT = dndT * TEMR / DENR; // (d ln n_e/d ln T)_\chi + DlnDHH = dndHH / DENR - DlnDH * DlnDH; // (d^2 ln n_e/d\chi^2)_T + DlnDTT = TEMR * TEMR / DENR * dndTT + DlnDT - DlnDT * DlnDT; // d^2 ln n_e/d ln T^2 + DlnDHT = TEMR / DENR * (dndHT - dndT * DlnDH); // d^2 ln n_e/d\chi d ln T + + Real DT = DENR * TEMR; + PEid = P / DT; + UEid = U / DT; + FEid = F / DT; + SEid = S / DT; + + // Empirical corrections of 16.02.09: + Real D1 = DeltaEF / EF; + Real D2 = D1 * (4.0_rt - 2.0_rt * (PF / G)); + CVE = CVE / (1.0_rt + D2); + SEid = SEid / (1.0_rt + D1); + CHITE = CHITE / (1.0_rt + D2); +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void elect11a(Real TEMP, Real CHI, + Real& DENS, Real& FEid, Real& PEid, Real& UEid, + Real& SEid, Real& CVE, Real& CHITE, Real& CHIRE, + Real& DlnDH, Real& DlnDT, Real& DlnDHH, Real& DlnDTT, + Real& DlnDHT) +{ + // Version 16.11.11 + // This is THE FIRST PART of ELECT9 v.04.03.09. + const Real BOHR = 137.036_rt; + const Real PI = 3.141592653_rt; + const Real PI2 = PI * PI; + const Real BOHR2 = BOHR * BOHR; + const Real BOHR3 = BOHR2 * BOHR; // cleaned 15/6 + + Real TEMR = TEMP / BOHR2; // T in rel.units (=T/mc^2) + + Real W0, W0DX, W0DT, W0DXX, W0DTT, W0DXT; + Real W1, W1DX, W1DT, W1DXX, W1DTT, W1DXT; + Real W2, W2DX, W2DT, W2DXX, W2DTT, W2DXT; + Real W0XXX, W0XTT, W0XXT; + + blin9(TEMR, CHI, + W0, W0DX, W0DT, W0DXX, W0DTT, W0DXT, + W1, W1DX, W1DT, W1DXX, W1DTT, W1DXT, + W2, W2DX, W2DT, W2DXX, W2DTT, W2DXT, + W0XXX, W0XTT, W0XXT); + + Real TPI = TEMR * std::sqrt(2.0_rt * TEMR) / PI2; // common pre-factor + Real DENR = TPI * (W1 * TEMR + W0); + Real PR = TEMR * TPI / 3.0_rt * (W2 * TEMR + 2.0_rt * W1); + Real U = TEMR * TPI * (W2 * TEMR + W1); + + // (these are density, pressure, and internal energy in the rel.units) + PEid = PR / (DENR * TEMR); + UEid = U / (DENR * TEMR); + FEid = CHI - PEid; + DENS = DENR * BOHR3; // converts from rel.units to a.u. + SEid = UEid - FEid; + + // derivatives over T at constant chi: + Real dndT = TPI * (1.5_rt * W0 / TEMR + 2.5_rt * W1 + W0DT + TEMR * W1DT); // (d n_e/dT)_\chi + Real dPdT = TPI / 3.0_rt * (5.0_rt * W1 + 2.0_rt * TEMR * W1DT + 3.5_rt * TEMR * W2 + TEMR * TEMR * W2DT); //dP/dT + Real dUdT = TPI * (2.5_rt * W1 + TEMR * W1DT + 3.5_rt * TEMR * W2 + TEMR * TEMR * W2DT); //dU/dT_\chi + + // derivatives over chi at constant T and second derivatives: + Real dndH = TPI * (W0DX + TEMR * W1DX); // (d n_e/d\chi)_T + Real dndHH = TPI * (W0DXX + TEMR * W1DXX); // (d^2 n_e/d\chi)_T + Real dndTT = TPI * (0.75_rt * W0 / TEMR * TEMR + 3.0_rt * W0DT / TEMR + W0DTT + + 3.75_rt * W1 / TEMR + 5.0_rt * W1DT + TEMR * W1DTT); + Real dndHT = TPI * (1.5_rt * W0DX / TEMR + W0DXT + 2.5_rt * W1DX + TEMR * W1DXT); + + DlnDH = dndH / DENR; // (d ln n_e/d\chi)_T + DlnDT = dndT * TEMR / DENR; // (d ln n_e/d ln T)_\chi + DlnDHH = dndHH / DENR - DlnDH * DlnDH; // (d^2 ln n_e/d\chi^2)_T + DlnDTT = TEMR * TEMR / DENR * dndTT + DlnDT - DlnDT * DlnDT; // d^2 ln n_e/d ln T^2 + DlnDHT = TEMR / DENR * (dndHT - dndT * DlnDH); // d^2 ln n_e/d\chi d ln T + Real dPdH = TPI / 3.0_rt * TEMR * (2.0_rt * W1DX + TEMR * W2DX); // (d P_e/d\chi)_T + Real dUdH = TPI * TEMR * (W1DX + TEMR * W2DX); // (d U_e/d\chi)_T + CVE = (dUdT - dUdH * dndT / dndH) / DENR; + CHITE = TEMR / PR * (dPdT - dPdH * dndT / dndH); + CHIRE = DENR / PR * dPdH / dndH; // (dndH * TEMR * PEid) // DENS / PRE * dPdH / dndH +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void elect11 (double TEMP, double CHI, + Real& DENS, Real& FEid, Real& PEid, Real& UEid, + Real& SEid, Real& CVE, Real& CHITE, Real& CHIRE, + Real& DlnDH, Real& DlnDT, Real& DlnDHH, Real& DlnDTT, + Real& DlnDHT) +{ + // Version 17.11.11 + // safeguard against huge (-CHI) values is added 27.05.17 + // ELECT9 v.04.03.09 + smooth match of two fits at chi >> 1 + add.outputs + // Compared to ELECTRON v.06.07.00, this S/R is completely rewritten: + // numerical differentiation is avoided now. + // Compared to ELECT7 v.06.06.07, + // - call BLIN7 is changed to call BLIN9, + // - Sommerfeld expansion is used at chi >~ 28 i.o. 1.e4 + // - Sommerfeld expansion is corrected: introduced DeltaEF, D1 and D2. + // Ideal electron-gas EOS. + // Input: TEMP - T [a.u.], CHI=\mu/T + // Output: DENS - electron number density n_e [a.u.], + // FEid - free energy / N_e kT, UEid - internal energy / N_e kT, + // PEid - pressure (P_e) / n_e kT, SEid - entropy / N_e k, + // CVE - heat capacity / N_e k, + // CHITE=(d ln P_e/d ln T)_V, CHIRE=(d ln P_e/d ln n_e)_T + // DlnDH=(d ln n_e/d CHI)_T = (T/n_e) (d n_e/d\mu)_T + // DlnDT=(d ln n_e/d ln T)_CHI + // DlnDHH=(d^2 ln n_e/d CHI^2)_T + // DlnDTT=(d^2 ln n_e/d (ln T)^2)_CHI + // DlnDHT=d^2 ln n_e/d (ln T) d CHI + + const Real CHI2 = 28.0_rt; + const Real XMAX = 20.0_rt; + const Real DCHI2 = CHI2 - 1.0_rt; + const Real XSCAL2 = XMAX / DCHI2; + + if (CHI < -1.e2_rt) { + printf("ELECT11: too large negative CHI\n"); // 27.05.17 + exit(1); + } + + Real X2 = (CHI - CHI2) * XSCAL2; + if (X2 < -XMAX) { + elect11a(TEMP, CHI, + DENS, FEid, PEid, UEid, SEid, CVE, CHITE, CHIRE, + DlnDH, DlnDT, DlnDHH, DlnDTT, DlnDHT); + } + else if (X2 > XMAX) { + elect11b(TEMP, CHI, + DENS, FEid, PEid, UEid, SEid, CVE, CHITE, CHIRE, + DlnDH, DlnDT, DlnDHH, DlnDTT, DlnDHT); + } + else { + Real FP, FM; + fermi10(X2, XMAX, FP, FM); + + Real DENSa, FEida, PEida, UEida, SEida, CVEa, CHITEa, CHIREa; + Real DlnDHa, DlnDTa, DlnDHHa, DlnDTTa, DlnDHTa; + + elect11a(TEMP, CHI, + DENSa, FEida, PEida, UEida, SEida, CVEa, CHITEa, CHIREa, + DlnDHa, DlnDTa, DlnDHHa, DlnDTTa, DlnDHTa); + + Real DENSb, FEidb, PEidb, UEidb, SEidb, CVEb, CHITEb, CHIREb; + Real DlnDHb, DlnDTb, DlnDHHb, DlnDTTb, DlnDHTb; + + elect11b(TEMP, CHI, + DENSb, FEidb, PEidb, UEidb, SEidb, CVEb, CHITEb, CHIREb, + DlnDHb, DlnDTb, DlnDHHb, DlnDTTb, DlnDHTb); + + DENS = DENSa * FP + DENSb * FM; + FEid = FEida * FP + FEidb * FM; + PEid = PEida * FP + PEidb * FM; + UEid = UEida * FP + UEidb * FM; + SEid = SEida * FP + SEidb * FM; + CVE = CVEa * FP + CVEb * FM; + CHITE = CHITEa * FP + CHITEb * FM; + CHIRE = CHIREa * FP + CHIREb * FM; + DlnDH = DlnDHa * FP + DlnDHb * FM; + DlnDT = DlnDTa * FP + DlnDTb * FM; + DlnDHH = DlnDHHa * FP + DlnDHHb * FM; + DlnDHT = DlnDHTa * FP + DlnDHTb * FM; + DlnDTT = DlnDTTa * FP + DlnDTTb * FM; + } +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void fscrsol8 (Real RS, Real GAMI, Real ZNUCL, Real TPT, + Real& FSCR, Real& USCR, Real& PSCR, Real& S_SCR, + Real& CVSCR, Real& PDTSCR, Real& PDRSCR) +{ + // Version 28.05.08 + // undefined zero variable Q1DXG is wiped out 21.06.10 + // accuracy-loss safeguard added 10.08.16 + // safequard against Zion < 1 added 27.05.17 + // Fit to the el.-ion screening in bcc or fcc Coulomb solid + // Stems from FSCRsol8 v.09.06.07. Included a check for RS = 0. + // INPUT: RS - el. density parameter, GAMI - ion coupling parameter, + // ZNUCL - ion charge, TPT = T_p/T - ion quantum parameter + // OUTPUT: FSCR - screening (e-i) free energy per kT per 1 ion, + // USCR - internal energy per kT per 1 ion (screen.contrib.) + // PSCR - pressure divided by (n_i kT) (screen.contrib.) + // S_SCR - screening entropy contribution / (N_i k) + // CVSCR - heat capacity per 1 ion (screen.contrib.) + // PDTSCR,PDRSCR = PSCR + d PSCR / d ln(T,\rho) + + const Real C13 = 1.0_rt / 3.0_rt; + const Real ENAT = 2.7182818285_rt; + const Real TINY = 1.e-19_rt; + + const Real AP[4] = {1.1866_rt, 0.684_rt, 17.9_rt, 41.5_rt}; + const Real PX = 0.205_rt; // for bcc lattice + + if (RS < 0.0_rt) { + printf("FSCRliq8: RS < 0\n"); + exit(1); + } + + if (RS < TINY) { + FSCR = 0.0_rt; + USCR = 0.0_rt; + PSCR = 0.0_rt; + S_SCR = 0.0_rt; + CVSCR = 0.0_rt; + PDTSCR = 0.0_rt; + PDRSCR = 0.0_rt; + return; + } + + Real Zion = ZNUCL; + if (Zion < 1.0_rt) { // 27.05.17 + Zion = 1.0_rt; + } + + Real XSR = 0.0140047_rt / RS; // relativity parameter + Real Z13 = std::pow(Zion, C13); + Real P1 = 0.00352_rt * (1.0_rt - AP[0] / std::pow(Zion, 0.267_rt) + 0.27_rt / Zion); + Real P2 = 1.0_rt + 2.25_rt / Z13 * + (1.0_rt + AP[1] * (Zion * Zion * Zion * Zion * Zion) + + 0.222_rt * (Zion * Zion * Zion * Zion * Zion * Zion)) / + (1.0_rt + .222 * Zion * Zion * Zion * Zion * Zion * Zion); + Real ZLN = std::log(Zion); + Real Finf = std::sqrt(P2 / (XSR * XSR) + 1.0_rt) * Z13 * Z13 * P1; // The TF limit + Real FinfX = -P2 / ((P2 + XSR * XSR) * XSR); + Real FinfDX = Finf * FinfX; + Real FinfDXX = FinfDX * FinfX - FinfDX * (P2 + 3.0_rt * XSR * XSR) / ((P2 + XSR * XSR) * XSR); + Real R1 = AP[3] / (1.0_rt + ZLN); + Real R2 = 0.395_rt * ZLN + .347 / Zion / std::sqrt(Zion); + Real R3 = 1.0_rt / (1.0_rt + ZLN * std::sqrt(ZLN) * 0.01_rt + 0.097_rt / (Zion * Zion)); + Real Q1U = R1 + AP[2] * XSR * XSR; + Real Q1D = 1.0_rt + R2 * XSR * XSR; + Real Q1 = Q1U / Q1D; + Real Q1X = 2.0_rt * XSR * (AP[2] / Q1U - R2 / Q1D); + Real Q1XDX = Q1X / XSR + 4.0_rt * XSR * XSR * ((R2 / Q1D) * (R2 / Q1D) - (AP[2] / Q1U) * (AP[2] / Q1U)); + Real Q1DX = Q1 * Q1X; + Real Q1DXX = Q1DX * Q1X + Q1 * Q1XDX; + + Real SUP, SUPDX, SUPDG, SUPDXX, SUPDGG, SUPDXG; + + // New quantum factor, in order to suppress CVSCR at TPT >> 1 + if (TPT < 6.0_rt / PX) { + Real Y0 = (PX * TPT) * (PX * TPT); + Real Y0DX = Y0 / XSR; + Real Y0DG = 2.0_rt * Y0 / GAMI; + Real Y0DXX = 0.0_rt; + Real Y0DGG = Y0DG / GAMI; + Real Y0DXG = Y0DG / XSR; + Real Y1 = std::exp(Y0); + Real Y1DX = Y1 * Y0DX; + Real Y1DG = Y1 * Y0DG; + Real Y1DXX = Y1 * (Y0DX * Y0DX + Y0DXX); + Real Y1DGG = Y1 * (Y0DG * Y0DG + Y0DGG); + Real Y1DXG = Y1 * (Y0DX * Y0DG + Y0DXG); + Real SA = 1.0_rt + Y1; + Real SUPA = std::log(SA); + Real SUPADX = Y1DX / SA; + Real SUPADG = Y1DG / SA; + Real SUPADXX = (Y1DXX - Y1DX * Y1DX / SA) / SA; + Real SUPADGG = (Y1DGG - Y1DG * Y1DG / SA) / SA; + Real SUPADXG = (Y1DXG - Y1DX * Y1DG / SA) / SA; + Real EM2 = ENAT - 2.0_rt; + Real SB = ENAT - EM2 / Y1; + Real SUPB = std::log(SB); + Real EM2Y1 = EM2 / (Y1 * Y1 * SB); + Real SUPBDX = EM2Y1 * Y1DX; + Real SUPBDG = EM2Y1 * Y1DG; + Real SUPBDXX = EM2Y1 * (Y1DXX - 2.0_rt * Y1DX * Y1DX / Y1 - Y1DX * SUPBDX); + Real SUPBDGG = EM2Y1 * (Y1DGG - 2.0_rt * Y1DG * Y1DG / Y1 - Y1DG * SUPBDG); + Real SUPBDXG = EM2Y1 * (Y1DXG - 2.0_rt * Y1DX * Y1DG / Y1 - Y1DG * SUPBDX); + + SUP = std::sqrt(SUPA / SUPB); + Real SUPX = 0.5_rt * (SUPADX / SUPA - SUPBDX / SUPB); + SUPDX = SUP * SUPX; + Real SUPG = 0.5_rt * (SUPADG / SUPA - SUPBDG / SUPB); + SUPDG = SUP * SUPG; + SUPDXX = SUPDX * SUPX + + SUP * 0.5_rt * (SUPADXX / SUPA - (SUPADX / SUPA) * (SUPADX / SUPA) - + SUPBDXX / SUPB + (SUPBDX / SUPB) * (SUPBDX / SUPB)); + SUPDGG = SUPDG * SUPG + + SUP * 0.5_rt * (SUPADGG / SUPA - (SUPADG / SUPA) * (SUPADG / SUPA) - + SUPBDGG / SUPB + (SUPBDG / SUPB) * (SUPBDG / SUPB)); + SUPDXG = SUPDX * SUPG + + SUP * 0.5_rt * ((SUPADXG - SUPADX * SUPADG / SUPA) / SUPA - + (SUPBDXG - SUPBDX * SUPBDG / SUPB) / SUPB); + } + else { + SUP = PX * TPT; + SUPDX = 0.5_rt * PX * TPT / XSR; + SUPDG = PX * TPT / GAMI; + SUPDXX = - 0.5_rt * SUPDX / XSR; + SUPDGG = 0.0_rt; + SUPDXG = SUPDX / GAMI; + } + + Real GR3 = std::pow(GAMI / SUP, R3); + Real GR3X = -R3 * SUPDX / SUP; + Real GR3DX = GR3 * GR3X; + Real GR3DXX = GR3DX * GR3X - R3 * GR3 * (SUPDXX / SUP - (SUPDX / SUP) * (SUPDX / SUP)); + Real GR3G = R3 * (1.0_rt / GAMI - SUPDG / SUP); + Real GR3DG = GR3 * GR3G; + Real GR3DGG = GR3DG * GR3G + GR3 * R3 * ((SUPDG / SUP) * (SUPDG / SUP) - SUPDGG / SUP - 1.0_rt / (GAMI * GAMI)); + Real GR3DXG = GR3DG * GR3X + GR3 * R3 * (SUPDX * SUPDG / (SUP * SUP) - SUPDXG / SUP); + Real W = 1.0_rt + Q1 / GR3; + Real WDX = Q1DX / GR3 - Q1 * GR3DX / (GR3 * GR3); + Real WDG = -Q1 * GR3DG / (GR3 * GR3); + Real WDXX = Q1DXX / GR3 - + (2.0_rt * Q1DX * GR3DX + Q1 * (GR3DXX - 2.0_rt * GR3DX * GR3DX / GR3)) / (GR3 * GR3); + Real WDGG = Q1 * (2.0_rt * GR3DG * GR3DG / GR3 - GR3DGG) / (GR3 * GR3); + Real WDXG = -(Q1DX * GR3DG + Q1 * (GR3DXG - 2.0_rt * GR3DX * GR3DG / GR3)) / (GR3 * GR3); + FSCR = -GAMI * Finf * W; + Real FDX = -GAMI * (FinfDX * W + Finf * WDX); + Real FDXX = -GAMI * (FinfDXX * W + 2.0_rt * FinfDX * WDX + Finf * WDXX); + Real FDG = -Finf * W - GAMI * Finf * WDG; + Real FDGG = -2.0_rt * Finf * WDG - GAMI * Finf * WDGG; + if (std::abs(FDGG) < TINY) { + FDGG = 0.0_rt; // 10.08.16: roundoff err.safeguard + } + Real FDXG = -FinfDX * W - Finf * WDX - GAMI * (FinfDX * WDG + Finf * WDXG); + S_SCR = -GAMI * GAMI * Finf * WDG; + USCR = S_SCR + FSCR; + CVSCR = -GAMI * GAMI * FDGG; + PSCR = (XSR * FDX + GAMI * FDG) / 3.0_rt; + PDTSCR = GAMI * GAMI * (XSR * Finf * (FinfX * WDG + WDXG) - FDGG) / 3.0_rt; + PDRSCR = (12.0_rt * PSCR + XSR * XSR * FDXX + 2.0_rt * XSR * GAMI * FDXG + + GAMI * GAMI * FDGG) / 9.0_rt; +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void anharm8 (double GAMI, double TPT, + double& Fah, double& Uah, double& Pah, + double& CVah, double& PDTah, double& PDRah) +{ + // ANHARMONIC free energy + // Version 27.07.07 + // cleaned 16.06.09 + // Stems from ANHARM8b. Difference: AC = 0., B1 = .12 (.1217 - over accuracy) + // Input: GAMI - ionic Gamma, TPT = Tp/T - ionic quantum parameter + // Output: anharm.free en. Fah = F_{AH}/(N_i kT), internal energy Uah, + // pressure Pah = P_{AH}/(n_i kT), specific heat CVah = C_{V,AH}/(N_i k), + // PDTah = Pah + d Pah / d ln T, PDRah = Pah + d Pah / d ln\rho + + const int NM = 3; + const Real AA[NM] = {10.9_rt, 247.0_rt, 1.765e5_rt}; // Farouki & Hamaguchi'93 + const Real B1 = 0.12_rt; // coeff.at \eta^2/\Gamma at T = 0 + + Real CK = B1 / AA[0]; // fit coefficient + Real TPT2 = TPT * TPT; + Real TPT4 = TPT2 * TPT2; + Real TQ = B1 * TPT2 / GAMI; // quantum dependence + Real TK2 = CK * TPT2; + Real SUP = std::exp(-TK2); // suppress.factor of class.anharmonicity + + Fah = 0.0_rt; + Uah = 0.0_rt; + Pah = 0.0_rt; + CVah = 0.0_rt; + PDTah = 0.0_rt; + PDRah = 0.0_rt; + + Real SUPGN = SUP; + for (int N = 1; N <= NM; ++N) { + Real CN = (Real) N; + SUPGN = SUPGN / GAMI; // SUP/Gamma^n + Real ACN = AA[N-1]; + Fah = Fah - ACN / CN * SUPGN; + Uah = Uah + (ACN * (1.0_rt + 2.0_rt * TK2 / CN)) * SUPGN; + Real PN = AA[N-1] / 3.0_rt + TK2 * AA[N-1] / CN; + Pah = Pah + PN * SUPGN; + CVah = CVah + ((CN + 1.0_rt) * AA[N-1] + (4.0_rt - 2.0_rt / CN) * AA[N-1] * TK2 + + 4.0_rt * AA[N-1] * CK * CK / CN * TPT4) * SUPGN; + PDTah = PDTah + (PN * (1.0_rt + CN + 2.0_rt * TK2) - 2.0_rt / CN * AA[N-1] * TK2) * SUPGN; + PDRah = PDRah + (PN * (1.0_rt - CN / 3.0_rt - TK2) + AA[N-1] / CN * TK2) * SUPGN; + } + + Fah = Fah - TQ; + Uah = Uah - TQ; + Pah = Pah - TQ / 1.5_rt; + PDRah = PDRah - TQ / 4.5_rt; +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void hlfit12 (Real eta, + Real& F, Real& U, Real& CV, Real& S, + Real& U1, Real& CW, int LATTICE) +{ + // Version 24.04.12 + // Stems from HLfit8 v.03.12.08; + // differences: E0 excluded from U and F; + // U1 and d(CV)/d\ln(T) are added on the output. + // Fit to thermal part of the thermodynamic functions. + // Baiko, Potekhin, & Yakovlev (2001). + // Zero-point lattice quantum energy 1.5u_1\eta EXCLUDED (unlike HLfit8). + // Input: eta = Tp/T, LATTICE = 1 for bcc, 2 for fcc + // Output: F and U (normalized to NkT) - due to phonon excitations, + // CV and S (normalized to Nk) in the HL model, + // U1 - the 1st phonon moment, + // CW = d(CV)/d\ln(T) + + const Real EPS = 1.e-5_rt; + const Real TINY = 1.e-99_rt; + + Real CLM, ALPHA, BETA, GAMMA; + Real A1, A2, A3, A4, A6, A8; + Real B0, B2, B4, B5, B6, B7, C9, C11; + + if (LATTICE == 1) { // bcc lattice + CLM = -2.49389_rt; // 3 * ln<\omega/\omega_p> + U1 = 0.5113875_rt; + ALPHA = 0.265764_rt; + BETA = 0.334547_rt; + GAMMA = 0.932446_rt; + A1 = 0.1839_rt; + A2 = 0.593586_rt; + A3 = 0.0054814_rt; + A4 = 5.01813e-4_rt; + A6 = 3.9247e-7_rt; + A8 = 5.8356e-11_rt; + B0 = 261.66_rt; + B2 = 7.07997_rt; + B4 = 0.0409484_rt; + B5 = 0.000397355_rt; + B6 = 5.11148e-5_rt; + B7 = 2.19749e-6_rt; + C9 = 0.004757014_rt; + C11 = 0.0047770935_rt; + } + else if (LATTICE == 2) { // fcc lattice + CLM = -2.45373_rt; + U1 = 0.513194_rt; + ALPHA = 0.257591_rt; + BETA = 0.365284_rt; + GAMMA = 0.9167070_rt; + A1 = 0.0_rt; + A2 = 0.532535_rt; + A3 = 0.0_rt; + A4 = 3.76545e-4_rt; + A6 = 2.63013e-7_rt; + A8 = 6.6318e-11_rt; + B0 = 303.20_rt; + B2 = 7.7255_rt; + B4 = 0.0439597_rt; + B5 = 0.000114295_rt; + B6 = 5.63434e-5_rt; + B7 = 1.36488e-6_rt; + C9 = 0.00492387_rt; + C11 = 0.00437506_rt; + } + else { + printf("HLfit: unknown lattice type\n"); + exit(1); + } + + if (eta > 1.0_rt / EPS) { // asymptote of Eq.(13) of BPY'01 + U = 3.0_rt / (C11 * eta * eta * eta); + F = -U / 3.0_rt; + CV = 4.0_rt * U; + S = U - F; + return; + } + else if (eta < EPS) { // Eq.(17) of BPY'01 + if (eta < TINY) { + printf("HLfit: eta is too small\n"); + exit(1); + } + F = 3.0_rt * std::log(eta) + CLM - 1.5_rt * U1 * eta + eta * eta / 24.0_rt; + U = 3.0_rt - 1.5_rt * U1 * eta + eta * eta / 12.0_rt; + CV = 3.0_rt - eta * eta / 12.0_rt; + S = U - F; + return; + } + + Real eta2 = eta * eta; + Real eta3 = eta2 * eta; + Real eta4 = eta3 * eta; + Real eta5 = eta4 * eta; + Real eta6 = eta5 * eta; + Real eta7 = eta6 * eta; + Real eta8 = eta7 * eta; + Real B9 = A6 * C9; + Real B11 = A8 * C11; + Real UP = 1.0_rt + A1 * eta + A2 * eta2 + A3 * eta3 + A4 * eta4 + A6 * eta6 + A8 * eta8; + Real DN = B0 + B2 * eta2 + B4 * eta4 + B5 * eta5 + B6 * eta6 + + B7 * eta7 + eta8 * (B9 * eta + B11 * eta3); + Real EA = std::exp(-ALPHA * eta); + Real EB = std::exp(-BETA * eta); + Real EG = std::exp(-GAMMA * eta); + F = std::log(1.0_rt - EA) + std::log(1.0_rt - EB) + std::log(1.0_rt - EG) - UP / DN; // F_{thermal}/NT + Real UP1 = A1 + 2.0_rt * A2 * eta + 3.0_rt * A3 * eta2 + 4.0_rt * A4 * eta3 + + 6.0_rt * A6 * eta5 + 8. * A8 * eta7; + Real UP2 = 2.0_rt * A2 + 6.0_rt * A3 * eta + 12.0_rt * A4 * eta2 + 30.0_rt * A6 * eta4 + 56.0_rt * A8 * eta6; + Real UP3 = 6.0_rt * A3 + 24.0_rt * A4 * eta + 120.0_rt * A6 * eta3 + 336.0_rt * A8 * eta5; + Real DN1 = 2.0_rt * B2 * eta + 4.0_rt * B4 * eta3 + 5.0_rt * B5 * eta4 + 6.0_rt * B6 * eta5 + + 7.0_rt * B7 * eta6 + eta8 * (9.0_rt * B9 + 11.0_rt * B11 * eta2); + Real DN2 = 2.0_rt * B2 + 12.0_rt * B4 * eta2 + 20. * B5 * eta3 + 30.0_rt * B6 * eta4 + + 42.0_rt * B7 * eta5 + 72.0_rt * B9 * eta7 + 110.0_rt * B11 * eta8 * eta; + Real DN3 = 24.0_rt * B4 * eta + 60.0_rt * B5 * eta2 + 120.0_rt * B6 * eta3 + + 210.0_rt * B7 * eta4 + 504.0_rt * B9 * eta6 + 990.0_rt * B11 * eta8; + Real DF1 = ALPHA * EA / (1.0_rt - EA) + BETA * EB / (1.0_rt - EB) + GAMMA * EG / (1.0_rt - EG) - + (UP1 * DN - DN1 * UP) / (DN * DN); // int.en./NT/eta = df/d\eta + Real DF2 = ALPHA * ALPHA * EA / ((1.0_rt - EA) * (1.0_rt - EA)) + BETA * BETA * EB / + ((1.0_rt - EB) * (1.0_rt - EB)) + GAMMA * GAMMA * EG / ((1.0_rt - EG) * (1.0_rt - EG)) + + ((UP2 * DN - DN2 * UP) * DN - 2.0_rt * (UP1 * DN - DN1 * UP) * DN1) / (DN * DN * DN); // -d2f/d\eta^2 + U = DF1 * eta; + CV = DF2 * eta2; + Real DF3 = -ALPHA * ALPHA * ALPHA * EA / std::pow(1.0_rt - EA, 3) * (1.0_rt + EA) - + BETA * BETA * BETA * EB / std::pow(1.0_rt - EB, 3) * (1.0_rt + EB) - + GAMMA * GAMMA * GAMMA * EG / std::pow(1.0_rt - EG, 3) * (1.0_rt + EG) + + UP3 / DN - (3.0_rt * UP2 * DN1 + 3.0_rt * UP1 * DN2 + UP * DN3) / (DN * DN) + + 6.0_rt * DN1 * (UP1 * DN1 + UP * DN2) / (DN * DN * DN) - + 6.0_rt * UP * DN1 * DN1 * DN1 / (DN * DN * DN * DN); // -d3f/d\eta^3 + CW = -2.0_rt * CV - eta3 * DF3; + S = U - F; +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void fharm12(Real GAMI, Real TPT, + Real& Fharm, Real& Uharm, Real& Pharm, Real& CVth, + Real& Sth, Real& PDTharm, Real& PDRharm) +{ + // Thermodynamic functions of a harmonic crystal, incl.stat.Coul.lattice + // + // Version 27.04.12 + // Stems from FHARM8 v.15.02.08 + // Replaced HLfit8 with HLfit12: rearranged output. + // Input: GAMI - ionic Gamma, TPT = T_{p,i}/T + // Output: Fharm = F/(N_i T), Uharm = U/(N_i T), Pharm = P/(n_i T), + // CVth = C_V/N_i, Sharm = S/N_i + // PDTharm = Pharm + d Pharm / d ln T, PDRharm = Pharm + d Pharm/d ln\rho + + const Real CM = 0.895929256_rt; // Madelung + + Real F, U, U1, CW; + hlfit12(TPT, F, U, CVth, Sth, U1, CW, 1); + + Real U0 = -CM * GAMI; // perfect lattice + Real E0 = 1.5_rt * U1 * TPT; // zero-point energy + Real Uth = U + E0; + Real Fth = F + E0; + Uharm = U0 + Uth; + Fharm = U0 + Fth; + Pharm = U0 / 3.0_rt + Uth / 2.0_rt; + PDTharm = 0.5_rt * CVth; + PDRharm = U0 / 2.25_rt + 0.75_rt * Uth - 0.25_rt * CVth; +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void cormix (Real RS, Real GAME, Real Zmean, Real Z2mean, Real Z52, Real Z53, Real Z321, + Real& FMIX, Real& UMIX, Real& PMIX, Real& CVMIX, Real& PDTMIX, Real& PDRMIX) +{ + // Version 02.07.09 + // Correction to the linear mixing rule for moderate to small Gamma + // Input: RS = r_s (if RS = 0, then OCP, otherwise EIP) + // GAME = \Gamma_e + // Zmean = (average Z of all ions, without electrons) + // Z2mean = , Z52 = , Z53 = , Z321 = + // Output: FMIX = \Delta f - corr.to the reduced free energy f = F/N_{ion}kT + // UMIX = \Delta u - corr.to the reduced internal energy u + // PMIX = \Delta u - corr.to the reduced pressure P = P/n_{ion}kT + // CVMIX = \Delta c - corr.to the reduced heat capacity c_V + // PDTMIX = (1/n_{ion}kT)d\Delta P / d ln T + // = \Delta p + d \Delta p / d ln T + // PDRMIX = (1/n_{ion}kT)d\Delta P / d ln n_e + // (composition is assumed fixed: Zmean,Z2mean,Z52,Z53 = constant) + + const Real TINY = 1.e-9_rt; + Real GAMImean = GAME * Z53; + + Real Dif0; + if (RS < TINY) { // OCP + Dif0 = Z52 - std::sqrt(Z2mean * Z2mean * Z2mean / Zmean); + } + else { + Dif0 = Z321 - std::sqrt(std::pow(Z2mean + Zmean, 3) / Zmean); + } + + Real DifR = Dif0 / Z52; + Real DifFDH = Dif0 * GAME * std::sqrt(GAME / 3.0_rt); // F_DH - F_LM(DH) + Real D = Z2mean / (Zmean * Zmean); + if (std::abs(D - 1.0_rt) < TINY) { // no correction + FMIX = 0.0_rt; + UMIX = 0.0_rt; + PMIX = 0.0_rt; + CVMIX = 0.0_rt; + PDTMIX = 0.0_rt; + PDRMIX = 0.0_rt; + return; + } + + Real P3 = std::pow(D, -0.2_rt); + Real D0 = (2.6_rt * DifR + 14.0_rt * DifR * DifR * DifR) / (1.0_rt - P3); + Real GP = D0 * std::pow(GAMImean, P3); + Real FMIX0 = DifFDH / (1.0_rt + GP); + Real Q = D * D * 0.0117_rt; + Real R = 1.5_rt / P3 - 1.0_rt; + Real GQ = Q * GP; + FMIX = FMIX0 / std::pow(1.0_rt + GQ, R); + Real G = 1.5_rt - P3 * GP / (1.0_rt + GP) - R * P3 * GQ / (1.0_rt + GQ); + UMIX = FMIX * G; + PMIX = UMIX / 3.0_rt; + Real GDG = -P3 * P3 * (GP / ((1.0_rt + GP) * (1.0_rt + GP)) + R * GQ / ((1.0_rt + GQ) * (1.0_rt + GQ))); // d G /d ln Gamma + Real UDG = UMIX * G + FMIX * GDG; // d u_mix /d ln Gamma + CVMIX = UMIX - UDG; + PDTMIX = PMIX - UDG / 3.0_rt; + PDRMIX = PMIX + UDG / 9.0_rt; +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void fscrliq8 (Real RS, Real GAME, Real Zion, + Real& FSCR, Real& USCR, Real& PSCR, + Real& CVSCR, Real& PDTSCR, Real& PDRSCR) +{ + // fit to the el.-ion scr. + // Version 11.09.08 + // cleaned 16.06.09 + // Stems from FSCRliq7 v. 09.06.07. Included a check for RS=0. + // INPUT: RS - density parameter, GAME - electron Coulomb parameter, + // Zion - ion charge number, + // OUTPUT: FSCR - screening (e-i) free energy per kT per 1 ion, + // USCR - internal energy per kT per 1 ion (screen.contrib.) + // PSCR - pressure divided by (n_i kT) (screen.contrib.) + // CVSCR - heat capacity per 1 ion (screen.contrib.) + // PDTSCR,PDRSCR = PSCR + d PSCR / d ln(T,\rho) + + const Real XRS = 0.0140047_rt; + const Real TINY = 1.e-19_rt; + + if (RS < 0.0_rt) { + printf("FSCRliq8: RS < 0\n"); + exit(1); + } + + if (RS < TINY) { + FSCR = 0.0_rt; + USCR = 0.0_rt; + PSCR = 0.0_rt; + CVSCR = 0.0_rt; + PDTSCR = 0.0_rt; + PDRSCR = 0.0_rt; + return; + } + + Real SQG = std::sqrt(GAME); + Real SQR = std::sqrt(RS); + Real SQZ1 = std::sqrt(1.0_rt + Zion); + Real SQZ = std::sqrt(Zion); + Real CDH0 = Zion / 1.73205_rt; // 1.73205 = std::sqrt(3.0_rt) + Real CDH = CDH0 * (SQZ1 * SQZ1 * SQZ1 - SQZ * SQZ * SQZ - 1.0_rt); + Real ZLN = std::log(Zion); + Real Z13 = std::exp(ZLN / 3.0_rt); // Zion**(1.0_rt / 3.0_rt) + Real X = XRS / RS; // relativity parameter + Real CTF = Zion * Zion * 0.2513_rt * (Z13 - 1.0_rt + 0.2_rt / std::sqrt(Z13)); + // Thomas - Fermi constant; .2513 = (18 / 175)(12 / \pi)^{2 / 3} + Real P01 = 1.11_rt * std::exp(0.475_rt * ZLN); + Real P03 = 0.2_rt + 0.078_rt * ZLN * ZLN; + Real PTX = 1.16_rt + 0.08_rt * ZLN; + Real TX = std::pow(GAME, PTX); + Real TXDG = PTX * TX / GAME; + Real TXDGG = (PTX - 1.0_rt) * TXDG / GAME; + Real TY1 = 1.0_rt / (1.e-3_rt * Zion * Zion + 2.0_rt * GAME); + Real TY1DG = -2.0_rt * TY1 * TY1; + Real TY1DGG = -4.0_rt * TY1 * TY1DG; + Real TY2 = 1.0_rt + 6.0_rt * RS * RS; + Real TY2DX = -12.0_rt * RS * RS / X; + Real TY2DXX = -3.0_rt * TY2DX / X; + Real TY = RS * RS * RS / TY2 * (1.0_rt + TY1); + Real TYX = 3.0_rt / X + TY2DX / TY2; + Real TYDX = -TY * TYX; + Real TYDG = RS * RS * RS * TY1DG / TY2; + Real P1 = (Zion - 1.0_rt) / 9.0_rt; + Real COR1 = 1.0_rt + P1 * TY; + Real COR1DX = P1 * TYDX; + Real COR1DG = P1 * TYDG; + Real COR1DXX = P1 * (TY * (3.0_rt / (X * X) + (TY2DX / TY2) * (TY2DX / TY2) - TY2DXX / TY2) - TYDX * TYX); + Real COR1DGG = P1 * RS * RS * RS * TY1DGG / TY2; + Real COR1DXG = -P1 * TYDG * TYX; + Real U0 = 0.78_rt * std::sqrt(GAME / Zion) * RS * RS * RS; + Real U0DX = -3.0_rt * U0 / X; + Real U0DG = 0.5_rt * U0 / GAME; + Real U0DXX = -4.0_rt * U0DX / X; + Real U0DGG = -0.5_rt * U0DG / GAME; + Real U0DXG = -3.0_rt * U0DG / X; + Real D0DG = Zion * Zion * Zion; + Real D0 = GAME * D0DG + 21.0_rt * RS * RS * RS; + Real D0DX = -63.0_rt * RS * RS * RS / X; + Real D0DXX = 252.0_rt * RS * RS * RS / (X * X); + Real COR0 = 1.0_rt + U0 / D0; + Real COR0DX = (U0DX - U0 * D0DX / D0) / D0; + Real COR0DG = (U0DG - U0 * D0DG / D0) / D0; + Real COR0DXX = (U0DXX - (2.0_rt * U0DX * D0DX + U0 * D0DXX) / D0 + 2.0_rt * (D0DX / D0) * (D0DX / D0)) / D0; + Real COR0DGG = (U0DGG - 2.0_rt * U0DG * D0DG / D0 + 2.0_rt * U0 * (D0DG / D0) * (D0DG / D0)) / D0; + Real COR0DXG = (U0DXG - (U0DX * D0DG + U0DG * D0DX) / D0 + 2.0_rt * U0 * D0DX * D0DG / (D0 * D0)) / D0; + // Relativism: + Real RELE = std::sqrt(1.0_rt + X * X); + Real Q1 = 0.18_rt / std::sqrt(std::sqrt(Zion)); + Real Q2 = 0.2_rt + 0.37_rt / std::sqrt(Zion); + Real H1U = 1.0_rt + X * X / 5.0_rt; + Real H1D = 1.0_rt + Q1 * X + Q2 * X * X; + Real H1 = H1U / H1D; + Real H1X = 0.4_rt * X / H1U - (Q1 + 2.0_rt * Q2 * X) / H1D; + Real H1DX = H1 * H1X; + Real H1DXX = H1DX * H1X + + H1 * (0.4_rt / H1U - (0.4_rt * X / H1U) * (0.4_rt * X / H1U) - 2.0_rt * Q2 / H1D + + std::pow((Q1 + 2.0_rt * Q2 * X) / H1D, 2.0_rt)); + Real UP = CDH * SQG + P01 * CTF * TX * COR0 * H1; + Real UPDX = P01 * CTF * TX * (COR0DX * H1 + COR0 * H1DX); + Real UPDG = 0.5_rt * CDH / SQG + P01 * CTF * (TXDG * COR0 + TX * COR0DG) * H1; + Real UPDXX = P01 * CTF * TX * (COR0DXX * H1 + 2.0_rt * COR0DX * H1DX + COR0 * H1DXX); + Real UPDGG = -0.25_rt * CDH / (SQG * GAME) + + P01 * CTF * (TXDGG * COR0 + 2.0_rt * TXDG * COR0DG + TX * COR0DGG) * H1; + Real UPDXG = P01 * CTF * (TXDG * (COR0DX * H1 + COR0 * H1DX) + + TX * (COR0DXG * H1 + COR0DG * H1DX)); + Real DN1 = P03 * SQG + P01 / RS * TX * COR1; + Real DN1DX = P01 * TX * (COR1 / XRS + COR1DX / RS); + Real DN1DG = 0.5_rt * P03 / SQG + P01 / RS * (TXDG * COR1 + TX * COR1DG); + Real DN1DXX = P01 * TX / XRS * (2.0_rt * COR1DX + X * COR1DXX); + Real DN1DGG = -0.25_rt * P03 / (GAME * SQG) + + P01 / RS * (TXDGG * COR1 + 2.0_rt * TXDG * COR1DG + TX * COR1DGG); + Real DN1DXG = P01 * (TXDG * (COR1 / XRS + COR1DX / RS) + TX * (COR1DG / XRS + COR1DXG / RS)); + Real DN = 1.0_rt + DN1 / RELE; + Real DNDX = DN1DX / RELE - X * DN1 / (RELE * RELE * RELE); + Real DNDXX = (DN1DXX - ((2.0_rt * X * DN1DX + DN1) - 3.0_rt * X * X * DN1 / (RELE * RELE)) / (RELE * RELE)) / RELE; + Real DNDG = DN1DG / RELE; + Real DNDGG = DN1DGG / RELE; + Real DNDXG = DN1DXG / RELE - X * DN1DG / (RELE * RELE * RELE); + FSCR = -UP / DN * GAME; + Real FX = (UP * DNDX / DN - UPDX) / DN; + Real FXDG = ((UPDG * DNDX + UPDX * DNDG + UP * DNDXG - 2.0_rt * UP * DNDX * DNDG / DN) / DN - + UPDXG) / DN; + Real FDX = FX * GAME; + Real FG = (UP * DNDG / DN - UPDG) / DN; + Real FDG = FG * GAME - UP / DN; + Real FDGDH = SQG * DNDG / (DN * DN); // d FDG / d CDH + Real FDXX = ((UP * DNDXX + 2.0_rt * (UPDX * DNDX - UP * DNDX * DNDX / DN)) / DN - UPDXX) / DN * GAME; + Real FDGG = 2.0_rt * FG + GAME * ((2.0_rt * DNDG * (UPDG - UP * DNDG / DN) + UP * DNDGG) / DN - UPDGG) / DN; + Real FDXG = FX + GAME * FXDG; + USCR = GAME * FDG; + CVSCR = -GAME * GAME * FDGG; + PSCR = (X * FDX + GAME * FDG) / 3.0_rt; + PDTSCR = -GAME * GAME * (X * FXDG + FDGG) / 3.0_rt; + PDRSCR = (12.0_rt * PSCR + X * X * FDXX + 2.0_rt * X * GAME * FDXG + GAME * GAME * FDGG) / 9.0_rt; +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void fition9 (Real GAMI, Real& FION, Real& UION, Real& PION, + Real& CVii, Real& PDTii, Real& PDRii) +{ + // Version 11.09.08 + // Dummy argument Zion is deleted in 2009. + // Non - ideal contributions to thermodynamic functions of classical OCP. + // Stems from FITION00 v.24.05.00. + // Input: GAMI - ion coupling parameter + // Output: FION - ii free energy / N_i kT + // UION - ii internal energy / N_i kT + // PION - ii pressure / n_i kT + // CVii - ii heat capacity / N_i k + // PDTii = PION + d(PION) / d ln T = (1 / N_i kT) * (d P_{ii} / d ln T) + // PDRii = PION + d(PION) / d ln\rho + // Parameters adjusted to Caillol (1999). + + const Real A1 = -0.907347_rt; + const Real A2 = 0.62849_rt; + const Real C1 = 0.004500_rt; + const Real G1 = 170.0_rt; + const Real C2 = -8.4e-5_rt; + const Real G2 = 0.0037_rt; + const Real SQ32 = 0.8660254038_rt; // SQ32 = sqrt(3) / 2 + Real A3 = -SQ32 - A1 / std::sqrt(A2); + Real F0 = A1 * (std::sqrt(GAMI * (A2 + GAMI)) - + A2 * std::log(std::sqrt(GAMI / A2) + std::sqrt(1.0_rt + GAMI / A2))) + + 2.0_rt * A3 * (std::sqrt(GAMI) - std::atan(std::sqrt(GAMI))); + Real U0 = std::pow(GAMI, 1.5_rt) * (A1 / std::sqrt(A2 + GAMI) + A3 / (1.0_rt + GAMI)); + // This is the zeroth approximation. Correction: + UION = U0 + C1 * GAMI * GAMI / (G1 + GAMI) + C2 * GAMI * GAMI / (G2 + GAMI * GAMI); + FION = F0 + C1 * (GAMI - G1 * std::log(1.0_rt + GAMI / G1)) + + C2 / 2.0_rt * std::log(1.0_rt + GAMI * GAMI / G2); + CVii = -0.5_rt * std::pow(GAMI, 1.5_rt) * (A1 * A2 / std::pow(A2 + GAMI, 1.5_rt) + + A3 * (1.0_rt - GAMI) / ((1.0_rt + GAMI) * (1.0_rt + GAMI))) - + GAMI * GAMI * (C1 * G1 / ((G1 + GAMI) * (G1 + GAMI)) + + C2 * (G2 - GAMI * GAMI) / ((G2 + GAMI * GAMI) * (G2 + GAMI * GAMI))); + PION = UION / 3.0_rt; + PDRii = (4.0_rt * UION - CVii) / 9.0_rt; // p_{ii} + d p_{ii} / d ln\rho + PDTii = CVii / 3.0_rt; // p_{ii} + d p_{ii} / d ln T +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void eosfi8(int LIQSOL, Real CMI, Real Zion, Real RS, Real GAMI, + Real& FC1, Real& UC1, Real& PC1, Real& SC1, Real& CV1, + Real& PDT1, Real& PDR1, Real& FC2, Real& UC2, Real& PC2, + Real& SC2, Real& CV2, Real& PDT2, Real& PDR2) +{ + // Version 16.09.08 + // call FHARM8 has been replaced by call FHARM12 27.04.12 + // Wigner - Kirkwood correction excluded 20.05.13 + // slight cleaning 10.12.14 + // Non - ideal parts of thermodynamic functions in the fully ionized plasma + // Stems from EOSFI5 and EOSFI05 v.04.10.05 + // Input: LIQSOL = 0 / 1(liquid / solid), + // Zion,CMI - ion charge and mass numbers, + // RS = r_s (electronic density parameter), + // GAMI = Gamma_i (ion coupling), + // Output: FC1 and UC1 - non - ideal "ii + ie + ee" contribution to the + // free and internal energies (per ion per kT), + // PC1 - analogous contribution to pressure divided by (n_i kT), + // CV1 - "ii + ie + ee" heat capacity per ion [units of k] + // PDT1 = (1 / n_i kT) * (d P_C / d ln T)_V + // PDR1 = (1 / n_i kT) * (d P_C / d ln\rho)_T + // FC2,UC2,PC2,SC2,CV2 - analogous to FC1,UC1,PC1,SC1,CV1, but including + // the part corresponding to the ideal ion gas. This is useful for + // preventing accuracy loss in some cases (e.g., when SC2 << SC1). + // FC2 does not take into account the entropy of mixing S_{mix}: in a + // mixture, S_{mix} / (N_i k) has to be added externally (see MELANGE9). + // FC2 does not take into account the ion spin degeneracy either. + // When needed, the spin term must be added to the entropy externally. + + const Real C53 = 5.0_rt / 3.0_rt; + const Real C76 = 7.0_rt / 6.0_rt; // TINY excl.10.12.14 + const Real AUM = 1822.888_rt; // a.m.u / m_e + + if (LIQSOL != 1 && LIQSOL != 0) { + printf("EOSFI8: invalid LIQSOL\n"); + exit(1); + } + if (CMI <= 0.1_rt) { + printf("EOSFI8: too small CMI\n"); + exit(1); + } + if (Zion <= 0.1_rt) { + printf("EOSFI8: too small Zion\n"); + exit(1); + } + if (RS <= 0.0_rt) { + printf("EOSFI8: invalid RS\n"); + exit(1); + } + if (GAMI <= 0.0_rt) { + printf("EOSFI8: invalid GAMI\n"); + exit(1); + } + + Real GAME = GAMI / std::pow(Zion, C53); + Real FXC, UXC, PXC, CVXC, SXC, PDTXC, PDRXC; + excor7(RS, GAME, FXC, UXC, PXC, CVXC, SXC, PDTXC, PDRXC); // "ee"("xc") + + // Calculate "ii" part: + Real COTPT = std::sqrt(3.0_rt / AUM / CMI) / std::pow(Zion, C76); // auxiliary coefficient + Real TPT = GAMI / std::sqrt(RS) * COTPT; // = T_p / T in the OCP + Real FidION = 1.5_rt * std::log(TPT * TPT / GAMI) - 1.323515_rt; + // 1.3235 = 1 + 0.5 * ln(6 / pi); FidION = F_{id.ion gas} / (N_i kT), but without + // the term x_i ln x_i = - S_{mix} / (N_i k). + + Real FItot, UItot, PItot, CVItot, SCItot, PDTi, PDRi; + Real FION, UION, PION, CVii, PDTii, PDRii; + + if (LIQSOL == 0) { // liquid + fition9(GAMI, FION, UION, PION, CVii, PDTii, PDRii); + FItot = FION + FidION; + UItot = UION + 1.5_rt; + PItot = PION + 1.0_rt; + CVItot = CVii + 1.5_rt; + SCItot = UItot - FItot; + PDTi = PDTii + 1.0_rt; + PDRi = PDRii + 1.0_rt; + } + else { // solid + Real Fharm, Uharm, Pharm, CVharm, Sharm, PDTharm, PDRharm; + fharm12(GAMI, TPT, Fharm, Uharm, Pharm, + CVharm, Sharm, PDTharm, PDRharm); // harm."ii" + + Real Fah, Uah, Pah, CVah, PDTah, PDRah; + anharm8(GAMI, TPT, Fah, Uah, Pah, CVah, PDTah, PDRah); // anharm. + + FItot = Fharm + Fah; + FION = FItot - FidION; + UItot = Uharm + Uah; + UION = UItot - 1.5_rt; // minus 1.5 = ideal - gas, in order to get "ii" + PItot = Pharm + Pah; + PION = PItot - 1.0_rt; // minus 1 = ideal - gas + PDTi = PDTharm + PDTah; + PDRi = PDRharm + PDRah; + PDTii = PDTi - 1.0_rt; // minus 1 = ideal - gas + PDRii = PDRi - 1.0_rt; // minus 1 = ideal - gas + CVItot = CVharm + CVah; + SCItot = Sharm + Uah - Fah; + CVii = CVItot - 1.5_rt; // minus 1.5 = ideal - gas + } + + // Calculate "ie" part: + + Real FSCR, USCR, PSCR, S_SCR, CVSCR, PDTSCR, PDRSCR; + if (LIQSOL == 1) { + fscrsol8(RS, GAMI, Zion, TPT, + FSCR, USCR, PSCR, S_SCR, CVSCR, PDTSCR, PDRSCR); + } + else { + fscrliq8(RS, GAME, Zion, + FSCR, USCR, PSCR, CVSCR, PDTSCR, PDRSCR); + S_SCR = USCR - FSCR; + } + + // Total excess quantities ("ii" + "ie" + "ee", per ion): + Real FC0 = FSCR + Zion * FXC; + Real UC0 = USCR + Zion * UXC; + Real PC0 = PSCR + Zion * PXC; + Real SC0 = S_SCR + Zion * SXC; + Real CV0 = CVSCR + Zion * CVXC; + Real PDT0 = PDTSCR + Zion * PDTXC; + Real PDR0 = PDRSCR + Zion * PDRXC; + + FC1 = FION + FC0; + UC1 = UION + UC0; + PC1 = PION + PC0; + SC1 = (UION - FION) + SC0; + CV1 = CVii + CV0; + PDT1 = PDTii + PDT0; + PDR1 = PDRii + PDR0; + + // Total excess + ideal - ion quantities + FC2 = FItot + FC0; + UC2 = UItot + UC0; + PC2 = PItot + PC0; + SC2 = SCItot + SC0; + CV2 = CVItot + CV0; + PDT2 = PDTi + PDT0; + PDR2 = PDRi + PDR0; +} + +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real T, + Real& DENS, + Real& GAMImean, Real& CHI, Real& TPT, int& LIQSOL, + Real& P, Real& U, Real& S, Real& CV, Real& CHIR, Real& CHIT) +{ + // Version 18.04.20 + // Difference from v.10.12.14: included switch - off of WK correction + // Stems from MELANGE8 v.26.12.09. + // Difference: output PRADnkT instead of input KRAD + // + EOS of fully ionized electron - ion plasma mixture. + // Limitations: + // (a) inapplicable in the regimes of + // (1) bound - state formation, + // (2) quantum liquid, + // (3) presence of positrons; + // (b) for the case of a composition gradually depending on RHO or TEMP, + // second - order functions (CV,CHIR,CHIT in output) should not be trusted + // Choice of the liquid or solid regime - criterion GAMI [because the + // choice based on comparison of total (non - OCP) free energies can be + // sometimes dangerous because of the fit uncertainties ("Local field + // correction" in solid and quantum effects in liquid are unknown)]. + // Input: AY - their partial number densities, + // AZion and ACMI - their charge and mass numbers, + // RHO - total mass density [g / cc] + // TEMP - temperature + // NB: instead of RHO, a true input is CHI, defined below + // Hence, disagreement between RHO and DENS is the fit error (<0.4%) + // Output: + // AY - rescaled so that to sum up to 1 and resorted (by AZion) + // AZion - resorted in ascending order + // ACMI - resorted in agreement with AZion + // DENS - electron number density [in a.u. = 6.7483346e24 cm^{ - 3}] + // GAMImean - effective ion - ion Coulomb coupling constant + // CHI = mu_e / kT, where mu_e is the electron chem.potential + // TPT - effective ionic quantum parameter (T_p / T) + // LIQSOL = 0 / 1 for liquid / solid + // S - entropy + // U - internal energy + // P - pressure + // CV - heat capacity per ion, div. by Boltzmann const. + // CHIR - inverse compressibility - (d ln P / d ln V)_T ("\chi_r") + // CHIT = (d ln P / d ln T)_V ("\chi_T") + + // Convert temperature to a.u. = 2Ryd = 3.1577e5 K. + const Real UN_T6 = 0.3157746_rt; + Real Tlg = std::log10(T); + Real T6 = std::pow(10.0_rt, Tlg - 6.0_rt); + Real TEMP = T6 / UN_T6; // T [au] + + const Real CWK = 1.0_rt; // Turn on Wigner corrections + const Real TINY = 1.e-7_rt; + const Real PI = 3.141592653_rt; + const Real C53 = 5.0_rt / 3.0_rt; + const Real C13 = 1.0_rt / 3.0_rt; + const Real AUM = 1822.888_rt; // a.m.u. / m_e + const Real GAMIMELT = 175.0_rt; // OCP value of Gamma_i for melting + const Real RSIMELT = 140.0_rt; // ion density parameter of quantum melting + const Real RAD = 2.554e-7_rt; // Radiation constant ( = 4\sigma / c) (in a.u.) + + if (RHO < 1.e-19_rt || RHO > 1.e15_rt) { + printf("MELANGE: RHO out of range\n"); + exit(1); + } + + // Calculation of average values: + Real zbar = 0.0_rt; + Real z2bar = 0.0_rt; + Real Z52 = 0.0_rt; + Real Z53 = 0.0_rt; + Real Z73 = 0.0_rt; + Real Z321 = 0.0_rt; // corr.26.12.09 + Real abar = 0.0_rt; + + for (int i = 0; i < NumSpec; ++i) { + zbar = zbar + AY[i] * AZion[i]; + z2bar = z2bar + AY[i] * AZion[i] * AZion[i]; + Real Z13 = std::pow(AZion[i], C13); + Z53 = Z53 + AY[i] * std::pow(Z13, 5); + Z73 = Z73 + AY[i] * std::pow(Z13, 7); + Z52 = Z52 + AY[i] * std::pow(AZion[i], 2.5_rt); + Z321 = Z321 + AY[i] * AZion[i] * std::pow(AZion[i] + 1.0_rt, 1.5_rt); // 26.12.09 + abar = abar + AY[i] * ACMI[i]; + } + + // (0) Photons: + Real UINTRAD = RAD * TEMP * TEMP * TEMP * TEMP; + Real PRESSRAD = UINTRAD / 3.0_rt; + + // (1) ideal electron gas (including relativity and degeneracy) + DENS = RHO / 11.20587 * zbar / abar; // number density of electrons [au] + chemfit(DENS, TEMP, CHI); + + // NB: CHI can be used as true input instead of RHO or DENS + Real FEid, PEid, UEid, SEid, CVE, CHITE, CHIRE; + Real DlnDH, DlnDT, DlnDHH, DlnDTT, DlnDHT; + elect11(TEMP, CHI, + DENS, FEid, PEid, UEid, SEid, CVE, CHITE, CHIRE, + DlnDH, DlnDT, DlnDHH, DlnDTT, DlnDHT); + + // NB: at this point DENS is redefined (the difference can be ~0.1%) + Real DTE = DENS * TEMP; + Real PRESSE = PEid * DTE; // P_e [a.u.] + Real UINTE = UEid * DTE; // U_e / V [a.u.] + + // (2) non - ideal Coulomb EIP + Real RS = std::pow(0.75_rt / PI / DENS, C13); // r_s - electron density parameter + Real RSI = RS * abar * Z73 * AUM; // R_S - ion density parameter + Real GAME = 1.0_rt / RS / TEMP; // electron Coulomb parameter Gamma_e + GAMImean = Z53 * GAME; // effective Gamma_i - ion Coulomb parameter + + if (GAMImean < GAMIMELT || RSI < RSIMELT) { + LIQSOL = 0; // liquid regime + } + else { + LIQSOL = 1; // solid regime + } + + // Calculate partial thermodynamic quantities and combine them together: + Real UINT = UINTE; + Real PRESS = PRESSE; + Real CVtot = CVE * DENS; + Real Stot = SEid * DENS; + Real PDLT = PRESSE * CHITE; // d P_e[a.u.] / d ln T + Real PDLR = PRESSE * CHIRE; // d P_e[a.u.] / d ln\rho + Real DENSI = DENS / zbar; // number density of all ions + Real PRESSI = DENSI * TEMP; // ideal - ions total pressure (normalization) + Real TPT2 = 0.0_rt; + Real CTP = 4.0_rt * PI / AUM / (TEMP * TEMP); // common coefficient for TPT2.10.12.14 + + // Add Coulomb + xc nonideal contributions, and ideal free energy: + for (int i = 0; i < NumSpec; ++i) { + if (AY[i] >= TINY) { + Real Zion = AZion[i]; + Real CMI = ACMI[i]; + Real GAMI = std::pow(Zion, C53) * GAME; // Gamma_i for given ion species + Real DNI = DENSI * AY[i]; // number density of ions of given type + Real PRI = DNI * TEMP; // = ideal - ions partial pressure (normalization) + + Real FC1, UC1, PC1, SC1, CV1, PDT1, PDR1; + Real FC2, UC2, PC2, SC2, CV2, PDT2, PDR2; + + eosfi8(LIQSOL, CMI, Zion, RS, GAMI, + FC1, UC1, PC1, SC1, CV1, PDT1, PDR1, + FC2, UC2, PC2, SC2, CV2, PDT2, PDR2); + + // First - order TD functions: + UINT = UINT + UC2 * PRI; // internal energy density (e + i + Coul.) + Stot = Stot + DNI * (SC2 - std::log(AY[i])); //entropy per unit volume[a.u.] + PRESS = PRESS + PC2 * PRI; // pressure (e + i + Coul.) [a.u.] + + // Second - order functions (they take into account compositional changes): + CVtot = CVtot + DNI * CV2; // C_V (e + i + Coul.) / V (optim.10.12.14) + PDLT = PDLT + PRI * PDT2; // d P / d ln T + PDLR = PDLR + PRI * PDR2; // d P / d ln\rho + TPT2 = TPT2 + CTP * DNI / ACMI[i] * AZion[i] * AZion[i]; // opt.10.12.14 + } + } + + // Wigner - Kirkwood perturbative correction for liquid: + TPT = std::sqrt(TPT2); // effective T_p / T - ion quantum parameter + // (in the case of a mixture, this estimate is crude) + if (LIQSOL == 0) { + Real FWK = TPT2 / 24.0_rt * CWK; // Wigner - Kirkwood (quantum diffr.) term + Real UWK = 2.0_rt * FWK; + UINT = UINT + UWK * PRESSI; + Stot = Stot + FWK * DENSI; // corrected 28.05.15 + PRESS = PRESS + FWK * PRESSI; + CVtot = CVtot - UWK * DENSI; // corrected 18.04.20 + PDLT = PDLT - FWK * PRESSI; + PDLR = PDLR + UWK * PRESSI; + } + + // Corrections to the linear mixing rule: + Real FMIX, UMIX, PMIX, CVMIX, PDTMIX, PDRMIX; + if (LIQSOL == 0) { // liquid phase + cormix(RS, GAME, zbar, z2bar, Z52, Z53, Z321, + FMIX, UMIX, PMIX, CVMIX, PDTMIX, PDRMIX); + } + else { // solid phase (only Madelung contribution) [22.12.12] + FMIX = 0.0_rt; + for (int i = 0; i < NumSpec; ++i) { + for (int j = i+1; j < NumSpec; ++j) { + Real RZ = AZion[j] / AZion[i]; + Real X2 = AY[j] / (AY[i] + AY[j]); + Real X1 = std::max(0.0, 1.0_rt - X2); + + if (X1 < TINY) { + continue; // 27.01.19 + } + if (X2 < TINY) { + continue; + } + + Real X = X2 / RZ + (1.0_rt - 1.0_rt / RZ) * std::pow(X2, RZ); + Real GAMI = std::pow(AZion[i], C53) * GAME; // Gamma_i corrected 14.05.13 + Real DeltaG = 0.012_rt * (1.0_rt - 1.0_rt / (RZ * RZ)) * (X1 + X2 * std::pow(RZ, C53)); + DeltaG = DeltaG * X / X2 * std::max(0.0_rt, 1.0_rt - X) / X1; + FMIX = FMIX + AY[i] * AY[j] * GAMI * DeltaG; + } + } + + UMIX = FMIX; + PMIX = FMIX / 3.0_rt; + CVMIX = 0.0_rt; + PDTMIX = 0.0_rt; + PDRMIX = FMIX / 2.25_rt; + } + + UINT = UINT + UMIX * PRESSI; + Stot = Stot + DENSI * (UMIX - FMIX); + PRESS = PRESS + PMIX * PRESSI; + CVtot = CVtot + DENSI * CVMIX; + PDLT = PDLT + PRESSI * PDTMIX; + PDLR = PDLR + PRESSI * PDRMIX; + + // First - order: + Real PRADnkT = PRESSRAD / PRESSI; // radiative pressure / n_i k T + Real PnkT = PRESS / PRESSI; // P / n_i k T + Real UNkT = UINT / PRESSI; // U / N_i k T + Real SNk = Stot / DENSI; // S / N_i k + + // Second - order: + CV = CVtot / DENSI; // C_V per ion + CHIR = PDLR / PRESS; // d ln P / d ln\rho + CHIT = PDLT / PRESS; // d ln P / d ln T + + // Convert to CGS + Real Tnk = 8.31447e13_rt / abar * RHO * T6; // n_i kT [erg/cc] + Real avo_eos = 6.0221417930e23_rt; + Real N = avo_eos / abar; + Real k_B = 1.3806488e-16_rt; + + P = PnkT * Tnk; + U = UNkT * N * k_B * T; + S = SNk * N * k_B; +} + +template +AMREX_GPU_HOST_DEVICE AMREX_INLINE +void actual_eos (I input, T& state) +{ + static_assert(std::is_same::value, "input must be an eos_input_t"); +} + +AMREX_INLINE +void actual_eos_init () +{ +} + +AMREX_INLINE +void actual_eos_finalize () +{ +} + +template +AMREX_GPU_HOST_DEVICE AMREX_INLINE +bool is_input_valid (I input) +{ + static_assert(std::is_same::value, "input must be an eos_input_t"); + + bool valid = true; + + if (input != eos_input_rt) { + valid = false; + } + + return valid; +} + + +#endif diff --git a/EOS/pc/eos_c.cpp b/EOS/pc/eos_c.cpp deleted file mode 100644 index 1d8ec920ec..0000000000 --- a/EOS/pc/eos_c.cpp +++ /dev/null @@ -1,2491 +0,0 @@ -#include -#include -#include -#include -#include - -typedef double Real; -const int NumSpec = 2; - -inline namespace literals { - constexpr Real - operator"" _rt( long double x ) - { - return Real( x ); - } - - constexpr Real - operator"" _rt( unsigned long long int x ) - { - return Real( x ); - } -} - - -// Equation of state for fully ionized electron-ion plasmas (EOS EIP) -// A.Y.Potekhin & G.Chabrier, Contrib. Plasma Phys., 50 (2010) 82, -// and references therein -// Please communicate comments/suggestions to Alexander Potekhin: -// palex@astro.ioffe.ru -// Previously distributed versions (obsolete): -// eos2000, eos2002, eos2004, eos2006, eos2007, eos2009, eos10, eos11, -// eos13, and eos14. -// Last update: 04.03.21. All updates since 2008 are listed below. -//// L I S T O F S U B R O U T I N E S : -// MAIN (normally commented-out) - example driving routine. -// MELANGE9 - for arbitrary ionic mixture, renders total (ion+electron) -// pressure, internal energy, entropy, heat capacity (all -// normalized to the ionic ideal-gas values), logarithmic -// derivatives of pressure over temperature and density. -// EOSFI8 - nonideal (ion-ion + ion-electron + electron-electron) -// contributions to the free and internal energies, pressure, -// entropy, heat capacity, derivatives of pressure over -// logarithm of temperature and over logarithm of density (all -// normalized to the ionic ideal-gas values) for one ionic -// component in a mixture. -// FITION9 - ion-ion interaction contributions to the free and internal -// energies, pressure, entropy, heat capacity, derivatives of -// pressure over logarithms of temperature and density. -// FSCRliq8 - ion-electron (screening) contributions to the free and -// internal energies, pressure, entropy, heat capacity, -// derivatives of pressure over logarithms of temperature and -// density in the liquid phase for one ionic component in a -// mixture. -// FSCRsol8 - ion-electron (screening) contributions to the free and -// internal energies, pressure, entropy, heat capacity, -// derivatives of pressure over logarithms of temperature and -// density for monoionic solid. -// FHARM12 - harmonic (including static-lattice and zero-point) -// contributions to the free and internal energies, pressure, -// entropy, heat capacity, derivatives of pressure over -// logarithms of temperature and density for solid OCP. -// HLfit12 - the same as FHARM12, but only for thermal contributions -// ANHARM8 - anharmonic contributions to the free and internal energies, -// pressure, entropy, heat capacity, derivatives of pressure -// over logarithms of temperature and density for solid OCP. -// CORMIX - correction to the linear mixing rule for the Coulomb -// contributions to the thermodynamic functions in the liquid. -// ELECT11 - for an ideal electron gas of arbitrary degeneracy and -// relativity at given temperature and electron chemical -// potential, renders number density (in atomic units), free -// energy, pressure, internal energy, entropy, heat capacity -// (normalized to the electron ideal-gas values), logarithmic -// derivatives of pressure over temperature and density. -// EXCOR7 - electron-electron (exchange-correlation) contributions to -// the free and internal energies, pressure, entropy, heat -// capacity, derivatives of pressure over logarithm of -// temperature and over logarithm of density (all normalized -// to the classical electron ideal-gas values). -// FERINV7 - inverse non-relativistic Fermi integrals of orders -1/2, -// 1/2, 3/2, 5/2, and their first and second derivatives. -// BLIN9 - relativistic Fermi-Dirac integrals of orders 1/2, 3/2, 5/2, -// and their first, second, and some third derivatives. -// CHEMFIT7 - electron chemical potential at given density and -// temperature, and its first derivatives over density and -// temperature and the second derivative over temperature. -//// I M P R O V E M E N T S S I N C E 2 0 0 8 : -// FHARM8 uses a fit HLfit8 to the thermal free energy of the harmonic -// Coulomb lattice, which is more accurate than its predecessor FHARM7. -// Resulting corrections amount up to 20% for the ion heat capacity. -// Accordingly, S/R D3fit and FthCHA7 deleted (not used anymore). -// BLIN7 upgraded to BLIN8: -// - cleaned (a never-reached if-else branch deleted); -// - Sommerfeld (high-\chi) expansion improved; -// - some third derivatives added. -// CORMIX added (and MELANGE7 upgraded to MELANGE8 accordingly). -// ANHARM7 upgraded to ANHARM8, more consistent with Wigner-Kirkwood. -// Since the T- and rho-dependences of individual Z values in a mixture -// are not considered, the corresponding inputs (AYLR, AYLT) are -// excluded from MELANGE8 (and EOSFI7 changed to EOSFI8 accordingly). -// ELECT7 upgraded to ELECT9 (high-degeneracy behaviour is improved) -//// P O S T - P U B L I C A T I O N (2 0 1 0 +) IMPROVEMENTS : -// ELECT9 upgraded (smooth match of two fits at chi >> 1) -// BLIN8 replaced by BLIN9 - smooth fit interfaces at chi=0.6 and 14. -// MELANGE8 replaced by MELANGE9 - slightly modified input/output -// 08.08.11 - corrected mistake (unlikely to have an effect) in CHEMFIT7 -// 16.11.11 - ELECT9 upgraded to ELECT11 (additional output) -// 20.04.12 - FHARM8 and HLfit8 upgraded to FHARM12 and HLfit12: -// output of HLfit12 does not include zero-point vibr., but provides U1 -// 22.12.12 - MELANGE9 now includes a correction to the linear mixing -// rule (LMR) for the Madelung energy in the random bcc multi-ion -// lattice. -// 14.05.13 - an accidental error in programming the newly introduced -// correction to the LMR is fixed. -// 20.05.13 - calculation of the Wigner-Kirkwood quantum diffraction term -// for the liquid plasma is moved from EOSFI8 into MELANGE9. -// 10.12.14 - slight cleaning of the text (no effect on the results) -// 28.05.15 - an accidental error in Wigner-Kirkwood entropy correction -// is fixed (it was in the line "Stot=Stot+FWK*DENSI" since 20.05.13) -// 29.08.15 - eliminated underflow of exp(-THETA) in CHEMFIT7 -// 10.08.16 - modified criteria to avoid accuracy loss (round-off errors) -// 07.02.17 - included possibility to switch off the WK (Wigner) terms -// 27.05.17 - safeguard against Zion < 1 is added in FSCRsol8; -// safeguard against huge (-CHI) values is added in ELECT11. -// 27.01.19 - safeguard against X1=0 in CORMIX. -// 18.04.20 - corrected Wigner-Kirkwood term for heat capacity. -// 04.03.21 - corrected SUBFERMJ: defined parameter EPS (was undefined). -//////////////////////////////////////////////////////////////////////// -// MAIN program: Version 02.06.09 -// This driving routine allows one to compile and run this code "as is". -// In practice, however, one usually needs to link subroutines from this -// file to another (external) code, therefore the MAIN program is -// normally commented-out. - -extern "C" -{ - // Inverse Fermi integral with q=1/2 - void ferinv7 (Real F, Real& X) - { - // Version 24.05.07 - // X_q(f)=F^{-1}_q(f) : H.M.Antia 93 ApJS 84, 101 - // Input: F - // Output: X = X_q - // Relative error: - // for X: 4.2e-9 - - const Real A[6] = { 1.999266880833e4_rt, 5.702479099336e3_rt, 6.610132843877e2_rt, - 3.818838129486e1_rt, 1.0_rt, 0.0_rt}; - const Real B[7] = { 1.771804140488e4_rt, -2.014785161019e3_rt, 9.130355392717e1_rt, - -1.670718177489e0_rt, 0.0_rt, 0.0_rt, - 0.0_rt}; - const Real C[7] = {-1.277060388085e-2_rt, 7.187946804945e-2_rt, -4.262314235106e-1_rt, - 4.997559426872e-1_rt, -1.285579118012e0_rt, -3.930805454272e-1_rt, - 1.0_rt}; - const Real D[7] = {-9.745794806288e-3_rt, 5.485432756838e-2_rt, -3.29946624326e-1_rt, - 4.077841975923e-1_rt, -1.145531476975e0_rt, -6.067091689181e-2_rt, - 0.0_rt}; - const int LA = 4; - const int LB = 3; - const int LD = 5; - - const int N = 1; - - if (F <= 0.0_rt) { - printf("ferinv7: Non-positive argument\n"); - exit(1); - } - if (F < 4.0_rt) { - Real T = F; - Real UP = 0.0_rt; - Real DOWN = 0.0_rt; - for (int i = LA; i >= 0; --i) { - UP = UP * T + A[i]; - } - for (int i = LB; i >= 0; --i) { - DOWN = DOWN * T + B[i]; - } - X = std::log(T * UP / DOWN); - } - else { - Real P = -1.0_rt / (0.5_rt + (Real) N); // = -1/(1+\nu) = power index - Real T = std::pow(F, P); // t - argument of the rational fraction - Real UP = 0.0_rt; - Real DOWN = 0.0_rt; - for (int i = 6; i >= 0; --i) { - UP = UP * T + C[i]; - } - for (int i = LD; i >= 0; --i) { - DOWN = DOWN * T + D[i]; - } - Real R = UP / DOWN; - X = R / T; - } - } - - void chemfit (Real DENS, Real TEMP, Real& CHI) - { - // Version 29.08.15 - // Fit to the chemical potential of free electron gas described in: - // G.Chabrier & A.Y.Potekhin, Phys.Rev.E 58, 4941 (1998) - // Stems from CHEMFIT v.10.10.96. The main difference - derivatives. - // Input: DENS - electron density [a.u.=6.7483346e24 cm^{-3}], - // TEMP - temperature [a.u.=2Ryd=3.1577e5 K] - // Output: CHI = CMU1 / TEMR, where CMU1 = \mu-1 - chem.pot.w/o rest-energy - - const Real C13 = 1.0_rt / 3.0_rt; - const Real PARA = 1.612_rt; - const Real PARB = 6.192_rt; - const Real PARC = 0.0944_rt; - const Real PARF = 5.535_rt; - const Real PARG = 0.698_rt; - const Real XEPST = 228.0_rt; // the largest argument of e^{-X} - - Real DENR = DENS / 2.5733806e6_rt; // n_e in rel.un.=\lambda_{Compton}^{-3} - Real TEMR = TEMP / 1.8778865e4_rt; // T in rel.un.=(mc^2/k)=5.93e9 K - - Real PF0 = std::pow(29.6088132_rt * DENR, C13); // Classical Fermi momentum - Real TF; - if (PF0 > 1.e-4_rt) { - TF = std::sqrt(1.0_rt + PF0 * PF0) - 1.0_rt; // Fermi temperature - } - else { - TF = 0.5_rt * PF0 * PF0; - } - - Real THETA = TEMR / TF; - Real THETA32 = THETA * std::sqrt(THETA); - Real Q2 = 12.0_rt + 8.0_rt / THETA32; - Real T1 = 0.0_rt; - if (THETA < XEPST) { - T1 = std::exp(-THETA); - } - Real U3 = T1 * T1 + PARA; - Real THETAC = std::pow(THETA, PARC); - Real THETAG = std::pow(THETA, PARG); - Real D3 = PARB * THETAC * T1 * T1 + PARF * THETAG; - Real Q3 = 1.365568127_rt - U3 / D3; // 1.365...=2/\pi^{1/3} - Real Q1; - if (THETA > 1.e-5_rt) { - Q1 = 1.5_rt * T1 / (1.0_rt - T1); - } - else { - Q1 = 1.5 / THETA; - } - Real SQT = std::sqrt(TEMR); - Real G = (1.0_rt + Q2 * TEMR * Q3 + Q1 * SQT) * TEMR; - Real H = (1.0_rt + 0.5 * TEMR / THETA) * (1.0_rt + Q2 * TEMR); - Real CT = 1.0_rt + G / H; - Real F = 2.0_rt * C13 / THETA32; - Real X; - ferinv7(F, X); - CHI = X // Non-relativistic result - - 1.5_rt * std::log(CT); // Relativistic fit - } - - void blin9a (Real TEMP, Real CHI, - Real& W0, Real& W0DX, Real& W0DT, Real& W0DXX, - Real& W0DTT, Real& W0DXT, - Real& W1, Real& W1DX, Real& W1DT, Real& W1DXX, - Real& W1DTT, Real& W1DXT, - Real& W2, Real& W2DX, Real& W2DT, Real& W2DXX, - Real& W2DTT, Real& W2DXT, - Real& W0XXX, Real& W0XTT, Real& W0XXT) - { - // Version 19.01.10 - // First part of blin9: small CHI. Stems from blin9 v.24.12.08 - const Real AC[3][5] = {{0.37045057_rt, 0.41258437_rt, - 9.777982e-2_rt, 5.3734153e-3_rt, 3.8746281e-5_rt}, // c_i^0 - {0.39603109_rt, 0.69468795_rt, - 0.22322760_rt, 1.5262934e-2_rt, 1.3081939e-4_rt}, // c_i^1 - {0.76934619_rt, 1.7891437_rt, - 0.70754974_rt, 5.6755672e-2_rt, 5.5571480e-4_rt}}; // c_i^2 - - const Real AU[3][5] = {{0.43139881_rt, 1.7597537_rt, - 4.10446540_rt, 7.7467038_rt, 13.457678_rt}, // \chi_i^0 - {0.81763176_rt, 2.4723339_rt, - 5.11600610_rt, 9.0441465_rt, 15.049882_rt}, // \chi_i^1 - {1.25584610_rt, 3.2070406_rt, - 6.12390820_rt, 10.3161260_rt, 16.597079_rt}}; // \chi_i^2 - - const Real AA[3][5] = {{std::exp(-AU[0][0]), std::exp(-AU[0][1]), - std::exp(-AU[0][2]), std::exp(-AU[0][3]), std::exp(-AU[0][4])}, // \chi_i^0 - {std::exp(-AU[1][0]), std::exp(-AU[1][1]), - std::exp(-AU[1][2]), std::exp(-AU[1][3]), std::exp(-AU[1][4])}, // \chi_i^1 - {std::exp(-AU[2][0]), std::exp(-AU[2][1]), - std::exp(-AU[2][2]), std::exp(-AU[2][3]), std::exp(-AU[2][4])}}; // \chi_i^2 - - for (int k = 0; k <= 2; ++k) { - Real W = 0.0; - Real WDX = 0.0; - Real WDT = 0.0; - Real WDXX = 0.0; - Real WDTT = 0.0; - Real WDXT = 0.0; - Real WDXXX = 0.0; - Real WDXTT = 0.0; - Real WDXXT = 0.0; - Real ECHI = std::exp(-CHI); - - for (int i = 0; i <= 4; ++i) { - Real SQ = std::sqrt(1.0_rt + AU[k][i] * TEMP / 2.0_rt); - Real DN = AA[k][i] + ECHI; // e^{-\chi_i}+e^{-\chi}) - - W = W + AC[k][i] * SQ / DN; - WDX = WDX + AC[k][i] * SQ / (DN * DN); - WDT = WDT + AC[k][i] * AU[k][i] / (SQ * DN); - WDXX = WDXX + AC[k][i] * SQ * (ECHI - AA[k][i]) / (DN * DN * DN); - WDTT = WDTT - AC[k][i] * AU[k][i] * AU[k][i] / (DN * SQ * SQ * SQ); - WDXT = WDXT + AC[k][i] * AU[k][i] / (SQ * DN * DN); - WDXXX = WDXXX + AC[k][i] * SQ * - (ECHI * ECHI - 4.0_rt * ECHI * AA[k][i] + AA[k][i] * AA[k][i]) / - (DN * DN * DN * DN); - WDXTT = WDXTT - AC[k][i] * AU[k][i] * AU[k][i] / (DN * DN * SQ * SQ * SQ); - WDXXT = WDXXT + AC[k][i] * AU[k][i] * (ECHI - AA[k][i]) / (SQ * DN * DN * DN); - } - - WDX = WDX * ECHI; - WDT = WDT / 4.0_rt; - WDXX = WDXX * ECHI; - WDTT = WDTT / 16.0_rt; - WDXT = WDXT / 4.0_rt * ECHI; - WDXXX = WDXXX * ECHI; - WDXTT = WDXTT * ECHI / 16.0_rt; - WDXXT = WDXXT / 4.0_rt * ECHI; - - if (k == 0) { - W0 = W; - W0DX = WDX; - W0DT = WDT; - W0DXX = WDXX; - W0DTT = WDTT; - W0DXT = WDXT; - W0XXX = WDXXX; - W0XTT = WDXTT; - W0XXT = WDXXT; - } - else if (k == 1) { - W1 = W; - W1DX = WDX; - W1DT = WDT; - W1DXX = WDXX; - W1DTT = WDTT; - W1DXT = WDXT; - } - else { - W2 = W; - W2DX = WDX; - W2DT = WDT; - W2DXX = WDXX; - W2DTT = WDTT; - W2DXT = WDXT; - } - } - } - - void blin9b(Real TEMP, Real CHI, - Real& W0, Real& W0DX, Real& W0DT, Real& W0DXX, - Real& W0DTT, Real& W0DXT, - Real& W1, Real& W1DX, Real& W1DT, Real& W1DXX, - Real& W1DTT, Real& W1DXT, - Real& W2, Real& W2DX, Real& W2DT, Real& W2DXX, - Real& W2DTT, Real& W2DXT, - Real& W0XXX, Real& W0XTT, Real& W0XXT) - { - // Version 19.01.10 - // Small syntax fix 15.03.13 - // Second part of BILN9: intermediate CHI. Stems from BLIN8 v.24.12.08 - const Real EPS = 1.e-3; - - const Real AX[5] = {7.265351e-2_rt, 0.2694608_rt, - 0.533122_rt, 0.7868801_rt, 0.9569313_rt}; // x_i - const Real AXI[5] = {0.26356032_rt, 1.4134031_rt, - 3.59642580_rt, 7.0858100_rt, 12.640801_rt}; // \xi_i - const Real AH[5] = {3.818735e-2_rt, 0.1256732_rt, - 0.1986308_rt, 0.1976334_rt, 0.1065420_rt}; // H_i - const Real AV[5] = {0.29505869_rt, 0.32064856_rt, - 7.3915570e-2_rt, 3.6087389e-3_rt, 2.3369894e-5_rt}; // \bar{V}_i - - if (CHI < EPS) { - printf("BLIN9b: CHI is too small\n"); - exit(1); - } - - for (int k = 0; k <= 2; ++k) { - Real W = 0.0; - Real WDX = 0.0; - Real WDT = 0.0; - Real WDXX = 0.0; - Real WDTT = 0.0; - Real WDXT = 0.0; - Real WDXXX = 0.0; - Real WDXTT = 0.0; - Real WDXXT = 0.0; - Real SQCHI = std::sqrt(CHI); - - for (int i = 0; i <= 4; ++i) { - Real CE = AX[i] - 1.0_rt; - Real ECHI = std::exp(CE * CHI); - Real DE = 1.0_rt + ECHI; - Real D = 1.0_rt + AX[i] * CHI * TEMP / 2.0_rt; - Real H = std::pow(CHI, k + 1) * SQCHI * std::sqrt(D) / DE; - Real HX = (k + 1.5_rt) / CHI + 0.25_rt * AX[i] * TEMP / D - ECHI * CE / DE; - Real HDX = H * HX; - Real HXX = (k + 1.5_rt) / (CHI * CHI) + 0.125_rt * (AX[i] * TEMP / D) * (AX[i] * TEMP / D) + - ECHI * (CE / DE) * (CE / DE); - Real HDXX = HDX * HX - H * HXX; - Real HT = 0.25_rt * AX[i] * CHI / D; - Real HDT = H * HT; - Real HDTT = -H * HT * HT; - Real HTX = 1.0_rt / CHI - 0.5_rt * AX[i] * TEMP / D; - Real HDXT = HDX * HT + HDT * HTX; - Real HDXXT = HDXX * HT + HDX * HT * HTX + HDXT * HTX + - HDT * (0.25_rt * (AX[i] * TEMP / D) * (AX[i] * TEMP / D) - - 1.0_rt / (CHI * CHI)); - Real HDXTT = HDXT * HT - HDX * 0.125_rt * (AX[i] * CHI / D) * (AX[i] * CHI / D) + HDTT * HTX + - HDT * 0.5_rt * AX[i] * (TEMP * 0.5_rt * AX[i] * CHI / (D * D) - 1.0_rt / D); - Real HXXX = (2 * k + 3) / (CHI * CHI * CHI) + 0.125_rt * (AX[i] * TEMP / D) * (AX[i] * TEMP / D) * - (AX[i] * TEMP / D) - ECHI * (1.0_rt - ECHI) * (CE / DE) * (CE / DE) * (CE / DE); - Real HDXXX = HDXX * HX - 2.0_rt * HDX * HXX + H * HXXX; - Real XICHI = AXI[i] + CHI; - Real DXI = 1.0_rt + XICHI * TEMP / 2.0_rt; - Real V = std::pow(XICHI, k) * std::sqrt(XICHI * DXI); - Real VX= (k + 0.5_rt) / XICHI + 0.25_rt * TEMP / DXI; - Real VDX = V * VX; - Real VT = 0.25_rt * XICHI / DXI; - Real VDT = V * VT; - Real VXX = (k + 0.5_rt) / (XICHI * XICHI) + 0.125_rt * (TEMP / DXI) * (TEMP / DXI); - Real VDXX = VDX * VX - V * VXX; - Real VDXXX = VDXX * VX - 2.0_rt * VDX * VXX + - V * ((2 * k + 1) / (XICHI * XICHI * XICHI) + - 0.125_rt * (TEMP / DXI) * (TEMP / DXI) * (TEMP / DXI)); - Real VXXT = (1.0_rt - 0.5_rt * TEMP * XICHI / DXI) / DXI; - Real VDTT = -V * VT * VT; - Real VXT = 1.0_rt / XICHI - 0.5_rt * TEMP / DXI; - Real VDXT = VDT * VXT + VDX * VT; - Real VDXXT = VDXT * VX + VDX * 0.25_rt * VXXT - VDT * VXX - V * 0.25_rt * TEMP / DXI * VXXT; - Real VDXTT = VDTT * VXT - VDT * 0.5_rt * VXXT + VDXT * VT - - VDX * 0.125_rt * (XICHI / DXI) * (XICHI / DXI); - W = W + AH[i] * std::pow(AX[i], k) * H + AV[i] * V; - WDX = WDX + AH[i] * std::pow(AX[i], k) * HDX + AV[i] * VDX; - WDT = WDT + AH[i] * std::pow(AX[i], k) * HDT + AV[i] * VDT; - WDXX = WDXX + AH[i] * std::pow(AX[i], k) * HDXX + AV[i] * VDXX; - WDTT = WDTT + AH[i] * std::pow(AX[i], k) * HDTT + AV[i] * VDTT; - WDXT = WDXT + AH[i] * std::pow(AX[i], k) * HDXT + AV[i] * VDXT; - WDXXX = WDXXX + AH[i] * std::pow(AX[i], k) * HDXXX + AV[i] * VDXXX; - WDXTT = WDXTT + AH[i] * std::pow(AX[i], k) * HDXTT + AV[i] * VDXTT; - WDXXT = WDXXT + AH[i] * std::pow(AX[i], k) * HDXXT + AV[i] * VDXXT; - } - - if (k == 0) { - W0 = W; - W0DX = WDX; - W0DT = WDT; - W0DXX = WDXX; - W0DTT = WDTT; - W0DXT = WDXT; - W0XXX = WDXXX; - W0XTT = WDXTT; - W0XXT = WDXXT; - } - else if (k == 1) { - W1 = W; - W1DX = WDX; - W1DT = WDT; - W1DXX = WDXX; - W1DTT = WDTT; - W1DXT = WDXT; - } - else { - W2 = W; - W2DX = WDX; - W2DT = WDT; - W2DXX = WDXX; - W2DTT = WDTT; - W2DXT = WDXT; - } - } - } - - void blin9c (Real TEMP, Real CHI, - Real& W0, Real& W0DX, Real& W0DT, Real& W0DXX, Real& W0DTT, Real& W0DXT, - Real& W1, Real& W1DX, Real& W1DT, Real& W1DXX, Real& W1DTT, Real& W1DXT, - Real& W2, Real& W2DX, Real& W2DT, Real& W2DXX, Real& W2DTT, Real& W2DXT, - Real& W0XXX, Real& W0XTT, Real& W0XXT) - { - // Version 19.01.10 - // Third part of BILN9: large CHI. Stems from BLIN8 v.24.12.08 - const Real PI = 3.141592653_rt; - const Real PI26 = PI * PI / 6.0; - - Real AM[3], AMDX[3], AMDT[3], AMDXX[3], AMDTT[3], AMDXT[3]; - - if (CHI * TEMP < 0.1_rt) { - - for (int k = 0; k <= 2; ++k) { - Real W = 0.0_rt; - Real WDX = 0.0_rt; - Real WDT = 0.0_rt; - Real WDXX = 0.0_rt; - Real WDTT = 0.0_rt; - Real WDXT = 0.0_rt; - Real WDXXX = 0.0_rt; - Real WDXTT = 0.0_rt; - Real WDXXT = 0.0_rt; - - Real C; - - for (int j = 0; j <= 4; ++j) { // for nonrel.Fermi integrals from k+1/2 to k+4.5 - Real CNU = k + j + 0.5_rt; // nonrelativistic Fermi integral index \nu - Real CHINU = std::pow(CHI, k + j) * std::sqrt(CHI); // \chi^\nu - Real F = CHINU * (CHI / (CNU + 1.0_rt) + PI26 * CNU / CHI + // nonrel.Fermi - 0.7_rt * PI26 * PI26 * CNU * (CNU - 1.0_rt) * - (CNU - 2.0_rt) / (CHI * CHI * CHI)); - Real FDX = CHINU * (1.0_rt + PI26 * CNU * (CNU - 1.0_rt) / (CHI * CHI) + - 0.7_rt * PI26 * PI26 * CNU * (CNU - 1.0_rt) * (CNU - 2.0_rt) - * (CNU - 3.0_rt) / (CHI * CHI * CHI * CHI)); - Real FDXX = CHINU / CHI * CNU * - (1.0_rt + PI26 * (CNU - 1.0_rt) * - (CNU - 2.0_rt) / (CHI * CHI) + - 0.7_rt * PI26 * PI26 * (CNU - 1.0_rt) * (CNU - 2.0_rt) * - (CNU - 3.0_rt) * (CNU - 4.0_rt) / (CHI * CHI * CHI * CHI)); - Real FDXXX = CHINU / (CHI * CHI) * CNU * (CNU - 1.0_rt) * - (1.0_rt + PI26 * (CNU - 2.0_rt) * (CNU - 3.0_rt) / (CHI * CHI) + - 0.7_rt * PI26 * PI26 * (CNU - 2.0_rt) * (CNU - 3.0_rt) * - (CNU - 4.0_rt) * (CNU - 5.0_rt) / (CHI * CHI * CHI * CHI)); - - if (j == 0) { - W = F; - WDX = FDX; - WDXX = FDXX; - WDXXX = FDXXX; - } - else if (j == 1) { - C = 0.25_rt * TEMP; - W = W + C * F; // Fermi-Dirac, expressed through Fermi - WDX = WDX + C * FDX; - WDXX = WDXX + C * FDXX; - WDT = F / 4.0_rt; - WDXT = FDX / 4.0_rt; - WDTT = 0.0_rt; - WDXXX = WDXXX + C * FDXXX; - WDXXT = FDXX / 4.0_rt; - WDXTT = 0.0_rt; - } - else { - C = -C / j * (2 * j - 3) / 4.0_rt * TEMP; - W = W + C * F; - WDX = WDX + C * FDX; - WDT = WDT + C * j / TEMP * F; - WDXX = WDXX + C * FDXX; - WDTT = WDTT + C * j * (j - 1) / (TEMP * TEMP) * F; - WDXT = WDXT + C * j / TEMP * FDX; - WDXXX = WDXXX + C * FDXXX; - WDXTT = WDXTT + C * j * (j - 1) / (TEMP * TEMP) * FDX; - WDXXT = WDXXT + C * j / TEMP * FDXX; - } - } - - if (k == 0) { - W0 = W; - W0DX = WDX; - W0DT = WDT; - W0DXX = WDXX; - W0DTT = WDTT; - W0DXT = WDXT; - W0XXX = WDXXX; - W0XTT = WDXTT; - W0XXT = WDXXT; - } - else if (k == 1) { - W1 = W; - W1DX = WDX; - W1DT = WDT; - W1DXX = WDXX; - W1DTT = WDTT; - W1DXT = WDXT; - } - else { - W2 = W; - W2DX = WDX; - W2DT = WDT; - W2DXX = WDXX; - W2DTT = WDTT; - W2DXT = WDXT; - } - } - - } - else { // CHI > 14, CHI * TEMP > 0.1: general high-\chi expansion - - Real D = 1.0_rt + CHI * TEMP / 2.0_rt; - Real R = std::sqrt(CHI * D); - Real RX = 0.5_rt / CHI + 0.25_rt * TEMP / D; - Real RDX = R * RX; - Real RDT = 0.25_rt * CHI * CHI / R; - Real RXX = -0.5_rt / (CHI * CHI) - 0.125_rt * (TEMP / D) * (TEMP / D); - Real RDXX = RDX * RX + R * RXX; - Real RDTT = -0.25_rt * RDT * CHI / D; - Real RXT = 0.25_rt / D - 0.125_rt * CHI * TEMP / (D * D); - Real RDXT = RDT * RX + R * RXT; - Real RXXX = 1.0_rt / (CHI * CHI * CHI) + 0.125_rt * (TEMP / D) * (TEMP / D) * (TEMP / D); - Real RDXXX = RDXX * RX + 2.0_rt * RDX * RXX + R * RXXX; - Real RXTT = -0.25_rt / (D * D) * CHI + 0.125_rt * CHI * CHI * TEMP / (D * D * D); - Real RDXTT = RDTT * RX + 2.0_rt * RDT * RXT + R * RXTT; - Real RXXT = -RXT * TEMP / D; - Real RDXXT = RDXT * RX + RDX * RXT + RDT * RXX + R * RXXT; - - Real AMDXXX, AMDXTT, AMDXXT; - - for (int k = 0; k <= 2; ++k) { - Real DM = k + 0.5_rt + (k + 1.0_rt) * CHI * TEMP / 2.0_rt; - AM[k] = std::pow(CHI, k) * DM / R; - Real FMX1 = 0.5_rt * (k + 1.0_rt) * TEMP / DM; - Real FMX2 = 0.25_rt * TEMP / D; - Real FMX = (k - 0.5_rt) / CHI + FMX1 - FMX2; - AMDX[k] = AM[k] * FMX; - Real CkM = 0.5_rt * (k + 1.0_rt) / DM; - Real FMT1 = CkM * CHI; - Real FMT2 = 0.25_rt * CHI / D; - Real FMT = FMT1 - FMT2; - AMDT[k] = AM[k] * FMT; - Real FMXX = -(k - 0.5_rt) / (CHI * CHI) - FMX1 * FMX1 + 2.0_rt * FMX2 * FMX2; - AMDXX[k] = AMDX[k] * FMX + AM[k] * FMXX; - Real FMTT = 2.0_rt * FMT2 * FMT2 - FMT1 * FMT1; - AMDTT[k] = AMDT[k] * FMT + AM[k] * FMTT; - AMDXT[k] = AMDX[k] * FMT + AM[k] * (CkM * (1.0_rt - CkM * CHI * TEMP) - - 0.25_rt / D + 0.125_rt * CHI * TEMP / (D * D)); - - if (k == 0) { - Real FMXXX = (2 * k - 1) / (CHI * CHI * CHI) + 2.0_rt * FMX1 * FMX1 * FMX1 - - 8.0_rt * FMX2 * FMX2 * FMX2; - AMDXXX = AMDXX[k] * FMX + 2.0_rt * AMDX[k] * FMXX + AM[k] * FMXXX; - Real FMT1DX = CkM - TEMP * CHI * CkM * CkM; - Real FMT2DX = (0.25_rt - CHI * TEMP * 0.125_rt / D) / D; - Real FMXT = FMT1DX - FMT2DX; - Real FMTTX = 4.0_rt * FMT2 * FMT2DX - 2.0_rt * FMT1 * FMT1DX; - AMDXTT = AMDXT[k] * FMT + AMDT[k] * FMXT + AMDX[k] * FMTT + AM[k] * FMTTX; - Real FMX1DT = CkM - CHI * TEMP * CkM * CkM; - Real FMX2DT = 0.25_rt / D * (1.0_rt - 0.5_rt * CHI * TEMP / D); - Real FMXXT = 4.0_rt * FMX2 * FMX2DT - 2.0_rt * FMX1 * FMX1DT; - AMDXXT = AMDXT[k] * FMX + AMDX[k] * FMXT + AMDT[k] * FMXX + AM[k] * FMXXT; - } - } - - Real SQ2T = std::sqrt(2.0_rt * TEMP); - Real A = 1.0_rt + CHI * TEMP + SQ2T * R; - Real ADX = TEMP + SQ2T * RDX; - Real ADT = CHI + R / SQ2T + SQ2T * RDT; - Real ADXX = SQ2T * RDXX; - Real ADTT = -R / (SQ2T * SQ2T * SQ2T) + 2.0_rt / SQ2T * RDT + SQ2T * RDTT; - Real ADXT = 1.0_rt + RDX / SQ2T + SQ2T * RDXT; - Real ADXTT = -RDX / (SQ2T * SQ2T * SQ2T) + 2.0_rt / SQ2T * RDXT + SQ2T * RDXTT; - Real ADXXT = RDXX / SQ2T + SQ2T * RDXXT; - Real XT1 = CHI + 1.0_rt / TEMP; - Real Aln = std::log(A); - Real FJ0 = 0.5_rt * XT1 * R - Aln / (SQ2T * SQ2T * SQ2T); - Real ASQ3 = A * SQ2T * SQ2T * SQ2T; - Real ASQ3DX = ADX * SQ2T * SQ2T * SQ2T; - Real FJ0DX = 0.5_rt * (R + XT1 * RDX) - ADX / ASQ3; - Real FJ0DT = 0.5_rt * (XT1 * RDT - R / (TEMP * TEMP)) - ADT / ASQ3 + - 0.75_rt / (TEMP * TEMP * SQ2T) * Aln; - Real FJ0DXX = RDX + 0.5_rt * XT1 * RDXX + (ADX / A) * (ADX / A) / (SQ2T * SQ2T * SQ2T) - ADXX / ASQ3; - Real FJ0DTT = R / (TEMP * TEMP * TEMP) - RDT / (TEMP * TEMP) + 0.5_rt * XT1 * RDTT + - 3.0_rt / (ASQ3 * TEMP) * ADT + - (ADT / A) * (ADT / A) / (SQ2T * SQ2T * SQ2T) - ADTT / ASQ3 - - 1.875_rt / (TEMP * TEMP * TEMP * SQ2T) * Aln; - Real BXT = 1.5_rt / TEMP * ADX + ADX * ADT / A - ADXT; - Real BXXT = 1.5_rt / TEMP * ADXX + (ADXX * ADT + ADX * ADXT) / A - - (ADX / A) * (ADX / A) * ADT - ADXXT; - Real FJ0DXT = 0.5_rt * (RDT - RDX / (TEMP * TEMP) + XT1 * RDXT) + BXT / ASQ3; - Real FJ0XXX = RDXX * 1.5_rt + 0.5_rt * XT1 * RDXXX + - (2.0_rt * ADX * (ADXX / A - (ADX / A) * (ADX / A)) - - SQ2T * RDXXX + ADXX / ASQ3 * ASQ3DX) / ASQ3; - Real FJ0XTT = RDX / (TEMP * TEMP * TEMP) - RDXT / (TEMP * TEMP) + 0.5_rt * (RDTT + XT1 * RDXTT) + - 3.0_rt / TEMP * (ADXT - ADT / ASQ3 * ASQ3DX) / ASQ3 + - (2.0_rt * ADT * (ADXT / A - ADT * ADX / (A * A)) - - ADXTT + ADTT * ASQ3DX / ASQ3) / ASQ3 - 1.875_rt / (TEMP * TEMP * TEMP * SQ2T) * ADX / A; - Real FJ0XXT = 0.5_rt * (RDXT - RDXX / (TEMP * TEMP) + RDXT + XT1 * RDXXT) + - (BXXT - BXT * ASQ3DX / ASQ3) / ASQ3; - - W0 = FJ0 + PI26 * AM[0]; - W0DX = FJ0DX + PI26 * AMDX[0]; - W0DT = FJ0DT + PI26 * AMDT[0]; - W0DXX = FJ0DXX + PI26 * AMDXX[0]; - W0DTT = FJ0DTT + PI26 * AMDTT[0]; - W0DXT = FJ0DXT + PI26 * AMDXT[0]; - W0XXX = FJ0XXX + PI26 * AMDXXX; - W0XTT = FJ0XTT + PI26 * AMDXTT; - W0XXT = FJ0XXT + PI26 * AMDXXT; - - Real FJ1 = (R * R * R / 1.5_rt - FJ0) / TEMP; - Real FJ1DX = (2.0_rt * R * R * RDX - FJ0DX) / TEMP; - Real FJ1DT = (2.0_rt * R * R * RDT - FJ0DT - FJ1) / TEMP; - Real FJ1DXX = (4.0_rt * R * RDX * RDX + 2.0_rt * R * R * RDXX - FJ0DXX) / TEMP; - Real FJ1DTT = (4.0_rt * R * RDT * RDX + 2.0_rt * R * R * RDTT - FJ0DTT - 2.0_rt * FJ1DT) / TEMP; - Real FJ1DXT = (4.0_rt * R * RDX * RDT + 2.0_rt * R * R * RDXT - FJ0DXT - FJ1DX) / TEMP; - - W1 = FJ1 + PI26 * AM[1]; - W1DX = FJ1DX + PI26 * AMDX[1]; - W1DT = FJ1DT + PI26 * AMDT[1]; - W1DXX = FJ1DXX + PI26 * AMDXX[1]; - W1DTT = FJ1DTT + PI26 * AMDTT[1]; - W1DXT = FJ1DXT + PI26 * AMDXT[1]; - - Real FJ2 = (0.5_rt * CHI * R * R * R - 1.25_rt * FJ1) / TEMP; - Real FJ2DX = (0.5_rt * R * R * R + 1.5_rt * CHI * R * R * RDX - 1.25_rt * FJ1DX) / TEMP; - Real FJ2DT = (1.5_rt * CHI * R * R * RDT - 1.25_rt * FJ1DT - FJ2) / TEMP; - Real FJ2DXX = (3.0_rt * R * RDX * (R + CHI * RDX) + 1.5_rt * CHI * R * R * RDXX - - 1.25_rt * FJ1DXX) / TEMP; - Real FJ2DTT = (3.0_rt * CHI * R * (RDT * RDT + 0.5_rt * R * RDTT) - - 1.25_rt * FJ1DTT - 2.0_rt * FJ2DT) / TEMP; - Real FJ2DXT = (1.5_rt * R * RDT * (R + 2.0_rt * CHI * RDX) + 1.5_rt * CHI * R * R * RDXT - - 1.25_rt * FJ1DXT - FJ2DX) / TEMP; - - W2 = FJ2 + PI26 * AM[2]; - W2DX = FJ2DX + PI26 * AMDX[2]; - W2DT = FJ2DT + PI26 * AMDT[2]; - W2DXX = FJ2DXX + PI26 * AMDXX[2]; - W2DTT = FJ2DTT + PI26 * AMDTT[2]; - W2DXT = FJ2DXT + PI26 * AMDXT[2]; - } - - } - - void fermi10 (Real X, Real XMAX, Real& FP, Real& FM) - { - // Version 20.01.10 - // Fermi distribution function and its 3 derivatives - // Input: X - argument f(x) - // XMAX - max|X| where it is assumed that 0 < f(x) < 1. - // Output: FP = f(x) - // FM = 1-f(x) - if (X > XMAX) { - FP = 0.0_rt; - FM = 1.0_rt; - } - else if (X < -XMAX) { - FP = 1.0_rt; - FM = 0.0_rt; - } - else { - FP = 1.0 / (std::exp(X) + 1.0_rt); - FM = 1.0 - FP; - } - } - - void blin9 (Real TEMP, Real CHI, - Real& W0, Real& W0DX, Real& W0DT, Real& W0DXX, Real& W0DTT, Real& W0DXT, - Real& W1, Real& W1DX, Real& W1DT, Real& W1DXX, Real& W1DTT, Real& W1DXT, - Real& W2, Real& W2DX, Real& W2DT, Real& W2DXX, Real& W2DTT, Real& W2DXT, - Real& W0XXX, Real& W0XTT, Real& W0XXT) - { - // Version 21.01.10 - // Stems from BLIN8 v.24.12.08 - // Difference - smooth matching of different CHI ranges - // Input: TEMP=T/mc^2; CHI=(\mu-mc^2)/T - // Output: Wk - Fermi-Dirac integral of the order k+1/2 - // WkDX=dWk/dCHI, WkDT = dWk/dT, WkDXX=d^2 Wk / d CHI^2, - // WkDTT=d^2 Wk / d T^2, WkDXT=d^2 Wk /dCHIdT, - // W0XXX=d^3 W0 / d CHI^3, W0XTT=d^3 W0 /(d CHI d^2 T), - // W0XXT=d^3 W0 /dCHI^2 dT - - const Real CHI1 = 0.6_rt; - const Real CHI2 = 14.0_rt; - const Real XMAX = 30.0_rt; - const Real DCHI1 = 0.1_rt; - const Real DCHI2 = CHI2 - CHI1 - DCHI1; - const Real XSCAL1 = XMAX / DCHI1; - const Real XSCAL2 = XMAX / DCHI2; - - Real X1 = (CHI - CHI1) * XSCAL1; - Real X2 = (CHI - CHI2) * XSCAL2; - - if (X1 < - XMAX) { - - blin9a(TEMP, CHI, - W0, W0DX, W0DT, W0DXX, W0DTT, W0DXT, - W1, W1DX, W1DT, W1DXX, W1DTT, W1DXT, - W2, W2DX, W2DT, W2DXX, W2DTT, W2DXT, - W0XXX, W0XTT, W0XXT); - - } - else if (X2 < XMAX) { // match two fits - - Real W0a, W0DXa, W0DTa, W0DXXa, W0DTTa, W0DXTa, - W1a, W1DXa, W1DTa, W1DXXa, W1DTTa, W1DXTa, - W2a, W2DXa, W2DTa, W2DXXa, W2DTTa, W2DXTa, - W0XXXa, W0XTTa, W0XXTa; - - Real W0b, W0DXb, W0DTb, W0DXXb, W0DTTb, W0DXTb, - W1b, W1DXb, W1DTb, W1DXXb, W1DTTb, W1DXTb, - W2b, W2DXb, W2DTb, W2DXXb, W2DTTb, W2DXTb, - W0XXXb, W0XTTb, W0XXTb; - - Real FP, FM; - - if (X1 < XMAX) { // match fits "a" and "b" - - fermi10(X1, XMAX, FP, FM); - blin9a(TEMP, CHI, - W0a, W0DXa, W0DTa, W0DXXa, W0DTTa, W0DXTa, - W1a, W1DXa, W1DTa, W1DXXa, W1DTTa, W1DXTa, - W2a, W2DXa, W2DTa, W2DXXa, W2DTTa, W2DXTa, - W0XXXa, W0XTTa, W0XXTa); - blin9b(TEMP, CHI, - W0b, W0DXb, W0DTb, W0DXXb, W0DTTb, W0DXTb, - W1b, W1DXb, W1DTb, W1DXXb, W1DTTb, W1DXTb, - W2b, W2DXb, W2DTb, W2DXXb, W2DTTb, W2DXTb, - W0XXXb, W0XTTb, W0XXTb); - - } - else { // match fits "b" and "c" - - fermi10(X2, XMAX, FP, FM); - blin9b(TEMP, CHI, - W0a, W0DXa, W0DTa, W0DXXa, W0DTTa, W0DXTa, - W1a, W1DXa, W1DTa, W1DXXa, W1DTTa, W1DXTa, - W2a, W2DXa, W2DTa, W2DXXa, W2DTTa, W2DXTa, - W0XXXa, W0XTTa, W0XXTa); - blin9c(TEMP, CHI, - W0b, W0DXb, W0DTb, W0DXXb, W0DTTb, W0DXTb, - W1b, W1DXb, W1DTb, W1DXXb, W1DTTb, W1DXTb, - W2b, W2DXb, W2DTb, W2DXXb, W2DTTb, W2DXTb, - W0XXXb, W0XTTb, W0XXTb); - - } - - W0 = W0a * FP + W0b * FM; - W0DX = W0DXa * FP + W0DXb * FM; - W0DT = W0DTa * FP + W0DTb * FM; - W0DXX = W0DXXa * FP + W0DXXb * FM; - W0DTT = W0DTTa * FP + W0DTTb * FM; - W0DXT = W0DXTa * FP + W0DXTb * FM; - W0XXX = W0XXXa * FP + W0XXXb * FM; - W0XTT = W0XTTa * FP + W0XTTb * FM; - W0XXT = W0XXTa * FP + W0XXTb * FM; - W1 = W1a * FP + W1b * FM; - W1DX = W1DXa * FP + W1DXb * FM; - W1DT = W1DTa * FP + W1DTb * FM; - W1DXX = W1DXXa * FP + W1DXXb * FM; - W1DTT = W1DTTa * FP + W1DTTb * FM; - W1DXT = W1DXTa * FP + W1DXTb * FM; - W2 = W2a * FP + W2b * FM; - W2DX = W2DXa * FP + W2DXb * FM; - W2DT = W2DTa * FP + W2DTb * FM; - W2DXX = W2DXXa * FP + W2DXXb * FM; - W2DTT = W2DTTa * FP + W2DTTb * FM; - W2DXT = W2DXTa * FP + W2DXTb * FM; - - } - else { - - blin9c(TEMP, CHI, - W0, W0DX, W0DT, W0DXX, W0DTT, W0DXT, - W1, W1DX, W1DT, W1DXX, W1DTT, W1DXT, - W2, W2DX, W2DT, W2DXX, W2DTT, W2DXT, - W0XXX, W0XTT, W0XXT); - - } - } - - void excor7 (double RS, double GAME, - double& FXC, double& UXC, double& PXC, - double& CVXC, double& SXC, double& PDTXC, - double& PDRXC) - { - // Version 09.06.07 - // Accuracy-loss cut-off modified on 10.08.16 - // Exchange-correlation contribution for the electron gas - // Stems from TANAKA1 v.03.03.96. Added derivatives. - // Input: RS - electron density parameter =electron-sphere radius in a.u. - // GAME - electron Coulomb coupling parameter - // Output: FXC - excess free energy of e-liquid per kT per one electron - // according to Tanaka & Ichimaru 85-87 and Ichimaru 93 - // UXC - internal energy contr.[per 1 electron, kT] - // PXC - pressure contribution divided by (n_e kT) - // CVXC - heat capacity divided by N_e k - // SXC - entropy divided by N_e k - // PDTXC,PDRXC = PXC + d PXC / d ln(T,\rho) - const Real EPS = 1.e-8_rt; // 10.08.16 - - Real THETA = 0.543_rt * RS / GAME; // non-relativistic degeneracy parameter - Real SQTH = std::sqrt(THETA); - Real THETA2 = THETA * THETA; - Real THETA3 = THETA2 * THETA; - Real THETA4 = THETA3 * THETA; - - Real T1, T1DH, T1DHH, T2, T2DH, T2DHH; - - if (THETA > .005_rt) { - Real CHT1 = std::cosh(1.0_rt / THETA); - Real SHT1 = std::sinh(1.0_rt / THETA); - Real CHT2 = std::cosh(1.0_rt / SQTH); - Real SHT2 = std::sinh(1.0_rt / SQTH); - T1 = SHT1 / CHT1; // tanh(1.0_rt / THETA) - T2 = SHT2 / CHT2; // tanh(1.0_rt / sqrt(THETA)) - T1DH = -1.0_rt / ((THETA * CHT1) * (THETA * CHT1)); // d T1 / d\theta - T1DHH = 2.0_rt / ((THETA * CHT1) * (THETA * CHT1) * (THETA * CHT1)) * - (CHT1 - SHT1 / THETA); - T2DH = -0.5_rt * SQTH / ((THETA * CHT2) * (THETA * CHT2)); - T2DHH = (0.75_rt * SQTH * CHT2 - 0.5_rt * SHT2) / - ((THETA * CHT2) * (THETA * CHT2) * (THETA * CHT2)); - } - else { - T1 = 1.0_rt; - T2 = 1.0_rt; - T1DH = 0.0_rt; - T2DH = 0.0_rt; - T1DHH = 0.0_rt; - T2DHH = 0.0_rt; - } - - Real A0 = 0.75_rt + 3.04363_rt * THETA2 - 0.09227_rt * THETA3 + 1.7035_rt * THETA4; - Real A0DH = 6.08726_rt * THETA - 0.27681_rt * THETA2 + 6.814_rt * THETA3; - Real A0DHH = 6.08726_rt - 0.55362_rt * THETA + 20.442_rt * THETA2; - Real A1 = 1.0_rt + 8.31051_rt * THETA2 + 5.1105_rt * THETA4; - Real A1DH = 16.62102_rt * THETA + 20.442_rt * THETA3; - Real A1DHH = 16.62102_rt + 61.326_rt * THETA2; - Real A = 0.610887_rt * A0 / A1 * T1; // HF fit of Perrot and Dharma - wardana - Real AH = A0DH / A0 - A1DH / A1 + T1DH / T1; - Real ADH = A * AH; - Real ADHH = ADH * AH + A * (A0DHH / A0 - (A0DH / A0) * (A0DH / A0) - - A1DHH / A1 + (A1DH / A1) * (A1DH / A1) + - T1DHH / T1 - (T1DH / T1) * (T1DH / T1)); - Real B0 = 0.341308_rt + 12.070873_rt * THETA2 + 1.148889_rt * THETA4; - Real B0DH = 24.141746_rt * THETA + 4.595556_rt * THETA3; - Real B0DHH = 24.141746_rt + 13.786668_rt * THETA2; - Real B1 = 1.0_rt + 10.495346_rt * THETA2 + 1.326623 * THETA4; - Real B1DH = 20.990692_rt * THETA + 5.306492 * THETA3; - Real B1DHH = 20.990692_rt + 15.919476_rt * THETA2; - Real B = SQTH * T2 * B0 / B1; - Real BH = 0.5_rt / THETA + T2DH / T2 + B0DH / B0 - B1DH / B1; - Real BDH = B * BH; - Real BDHH = BDH * BH + B * (-0.5_rt / THETA2 + T2DHH / T2 - (T2DH / T2) * (T2DH / T2) + - B0DHH / B0 - (B0DH / B0) * (B0DH / B0) - B1DHH / B1 + - (B1DH / B1) * (B1DH / B1)); - Real D0 = 0.614925_rt + 16.996055_rt * THETA2 + 1.489056_rt * THETA4; - Real D0DH = 33.99211_rt * THETA + 5.956224_rt * THETA3; - Real D0DHH = 33.99211_rt + 17.868672_rt * THETA2; - Real D1 = 1.0_rt + 10.10935_rt * THETA2 + 1.22184_rt * THETA4; - Real D1DH = 20.2187_rt * THETA + 4.88736_rt * THETA3; - Real D1DHH = 20.2187_rt + 14.66208_rt * THETA2; - Real D = SQTH * T2 * D0 / D1; - Real DH = 0.5_rt / THETA + T2DH / T2 + D0DH / D0 - D1DH / D1; - Real DDH = D * DH; - Real DDHH = DDH * DH + D * (-0.5_rt / THETA2 + T2DHH / T2 - (T2DH / T2) * (T2DH / T2) + - D0DHH / D0 - (D0DH / D0) * (D0DH / D0) - D1DHH / D1 + - (D1DH / D1) * (D1DH / D1)); - Real E0 = 0.539409_rt + 2.522206_rt * THETA2 + 0.178484_rt * THETA4; - Real E0DH = 5.044412_rt * THETA + 0.713936_rt * THETA3; - Real E0DHH = 5.044412_rt + 2.141808_rt * THETA2; - Real E1 = 1.0_rt + 2.555501_rt * THETA2 + 0.146319_rt * THETA4; - Real E1DH = 5.111002_rt * THETA + 0.585276_rt * THETA3; - Real E1DHH = 5.111002_rt + 1.755828_rt * THETA2; - Real E = THETA * T1 * E0 / E1; - Real EH = 1.0_rt / THETA + T1DH / T1 + E0DH / E0 - E1DH / E1; - Real EDH = E * EH; - Real EDHH = EDH * EH + E * (T1DHH / T1 - (T1DH / T1) * (T1DH / T1) + E0DHH / E0 - - (E0DH / E0) * (E0DH / E0) - - E1DHH / E1 + (E1DH / E1) * (E1DH / E1) - 1.0_rt / THETA2); - Real EXP1TH = std::exp(-1.0_rt / THETA); - Real C = (0.872496_rt + 0.025248_rt * EXP1TH) * E; - Real CDH = 0.025248_rt * EXP1TH / THETA2 * E + C * EDH / E; - Real CDHH = 0.025248_rt * EXP1TH / THETA2 * (EDH + (1.0_rt - 2.0_rt * THETA) / THETA2 * E) + - CDH * EDH / E + C * EDHH / E - C * (EDH / E) * (EDH / E); - Real DISCR = std::sqrt(4.0_rt * E - D * D); - Real DIDH = 0.5_rt / DISCR * (4.0_rt * EDH - 2.0_rt * D * DDH); - Real DIDHH = (-std::pow((2.0_rt * EDH - D * DDH) / DISCR, 2) + 2.0_rt * EDHH - - DDH * DDH - D * DDHH) / DISCR; - Real S1 = -C / E * GAME; - Real S1H = CDH / C - EDH / E; - Real S1DH = S1 * S1H; - Real S1DHH = S1DH * S1H + S1 * (CDHH / C - (CDH / C) * (CDH / C) - - EDHH / E + (EDH / E) * (EDH / E)); - Real S1DG = -C / E; // = > S1DGG = 0 - Real S1DHG = S1DG * (CDH / C - EDH / E); - Real B2 = B - C * D / E; - Real B2DH = BDH - (CDH * D + C * DDH) / E + C * D * EDH / (E * E); - Real B2DHH = BDHH - (CDHH * D + 2.0_rt * CDH * DDH + C * DDHH) / E + - (2.0_rt * (CDH * D + C * DDH - C * D * EDH / E) * EDH + - C * D * EDHH) / (E * E); - Real SQGE = std::sqrt(GAME); - Real S2 = -2.0_rt / E * B2 * SQGE; - Real S2H = B2DH / B2 - EDH / E; - Real S2DH = S2 * S2H; - Real S2DHH = S2DH * S2H + S2 * (B2DHH / B2 - (B2DH / B2) * (B2DH / B2) - - EDHH / E + (EDH / E) * (EDH / E)); - Real S2DG = 0.5_rt * S2 / GAME; - Real S2DGG = -0.5_rt * S2DG / GAME; - Real S2DHG = 0.5_rt * S2DH / GAME; - Real R3 = E * GAME + D * SQGE + 1.0_rt; - Real R3DH = EDH * GAME + DDH * SQGE; - Real R3DHH = EDHH * GAME + DDHH * SQGE; - Real R3DG = E + 0.5_rt * D / SQGE; - Real R3DGG = -0.25_rt * D / (GAME * SQGE); - Real R3DHG = EDH + 0.5_rt * DDH / SQGE; - Real B3 = A - C / E; - Real B3DH = ADH - CDH / E + C * EDH / (E * E); - Real B3DHH = ADHH - CDHH / E + (2.0_rt * CDH * EDH + C * EDHH) / (E * E) - - 2.0_rt * C * EDH * EDH / (E * E * E); - Real C3 = (D / E * B2 - B3) / E; // = D * B2 / (E * E) - B3 / E; - Real C3DH = (DDH * B2 + D * B2DH + B3 * EDH) / (E * E) - - 2.0_rt * D * B2 * EDH / (E * E * E) - B3DH / E; - Real C3DHH = (-B3DHH + - (DDHH * B2 + 2.0_rt * DDH * B2DH + D * B2DHH + - B3DH * EDH + B3 * EDHH + B3DH * EDH) / E - - 2.0_rt * ((DDH * B2 + D * B2DH + B3 * EDH + DDH * B2 + D * B2DH) * EDH + - D * B2 * EDHH) / (E * E) + - 6.0_rt * D * B2 * EDH * EDH / (E * E * E)) / E; - Real S3 = C3 * std::log(R3); - Real S3DH = S3 * C3DH / C3 + C3 * R3DH / R3; - Real S3DHH = (S3DH * C3DH + S3 * C3DHH) / C3 - S3 * (C3DH / C3) * (C3DH / C3) + - (C3DH * R3DH + C3 * R3DHH) / R3 - C3 * (R3DH / R3) * (R3DH / R3); - Real S3DG = C3 * R3DG / R3; - Real S3DGG = C3 * (R3DGG / R3 - (R3DG / R3) * (R3DG / R3)); - Real S3DHG = (C3DH * R3DG + C3 * R3DHG) / R3 - C3 * R3DG * R3DH / (R3 * R3); - Real B4 = 2.0_rt - D * D / E; - Real B4DH = EDH * (D / E) * (D / E) - 2.0_rt * D * DDH / E; - Real B4DHH = EDHH * (D / E) * (D / E) + 2.0_rt * EDH * (D / E) * (D / E) * (DDH / D - EDH / E) - - 2.0_rt * (DDH * DDH + D * DDHH) / E + 2.0_rt * D * DDH * EDH / (E * E); - Real C4 = 2.0_rt * E * SQGE + D; - Real C4DH = 2.0_rt * EDH * SQGE + DDH; - Real C4DHH = 2.0_rt * EDHH * SQGE + DDHH; - Real C4DG = E / SQGE; - Real C4DGG = -0.5_rt * E / (GAME * SQGE); - Real C4DHG = EDH / SQGE; - Real S4A = 2.0_rt / E / DISCR; - Real S4AH = EDH / E + DIDH / DISCR; - Real S4ADH = -S4A * S4AH; - Real S4ADHH = -S4ADH * S4AH - - S4A * (EDHH / E - (EDH / E) * (EDH / E) + DIDHH / DISCR - - (DIDH / DISCR) * (DIDH / DISCR)); - Real S4B = D * B3 + B4 * B2; - Real S4BDH = DDH * B3 + D * B3DH + B4DH * B2 + B4 * B2DH; - Real S4BDHH = DDHH * B3 + 2.0_rt * DDH * B3DH + D * B3DHH + B4DHH * B2 + - 2.0_rt * B4DH * B2DH + B4 * B2DHH; - Real S4C = std::atan(C4 / DISCR) - std::atan(D / DISCR); - Real UP1 = C4DH * DISCR - C4 * DIDH; - Real DN1 = DISCR * DISCR + C4 * C4; - Real UP2 = DDH * DISCR - D * DIDH; - Real DN2 = DISCR * DISCR + D * D; - Real S4CDH = UP1 / DN1 - UP2 / DN2; - Real S4CDHH = (C4DHH * DISCR - C4 * DIDHH) / DN1 - - UP1 * 2.0_rt * (DISCR * DIDH + C4 * C4DH) / (DN1 * DN1) - - (DDHH * DISCR - D * DIDHH) / DN2 + UP2 * 2.0_rt * - (DISCR * DIDH + D * DDH) / (DN2 * DN2); - Real S4CDG = C4DG * DISCR / DN1; - Real S4CDGG = C4DGG * DISCR / DN1 - 2.0_rt * C4 * DISCR * (C4DG / DN1) * (C4DG / DN1); - Real S4CDHG = (C4DHG * DISCR + C4DG * DIDH - - C4DG * DISCR / DN1 * 2.0_rt * (DISCR * DIDH + C4 * C4DH)) / DN1; - Real S4 = S4A * S4B * S4C; - Real S4DH = S4ADH * S4B * S4C + S4A * S4BDH * S4C + S4A * S4B * S4CDH; - Real S4DHH = S4ADHH * S4B * S4C + S4A * S4BDHH * S4C + S4A * S4B * S4CDHH + - 2.0_rt * (S4ADH * S4BDH * S4C + S4ADH * S4B * S4CDH + S4A * S4BDH * S4CDH); - Real S4DG = S4A * S4B * S4CDG; - Real S4DGG = S4A * S4B * S4CDGG; - Real S4DHG = S4A * S4B * S4CDHG + S4CDG * (S4ADH * S4B + S4A * S4BDH); - - FXC = S1 + S2 + S3 + S4; - Real FXCDH = S1DH + S2DH + S3DH + S4DH; - Real FXCDG = S1DG + S2DG + S3DG + S4DG; - Real FXCDHH = S1DHH + S2DHH + S3DHH + S4DHH; - Real FXCDGG = S2DGG + S3DGG + S4DGG; - Real FXCDHG = S1DHG + S2DHG + S3DHG + S4DHG; - PXC = (GAME * FXCDG - 2.0_rt * THETA * FXCDH) / 3.0_rt; - UXC = GAME * FXCDG - THETA * FXCDH; - SXC = (GAME * S2DG - S2 + GAME * S3DG - S3 + S4A * S4B * (GAME * S4CDG - S4C)) - - THETA * FXCDH; - if (std::abs(SXC) < EPS * std::abs(THETA * FXCDH)) { - SXC = 0.0_rt; // accuracy loss - } - CVXC = 2.0_rt * THETA * (GAME * FXCDHG - FXCDH) - THETA * THETA * FXCDHH - GAME * GAME * FXCDGG; - if (std::abs(CVXC) < EPS * std::abs(GAME * GAME * FXCDGG)) { - CVXC = 0.0_rt; // accuracy - } - Real PDLH = THETA * (GAME * FXCDHG - 2.0_rt * FXCDH - 2.0_rt * THETA * FXCDHH) / 3.0_rt; - Real PDLG = GAME * (FXCDG + GAME * FXCDGG - 2.0_rt * THETA * FXCDHG) / 3.0_rt; - PDRXC = PXC + (PDLG - 2.0_rt * PDLH) / 3.0_rt; - PDTXC = GAME * (THETA * FXCDHG - GAME * FXCDGG / 3.0_rt) - - THETA * (FXCDH / 0.75_rt + THETA * FXCDHH / 1.5_rt); - } - - void subfermj (Real CMU1, - Real& CJ00, Real& CJ10, Real& CJ20, - Real& CJ01, Real& CJ11, Real& CJ21, - Real& CJ02, Real& CJ12, Real& CJ22, - Real& CJ03, Real& CJ13, Real& CJ23, - Real& CJ04, Real& CJ14, Real& CJ24, Real& CJ05) - { - // Version 17.11.11 - // corrected 04.03.21 - // Supplement to SOMMERF - const Real EPS = 1.e-4_rt; // inserted 04.03.21 - if (CMU1 <= 0.0_rt) { - printf("SUBFERMJ: small CHI\n"); - exit(1); - } - - Real CMU = 1.0_rt + CMU1; - Real X0 = std::sqrt(CMU1 * (2.0_rt + CMU1)); - Real X3 = X0 * X0 * X0; - Real X5 = X3 * X0 * X0; - Real X7 = X5 * X0 * X0; - if (X0 < EPS) { - CJ00 = X3 / 3.0_rt; - CJ10 = 0.1_rt * X5; - CJ20 = X7 / 28.0_rt; - } - else { - Real CL = std::log(X0 + CMU); - CJ00 = 0.5_rt * (X0 * CMU - CL); // J_{1/2}^0 - CJ10 = X3 / 3.0_rt - CJ00; // J_{3/2}^0 - CJ20 = (0.75_rt * CMU - 2.0_rt) / 3.0_rt * X3 + 1.25_rt * CJ00; // J_{5/2}^0 - } - - CJ01 = X0; // J_{1/2}^1 - CJ11 = CJ01 * CMU1; // J_{3/2}^1 - CJ21 = CJ11 * CMU1; // J_{5/2}^1 - Real RCJ02 = CMU / X0; // J_{1/2}^2 - CJ12 = CMU1 / X0 * (3.0_rt + 2.0_rt * CMU1); // J_{3/2}^2 - CJ22 = CMU1 * CMU1 / X0 * (5.0_rt + 3.0_rt * CMU1); // J_{5/2}^2 - CJ03 = -1.0_rt / X3; // J_{1/2}^3 - CJ13 = CMU1 / X3 * (2.0_rt * CMU1 * CMU1 + 6.0_rt * CMU1 + 3.0_rt); - CJ23 = CMU1 * CMU1 / X3 * (6.0_rt * CMU1 * CMU1 + 2.0e1_rt * CMU1 + 1.5e1_rt); - CJ04 = 3.0_rt * CMU / X5; - CJ14 = -3.0_rt * CMU1 / X5; - CJ24 = CMU1 * CMU1 / X5 * (6.0_rt * CMU1 * CMU1 * CMU1 + 3.0e1_rt * CMU1 * CMU1 + - 45.0_rt * CMU1 + 15.0_rt); - CJ05 = (-12.0_rt * CMU1 * CMU1 - 24.0_rt * CMU1 - 15.0_rt) / (X7); - } - - void sommerf (Real TEMR, Real CHI, - Real& W0, Real& W0DX, Real& W0DT, Real& W0DXX, Real& W0DTT, Real& W0DXT, - Real& W1, Real& W1DX, Real& W1DT, Real& W1DXX, Real& W1DTT, Real& W1DXT, - Real& W2, Real& W2DX, Real& W2DT, Real& W2DXX, Real& W2DTT, Real& W2DXT, - Real& W0XXX, Real& W0XTT, Real& W0XXT) - { - // Version 17.11.11 - // Sommerfeld expansion for the Fermi-Dirac integrals - // Input: TEMR=T/mc^2; CHI=(\mu-mc^2)/T - // Output: Wk - Fermi-Dirac integral of the order k+1/2 - // WkDX=dWk/dCHI, WkDT = dWk/dT, WkDXX=d^2 Wk / d CHI^2, - // WkDTT=d^2 Wk / d T^2, WkDXT=d^2 Wk /dCHIdT, - // W0XXX=d^3 W0 / d CHI^3, W0XTT=d^3 W0 /(d CHI d^2 T), - // W0XXT=d^3 W0 /dCHI^2 dT - // [Draft source: yellow book pages 124-127] - - const Real PI = 3.141592653_rt; - const Real PI2 = PI * PI; - - if (CHI < 0.5_rt) { - printf("SOMMERF: non-degenerate (small CHI)\n"); - exit(1); - } - - if (TEMR <= 0.0_rt) { - printf("SOMMERF: T < 0\n"); - exit(1); - } - - Real CMU1 = CHI * TEMR; // chemical potential in rel.units - Real CMU = 1.0_rt + CMU1; - - Real CJ00, CJ10, CJ20; - Real CJ01, CJ11, CJ21; - Real CJ02, CJ12, CJ22; - Real CJ03, CJ13, CJ23; - Real CJ04, CJ14, CJ24; - Real CJ05; - - subfermj(CMU1, - CJ00, CJ10, CJ20, - CJ01, CJ11, CJ21, - CJ02, CJ12, CJ22, - CJ03, CJ13, CJ23, - CJ04, CJ14, CJ24, CJ05); - - Real PIT26 = (PI * TEMR)*(PI * TEMR) / 6.0_rt; - Real CN0 = std::sqrt(0.5_rt / TEMR) / TEMR; - Real CN1 = CN0 / TEMR; - Real CN2 = CN1 / TEMR; - W0 = CN0 * (CJ00 + PIT26 * CJ02); // + CN0 * PITAU4 * CJ04 - W1 = CN1 * (CJ10 + PIT26 * CJ12); // + CN1 * PITAU4 * CJ14 - W2 = CN2 * (CJ20 + PIT26 * CJ22); // + CN2 * PITAU4 * CJ24 - W0DX = CN0 * TEMR * (CJ01 + PIT26 * CJ03); // + CN0 * PITAU4 * CJ05 - W1DX = CN0 * (CJ11 + PIT26 * CJ13); - W2DX = CN1 * (CJ21 + PIT26 * CJ23); - W0DT = CN1 * (CMU1 * CJ01 - 1.5_rt * CJ00 + PIT26 * (CMU1 * CJ03 + 0.5_rt * CJ02)); - W1DT = CN2 * (CMU1 * CJ11 - 2.5_rt * CJ10 + PIT26 * (CMU1 * CJ13 - 0.5_rt * CJ12)); - W2DT = CN2 / TEMR * (CMU1 * CJ21 - 3.5_rt * CJ20 + PIT26 * (CMU1 * CJ23 - 1.5_rt * CJ22)); - W0DXX = CN0 * TEMR * TEMR * (CJ02 + PIT26 * CJ04); - W1DXX = CN0 * TEMR * (CJ12 + PIT26 * CJ14); - W2DXX = CN0 * (CJ22 + PIT26 * CJ24); - W0DXT = CN0 * (CMU1 * CJ02 - 0.5_rt * CJ01 + PIT26 * (CMU1 * CJ04 + 1.5_rt * CJ03)); - W1DXT = CN1 * (CMU1 * CJ12 - 1.5_rt * CJ11 + PIT26 * (CMU1 * CJ14 + 0.5_rt * CJ13)); - W2DXT = CN2 * (CMU1 * CJ22 - 2.5_rt * CJ21 + PIT26 * (CMU1 * CJ24 - 0.5_rt * CJ23)); - W0DTT = CN2 * (3.75_rt * CJ00 - 3.0_rt * CMU1 * CJ01 + CMU1 * CMU1 * CJ02 + - PIT26 * (-0.25_rt * CJ02 + CMU1 * CJ03 + CMU1 * CMU1 * CJ04)); - W1DTT = CN2 / TEMR * (8.75_rt * CJ10 - 5.0_rt * CMU1 * CJ11 + CMU1 * CMU1 * CJ12 + - PIT26 * (0.75_rt * CJ12 - CMU1 * CJ13 + CMU1 * CMU1 * CJ14)); - W2DTT = CN2 / TEMR * TEMR * (15.75_rt * CJ20 - 7.0_rt * CMU1 * CJ21 + CMU1 * CMU1 * CJ22 + - PIT26 * (3.75_rt * CJ22 - 3.0_rt * CMU1 * CJ23 + CMU1 * CMU1 * CJ24)); - W0XXX = CN0 * TEMR * TEMR * TEMR * (CJ03 + PIT26 * CJ05); - W0XXT = CN0 * TEMR * (CMU1 * CJ03 + 0.5_rt * CJ02 + PIT26 * (CMU1 * CJ05 + 2.5_rt * CJ04)); - W0XTT = CN1 * (0.75_rt * CJ01 - CMU1 * CJ02 + CMU1 * CMU1 * CJ03 + - PIT26 * (0.75_rt * CJ03 + 3.0_rt * CMU1 * CJ04 + CMU1 * CMU1 * CJ05)); - } - - void elect11b(Real TEMP, Real CHI, - Real& DENS, Real& FEid, Real& PEid, Real& UEid, - Real& SEid, Real& CVE, Real& CHITE, Real& CHIRE, - Real& DlnDH, Real& DlnDT, Real& DlnDHH, - Real& DlnDTT, Real& DlnDHT) - { - // Version 17.11.11 - // Stems from ELECT9b v.19.01.10, Diff. - additional output. - // Sommerfeld expansion at very large CHI. - - const Real BOHR = 137.036_rt; - const Real PI = 3.141592653_rt; - const Real PI2 = PI * PI; - const Real BOHR2 = BOHR * BOHR; - const Real BOHR3 = BOHR2 * BOHR; // cleaned 15/6 - - Real TEMR = TEMP / BOHR2; // T in rel.units ( = T/mc^2) - Real EF = CHI * TEMR; // Fermi energy in mc^2 - zeroth aprox. = CMU1 - Real DeltaEF = PI2 * TEMR * TEMR / 6.0_rt * (1.0_rt + 2.0_rt * EF * (2.0_rt + EF)) / - (EF * (1.0_rt + EF) * (2.0_rt + EF)); // corr. [p.125, equiv.Eq.(6) of PC'10] - EF = EF + DeltaEF; // corrected Fermi energy (14.02.09) - Real G = 1.0_rt + EF; // electron Lorentz-factor - - Real PF, F, DF, P, DP; - - if (EF > 1.e-5_rt) { // relativistic expansion (Yak.&Shal.'89) - PF = std::sqrt(G * G - 1.0_rt); // Fermi momentum [rel.un. = mc] - F = (PF * (1.0_rt + 2.0_rt * PF * PF) * G - PF * PF * PF / .375_rt - std::log(PF + G)) / 8.0_rt / PI2; // F/V - DF = -TEMR * TEMR * PF * G / 6.0_rt; // thermal correction to F/V - P = (PF * G * (PF * PF / 1.5_rt - 1.0_rt) + std::log(PF + G)) / 8.0_rt / PI2; // P(T = 0) - DP = TEMR * TEMR * PF * (PF * PF + 2.0_rt) / G / 18.0_rt; // thermal correction to P - CVE = PI2 * TEMR * G / (PF * PF); - } - else { // nonrelativistic limit - PF = std::sqrt(2.0_rt * EF); - F = (PF * PF * PF * PF * PF) * 0.1_rt / PI2; - DF = -TEMR * TEMR * PF / 6.0_rt; - P = F / 1.5_rt; - DP = TEMR * TEMR * PF / 9.0_rt; - CVE = PI2 * TEMR / EF / 2.0_rt; - } - - F = F + DF; - P = P + DP; - Real S = -2.0_rt * DF; // entropy per unit volume [rel.un.] - Real U = F + S; - CHIRE = (PF * PF * PF * PF * PF) / (9.0_rt * PI2 * P * G); - CHITE = 2.0_rt * DP / P; - Real DENR = PF * PF * PF / 3.0_rt / PI2; // n_e [rel.un. = \Compton^{-3}] - DENS = DENR * BOHR3; // conversion to a.u.( = \Bohr_radius^{-3}) - - // derivatives over chi at constant T and T at constant chi: - Real TPI = TEMR * std::sqrt(2.0_rt * TEMR) / PI2; // common pre-factor - - Real W0, W0DX, W0DT, W0DXX, W0DTT, W0DXT; - Real W1, W1DX, W1DT, W1DXX, W1DTT, W1DXT; - Real W2, W2DX, W2DT, W2DXX, W2DTT, W2DXT; - Real W0XXX, W0XTT, W0XXT; - - sommerf(TEMR, CHI, - W0, W0DX, W0DT, W0DXX, W0DTT, W0DXT, - W1, W1DX, W1DT, W1DXX, W1DTT, W1DXT, - W2, W2DX, W2DT, W2DXX, W2DTT, W2DXT, - W0XXX, W0XTT, W0XXT); - - Real dndH = TPI * (W0DX + TEMR * W1DX); // (d n_e/d\chi)_T - Real dndT = TPI * (1.5_rt * W0 / TEMR + 2.5 * W1 + W0DT + TEMR * W1DT); // (d n_e/dT)_\chi - Real dndHH = TPI * (W0DXX + TEMR * W1DXX); // (d^2 n_e/d\chi)_T - Real dndTT = TPI * (0.75_rt * W0 / TEMR * TEMR + 3. * W0DT / TEMR + W0DTT + - 3.75 * W1 / TEMR + 5. * W1DT + TEMR * W1DTT); - Real dndHT = TPI * (1.5_rt * W0DX / TEMR + W0DXT + 2.5 * W1DX + TEMR * W1DXT); - - DlnDH = dndH / DENR; // (d ln n_e/d\chi)_T - DlnDT = dndT * TEMR / DENR; // (d ln n_e/d ln T)_\chi - DlnDHH = dndHH / DENR - DlnDH * DlnDH; // (d^2 ln n_e/d\chi^2)_T - DlnDTT = TEMR * TEMR / DENR * dndTT + DlnDT - DlnDT * DlnDT; // d^2 ln n_e/d ln T^2 - DlnDHT = TEMR / DENR * (dndHT - dndT * DlnDH); // d^2 ln n_e/d\chi d ln T - - Real DT = DENR * TEMR; - PEid = P / DT; - UEid = U / DT; - FEid = F / DT; - SEid = S / DT; - - // Empirical corrections of 16.02.09: - Real D1 = DeltaEF / EF; - Real D2 = D1 * (4.0_rt - 2.0_rt * (PF / G)); - CVE = CVE / (1.0_rt + D2); - SEid = SEid / (1.0_rt + D1); - CHITE = CHITE / (1.0_rt + D2); - } - - void elect11a(Real TEMP, Real CHI, - Real& DENS, Real& FEid, Real& PEid, Real& UEid, - Real& SEid, Real& CVE, Real& CHITE, Real& CHIRE, - Real& DlnDH, Real& DlnDT, Real& DlnDHH, Real& DlnDTT, - Real& DlnDHT) - { - // Version 16.11.11 - // This is THE FIRST PART of ELECT9 v.04.03.09. - const Real BOHR = 137.036_rt; - const Real PI = 3.141592653_rt; - const Real PI2 = PI * PI; - const Real BOHR2 = BOHR * BOHR; - const Real BOHR3 = BOHR2 * BOHR; // cleaned 15/6 - - Real TEMR = TEMP / BOHR2; // T in rel.units (=T/mc^2) - - Real W0, W0DX, W0DT, W0DXX, W0DTT, W0DXT; - Real W1, W1DX, W1DT, W1DXX, W1DTT, W1DXT; - Real W2, W2DX, W2DT, W2DXX, W2DTT, W2DXT; - Real W0XXX, W0XTT, W0XXT; - - blin9(TEMR, CHI, - W0, W0DX, W0DT, W0DXX, W0DTT, W0DXT, - W1, W1DX, W1DT, W1DXX, W1DTT, W1DXT, - W2, W2DX, W2DT, W2DXX, W2DTT, W2DXT, - W0XXX, W0XTT, W0XXT); - - Real TPI = TEMR * std::sqrt(2.0_rt * TEMR) / PI2; // common pre-factor - Real DENR = TPI * (W1 * TEMR + W0); - Real PR = TEMR * TPI / 3.0_rt * (W2 * TEMR + 2.0_rt * W1); - Real U = TEMR * TPI * (W2 * TEMR + W1); - - // (these are density, pressure, and internal energy in the rel.units) - PEid = PR / (DENR * TEMR); - UEid = U / (DENR * TEMR); - FEid = CHI - PEid; - DENS = DENR * BOHR3; // converts from rel.units to a.u. - SEid = UEid - FEid; - - // derivatives over T at constant chi: - Real dndT = TPI * (1.5_rt * W0 / TEMR + 2.5_rt * W1 + W0DT + TEMR * W1DT); // (d n_e/dT)_\chi - Real dPdT = TPI / 3.0_rt * (5.0_rt * W1 + 2.0_rt * TEMR * W1DT + 3.5_rt * TEMR * W2 + TEMR * TEMR * W2DT); //dP/dT - Real dUdT = TPI * (2.5_rt * W1 + TEMR * W1DT + 3.5_rt * TEMR * W2 + TEMR * TEMR * W2DT); //dU/dT_\chi - - // derivatives over chi at constant T and second derivatives: - Real dndH = TPI * (W0DX + TEMR * W1DX); // (d n_e/d\chi)_T - Real dndHH = TPI * (W0DXX + TEMR * W1DXX); // (d^2 n_e/d\chi)_T - Real dndTT = TPI * (0.75_rt * W0 / TEMR * TEMR + 3.0_rt * W0DT / TEMR + W0DTT + - 3.75_rt * W1 / TEMR + 5.0_rt * W1DT + TEMR * W1DTT); - Real dndHT = TPI * (1.5_rt * W0DX / TEMR + W0DXT + 2.5_rt * W1DX + TEMR * W1DXT); - - DlnDH = dndH / DENR; // (d ln n_e/d\chi)_T - DlnDT = dndT * TEMR / DENR; // (d ln n_e/d ln T)_\chi - DlnDHH = dndHH / DENR - DlnDH * DlnDH; // (d^2 ln n_e/d\chi^2)_T - DlnDTT = TEMR * TEMR / DENR * dndTT + DlnDT - DlnDT * DlnDT; // d^2 ln n_e/d ln T^2 - DlnDHT = TEMR / DENR * (dndHT - dndT * DlnDH); // d^2 ln n_e/d\chi d ln T - Real dPdH = TPI / 3.0_rt * TEMR * (2.0_rt * W1DX + TEMR * W2DX); // (d P_e/d\chi)_T - Real dUdH = TPI * TEMR * (W1DX + TEMR * W2DX); // (d U_e/d\chi)_T - CVE = (dUdT - dUdH * dndT / dndH) / DENR; - CHITE = TEMR / PR * (dPdT - dPdH * dndT / dndH); - CHIRE = DENR / PR * dPdH / dndH; // (dndH * TEMR * PEid) // DENS / PRE * dPdH / dndH - } - - void elect11 (double TEMP, double CHI, - Real& DENS, Real& FEid, Real& PEid, Real& UEid, - Real& SEid, Real& CVE, Real& CHITE, Real& CHIRE, - Real& DlnDH, Real& DlnDT, Real& DlnDHH, Real& DlnDTT, - Real& DlnDHT) - { - // Version 17.11.11 - // safeguard against huge (-CHI) values is added 27.05.17 - // ELECT9 v.04.03.09 + smooth match of two fits at chi >> 1 + add.outputs - // Compared to ELECTRON v.06.07.00, this S/R is completely rewritten: - // numerical differentiation is avoided now. - // Compared to ELECT7 v.06.06.07, - // - call BLIN7 is changed to call BLIN9, - // - Sommerfeld expansion is used at chi >~ 28 i.o. 1.e4 - // - Sommerfeld expansion is corrected: introduced DeltaEF, D1 and D2. - // Ideal electron-gas EOS. - // Input: TEMP - T [a.u.], CHI=\mu/T - // Output: DENS - electron number density n_e [a.u.], - // FEid - free energy / N_e kT, UEid - internal energy / N_e kT, - // PEid - pressure (P_e) / n_e kT, SEid - entropy / N_e k, - // CVE - heat capacity / N_e k, - // CHITE=(d ln P_e/d ln T)_V, CHIRE=(d ln P_e/d ln n_e)_T - // DlnDH=(d ln n_e/d CHI)_T = (T/n_e) (d n_e/d\mu)_T - // DlnDT=(d ln n_e/d ln T)_CHI - // DlnDHH=(d^2 ln n_e/d CHI^2)_T - // DlnDTT=(d^2 ln n_e/d (ln T)^2)_CHI - // DlnDHT=d^2 ln n_e/d (ln T) d CHI - - const Real CHI2 = 28.0_rt; - const Real XMAX = 20.0_rt; - const Real DCHI2 = CHI2 - 1.0_rt; - const Real XSCAL2 = XMAX / DCHI2; - - if (CHI < -1.e2_rt) { - printf("ELECT11: too large negative CHI\n"); // 27.05.17 - exit(1); - } - - Real X2 = (CHI - CHI2) * XSCAL2; - if (X2 < -XMAX) { - elect11a(TEMP, CHI, - DENS, FEid, PEid, UEid, SEid, CVE, CHITE, CHIRE, - DlnDH, DlnDT, DlnDHH, DlnDTT, DlnDHT); - } - else if (X2 > XMAX) { - elect11b(TEMP, CHI, - DENS, FEid, PEid, UEid, SEid, CVE, CHITE, CHIRE, - DlnDH, DlnDT, DlnDHH, DlnDTT, DlnDHT); - } - else { - Real FP, FM; - fermi10(X2, XMAX, FP, FM); - - Real DENSa, FEida, PEida, UEida, SEida, CVEa, CHITEa, CHIREa; - Real DlnDHa, DlnDTa, DlnDHHa, DlnDTTa, DlnDHTa; - - elect11a(TEMP, CHI, - DENSa, FEida, PEida, UEida, SEida, CVEa, CHITEa, CHIREa, - DlnDHa, DlnDTa, DlnDHHa, DlnDTTa, DlnDHTa); - - Real DENSb, FEidb, PEidb, UEidb, SEidb, CVEb, CHITEb, CHIREb; - Real DlnDHb, DlnDTb, DlnDHHb, DlnDTTb, DlnDHTb; - - elect11b(TEMP, CHI, - DENSb, FEidb, PEidb, UEidb, SEidb, CVEb, CHITEb, CHIREb, - DlnDHb, DlnDTb, DlnDHHb, DlnDTTb, DlnDHTb); - - DENS = DENSa * FP + DENSb * FM; - FEid = FEida * FP + FEidb * FM; - PEid = PEida * FP + PEidb * FM; - UEid = UEida * FP + UEidb * FM; - SEid = SEida * FP + SEidb * FM; - CVE = CVEa * FP + CVEb * FM; - CHITE = CHITEa * FP + CHITEb * FM; - CHIRE = CHIREa * FP + CHIREb * FM; - DlnDH = DlnDHa * FP + DlnDHb * FM; - DlnDT = DlnDTa * FP + DlnDTb * FM; - DlnDHH = DlnDHHa * FP + DlnDHHb * FM; - DlnDHT = DlnDHTa * FP + DlnDHTb * FM; - DlnDTT = DlnDTTa * FP + DlnDTTb * FM; - } - } - - void fscrsol8 (Real RS, Real GAMI, Real ZNUCL, Real TPT, - Real& FSCR, Real& USCR, Real& PSCR, Real& S_SCR, - Real& CVSCR, Real& PDTSCR, Real& PDRSCR) - { - // Version 28.05.08 - // undefined zero variable Q1DXG is wiped out 21.06.10 - // accuracy-loss safeguard added 10.08.16 - // safequard against Zion < 1 added 27.05.17 - // Fit to the el.-ion screening in bcc or fcc Coulomb solid - // Stems from FSCRsol8 v.09.06.07. Included a check for RS = 0. - // INPUT: RS - el. density parameter, GAMI - ion coupling parameter, - // ZNUCL - ion charge, TPT = T_p/T - ion quantum parameter - // OUTPUT: FSCR - screening (e-i) free energy per kT per 1 ion, - // USCR - internal energy per kT per 1 ion (screen.contrib.) - // PSCR - pressure divided by (n_i kT) (screen.contrib.) - // S_SCR - screening entropy contribution / (N_i k) - // CVSCR - heat capacity per 1 ion (screen.contrib.) - // PDTSCR,PDRSCR = PSCR + d PSCR / d ln(T,\rho) - - const Real C13 = 1.0_rt / 3.0_rt; - const Real ENAT = 2.7182818285_rt; - const Real TINY = 1.e-19_rt; - - const Real AP[4] = {1.1866_rt, 0.684_rt, 17.9_rt, 41.5_rt}; - const Real PX = 0.205_rt; // for bcc lattice - - if (RS < 0.0_rt) { - printf("FSCRliq8: RS < 0\n"); - exit(1); - } - - if (RS < TINY) { - FSCR = 0.0_rt; - USCR = 0.0_rt; - PSCR = 0.0_rt; - S_SCR = 0.0_rt; - CVSCR = 0.0_rt; - PDTSCR = 0.0_rt; - PDRSCR = 0.0_rt; - return; - } - - Real Zion = ZNUCL; - if (Zion < 1.0_rt) { // 27.05.17 - Zion = 1.0_rt; - } - - Real XSR = 0.0140047_rt / RS; // relativity parameter - Real Z13 = std::pow(Zion, C13); - Real P1 = 0.00352_rt * (1.0_rt - AP[0] / std::pow(Zion, 0.267_rt) + 0.27_rt / Zion); - Real P2 = 1.0_rt + 2.25_rt / Z13 * - (1.0_rt + AP[1] * (Zion * Zion * Zion * Zion * Zion) + - 0.222_rt * (Zion * Zion * Zion * Zion * Zion * Zion)) / - (1.0_rt + .222 * Zion * Zion * Zion * Zion * Zion * Zion); - Real ZLN = std::log(Zion); - Real Finf = std::sqrt(P2 / (XSR * XSR) + 1.0_rt) * Z13 * Z13 * P1; // The TF limit - Real FinfX = -P2 / ((P2 + XSR * XSR) * XSR); - Real FinfDX = Finf * FinfX; - Real FinfDXX = FinfDX * FinfX - FinfDX * (P2 + 3.0_rt * XSR * XSR) / ((P2 + XSR * XSR) * XSR); - Real R1 = AP[3] / (1.0_rt + ZLN); - Real R2 = 0.395_rt * ZLN + .347 / Zion / std::sqrt(Zion); - Real R3 = 1.0_rt / (1.0_rt + ZLN * std::sqrt(ZLN) * 0.01_rt + 0.097_rt / (Zion * Zion)); - Real Q1U = R1 + AP[2] * XSR * XSR; - Real Q1D = 1.0_rt + R2 * XSR * XSR; - Real Q1 = Q1U / Q1D; - Real Q1X = 2.0_rt * XSR * (AP[2] / Q1U - R2 / Q1D); - Real Q1XDX = Q1X / XSR + 4.0_rt * XSR * XSR * ((R2 / Q1D) * (R2 / Q1D) - (AP[2] / Q1U) * (AP[2] / Q1U)); - Real Q1DX = Q1 * Q1X; - Real Q1DXX = Q1DX * Q1X + Q1 * Q1XDX; - - Real SUP, SUPDX, SUPDG, SUPDXX, SUPDGG, SUPDXG; - - // New quantum factor, in order to suppress CVSCR at TPT >> 1 - if (TPT < 6.0_rt / PX) { - Real Y0 = (PX * TPT) * (PX * TPT); - Real Y0DX = Y0 / XSR; - Real Y0DG = 2.0_rt * Y0 / GAMI; - Real Y0DXX = 0.0_rt; - Real Y0DGG = Y0DG / GAMI; - Real Y0DXG = Y0DG / XSR; - Real Y1 = std::exp(Y0); - Real Y1DX = Y1 * Y0DX; - Real Y1DG = Y1 * Y0DG; - Real Y1DXX = Y1 * (Y0DX * Y0DX + Y0DXX); - Real Y1DGG = Y1 * (Y0DG * Y0DG + Y0DGG); - Real Y1DXG = Y1 * (Y0DX * Y0DG + Y0DXG); - Real SA = 1.0_rt + Y1; - Real SUPA = std::log(SA); - Real SUPADX = Y1DX / SA; - Real SUPADG = Y1DG / SA; - Real SUPADXX = (Y1DXX - Y1DX * Y1DX / SA) / SA; - Real SUPADGG = (Y1DGG - Y1DG * Y1DG / SA) / SA; - Real SUPADXG = (Y1DXG - Y1DX * Y1DG / SA) / SA; - Real EM2 = ENAT - 2.0_rt; - Real SB = ENAT - EM2 / Y1; - Real SUPB = std::log(SB); - Real EM2Y1 = EM2 / (Y1 * Y1 * SB); - Real SUPBDX = EM2Y1 * Y1DX; - Real SUPBDG = EM2Y1 * Y1DG; - Real SUPBDXX = EM2Y1 * (Y1DXX - 2.0_rt * Y1DX * Y1DX / Y1 - Y1DX * SUPBDX); - Real SUPBDGG = EM2Y1 * (Y1DGG - 2.0_rt * Y1DG * Y1DG / Y1 - Y1DG * SUPBDG); - Real SUPBDXG = EM2Y1 * (Y1DXG - 2.0_rt * Y1DX * Y1DG / Y1 - Y1DG * SUPBDX); - - SUP = std::sqrt(SUPA / SUPB); - Real SUPX = 0.5_rt * (SUPADX / SUPA - SUPBDX / SUPB); - SUPDX = SUP * SUPX; - Real SUPG = 0.5_rt * (SUPADG / SUPA - SUPBDG / SUPB); - SUPDG = SUP * SUPG; - SUPDXX = SUPDX * SUPX + - SUP * 0.5_rt * (SUPADXX / SUPA - (SUPADX / SUPA) * (SUPADX / SUPA) - - SUPBDXX / SUPB + (SUPBDX / SUPB) * (SUPBDX / SUPB)); - SUPDGG = SUPDG * SUPG + - SUP * 0.5_rt * (SUPADGG / SUPA - (SUPADG / SUPA) * (SUPADG / SUPA) - - SUPBDGG / SUPB + (SUPBDG / SUPB) * (SUPBDG / SUPB)); - SUPDXG = SUPDX * SUPG + - SUP * 0.5_rt * ((SUPADXG - SUPADX * SUPADG / SUPA) / SUPA - - (SUPBDXG - SUPBDX * SUPBDG / SUPB) / SUPB); - } - else { - SUP = PX * TPT; - SUPDX = 0.5_rt * PX * TPT / XSR; - SUPDG = PX * TPT / GAMI; - SUPDXX = - 0.5_rt * SUPDX / XSR; - SUPDGG = 0.0_rt; - SUPDXG = SUPDX / GAMI; - } - - Real GR3 = std::pow(GAMI / SUP, R3); - Real GR3X = -R3 * SUPDX / SUP; - Real GR3DX = GR3 * GR3X; - Real GR3DXX = GR3DX * GR3X - R3 * GR3 * (SUPDXX / SUP - (SUPDX / SUP) * (SUPDX / SUP)); - Real GR3G = R3 * (1.0_rt / GAMI - SUPDG / SUP); - Real GR3DG = GR3 * GR3G; - Real GR3DGG = GR3DG * GR3G + GR3 * R3 * ((SUPDG / SUP) * (SUPDG / SUP) - SUPDGG / SUP - 1.0_rt / (GAMI * GAMI)); - Real GR3DXG = GR3DG * GR3X + GR3 * R3 * (SUPDX * SUPDG / (SUP * SUP) - SUPDXG / SUP); - Real W = 1.0_rt + Q1 / GR3; - Real WDX = Q1DX / GR3 - Q1 * GR3DX / (GR3 * GR3); - Real WDG = -Q1 * GR3DG / (GR3 * GR3); - Real WDXX = Q1DXX / GR3 - - (2.0_rt * Q1DX * GR3DX + Q1 * (GR3DXX - 2.0_rt * GR3DX * GR3DX / GR3)) / (GR3 * GR3); - Real WDGG = Q1 * (2.0_rt * GR3DG * GR3DG / GR3 - GR3DGG) / (GR3 * GR3); - Real WDXG = -(Q1DX * GR3DG + Q1 * (GR3DXG - 2.0_rt * GR3DX * GR3DG / GR3)) / (GR3 * GR3); - FSCR = -GAMI * Finf * W; - Real FDX = -GAMI * (FinfDX * W + Finf * WDX); - Real FDXX = -GAMI * (FinfDXX * W + 2.0_rt * FinfDX * WDX + Finf * WDXX); - Real FDG = -Finf * W - GAMI * Finf * WDG; - Real FDGG = -2.0_rt * Finf * WDG - GAMI * Finf * WDGG; - if (std::abs(FDGG) < TINY) { - FDGG = 0.0_rt; // 10.08.16: roundoff err.safeguard - } - Real FDXG = -FinfDX * W - Finf * WDX - GAMI * (FinfDX * WDG + Finf * WDXG); - S_SCR = -GAMI * GAMI * Finf * WDG; - USCR = S_SCR + FSCR; - CVSCR = -GAMI * GAMI * FDGG; - PSCR = (XSR * FDX + GAMI * FDG) / 3.0_rt; - PDTSCR = GAMI * GAMI * (XSR * Finf * (FinfX * WDG + WDXG) - FDGG) / 3.0_rt; - PDRSCR = (12.0_rt * PSCR + XSR * XSR * FDXX + 2.0_rt * XSR * GAMI * FDXG + - GAMI * GAMI * FDGG) / 9.0_rt; - } - - void anharm8 (double GAMI, double TPT, - double& Fah, double& Uah, double& Pah, - double& CVah, double& PDTah, double& PDRah) - { - // ANHARMONIC free energy - // Version 27.07.07 - // cleaned 16.06.09 - // Stems from ANHARM8b. Difference: AC = 0., B1 = .12 (.1217 - over accuracy) - // Input: GAMI - ionic Gamma, TPT = Tp/T - ionic quantum parameter - // Output: anharm.free en. Fah = F_{AH}/(N_i kT), internal energy Uah, - // pressure Pah = P_{AH}/(n_i kT), specific heat CVah = C_{V,AH}/(N_i k), - // PDTah = Pah + d Pah / d ln T, PDRah = Pah + d Pah / d ln\rho - - const int NM = 3; - const Real AA[NM] = {10.9_rt, 247.0_rt, 1.765e5_rt}; // Farouki & Hamaguchi'93 - const Real B1 = 0.12_rt; // coeff.at \eta^2/\Gamma at T = 0 - - Real CK = B1 / AA[0]; // fit coefficient - Real TPT2 = TPT * TPT; - Real TPT4 = TPT2 * TPT2; - Real TQ = B1 * TPT2 / GAMI; // quantum dependence - Real TK2 = CK * TPT2; - Real SUP = std::exp(-TK2); // suppress.factor of class.anharmonicity - - Fah = 0.0_rt; - Uah = 0.0_rt; - Pah = 0.0_rt; - CVah = 0.0_rt; - PDTah = 0.0_rt; - PDRah = 0.0_rt; - - Real SUPGN = SUP; - for (int N = 1; N <= NM; ++N) { - Real CN = (Real) N; - SUPGN = SUPGN / GAMI; // SUP/Gamma^n - Real ACN = AA[N-1]; - Fah = Fah - ACN / CN * SUPGN; - Uah = Uah + (ACN * (1.0_rt + 2.0_rt * TK2 / CN)) * SUPGN; - Real PN = AA[N-1] / 3.0_rt + TK2 * AA[N-1] / CN; - Pah = Pah + PN * SUPGN; - CVah = CVah + ((CN + 1.0_rt) * AA[N-1] + (4.0_rt - 2.0_rt / CN) * AA[N-1] * TK2 + - 4.0_rt * AA[N-1] * CK * CK / CN * TPT4) * SUPGN; - PDTah = PDTah + (PN * (1.0_rt + CN + 2.0_rt * TK2) - 2.0_rt / CN * AA[N-1] * TK2) * SUPGN; - PDRah = PDRah + (PN * (1.0_rt - CN / 3.0_rt - TK2) + AA[N-1] / CN * TK2) * SUPGN; - } - - Fah = Fah - TQ; - Uah = Uah - TQ; - Pah = Pah - TQ / 1.5_rt; - PDRah = PDRah - TQ / 4.5_rt; - } - - void hlfit12 (Real eta, - Real& F, Real& U, Real& CV, Real& S, - Real& U1, Real& CW, int LATTICE) - { - // Version 24.04.12 - // Stems from HLfit8 v.03.12.08; - // differences: E0 excluded from U and F; - // U1 and d(CV)/d\ln(T) are added on the output. - // Fit to thermal part of the thermodynamic functions. - // Baiko, Potekhin, & Yakovlev (2001). - // Zero-point lattice quantum energy 1.5u_1\eta EXCLUDED (unlike HLfit8). - // Input: eta = Tp/T, LATTICE = 1 for bcc, 2 for fcc - // Output: F and U (normalized to NkT) - due to phonon excitations, - // CV and S (normalized to Nk) in the HL model, - // U1 - the 1st phonon moment, - // CW = d(CV)/d\ln(T) - - const Real EPS = 1.e-5_rt; - const Real TINY = 1.e-99_rt; - - Real CLM, ALPHA, BETA, GAMMA; - Real A1, A2, A3, A4, A6, A8; - Real B0, B2, B4, B5, B6, B7, C9, C11; - - if (LATTICE == 1) { // bcc lattice - CLM = -2.49389_rt; // 3 * ln<\omega/\omega_p> - U1 = 0.5113875_rt; - ALPHA = 0.265764_rt; - BETA = 0.334547_rt; - GAMMA = 0.932446_rt; - A1 = 0.1839_rt; - A2 = 0.593586_rt; - A3 = 0.0054814_rt; - A4 = 5.01813e-4_rt; - A6 = 3.9247e-7_rt; - A8 = 5.8356e-11_rt; - B0 = 261.66_rt; - B2 = 7.07997_rt; - B4 = 0.0409484_rt; - B5 = 0.000397355_rt; - B6 = 5.11148e-5_rt; - B7 = 2.19749e-6_rt; - C9 = 0.004757014_rt; - C11 = 0.0047770935_rt; - } - else if (LATTICE == 2) { // fcc lattice - CLM = -2.45373_rt; - U1 = 0.513194_rt; - ALPHA = 0.257591_rt; - BETA = 0.365284_rt; - GAMMA = 0.9167070_rt; - A1 = 0.0_rt; - A2 = 0.532535_rt; - A3 = 0.0_rt; - A4 = 3.76545e-4_rt; - A6 = 2.63013e-7_rt; - A8 = 6.6318e-11_rt; - B0 = 303.20_rt; - B2 = 7.7255_rt; - B4 = 0.0439597_rt; - B5 = 0.000114295_rt; - B6 = 5.63434e-5_rt; - B7 = 1.36488e-6_rt; - C9 = 0.00492387_rt; - C11 = 0.00437506_rt; - } - else { - printf("HLfit: unknown lattice type\n"); - exit(1); - } - - if (eta > 1.0_rt / EPS) { // asymptote of Eq.(13) of BPY'01 - U = 3.0_rt / (C11 * eta * eta * eta); - F = -U / 3.0_rt; - CV = 4.0_rt * U; - S = U - F; - return; - } - else if (eta < EPS) { // Eq.(17) of BPY'01 - if (eta < TINY) { - printf("HLfit: eta is too small\n"); - exit(1); - } - F = 3.0_rt * std::log(eta) + CLM - 1.5_rt * U1 * eta + eta * eta / 24.0_rt; - U = 3.0_rt - 1.5_rt * U1 * eta + eta * eta / 12.0_rt; - CV = 3.0_rt - eta * eta / 12.0_rt; - S = U - F; - return; - } - - Real eta2 = eta * eta; - Real eta3 = eta2 * eta; - Real eta4 = eta3 * eta; - Real eta5 = eta4 * eta; - Real eta6 = eta5 * eta; - Real eta7 = eta6 * eta; - Real eta8 = eta7 * eta; - Real B9 = A6 * C9; - Real B11 = A8 * C11; - Real UP = 1.0_rt + A1 * eta + A2 * eta2 + A3 * eta3 + A4 * eta4 + A6 * eta6 + A8 * eta8; - Real DN = B0 + B2 * eta2 + B4 * eta4 + B5 * eta5 + B6 * eta6 + - B7 * eta7 + eta8 * (B9 * eta + B11 * eta3); - Real EA = std::exp(-ALPHA * eta); - Real EB = std::exp(-BETA * eta); - Real EG = std::exp(-GAMMA * eta); - F = std::log(1.0_rt - EA) + std::log(1.0_rt - EB) + std::log(1.0_rt - EG) - UP / DN; // F_{thermal}/NT - Real UP1 = A1 + 2.0_rt * A2 * eta + 3.0_rt * A3 * eta2 + 4.0_rt * A4 * eta3 + - 6.0_rt * A6 * eta5 + 8. * A8 * eta7; - Real UP2 = 2.0_rt * A2 + 6.0_rt * A3 * eta + 12.0_rt * A4 * eta2 + 30.0_rt * A6 * eta4 + 56.0_rt * A8 * eta6; - Real UP3 = 6.0_rt * A3 + 24.0_rt * A4 * eta + 120.0_rt * A6 * eta3 + 336.0_rt * A8 * eta5; - Real DN1 = 2.0_rt * B2 * eta + 4.0_rt * B4 * eta3 + 5.0_rt * B5 * eta4 + 6.0_rt * B6 * eta5 + - 7.0_rt * B7 * eta6 + eta8 * (9.0_rt * B9 + 11.0_rt * B11 * eta2); - Real DN2 = 2.0_rt * B2 + 12.0_rt * B4 * eta2 + 20. * B5 * eta3 + 30.0_rt * B6 * eta4 + - 42.0_rt * B7 * eta5 + 72.0_rt * B9 * eta7 + 110.0_rt * B11 * eta8 * eta; - Real DN3 = 24.0_rt * B4 * eta + 60.0_rt * B5 * eta2 + 120.0_rt * B6 * eta3 + - 210.0_rt * B7 * eta4 + 504.0_rt * B9 * eta6 + 990.0_rt * B11 * eta8; - Real DF1 = ALPHA * EA / (1.0_rt - EA) + BETA * EB / (1.0_rt - EB) + GAMMA * EG / (1.0_rt - EG) - - (UP1 * DN - DN1 * UP) / (DN * DN); // int.en./NT/eta = df/d\eta - Real DF2 = ALPHA * ALPHA * EA / ((1.0_rt - EA) * (1.0_rt - EA)) + BETA * BETA * EB / - ((1.0_rt - EB) * (1.0_rt - EB)) + GAMMA * GAMMA * EG / ((1.0_rt - EG) * (1.0_rt - EG)) + - ((UP2 * DN - DN2 * UP) * DN - 2.0_rt * (UP1 * DN - DN1 * UP) * DN1) / (DN * DN * DN); // -d2f/d\eta^2 - U = DF1 * eta; - CV = DF2 * eta2; - Real DF3 = -ALPHA * ALPHA * ALPHA * EA / std::pow(1.0_rt - EA, 3) * (1.0_rt + EA) - - BETA * BETA * BETA * EB / std::pow(1.0_rt - EB, 3) * (1.0_rt + EB) - - GAMMA * GAMMA * GAMMA * EG / std::pow(1.0_rt - EG, 3) * (1.0_rt + EG) + - UP3 / DN - (3.0_rt * UP2 * DN1 + 3.0_rt * UP1 * DN2 + UP * DN3) / (DN * DN) + - 6.0_rt * DN1 * (UP1 * DN1 + UP * DN2) / (DN * DN * DN) - - 6.0_rt * UP * DN1 * DN1 * DN1 / (DN * DN * DN * DN); // -d3f/d\eta^3 - CW = -2.0_rt * CV - eta3 * DF3; - S = U - F; - } - - void fharm12(Real GAMI, Real TPT, - Real& Fharm, Real& Uharm, Real& Pharm, Real& CVth, - Real& Sth, Real& PDTharm, Real& PDRharm) - { - // Thermodynamic functions of a harmonic crystal, incl.stat.Coul.lattice - // - // Version 27.04.12 - // Stems from FHARM8 v.15.02.08 - // Replaced HLfit8 with HLfit12: rearranged output. - // Input: GAMI - ionic Gamma, TPT = T_{p,i}/T - // Output: Fharm = F/(N_i T), Uharm = U/(N_i T), Pharm = P/(n_i T), - // CVth = C_V/N_i, Sharm = S/N_i - // PDTharm = Pharm + d Pharm / d ln T, PDRharm = Pharm + d Pharm/d ln\rho - - const Real CM = 0.895929256_rt; // Madelung - - Real F, U, U1, CW; - hlfit12(TPT, F, U, CVth, Sth, U1, CW, 1); - - Real U0 = -CM * GAMI; // perfect lattice - Real E0 = 1.5_rt * U1 * TPT; // zero-point energy - Real Uth = U + E0; - Real Fth = F + E0; - Uharm = U0 + Uth; - Fharm = U0 + Fth; - Pharm = U0 / 3.0_rt + Uth / 2.0_rt; - PDTharm = 0.5_rt * CVth; - PDRharm = U0 / 2.25_rt + 0.75_rt * Uth - 0.25_rt * CVth; - } - - void cormix (Real RS, Real GAME, Real Zmean, Real Z2mean, Real Z52, Real Z53, Real Z321, - Real& FMIX, Real& UMIX, Real& PMIX, Real& CVMIX, Real& PDTMIX, Real& PDRMIX) - { - // Version 02.07.09 - // Correction to the linear mixing rule for moderate to small Gamma - // Input: RS = r_s (if RS = 0, then OCP, otherwise EIP) - // GAME = \Gamma_e - // Zmean = (average Z of all ions, without electrons) - // Z2mean = , Z52 = , Z53 = , Z321 = - // Output: FMIX = \Delta f - corr.to the reduced free energy f = F/N_{ion}kT - // UMIX = \Delta u - corr.to the reduced internal energy u - // PMIX = \Delta u - corr.to the reduced pressure P = P/n_{ion}kT - // CVMIX = \Delta c - corr.to the reduced heat capacity c_V - // PDTMIX = (1/n_{ion}kT)d\Delta P / d ln T - // = \Delta p + d \Delta p / d ln T - // PDRMIX = (1/n_{ion}kT)d\Delta P / d ln n_e - // (composition is assumed fixed: Zmean,Z2mean,Z52,Z53 = constant) - - const Real TINY = 1.e-9_rt; - Real GAMImean = GAME * Z53; - - Real Dif0; - if (RS < TINY) { // OCP - Dif0 = Z52 - std::sqrt(Z2mean * Z2mean * Z2mean / Zmean); - } - else { - Dif0 = Z321 - std::sqrt(std::pow(Z2mean + Zmean, 3) / Zmean); - } - - Real DifR = Dif0 / Z52; - Real DifFDH = Dif0 * GAME * std::sqrt(GAME / 3.0_rt); // F_DH - F_LM(DH) - Real D = Z2mean / (Zmean * Zmean); - if (std::abs(D - 1.0_rt) < TINY) { // no correction - FMIX = 0.0_rt; - UMIX = 0.0_rt; - PMIX = 0.0_rt; - CVMIX = 0.0_rt; - PDTMIX = 0.0_rt; - PDRMIX = 0.0_rt; - return; - } - - Real P3 = std::pow(D, -0.2_rt); - Real D0 = (2.6_rt * DifR + 14.0_rt * DifR * DifR * DifR) / (1.0_rt - P3); - Real GP = D0 * std::pow(GAMImean, P3); - Real FMIX0 = DifFDH / (1.0_rt + GP); - Real Q = D * D * 0.0117_rt; - Real R = 1.5_rt / P3 - 1.0_rt; - Real GQ = Q * GP; - FMIX = FMIX0 / std::pow(1.0_rt + GQ, R); - Real G = 1.5_rt - P3 * GP / (1.0_rt + GP) - R * P3 * GQ / (1.0_rt + GQ); - UMIX = FMIX * G; - PMIX = UMIX / 3.0_rt; - Real GDG = -P3 * P3 * (GP / ((1.0_rt + GP) * (1.0_rt + GP)) + R * GQ / ((1.0_rt + GQ) * (1.0_rt + GQ))); // d G /d ln Gamma - Real UDG = UMIX * G + FMIX * GDG; // d u_mix /d ln Gamma - CVMIX = UMIX - UDG; - PDTMIX = PMIX - UDG / 3.0_rt; - PDRMIX = PMIX + UDG / 9.0_rt; - } - - void fscrliq8 (Real RS, Real GAME, Real Zion, - Real& FSCR, Real& USCR, Real& PSCR, - Real& CVSCR, Real& PDTSCR, Real& PDRSCR) - { - // fit to the el.-ion scr. - // Version 11.09.08 - // cleaned 16.06.09 - // Stems from FSCRliq7 v. 09.06.07. Included a check for RS=0. - // INPUT: RS - density parameter, GAME - electron Coulomb parameter, - // Zion - ion charge number, - // OUTPUT: FSCR - screening (e-i) free energy per kT per 1 ion, - // USCR - internal energy per kT per 1 ion (screen.contrib.) - // PSCR - pressure divided by (n_i kT) (screen.contrib.) - // CVSCR - heat capacity per 1 ion (screen.contrib.) - // PDTSCR,PDRSCR = PSCR + d PSCR / d ln(T,\rho) - - const Real XRS = 0.0140047_rt; - const Real TINY = 1.e-19_rt; - - if (RS < 0.0_rt) { - printf("FSCRliq8: RS < 0\n"); - exit(1); - } - - if (RS < TINY) { - FSCR = 0.0_rt; - USCR = 0.0_rt; - PSCR = 0.0_rt; - CVSCR = 0.0_rt; - PDTSCR = 0.0_rt; - PDRSCR = 0.0_rt; - return; - } - - Real SQG = std::sqrt(GAME); - Real SQR = std::sqrt(RS); - Real SQZ1 = std::sqrt(1.0_rt + Zion); - Real SQZ = std::sqrt(Zion); - Real CDH0 = Zion / 1.73205_rt; // 1.73205 = std::sqrt(3.0_rt) - Real CDH = CDH0 * (SQZ1 * SQZ1 * SQZ1 - SQZ * SQZ * SQZ - 1.0_rt); - Real ZLN = std::log(Zion); - Real Z13 = std::exp(ZLN / 3.0_rt); // Zion**(1.0_rt / 3.0_rt) - Real X = XRS / RS; // relativity parameter - Real CTF = Zion * Zion * 0.2513_rt * (Z13 - 1.0_rt + 0.2_rt / std::sqrt(Z13)); - // Thomas - Fermi constant; .2513 = (18 / 175)(12 / \pi)^{2 / 3} - Real P01 = 1.11_rt * std::exp(0.475_rt * ZLN); - Real P03 = 0.2_rt + 0.078_rt * ZLN * ZLN; - Real PTX = 1.16_rt + 0.08_rt * ZLN; - Real TX = std::pow(GAME, PTX); - Real TXDG = PTX * TX / GAME; - Real TXDGG = (PTX - 1.0_rt) * TXDG / GAME; - Real TY1 = 1.0_rt / (1.e-3_rt * Zion * Zion + 2.0_rt * GAME); - Real TY1DG = -2.0_rt * TY1 * TY1; - Real TY1DGG = -4.0_rt * TY1 * TY1DG; - Real TY2 = 1.0_rt + 6.0_rt * RS * RS; - Real TY2DX = -12.0_rt * RS * RS / X; - Real TY2DXX = -3.0_rt * TY2DX / X; - Real TY = RS * RS * RS / TY2 * (1.0_rt + TY1); - Real TYX = 3.0_rt / X + TY2DX / TY2; - Real TYDX = -TY * TYX; - Real TYDG = RS * RS * RS * TY1DG / TY2; - Real P1 = (Zion - 1.0_rt) / 9.0_rt; - Real COR1 = 1.0_rt + P1 * TY; - Real COR1DX = P1 * TYDX; - Real COR1DG = P1 * TYDG; - Real COR1DXX = P1 * (TY * (3.0_rt / (X * X) + (TY2DX / TY2) * (TY2DX / TY2) - TY2DXX / TY2) - TYDX * TYX); - Real COR1DGG = P1 * RS * RS * RS * TY1DGG / TY2; - Real COR1DXG = -P1 * TYDG * TYX; - Real U0 = 0.78_rt * std::sqrt(GAME / Zion) * RS * RS * RS; - Real U0DX = -3.0_rt * U0 / X; - Real U0DG = 0.5_rt * U0 / GAME; - Real U0DXX = -4.0_rt * U0DX / X; - Real U0DGG = -0.5_rt * U0DG / GAME; - Real U0DXG = -3.0_rt * U0DG / X; - Real D0DG = Zion * Zion * Zion; - Real D0 = GAME * D0DG + 21.0_rt * RS * RS * RS; - Real D0DX = -63.0_rt * RS * RS * RS / X; - Real D0DXX = 252.0_rt * RS * RS * RS / (X * X); - Real COR0 = 1.0_rt + U0 / D0; - Real COR0DX = (U0DX - U0 * D0DX / D0) / D0; - Real COR0DG = (U0DG - U0 * D0DG / D0) / D0; - Real COR0DXX = (U0DXX - (2.0_rt * U0DX * D0DX + U0 * D0DXX) / D0 + 2.0_rt * (D0DX / D0) * (D0DX / D0)) / D0; - Real COR0DGG = (U0DGG - 2.0_rt * U0DG * D0DG / D0 + 2.0_rt * U0 * (D0DG / D0) * (D0DG / D0)) / D0; - Real COR0DXG = (U0DXG - (U0DX * D0DG + U0DG * D0DX) / D0 + 2.0_rt * U0 * D0DX * D0DG / (D0 * D0)) / D0; - // Relativism: - Real RELE = std::sqrt(1.0_rt + X * X); - Real Q1 = 0.18_rt / std::sqrt(std::sqrt(Zion)); - Real Q2 = 0.2_rt + 0.37_rt / std::sqrt(Zion); - Real H1U = 1.0_rt + X * X / 5.0_rt; - Real H1D = 1.0_rt + Q1 * X + Q2 * X * X; - Real H1 = H1U / H1D; - Real H1X = 0.4_rt * X / H1U - (Q1 + 2.0_rt * Q2 * X) / H1D; - Real H1DX = H1 * H1X; - Real H1DXX = H1DX * H1X + - H1 * (0.4_rt / H1U - (0.4_rt * X / H1U) * (0.4_rt * X / H1U) - 2.0_rt * Q2 / H1D + - std::pow((Q1 + 2.0_rt * Q2 * X) / H1D, 2.0_rt)); - Real UP = CDH * SQG + P01 * CTF * TX * COR0 * H1; - Real UPDX = P01 * CTF * TX * (COR0DX * H1 + COR0 * H1DX); - Real UPDG = 0.5_rt * CDH / SQG + P01 * CTF * (TXDG * COR0 + TX * COR0DG) * H1; - Real UPDXX = P01 * CTF * TX * (COR0DXX * H1 + 2.0_rt * COR0DX * H1DX + COR0 * H1DXX); - Real UPDGG = -0.25_rt * CDH / (SQG * GAME) + - P01 * CTF * (TXDGG * COR0 + 2.0_rt * TXDG * COR0DG + TX * COR0DGG) * H1; - Real UPDXG = P01 * CTF * (TXDG * (COR0DX * H1 + COR0 * H1DX) + - TX * (COR0DXG * H1 + COR0DG * H1DX)); - Real DN1 = P03 * SQG + P01 / RS * TX * COR1; - Real DN1DX = P01 * TX * (COR1 / XRS + COR1DX / RS); - Real DN1DG = 0.5_rt * P03 / SQG + P01 / RS * (TXDG * COR1 + TX * COR1DG); - Real DN1DXX = P01 * TX / XRS * (2.0_rt * COR1DX + X * COR1DXX); - Real DN1DGG = -0.25_rt * P03 / (GAME * SQG) + - P01 / RS * (TXDGG * COR1 + 2.0_rt * TXDG * COR1DG + TX * COR1DGG); - Real DN1DXG = P01 * (TXDG * (COR1 / XRS + COR1DX / RS) + TX * (COR1DG / XRS + COR1DXG / RS)); - Real DN = 1.0_rt + DN1 / RELE; - Real DNDX = DN1DX / RELE - X * DN1 / (RELE * RELE * RELE); - Real DNDXX = (DN1DXX - ((2.0_rt * X * DN1DX + DN1) - 3.0_rt * X * X * DN1 / (RELE * RELE)) / (RELE * RELE)) / RELE; - Real DNDG = DN1DG / RELE; - Real DNDGG = DN1DGG / RELE; - Real DNDXG = DN1DXG / RELE - X * DN1DG / (RELE * RELE * RELE); - FSCR = -UP / DN * GAME; - Real FX = (UP * DNDX / DN - UPDX) / DN; - Real FXDG = ((UPDG * DNDX + UPDX * DNDG + UP * DNDXG - 2.0_rt * UP * DNDX * DNDG / DN) / DN - - UPDXG) / DN; - Real FDX = FX * GAME; - Real FG = (UP * DNDG / DN - UPDG) / DN; - Real FDG = FG * GAME - UP / DN; - Real FDGDH = SQG * DNDG / (DN * DN); // d FDG / d CDH - Real FDXX = ((UP * DNDXX + 2.0_rt * (UPDX * DNDX - UP * DNDX * DNDX / DN)) / DN - UPDXX) / DN * GAME; - Real FDGG = 2.0_rt * FG + GAME * ((2.0_rt * DNDG * (UPDG - UP * DNDG / DN) + UP * DNDGG) / DN - UPDGG) / DN; - Real FDXG = FX + GAME * FXDG; - USCR = GAME * FDG; - CVSCR = -GAME * GAME * FDGG; - PSCR = (X * FDX + GAME * FDG) / 3.0_rt; - PDTSCR = -GAME * GAME * (X * FXDG + FDGG) / 3.0_rt; - PDRSCR = (12.0_rt * PSCR + X * X * FDXX + 2.0_rt * X * GAME * FDXG + GAME * GAME * FDGG) / 9.0_rt; - } - - void fition9 (Real GAMI, Real& FION, Real& UION, Real& PION, - Real& CVii, Real& PDTii, Real& PDRii) - { - // Version 11.09.08 - // Dummy argument Zion is deleted in 2009. - // Non - ideal contributions to thermodynamic functions of classical OCP. - // Stems from FITION00 v.24.05.00. - // Input: GAMI - ion coupling parameter - // Output: FION - ii free energy / N_i kT - // UION - ii internal energy / N_i kT - // PION - ii pressure / n_i kT - // CVii - ii heat capacity / N_i k - // PDTii = PION + d(PION) / d ln T = (1 / N_i kT) * (d P_{ii} / d ln T) - // PDRii = PION + d(PION) / d ln\rho - // Parameters adjusted to Caillol (1999). - - const Real A1 = -0.907347_rt; - const Real A2 = 0.62849_rt; - const Real C1 = 0.004500_rt; - const Real G1 = 170.0_rt; - const Real C2 = -8.4e-5_rt; - const Real G2 = 0.0037_rt; - const Real SQ32 = 0.8660254038_rt; // SQ32 = sqrt(3) / 2 - Real A3 = -SQ32 - A1 / std::sqrt(A2); - Real F0 = A1 * (std::sqrt(GAMI * (A2 + GAMI)) - - A2 * std::log(std::sqrt(GAMI / A2) + std::sqrt(1.0_rt + GAMI / A2))) + - 2.0_rt * A3 * (std::sqrt(GAMI) - std::atan(std::sqrt(GAMI))); - Real U0 = std::pow(GAMI, 1.5_rt) * (A1 / std::sqrt(A2 + GAMI) + A3 / (1.0_rt + GAMI)); - // This is the zeroth approximation. Correction: - UION = U0 + C1 * GAMI * GAMI / (G1 + GAMI) + C2 * GAMI * GAMI / (G2 + GAMI * GAMI); - FION = F0 + C1 * (GAMI - G1 * std::log(1.0_rt + GAMI / G1)) + - C2 / 2.0_rt * std::log(1.0_rt + GAMI * GAMI / G2); - CVii = -0.5_rt * std::pow(GAMI, 1.5_rt) * (A1 * A2 / std::pow(A2 + GAMI, 1.5_rt) + - A3 * (1.0_rt - GAMI) / ((1.0_rt + GAMI) * (1.0_rt + GAMI))) - - GAMI * GAMI * (C1 * G1 / ((G1 + GAMI) * (G1 + GAMI)) + - C2 * (G2 - GAMI * GAMI) / ((G2 + GAMI * GAMI) * (G2 + GAMI * GAMI))); - PION = UION / 3.0_rt; - PDRii = (4.0_rt * UION - CVii) / 9.0_rt; // p_{ii} + d p_{ii} / d ln\rho - PDTii = CVii / 3.0_rt; // p_{ii} + d p_{ii} / d ln T - } - - void eosfi8(int LIQSOL, Real CMI, Real Zion, Real RS, Real GAMI, - Real& FC1, Real& UC1, Real& PC1, Real& SC1, Real& CV1, - Real& PDT1, Real& PDR1, Real& FC2, Real& UC2, Real& PC2, - Real& SC2, Real& CV2, Real& PDT2, Real& PDR2) - { - // Version 16.09.08 - // call FHARM8 has been replaced by call FHARM12 27.04.12 - // Wigner - Kirkwood correction excluded 20.05.13 - // slight cleaning 10.12.14 - // Non - ideal parts of thermodynamic functions in the fully ionized plasma - // Stems from EOSFI5 and EOSFI05 v.04.10.05 - // Input: LIQSOL = 0 / 1(liquid / solid), - // Zion,CMI - ion charge and mass numbers, - // RS = r_s (electronic density parameter), - // GAMI = Gamma_i (ion coupling), - // Output: FC1 and UC1 - non - ideal "ii + ie + ee" contribution to the - // free and internal energies (per ion per kT), - // PC1 - analogous contribution to pressure divided by (n_i kT), - // CV1 - "ii + ie + ee" heat capacity per ion [units of k] - // PDT1 = (1 / n_i kT) * (d P_C / d ln T)_V - // PDR1 = (1 / n_i kT) * (d P_C / d ln\rho)_T - // FC2,UC2,PC2,SC2,CV2 - analogous to FC1,UC1,PC1,SC1,CV1, but including - // the part corresponding to the ideal ion gas. This is useful for - // preventing accuracy loss in some cases (e.g., when SC2 << SC1). - // FC2 does not take into account the entropy of mixing S_{mix}: in a - // mixture, S_{mix} / (N_i k) has to be added externally (see MELANGE9). - // FC2 does not take into account the ion spin degeneracy either. - // When needed, the spin term must be added to the entropy externally. - - const Real C53 = 5.0_rt / 3.0_rt; - const Real C76 = 7.0_rt / 6.0_rt; // TINY excl.10.12.14 - const Real AUM = 1822.888_rt; // a.m.u / m_e - - if (LIQSOL != 1 && LIQSOL != 0) { - printf("EOSFI8: invalid LIQSOL\n"); - exit(1); - } - if (CMI <= 0.1_rt) { - printf("EOSFI8: too small CMI\n"); - exit(1); - } - if (Zion <= 0.1_rt) { - printf("EOSFI8: too small Zion\n"); - exit(1); - } - if (RS <= 0.0_rt) { - printf("EOSFI8: invalid RS\n"); - exit(1); - } - if (GAMI <= 0.0_rt) { - printf("EOSFI8: invalid GAMI\n"); - exit(1); - } - - Real GAME = GAMI / std::pow(Zion, C53); - Real FXC, UXC, PXC, CVXC, SXC, PDTXC, PDRXC; - excor7(RS, GAME, FXC, UXC, PXC, CVXC, SXC, PDTXC, PDRXC); // "ee"("xc") - - // Calculate "ii" part: - Real COTPT = std::sqrt(3.0_rt / AUM / CMI) / std::pow(Zion, C76); // auxiliary coefficient - Real TPT = GAMI / std::sqrt(RS) * COTPT; // = T_p / T in the OCP - Real FidION = 1.5_rt * std::log(TPT * TPT / GAMI) - 1.323515_rt; - // 1.3235 = 1 + 0.5 * ln(6 / pi); FidION = F_{id.ion gas} / (N_i kT), but without - // the term x_i ln x_i = - S_{mix} / (N_i k). - - Real FItot, UItot, PItot, CVItot, SCItot, PDTi, PDRi; - Real FION, UION, PION, CVii, PDTii, PDRii; - - if (LIQSOL == 0) { // liquid - fition9(GAMI, FION, UION, PION, CVii, PDTii, PDRii); - FItot = FION + FidION; - UItot = UION + 1.5_rt; - PItot = PION + 1.0_rt; - CVItot = CVii + 1.5_rt; - SCItot = UItot - FItot; - PDTi = PDTii + 1.0_rt; - PDRi = PDRii + 1.0_rt; - } - else { // solid - Real Fharm, Uharm, Pharm, CVharm, Sharm, PDTharm, PDRharm; - fharm12(GAMI, TPT, Fharm, Uharm, Pharm, - CVharm, Sharm, PDTharm, PDRharm); // harm."ii" - - Real Fah, Uah, Pah, CVah, PDTah, PDRah; - anharm8(GAMI, TPT, Fah, Uah, Pah, CVah, PDTah, PDRah); // anharm. - - FItot = Fharm + Fah; - FION = FItot - FidION; - UItot = Uharm + Uah; - UION = UItot - 1.5_rt; // minus 1.5 = ideal - gas, in order to get "ii" - PItot = Pharm + Pah; - PION = PItot - 1.0_rt; // minus 1 = ideal - gas - PDTi = PDTharm + PDTah; - PDRi = PDRharm + PDRah; - PDTii = PDTi - 1.0_rt; // minus 1 = ideal - gas - PDRii = PDRi - 1.0_rt; // minus 1 = ideal - gas - CVItot = CVharm + CVah; - SCItot = Sharm + Uah - Fah; - CVii = CVItot - 1.5_rt; // minus 1.5 = ideal - gas - } - - // Calculate "ie" part: - - Real FSCR, USCR, PSCR, S_SCR, CVSCR, PDTSCR, PDRSCR; - if (LIQSOL == 1) { - fscrsol8(RS, GAMI, Zion, TPT, - FSCR, USCR, PSCR, S_SCR, CVSCR, PDTSCR, PDRSCR); - } - else { - fscrliq8(RS, GAME, Zion, - FSCR, USCR, PSCR, CVSCR, PDTSCR, PDRSCR); - S_SCR = USCR - FSCR; - } - - // Total excess quantities ("ii" + "ie" + "ee", per ion): - Real FC0 = FSCR + Zion * FXC; - Real UC0 = USCR + Zion * UXC; - Real PC0 = PSCR + Zion * PXC; - Real SC0 = S_SCR + Zion * SXC; - Real CV0 = CVSCR + Zion * CVXC; - Real PDT0 = PDTSCR + Zion * PDTXC; - Real PDR0 = PDRSCR + Zion * PDRXC; - - FC1 = FION + FC0; - UC1 = UION + UC0; - PC1 = PION + PC0; - SC1 = (UION - FION) + SC0; - CV1 = CVii + CV0; - PDT1 = PDTii + PDT0; - PDR1 = PDRii + PDR0; - - // Total excess + ideal - ion quantities - FC2 = FItot + FC0; - UC2 = UItot + UC0; - PC2 = PItot + PC0; - SC2 = SCItot + SC0; - CV2 = CVItot + CV0; - PDT2 = PDTi + PDT0; - PDR2 = PDRi + PDR0; - } - - void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real T, - Real& DENS, - Real& GAMImean, Real& CHI, Real& TPT, int& LIQSOL, - Real& P, Real& U, Real& S, Real& CV, Real& CHIR, Real& CHIT) - { - // Version 18.04.20 - // Difference from v.10.12.14: included switch - off of WK correction - // Stems from MELANGE8 v.26.12.09. - // Difference: output PRADnkT instead of input KRAD - // + EOS of fully ionized electron - ion plasma mixture. - // Limitations: - // (a) inapplicable in the regimes of - // (1) bound - state formation, - // (2) quantum liquid, - // (3) presence of positrons; - // (b) for the case of a composition gradually depending on RHO or TEMP, - // second - order functions (CV,CHIR,CHIT in output) should not be trusted - // Choice of the liquid or solid regime - criterion GAMI [because the - // choice based on comparison of total (non - OCP) free energies can be - // sometimes dangerous because of the fit uncertainties ("Local field - // correction" in solid and quantum effects in liquid are unknown)]. - // Input: AY - their partial number densities, - // AZion and ACMI - their charge and mass numbers, - // RHO - total mass density [g / cc] - // TEMP - temperature - // NB: instead of RHO, a true input is CHI, defined below - // Hence, disagreement between RHO and DENS is the fit error (<0.4%) - // Output: - // AY - rescaled so that to sum up to 1 and resorted (by AZion) - // AZion - resorted in ascending order - // ACMI - resorted in agreement with AZion - // DENS - electron number density [in a.u. = 6.7483346e24 cm^{ - 3}] - // GAMImean - effective ion - ion Coulomb coupling constant - // CHI = mu_e / kT, where mu_e is the electron chem.potential - // TPT - effective ionic quantum parameter (T_p / T) - // LIQSOL = 0 / 1 for liquid / solid - // S - entropy - // U - internal energy - // P - pressure - // CV - heat capacity per ion, div. by Boltzmann const. - // CHIR - inverse compressibility - (d ln P / d ln V)_T ("\chi_r") - // CHIT = (d ln P / d ln T)_V ("\chi_T") - - // Convert temperature to a.u. = 2Ryd = 3.1577e5 K. - const Real UN_T6 = 0.3157746_rt; - Real Tlg = std::log10(T); - Real T6 = std::pow(10.0_rt, Tlg - 6.0_rt); - Real TEMP = T6 / UN_T6; // T [au] - - const Real CWK = 1.0_rt; // Turn on Wigner corrections - const Real TINY = 1.e-7_rt; - const Real PI = 3.141592653_rt; - const Real C53 = 5.0_rt / 3.0_rt; - const Real C13 = 1.0_rt / 3.0_rt; - const Real AUM = 1822.888_rt; // a.m.u. / m_e - const Real GAMIMELT = 175.0_rt; // OCP value of Gamma_i for melting - const Real RSIMELT = 140.0_rt; // ion density parameter of quantum melting - const Real RAD = 2.554e-7_rt; // Radiation constant ( = 4\sigma / c) (in a.u.) - - if (RHO < 1.e-19_rt || RHO > 1.e15_rt) { - printf("MELANGE: RHO out of range\n"); - exit(1); - } - - // Calculation of average values: - Real zbar = 0.0_rt; - Real z2bar = 0.0_rt; - Real Z52 = 0.0_rt; - Real Z53 = 0.0_rt; - Real Z73 = 0.0_rt; - Real Z321 = 0.0_rt; // corr.26.12.09 - Real abar = 0.0_rt; - - for (int i = 0; i < NumSpec; ++i) { - zbar = zbar + AY[i] * AZion[i]; - z2bar = z2bar + AY[i] * AZion[i] * AZion[i]; - Real Z13 = std::pow(AZion[i], C13); - Z53 = Z53 + AY[i] * std::pow(Z13, 5); - Z73 = Z73 + AY[i] * std::pow(Z13, 7); - Z52 = Z52 + AY[i] * std::pow(AZion[i], 2.5_rt); - Z321 = Z321 + AY[i] * AZion[i] * std::pow(AZion[i] + 1.0_rt, 1.5_rt); // 26.12.09 - abar = abar + AY[i] * ACMI[i]; - } - - // (0) Photons: - Real UINTRAD = RAD * TEMP * TEMP * TEMP * TEMP; - Real PRESSRAD = UINTRAD / 3.0_rt; - - // (1) ideal electron gas (including relativity and degeneracy) - DENS = RHO / 11.20587 * zbar / abar; // number density of electrons [au] - chemfit(DENS, TEMP, CHI); - - // NB: CHI can be used as true input instead of RHO or DENS - Real FEid, PEid, UEid, SEid, CVE, CHITE, CHIRE; - Real DlnDH, DlnDT, DlnDHH, DlnDTT, DlnDHT; - elect11(TEMP, CHI, - DENS, FEid, PEid, UEid, SEid, CVE, CHITE, CHIRE, - DlnDH, DlnDT, DlnDHH, DlnDTT, DlnDHT); - - // NB: at this point DENS is redefined (the difference can be ~0.1%) - Real DTE = DENS * TEMP; - Real PRESSE = PEid * DTE; // P_e [a.u.] - Real UINTE = UEid * DTE; // U_e / V [a.u.] - - // (2) non - ideal Coulomb EIP - Real RS = std::pow(0.75_rt / PI / DENS, C13); // r_s - electron density parameter - Real RSI = RS * abar * Z73 * AUM; // R_S - ion density parameter - Real GAME = 1.0_rt / RS / TEMP; // electron Coulomb parameter Gamma_e - GAMImean = Z53 * GAME; // effective Gamma_i - ion Coulomb parameter - - if (GAMImean < GAMIMELT || RSI < RSIMELT) { - LIQSOL = 0; // liquid regime - } - else { - LIQSOL = 1; // solid regime - } - - // Calculate partial thermodynamic quantities and combine them together: - Real UINT = UINTE; - Real PRESS = PRESSE; - Real CVtot = CVE * DENS; - Real Stot = SEid * DENS; - Real PDLT = PRESSE * CHITE; // d P_e[a.u.] / d ln T - Real PDLR = PRESSE * CHIRE; // d P_e[a.u.] / d ln\rho - Real DENSI = DENS / zbar; // number density of all ions - Real PRESSI = DENSI * TEMP; // ideal - ions total pressure (normalization) - Real TPT2 = 0.0_rt; - Real CTP = 4.0_rt * PI / AUM / (TEMP * TEMP); // common coefficient for TPT2.10.12.14 - - // Add Coulomb + xc nonideal contributions, and ideal free energy: - for (int i = 0; i < NumSpec; ++i) { - if (AY[i] >= TINY) { - Real Zion = AZion[i]; - Real CMI = ACMI[i]; - Real GAMI = std::pow(Zion, C53) * GAME; // Gamma_i for given ion species - Real DNI = DENSI * AY[i]; // number density of ions of given type - Real PRI = DNI * TEMP; // = ideal - ions partial pressure (normalization) - - Real FC1, UC1, PC1, SC1, CV1, PDT1, PDR1; - Real FC2, UC2, PC2, SC2, CV2, PDT2, PDR2; - - eosfi8(LIQSOL, CMI, Zion, RS, GAMI, - FC1, UC1, PC1, SC1, CV1, PDT1, PDR1, - FC2, UC2, PC2, SC2, CV2, PDT2, PDR2); - - // First - order TD functions: - UINT = UINT + UC2 * PRI; // internal energy density (e + i + Coul.) - Stot = Stot + DNI * (SC2 - std::log(AY[i])); //entropy per unit volume[a.u.] - PRESS = PRESS + PC2 * PRI; // pressure (e + i + Coul.) [a.u.] - - // Second - order functions (they take into account compositional changes): - CVtot = CVtot + DNI * CV2; // C_V (e + i + Coul.) / V (optim.10.12.14) - PDLT = PDLT + PRI * PDT2; // d P / d ln T - PDLR = PDLR + PRI * PDR2; // d P / d ln\rho - TPT2 = TPT2 + CTP * DNI / ACMI[i] * AZion[i] * AZion[i]; // opt.10.12.14 - } - } - - // Wigner - Kirkwood perturbative correction for liquid: - TPT = std::sqrt(TPT2); // effective T_p / T - ion quantum parameter - // (in the case of a mixture, this estimate is crude) - if (LIQSOL == 0) { - Real FWK = TPT2 / 24.0_rt * CWK; // Wigner - Kirkwood (quantum diffr.) term - Real UWK = 2.0_rt * FWK; - UINT = UINT + UWK * PRESSI; - Stot = Stot + FWK * DENSI; // corrected 28.05.15 - PRESS = PRESS + FWK * PRESSI; - CVtot = CVtot - UWK * DENSI; // corrected 18.04.20 - PDLT = PDLT - FWK * PRESSI; - PDLR = PDLR + UWK * PRESSI; - } - - // Corrections to the linear mixing rule: - Real FMIX, UMIX, PMIX, CVMIX, PDTMIX, PDRMIX; - if (LIQSOL == 0) { // liquid phase - cormix(RS, GAME, zbar, z2bar, Z52, Z53, Z321, - FMIX, UMIX, PMIX, CVMIX, PDTMIX, PDRMIX); - } - else { // solid phase (only Madelung contribution) [22.12.12] - FMIX = 0.0_rt; - for (int i = 0; i < NumSpec; ++i) { - for (int j = i+1; j < NumSpec; ++j) { - Real RZ = AZion[j] / AZion[i]; - Real X2 = AY[j] / (AY[i] + AY[j]); - Real X1 = std::max(0.0, 1.0_rt - X2); - - if (X1 < TINY) { - continue; // 27.01.19 - } - if (X2 < TINY) { - continue; - } - - Real X = X2 / RZ + (1.0_rt - 1.0_rt / RZ) * std::pow(X2, RZ); - Real GAMI = std::pow(AZion[i], C53) * GAME; // Gamma_i corrected 14.05.13 - Real DeltaG = 0.012_rt * (1.0_rt - 1.0_rt / (RZ * RZ)) * (X1 + X2 * std::pow(RZ, C53)); - DeltaG = DeltaG * X / X2 * std::max(0.0_rt, 1.0_rt - X) / X1; - FMIX = FMIX + AY[i] * AY[j] * GAMI * DeltaG; - } - } - - UMIX = FMIX; - PMIX = FMIX / 3.0_rt; - CVMIX = 0.0_rt; - PDTMIX = 0.0_rt; - PDRMIX = FMIX / 2.25_rt; - } - - UINT = UINT + UMIX * PRESSI; - Stot = Stot + DENSI * (UMIX - FMIX); - PRESS = PRESS + PMIX * PRESSI; - CVtot = CVtot + DENSI * CVMIX; - PDLT = PDLT + PRESSI * PDTMIX; - PDLR = PDLR + PRESSI * PDRMIX; - - // First - order: - Real PRADnkT = PRESSRAD / PRESSI; // radiative pressure / n_i k T - Real PnkT = PRESS / PRESSI; // P / n_i k T - Real UNkT = UINT / PRESSI; // U / N_i k T - Real SNk = Stot / DENSI; // S / N_i k - - // Second - order: - CV = CVtot / DENSI; // C_V per ion - CHIR = PDLR / PRESS; // d ln P / d ln\rho - CHIT = PDLT / PRESS; // d ln P / d ln T - - // Convert to CGS - Real Tnk = 8.31447e13_rt / abar * RHO * T6; // n_i kT [erg/cc] - Real avo_eos = 6.0221417930e23_rt; - Real N = avo_eos / abar; - Real k_B = 1.3806488e-16_rt; - - P = PnkT * Tnk; - U = UNkT * N * k_B * T; - S = SNk * N * k_B; - } - -} - -int main() { - - const Real UN_T6 = 0.3157746_rt; - Real AY[NumSpec], AZion[NumSpec], ACMI[NumSpec]; - Real RHO, RHOlg, T, Tlg, T6, Tnk, TEMP, DENS; - Real GAMI; - Real CHI, TPT; - Real P, U, S, CV, CHIR, CHIT; - int LIQSOL; - Real T_arr[3], rho_arr[2]; - - AZion[0] = 6.0_rt; - AZion[1] = 8.0_rt; - ACMI[0] = 12.0_rt; - ACMI[1] = 16.0_rt; - AY[0] = 0.6_rt; - AY[1] = 0.4_rt; - T_arr[0] = 1.e9_rt; - T_arr[1] = 5.e9_rt; - T_arr[2] = 1.e6_rt; - rho_arr[0] = 1.e7_rt; - rho_arr[1] = 5.e9_rt; - - for (int j = 0; j <= 0; ++j) { - for (int i = 0; i < 3; ++i) { - T = T_arr[i]; - RHO = rho_arr[j]; - RHOlg = std::log10(RHO); - Tlg = std::log10(T); - T6 = std::pow(10.0_rt, Tlg - 6.0_rt); - RHO = std::pow(10.0_rt, RHOlg); - TEMP = T6 / UN_T6; // T [au] - - melange9(AY, AZion, ACMI, RHO, T, // input - DENS, GAMI, CHI, TPT, LIQSOL, // output param. - P, U, S, CV, CHIR, CHIT); // output dimensionless TD functions - - // -------------------- OUTPUT -------------------------------- - // Here in the output we have: - // RHO - mass density in g/cc - // P - total pressure in Mbar (i.e. in 1.e12 dyn/cm^2) - // PnkT=P/nkT, where n is the number density of ions, T temperature - // CV - heat capacity at constant volume, divided by number of ions, /k - // CHIT - logarithmic derivative of pressure \chi_T - // CHIR - logarithmic derivative of pressure \chi_\rho - // UNkT - internal energy divided by NkT, N being the number of ions - // SNk - entropy divided by number of ions, /k - // GAMI - ionic Coulomb coupling parameter - // TPT=T_p/T, where T_p is the ion plasma temperature - // CHI - electron chemical potential, divided by kT - // LIQSOL = 0 in the liquid state, = 1 in the solid state - - } - } -} From fe8a3bcd20f97b7fe030528fd8bee1aad35f0aaa Mon Sep 17 00:00:00 2001 From: Max Katz Date: Wed, 20 Oct 2021 21:49:51 -0700 Subject: [PATCH 68/70] Add PC input --- unit_test/test_eos/input_eos.pc | 9 +++++++++ 1 file changed, 9 insertions(+) create mode 100644 unit_test/test_eos/input_eos.pc diff --git a/unit_test/test_eos/input_eos.pc b/unit_test/test_eos/input_eos.pc new file mode 100644 index 0000000000..ba1e1a2da1 --- /dev/null +++ b/unit_test/test_eos/input_eos.pc @@ -0,0 +1,9 @@ +n_cell = 16 +max_grid_size = 32 + +unit_test.dens_min = 10.0 +unit_test.dens_max = 5.e9 +unit_test.temp_min = 1.e6 +unit_test.temp_max = 1.e10 + +unit_test.metalicity_max = 0.5 From 22ef98a4c46ebd857ce768a62ca43e0f262cdc7d Mon Sep 17 00:00:00 2001 From: Max Katz Date: Wed, 20 Oct 2021 21:54:29 -0700 Subject: [PATCH 69/70] Start reworking to use eos_t --- EOS/pc/actual_eos.H | 76 +++++++++++++++++++++++++-------------------- 1 file changed, 43 insertions(+), 33 deletions(-) diff --git a/EOS/pc/actual_eos.H b/EOS/pc/actual_eos.H index a882434a0b..c68cfda3d2 100644 --- a/EOS/pc/actual_eos.H +++ b/EOS/pc/actual_eos.H @@ -10,6 +10,7 @@ #include #include +#include #include // Equation of state for fully ionized electron-ion plasmas (EOS EIP) @@ -2201,10 +2202,7 @@ void eosfi8(int LIQSOL, Real CMI, Real Zion, Real RS, Real GAMI, } AMREX_GPU_HOST_DEVICE AMREX_INLINE -void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real T, - Real& DENS, - Real& GAMImean, Real& CHI, Real& TPT, int& LIQSOL, - Real& P, Real& U, Real& S, Real& CV, Real& CHIR, Real& CHIT) +void melange9 (eos_t& state) { // Version 18.04.20 // Difference from v.10.12.14: included switch - off of WK correction @@ -2244,6 +2242,9 @@ void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real T, // CHIR - inverse compressibility - (d ln P / d ln V)_T ("\chi_r") // CHIT = (d ln P / d ln T)_V ("\chi_T") + Real RHO = state.rho; + Real T = state.T; + // Convert temperature to a.u. = 2Ryd = 3.1577e5 K. const Real UN_T6 = 0.3157746_rt; Real Tlg = std::log10(T); @@ -2266,23 +2267,21 @@ void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real T, } // Calculation of average values: - Real zbar = 0.0_rt; + Real zbar = state.zbar; Real z2bar = 0.0_rt; Real Z52 = 0.0_rt; Real Z53 = 0.0_rt; Real Z73 = 0.0_rt; Real Z321 = 0.0_rt; // corr.26.12.09 - Real abar = 0.0_rt; + Real abar = state.abar; for (int i = 0; i < NumSpec; ++i) { - zbar = zbar + AY[i] * AZion[i]; - z2bar = z2bar + AY[i] * AZion[i] * AZion[i]; - Real Z13 = std::pow(AZion[i], C13); - Z53 = Z53 + AY[i] * std::pow(Z13, 5); - Z73 = Z73 + AY[i] * std::pow(Z13, 7); - Z52 = Z52 + AY[i] * std::pow(AZion[i], 2.5_rt); - Z321 = Z321 + AY[i] * AZion[i] * std::pow(AZion[i] + 1.0_rt, 1.5_rt); // 26.12.09 - abar = abar + AY[i] * ACMI[i]; + z2bar = z2bar + state.xn[i] * zion[i] * zion[i]; + Real Z13 = std::pow(zion[i], C13); + Z53 = Z53 + state.xn[i] * std::pow(Z13, 5); + Z73 = Z73 + state.xn[i] * std::pow(Z13, 7); + Z52 = Z52 + state.xn[i] * std::pow(zion[i], 2.5_rt); + Z321 = Z321 + state.xn[i] * zion[i] * std::pow(zion[i] + 1.0_rt, 1.5_rt); // 26.12.09 } // (0) Photons: @@ -2290,7 +2289,8 @@ void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real T, Real PRESSRAD = UINTRAD / 3.0_rt; // (1) ideal electron gas (including relativity and degeneracy) - DENS = RHO / 11.20587 * zbar / abar; // number density of electrons [au] + Real DENS = RHO / 11.20587 * zbar / abar; // number density of electrons [au] + Real CHI; chemfit(DENS, TEMP, CHI); // NB: CHI can be used as true input instead of RHO or DENS @@ -2309,8 +2309,9 @@ void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real T, Real RS = std::pow(0.75_rt / PI / DENS, C13); // r_s - electron density parameter Real RSI = RS * abar * Z73 * AUM; // R_S - ion density parameter Real GAME = 1.0_rt / RS / TEMP; // electron Coulomb parameter Gamma_e - GAMImean = Z53 * GAME; // effective Gamma_i - ion Coulomb parameter + Real GAMImean = Z53 * GAME; // effective Gamma_i - ion Coulomb parameter + Real LIQSOL; if (GAMImean < GAMIMELT || RSI < RSIMELT) { LIQSOL = 0; // liquid regime } @@ -2332,11 +2333,13 @@ void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real T, // Add Coulomb + xc nonideal contributions, and ideal free energy: for (int i = 0; i < NumSpec; ++i) { - if (AY[i] >= TINY) { - Real Zion = AZion[i]; - Real CMI = ACMI[i]; + // Only include species with non-negligible mass number + // and Z >= 1 (to exclude e.g. free neutron species). + if (state.xn[i] >= TINY && zion[i] >= 1.0_rt) { + Real Zion = zion[i]; + Real CMI = aion[i]; Real GAMI = std::pow(Zion, C53) * GAME; // Gamma_i for given ion species - Real DNI = DENSI * AY[i]; // number density of ions of given type + Real DNI = DENSI * state.xn[i]; // number density of ions of given type Real PRI = DNI * TEMP; // = ideal - ions partial pressure (normalization) Real FC1, UC1, PC1, SC1, CV1, PDT1, PDR1; @@ -2348,19 +2351,19 @@ void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real T, // First - order TD functions: UINT = UINT + UC2 * PRI; // internal energy density (e + i + Coul.) - Stot = Stot + DNI * (SC2 - std::log(AY[i])); //entropy per unit volume[a.u.] + Stot = Stot + DNI * (SC2 - std::log(state.xn[i])); //entropy per unit volume[a.u.] PRESS = PRESS + PC2 * PRI; // pressure (e + i + Coul.) [a.u.] // Second - order functions (they take into account compositional changes): CVtot = CVtot + DNI * CV2; // C_V (e + i + Coul.) / V (optim.10.12.14) PDLT = PDLT + PRI * PDT2; // d P / d ln T PDLR = PDLR + PRI * PDR2; // d P / d ln\rho - TPT2 = TPT2 + CTP * DNI / ACMI[i] * AZion[i] * AZion[i]; // opt.10.12.14 + TPT2 = TPT2 + CTP * DNI / aion[i] * zion[i] * zion[i]; // opt.10.12.14 } } // Wigner - Kirkwood perturbative correction for liquid: - TPT = std::sqrt(TPT2); // effective T_p / T - ion quantum parameter + Real TPT = std::sqrt(TPT2); // effective T_p / T - ion quantum parameter // (in the case of a mixture, this estimate is crude) if (LIQSOL == 0) { Real FWK = TPT2 / 24.0_rt * CWK; // Wigner - Kirkwood (quantum diffr.) term @@ -2383,8 +2386,8 @@ void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real T, FMIX = 0.0_rt; for (int i = 0; i < NumSpec; ++i) { for (int j = i+1; j < NumSpec; ++j) { - Real RZ = AZion[j] / AZion[i]; - Real X2 = AY[j] / (AY[i] + AY[j]); + Real RZ = zion[j] / zion[i]; + Real X2 = state.xn[j] / (state.xn[i] + state.xn[j]); Real X1 = std::max(0.0, 1.0_rt - X2); if (X1 < TINY) { @@ -2395,10 +2398,10 @@ void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real T, } Real X = X2 / RZ + (1.0_rt - 1.0_rt / RZ) * std::pow(X2, RZ); - Real GAMI = std::pow(AZion[i], C53) * GAME; // Gamma_i corrected 14.05.13 + Real GAMI = std::pow(zion[i], C53) * GAME; // Gamma_i corrected 14.05.13 Real DeltaG = 0.012_rt * (1.0_rt - 1.0_rt / (RZ * RZ)) * (X1 + X2 * std::pow(RZ, C53)); DeltaG = DeltaG * X / X2 * std::max(0.0_rt, 1.0_rt - X) / X1; - FMIX = FMIX + AY[i] * AY[j] * GAMI * DeltaG; + FMIX = FMIX + state.xn[i] * state.xn[j] * GAMI * DeltaG; } } @@ -2423,9 +2426,9 @@ void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real T, Real SNk = Stot / DENSI; // S / N_i k // Second - order: - CV = CVtot / DENSI; // C_V per ion - CHIR = PDLR / PRESS; // d ln P / d ln\rho - CHIT = PDLT / PRESS; // d ln P / d ln T + Real CV = CVtot / DENSI; // C_V per ion + Real CHIR = PDLR / PRESS; // d ln P / d ln\rho + Real CHIT = PDLT / PRESS; // d ln P / d ln T // Convert to CGS Real Tnk = 8.31447e13_rt / abar * RHO * T6; // n_i kT [erg/cc] @@ -2433,9 +2436,9 @@ void melange9 (Real* AY, Real* AZion, Real* ACMI, Real RHO, Real T, Real N = avo_eos / abar; Real k_B = 1.3806488e-16_rt; - P = PnkT * Tnk; - U = UNkT * N * k_B * T; - S = SNk * N * k_B; + state.p = PnkT * Tnk; + state.e = UNkT * N * k_B * T; + state.s = SNk * N * k_B; } template @@ -2443,11 +2446,18 @@ AMREX_GPU_HOST_DEVICE AMREX_INLINE void actual_eos (I input, T& state) { static_assert(std::is_same::value, "input must be an eos_input_t"); + + if (input == eos_input_rt) { + melange9(state); + } } AMREX_INLINE void actual_eos_init () { + // TODO: + // - Verify that zion is sorted in increasing order + // - Set mintemp, mindens, etc. } AMREX_INLINE From 4fb7b328d130a732f1c4f7c2b680ae1dbc0031ca Mon Sep 17 00:00:00 2001 From: Max Katz Date: Wed, 20 Oct 2021 23:20:19 -0700 Subject: [PATCH 70/70] Revert to original abar/zbar --- EOS/pc/actual_eos.H | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/EOS/pc/actual_eos.H b/EOS/pc/actual_eos.H index c68cfda3d2..4e1adf11c9 100644 --- a/EOS/pc/actual_eos.H +++ b/EOS/pc/actual_eos.H @@ -2267,21 +2267,23 @@ void melange9 (eos_t& state) } // Calculation of average values: - Real zbar = state.zbar; + Real zbar = 0.0_rt; // Note that this is not the same as state.zbar Real z2bar = 0.0_rt; Real Z52 = 0.0_rt; Real Z53 = 0.0_rt; Real Z73 = 0.0_rt; Real Z321 = 0.0_rt; // corr.26.12.09 - Real abar = state.abar; + Real abar = 0.0_rt; // Note that this is not the same as state.abar for (int i = 0; i < NumSpec; ++i) { + zbar = zbar + state.xn[i] * zion[i]; z2bar = z2bar + state.xn[i] * zion[i] * zion[i]; Real Z13 = std::pow(zion[i], C13); Z53 = Z53 + state.xn[i] * std::pow(Z13, 5); Z73 = Z73 + state.xn[i] * std::pow(Z13, 7); Z52 = Z52 + state.xn[i] * std::pow(zion[i], 2.5_rt); Z321 = Z321 + state.xn[i] * zion[i] * std::pow(zion[i] + 1.0_rt, 1.5_rt); // 26.12.09 + abar = abar + state.xn[i] * aion[i]; } // (0) Photons: