├── .gitignore ├── Makefile ├── README.org ├── __init__.py ├── const.dek ├── eosfxt.f90 ├── fig1.png ├── helm_table.dat ├── helm_table_storage.dek ├── helmholtz.f90 ├── helmholtz.py ├── implno.dek ├── pycall.f90 ├── pycall_eosfxt.f90 ├── test.f90 └── vector_eos.dek /.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.so 3 | *.x 4 | 5 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | FC=gfortran 2 | F2PY=f2py 3 | HELM_TABLE_DIR=$(shell pwd) 4 | HELM_TABLE_NAME=helm_table.dat 5 | 6 | all: module 7 | 8 | module: helmholtz.o eosfxt.o 9 | ${F2PY} -m fhelmholtz --fcompiler=${FC} -c pycall.f90 -I helmholtz.o 10 | ${F2PY} -m ftimmes --fcompiler=${FC} -c pycall_eosfxt.f90 -I eosfxt.o 11 | 12 | test: test.o helmholtz.o 13 | ${FC} -o test.x test.o helmholtz.o 14 | ./test.x 15 | 16 | helmholtz.o: helmholtz.f90 const.dek implno.dek vector_eos.dek 17 | ${FC} -cpp -DTBLPATH="'${HELM_TABLE_DIR}/${HELM_TABLE_NAME}'" -ffree-line-length-none -c -fPIC $< 18 | 19 | eosfxt.o: eosfxt.f90 const.dek implno.dek vector_eos.dek 20 | ${FC} -c -fPIC $< 21 | 22 | %.o : %.f90 23 | ${FC} -c $< 24 | 25 | clean: 26 | rm -f *.o *.so *.x 27 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | * python-helmholtz 2 | Python bindings for [[http://cococubed.asu.edu/code_pages/eos.shtml][Frank Timmes' Helmholtz EoS]]. 3 | 4 | This also includes bindings to the Timmes EOS (but only in Rho-T 5 | basis). 6 | 7 | If you use this code, please cite [[https://ui.adsabs.harvard.edu/abs/2000ApJS..126..501T/abstract][Timmes & Swesty (2000)]] and this software 8 | [[https://zenodo.org/badge/latestdoi/12258614][https://zenodo.org/badge/12258614.svg]]. 9 | 10 | ** Prerequisites 11 | You must have numpy and a fortran compiler installed. These bindings 12 | are constructed using [[https://docs.scipy.org/doc/numpy/f2py/index.html][f2py]]. 13 | 14 | This is only tested on python3, though in principle one should be able 15 | to relatively easily adapt it to python2. 16 | ** Installation 17 | Python determines the module name using the path name, so you should 18 | change the root folder of this git repository to helmholtz. For 19 | example, 20 | #+BEGIN_EXAMPLE 21 | git clone git@github.com:jschwab/python-helmholtz.git helmholtz 22 | #+END_EXAMPLE 23 | 24 | The Makefile contains several relevant executable names and paths. 25 | The defaults are sensible, but you might need/want to edit them (for 26 | example, if your system appends "3" to python3 related executables). 27 | #+BEGIN_EXAMPLE 28 | FC=gfortran 29 | F2PY=f2py 30 | HELM_TABLE_DIR=$(shell pwd) 31 | HELM_TABLE_NAME=helm_table.dat 32 | #+END_EXAMPLE 33 | 34 | Then in this directory, simply type 35 | #+BEGIN_EXAMPLE 36 | make module 37 | #+END_EXAMPLE 38 | and then add this directory to your python path 39 | #+BEGIN_EXAMPLE 40 | export PYTHONPATH=/path/to/module:$PYTHONPATH 41 | #+END_EXAMPLE 42 | ** Changes from helmholtz 43 | This code has only cosmetic changes from the version of helmholtz 44 | provided on Frank Timmes website (last updated 2018-12-10). 45 | 46 | + Set ionization variables irowmax and jstagemax to 1 47 | + Set nrowmax to 1,000,000 (allowing large arrays) 48 | + Set path to helm_table.dat at compile time 49 | 50 | At least in theory, updates can be performed by simply untar-ing a new 51 | version of helmholtz and accepting all code changes except for these. 52 | 53 | ** Example 54 | #+BEGIN_SRC python 55 | import numpy as np 56 | import matplotlib.pyplot as plt 57 | 58 | import helmholtz 59 | 60 | d = np.logspace(-3, 11, 512) 61 | ts = [1e8, 1e9, 1e10] 62 | 63 | fig, axs = plt.subplots(3) 64 | 65 | for ax, t in zip(axs, ts): 66 | 67 | f = helmholtz.eosfxt(dens=d, temp=t, abar=1.0, zbar=1.0) 68 | h = helmholtz.helmeos(dens=d, temp=t, abar=1.0, zbar=1.0) 69 | 70 | ax.plot(d, np.abs((h.ptot - f.ptot)/f.ptot)) 71 | ax.set_xlabel(r'$\rho$ (g/cc)') 72 | ax.set_ylabel(r'fractional difference') 73 | ax.set_xscale('log') 74 | ax.set_yscale('log') 75 | ax.set_ylim(1e-12, 1e0) 76 | 77 | logT = int(np.log10(t)) 78 | ax.text(1e-2, 3e-6, '$T = 10^{{{}}}$ K'.format(logT)) 79 | 80 | fig.suptitle('Pressure difference (Timmes vs Helmholtz)') 81 | fig.set_size_inches(6,6) 82 | fig.savefig('fig1.png', dpi=150) 83 | 84 | #+END_SRC 85 | 86 | [[file:fig1.png]] 87 | 88 | ** Author 89 | Josiah Schwab 90 | -------------------------------------------------------------------------------- /__init__.py: -------------------------------------------------------------------------------- 1 | from .helmholtz import helmeos, helmeos_DE, helmeos_DP, helmeos_DS, eosfxt 2 | -------------------------------------------------------------------------------- /const.dek: -------------------------------------------------------------------------------- 1 | 2 | ! mathematical and physical constants (in cgs,except e0 which is in ev) 3 | ! 4 | ! 2006 codata recommended values of the physical constants 5 | ! by coehn & taylor 6 | 7 | 8 | ! math constants 9 | real*8, parameter:: pi = 3.1415926535897932384d0, & 10 | eulercon = 0.577215664901532861d0, & 11 | a2rad = pi/180.0d0, rad2a = 180.0d0/pi 12 | 13 | ! physical constants 14 | real*8, parameter :: g = 6.6742867d-8, & 15 | h = 6.6260689633d-27, & 16 | hbar = 0.5d0 * h/pi, & 17 | qe = 4.8032042712d-10, & 18 | avo = 6.0221417930d23, & 19 | clight = 2.99792458d10, & 20 | kerg = 1.380650424d-16, & 21 | ev2erg = 1.60217648740d-12, & 22 | kev = kerg/ev2erg, & 23 | amu = 1.66053878283d-24, & 24 | mn = 1.67492721184d-24, & 25 | mp = 1.67262163783d-24, & 26 | me = 9.1093821545d-28, & 27 | rbohr = hbar*hbar/(me * qe * qe), & 28 | fine = qe*qe/(hbar*clight), & 29 | hion = 13.605698140d0, & 30 | ssol = 5.6704d-5, & 31 | asol = 4.0d0 * ssol / clight, & 32 | weinlam = h*clight/(kerg * 4.965114232d0), & 33 | weinfre = 2.821439372d0*kerg/h, & 34 | rhonuc = 2.342d14 35 | 36 | 37 | ! astronomical constants 38 | real*8, parameter :: msol = 1.9892d33, & 39 | rsol = 6.95997d10, & 40 | lsol = 3.8268d33, & 41 | mearth = 5.9764d27, & 42 | rearth = 6.37d8, & 43 | ly = 9.460528d17, & 44 | pc = 3.261633d0 * ly, & 45 | au = 1.495978921d13, & 46 | secyer = 3.1558149984d7 47 | -------------------------------------------------------------------------------- /fig1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jschwab/python-helmholtz/8fc5f2be1c18ef8db2a9cde9f449b4e1bd139c5d/fig1.png -------------------------------------------------------------------------------- /helm_table_storage.dek: -------------------------------------------------------------------------------- 1 | ! sizes of the tables 2 | ! normal table, big table, bigger table, denser bigger table 3 | 4 | integer imax,jmax 5 | 6 | ! original 7 | ! parameter (imax = 211, jmax = 71) 8 | 9 | ! standard 10 | ! parameter (imax = 271, jmax = 101) 11 | 12 | ! twice as dense 13 | parameter (imax = 541, jmax = 201) 14 | 15 | ! half as dense 16 | ! parameter (imax = 136, jmax = 51) 17 | 18 | 19 | 20 | ! for the electrons 21 | ! density and temperature 22 | double precision tlo,thi,tstp,tstpi,dlo,dhi,dstp,dstpi 23 | double precision d(imax),t(jmax) 24 | common /dttabc1/ d,t, & 25 | tlo,thi,tstp,tstpi,dlo,dhi,dstp,dstpi 26 | 27 | ! for the helmholtz free energy tables 28 | double precision f(imax,jmax),fd(imax,jmax), & 29 | ft(imax,jmax),fdd(imax,jmax),ftt(imax,jmax), & 30 | fdt(imax,jmax),fddt(imax,jmax),fdtt(imax,jmax), & 31 | fddtt(imax,jmax) 32 | 33 | common /frtabc1/ f,fd, & 34 | ft,fdd,ftt, & 35 | fdt,fddt,fdtt, & 36 | fddtt 37 | 38 | ! for the pressure derivative with density tables 39 | double precision dpdf(imax,jmax),dpdfd(imax,jmax), & 40 | dpdft(imax,jmax),dpdfdt(imax,jmax) 41 | 42 | common /dpdtab1/ dpdf,dpdfd, & 43 | dpdft,dpdfdt 44 | 45 | 46 | ! for chemical potential tables 47 | double precision ef(imax,jmax),efd(imax,jmax), & 48 | eft(imax,jmax),efdt(imax,jmax) 49 | 50 | common /eftabc1/ ef,efd, & 51 | eft,efdt 52 | 53 | 54 | ! for the number density tables 55 | double precision xf(imax,jmax),xfd(imax,jmax), & 56 | xft(imax,jmax),xfdt(imax,jmax) 57 | 58 | common /xftabc1/ xf,xfd, & 59 | xft,xfdt 60 | 61 | 62 | ! for storing the differences 63 | double precision dt_sav(jmax),dt2_sav(jmax), & 64 | dti_sav(jmax),dt2i_sav(jmax),dt3i_sav(jmax), & 65 | dd_sav(imax),dd2_sav(imax), & 66 | ddi_sav(imax),dd2i_sav(imax),dd3i_sav(imax) 67 | 68 | common /diftabc1/dt_sav,dt2_sav, & 69 | dti_sav,dt2i_sav,dt3i_sav, & 70 | dd_sav,dd2_sav, & 71 | ddi_sav,dd2i_sav,dd3i_sav 72 | 73 | 74 | 75 | 76 | ! for the ions 77 | ! density and temperature 78 | double precision tion_lo,tion_hi,tion_stp,tion_stpi, & 79 | dion_lo,dion_hi,dion_stp,dion_stpi 80 | double precision dion(imax),tion(jmax) 81 | common /dttabc2/ dion,tion, & 82 | tion_lo,tion_hi,tion_stp,tion_stpi, & 83 | dion_lo,dion_hi,dion_stp,dion_stpi 84 | 85 | ! for the helmholtz free energy tables 86 | double precision fion(imax,jmax),fiond(imax,jmax), & 87 | fiont(imax,jmax),fiondd(imax,jmax), & 88 | fiontt(imax,jmax),fiondt(imax,jmax), & 89 | fionddt(imax,jmax),fiondtt(imax,jmax), & 90 | fionddtt(imax,jmax) 91 | 92 | common /frtabc2/ fion,fiond, & 93 | fiont,fiondd,fiontt, & 94 | fiondt,fionddt,fiondtt, & 95 | fionddtt 96 | 97 | ! for the pressure derivative with density tables 98 | double precision dpiondf(imax,jmax),dpiondfd(imax,jmax), & 99 | dpiondft(imax,jmax),dpiondfdt(imax,jmax) 100 | 101 | common /dpdtab2/ dpiondf,dpiondfd, & 102 | dpiondft,dpiondfdt 103 | 104 | 105 | ! for chemical potential tables 106 | double precision efion(imax,jmax),efiond(imax,jmax), & 107 | efiont(imax,jmax),efiondt(imax,jmax) 108 | 109 | common /eftabc2/ efion,efiond, & 110 | efiont,efiondt 111 | 112 | 113 | ! for the number density tables 114 | double precision xfion(imax,jmax),xfiond(imax,jmax), & 115 | xfiont(imax,jmax),xfiondt(imax,jmax) 116 | 117 | common /xftabc2/ xfion,xfiond, & 118 | xfiont,xfiondt 119 | 120 | 121 | ! for storing the differences 122 | double precision dt_sav_ion(jmax),dt2_sav_ion(jmax), & 123 | dti_sav_ion(jmax),dt2i_sav_ion(jmax), & 124 | dt3i_sav_ion(jmax),dd_sav_ion(imax), & 125 | dd2_sav_ion(imax),ddi_sav_ion(imax), & 126 | dd2i_sav_ion(imax),dd3i_sav_ion(imax) 127 | 128 | common /diftabc2/dt_sav_ion,dt2_sav_ion, & 129 | dti_sav_ion,dt2i_sav_ion, & 130 | dt3i_sav_ion,dd_sav_ion, & 131 | dd2_sav_ion,ddi_sav_ion, & 132 | dd2i_sav_ion,dd3i_sav_ion 133 | -------------------------------------------------------------------------------- /helmholtz.f90: -------------------------------------------------------------------------------- 1 | program teos 2 | include 'implno.dek' 3 | include 'vector_eos.dek' 4 | 5 | ! tests the eos routine 6 | ! 7 | ! ionmax = number of isotopes in the network 8 | ! xmass = mass fraction of isotope i 9 | ! aion = number of nucleons in isotope i 10 | ! zion = number of protons in isotope i 11 | 12 | integer ionmax 13 | parameter (ionmax=3) 14 | double precision xmass(ionmax),aion(ionmax),zion(ionmax),temp,den,abar,zbar 15 | 16 | 17 | ! set the mass fractions, z's and a's of the composition 18 | ! hydrogen, helium, and carbon 19 | 20 | xmass(1) = 0.75d0 ; aion(1) = 1.0d0 ; zion(1) = 1.0d0 21 | xmass(2) = 0.23d0 ; aion(2) = 4.0d0 ; zion(2) = 2.0d0 22 | xmass(3) = 0.02d0 ; aion(3) = 12.0d0 ; zion(3) = 6.0d0 23 | 24 | ! average atomic weight and charge 25 | abar = 1.0d0/sum(xmass(1:ionmax)/aion(1:ionmax)) 26 | zbar = abar * sum(xmass(1:ionmax) * zion(1:ionmax)/aion(1:ionmax)) 27 | 28 | 29 | ! set the input vector. pipeline is only 1 element long in this example 30 | temp_row(1) = 1.0d8 ; den_row(1) = 1.0d6 ; abar_row(1) = abar ; zbar_row(1) = zbar 31 | jlo_eos = 1 ; jhi_eos = 1 32 | 33 | 34 | ! read the helmholtz free energy data table - only once 35 | call read_helm_table 36 | 37 | ! call the eos 38 | call helmeos 39 | 40 | ! write out the results 41 | call pretty_eos_out('helm: ') 42 | 43 | end 44 | 45 | 46 | 47 | 48 | 49 | 50 | ! here is the tabular helmholtz free energy eos: 51 | ! 52 | ! routine read_helm_table reads an electron helm free energy table 53 | ! routine helmeos computes the pressure, energy and entropy via tables 54 | 55 | 56 | subroutine read_helm_table 57 | include 'implno.dek' 58 | include 'helm_table_storage.dek' 59 | 60 | ! this routine reads the helmholtz eos file, and 61 | ! must be called once before the helmeos routine is invoked. 62 | 63 | ! declare local variables 64 | integer i,j 65 | double precision tsav,dsav,dth,dt2,dti,dt2i,dt3i, & 66 | dd,dd2,ddi,dd2i,dd3i 67 | 68 | 69 | ! open the file (use softlinks to input the desired table) 70 | 71 | open(unit=19,file=TBLPATH,status='old') 72 | 73 | 74 | ! for standard table limits 75 | tlo = 3.0d0 76 | thi = 13.0d0 77 | tstp = (thi - tlo)/float(jmax-1) 78 | tstpi = 1.0d0/tstp 79 | dlo = -12.0d0 80 | dhi = 15.0d0 81 | dstp = (dhi - dlo)/float(imax-1) 82 | dstpi = 1.0d0/dstp 83 | 84 | ! read the helmholtz free energy and its derivatives 85 | do j=1,jmax 86 | tsav = tlo + (j-1)*tstp 87 | t(j) = 10.0d0**(tsav) 88 | do i=1,imax 89 | dsav = dlo + (i-1)*dstp 90 | d(i) = 10.0d0**(dsav) 91 | read(19,*) f(i,j),fd(i,j),ft(i,j),fdd(i,j),ftt(i,j),fdt(i,j), & 92 | fddt(i,j),fdtt(i,j),fddtt(i,j) 93 | enddo 94 | enddo 95 | ! write(6,*) 'read main table' 96 | 97 | 98 | ! read the pressure derivative with density table 99 | do j=1,jmax 100 | do i=1,imax 101 | read(19,*) dpdf(i,j),dpdfd(i,j),dpdft(i,j),dpdfdt(i,j) 102 | enddo 103 | enddo 104 | ! write(6,*) 'read dpdd table' 105 | 106 | ! read the electron chemical potential table 107 | do j=1,jmax 108 | do i=1,imax 109 | read(19,*) ef(i,j),efd(i,j),eft(i,j),efdt(i,j) 110 | enddo 111 | enddo 112 | ! write(6,*) 'read eta table' 113 | 114 | ! read the number density table 115 | do j=1,jmax 116 | do i=1,imax 117 | read(19,*) xf(i,j),xfd(i,j),xft(i,j),xfdt(i,j) 118 | enddo 119 | enddo 120 | ! write(6,*) 'read xne table' 121 | 122 | ! close the file 123 | close(unit=19) 124 | 125 | 126 | ! construct the temperature and density deltas and their inverses 127 | do j=1,jmax-1 128 | dth = t(j+1) - t(j) 129 | dt2 = dth * dth 130 | dti = 1.0d0/dth 131 | dt2i = 1.0d0/dt2 132 | dt3i = dt2i*dti 133 | dt_sav(j) = dth 134 | dt2_sav(j) = dt2 135 | dti_sav(j) = dti 136 | dt2i_sav(j) = dt2i 137 | dt3i_sav(j) = dt3i 138 | end do 139 | do i=1,imax-1 140 | dd = d(i+1) - d(i) 141 | dd2 = dd * dd 142 | ddi = 1.0d0/dd 143 | dd2i = 1.0d0/dd2 144 | dd3i = dd2i*ddi 145 | dd_sav(i) = dd 146 | dd2_sav(i) = dd2 147 | ddi_sav(i) = ddi 148 | dd2i_sav(i) = dd2i 149 | dd3i_sav(i) = dd3i 150 | enddo 151 | 152 | 153 | 154 | ! write(6,*) 155 | ! write(6,*) 'finished reading eos table' 156 | ! write(6,04) 'imax=',imax,' jmax=',jmax 157 | !04 format(1x,4(a,i4)) 158 | ! write(6,03) 'temp(1) =',t(1),' temp(jmax) =',t(jmax) 159 | ! write(6,03) 'ye*den(1) =',d(1),' ye*den(imax) =',d(imax) 160 | !03 format(1x,4(a,1pe11.3)) 161 | ! write(6,*) 162 | 163 | return 164 | end 165 | 166 | 167 | 168 | 169 | 170 | 171 | subroutine read_helm_iontable 172 | include 'implno.dek' 173 | include 'helm_table_storage.dek' 174 | 175 | ! this routine reads the helmholtz eos file, and 176 | ! must be called once before the helmeos routine is invoked. 177 | 178 | ! declare local variables 179 | integer i,j 180 | double precision tsav,dsav,dth,dt2,dti,dt2i,dt3i, & 181 | dd,dd2,ddi,dd2i,dd3i 182 | 183 | 184 | ! open the file (use softlinks to input the desired table) 185 | 186 | open(unit=19,file='helm_iontable.dat',status='old') 187 | 188 | 189 | ! for the standard table 190 | tion_lo = 3.0d0 191 | tion_hi = 13.0d0 192 | tion_stp = (thi - tlo)/float(jmax-1) 193 | tion_stpi = 1.0d0/tstp 194 | dion_lo = -12.0d0 195 | dion_hi = 15.0d0 196 | dion_stp = (dhi - dlo)/float(imax-1) 197 | dion_stpi = 1.0d0/dstp 198 | 199 | ! read the helmholtz free energy and its derivatives 200 | do j=1,jmax 201 | tsav = tion_lo + (j-1)*tion_stp 202 | tion(j) = 10.0d0**(tsav) 203 | do i=1,imax 204 | dsav = dion_lo + (i-1)*dion_stp 205 | dion(i) = 10.0d0**(dsav) 206 | read(19,*) fion(i,j),fiond(i,j),fiont(i,j),fiondd(i,j), & 207 | fiontt(i,j),fiondt(i,j),fionddt(i,j),fiondtt(i,j), & 208 | fionddtt(i,j) 209 | enddo 210 | enddo 211 | 212 | 213 | ! read the pressure derivative with density table 214 | do j=1,jmax 215 | do i=1,imax 216 | read(19,*) dpiondf(i,j),dpiondfd(i,j), & 217 | dpiondft(i,j),dpiondfdt(i,j) 218 | enddo 219 | enddo 220 | 221 | ! read the electron chemical potential table 222 | do j=1,jmax 223 | do i=1,imax 224 | read(19,*) efion(i,j),efiond(i,j),efiont(i,j),efiondt(i,j) 225 | enddo 226 | enddo 227 | 228 | ! read the number density table 229 | do j=1,jmax 230 | do i=1,imax 231 | read(19,*) xfion(i,j),xfiond(i,j),xfiont(i,j),xfiondt(i,j) 232 | enddo 233 | enddo 234 | 235 | ! close the file 236 | close(unit=19) 237 | 238 | 239 | ! construct the temperature and density deltas and their inverses 240 | do j=1,jmax-1 241 | dth = t(j+1) - t(j) 242 | dt2 = dth * dth 243 | dti = 1.0d0/dth 244 | dt2i = 1.0d0/dt2 245 | dt3i = dt2i*dti 246 | dt_sav_ion(j) = dth 247 | dt2_sav_ion(j) = dt2 248 | dti_sav_ion(j) = dti 249 | dt2i_sav_ion(j) = dt2i 250 | dt3i_sav_ion(j) = dt3i 251 | end do 252 | do i=1,imax-1 253 | dd = d(i+1) - d(i) 254 | dd2 = dd * dd 255 | ddi = 1.0d0/dd 256 | dd2i = 1.0d0/dd2 257 | dd3i = dd2i*ddi 258 | dd_sav_ion(i) = dd 259 | dd2_sav_ion(i) = dd2 260 | ddi_sav_ion(i) = ddi 261 | dd2i_sav_ion(i) = dd2i 262 | dd3i_sav_ion(i) = dd3i 263 | enddo 264 | 265 | 266 | ! write(6,*) 267 | ! write(6,*) 'finished reading eos ion table' 268 | ! write(6,04) 'imax=',imax,' jmax=',jmax 269 | !04 format(1x,4(a,i4)) 270 | ! write(6,03) 'temp(1) =',tion(1),' temp(jmax) =',tion(jmax) 271 | ! write(6,03) 'ytot*den(1) =',dion(1),' ytot*den(imax) =',dion(imax) 272 | !03 format(1x,4(a,1pe11.3)) 273 | ! write(6,*) 274 | 275 | return 276 | end 277 | 278 | 279 | 280 | 281 | subroutine helmeos 282 | include 'implno.dek' 283 | include 'const.dek' 284 | include 'vector_eos.dek' 285 | include 'helm_table_storage.dek' 286 | 287 | 288 | ! given a temperature temp [K], density den [g/cm**3], and a composition 289 | ! characterized by abar and zbar, this routine returns most of the other 290 | ! thermodynamic quantities. of prime interest is the pressure [erg/cm**3], 291 | ! specific thermal energy [erg/gr], the entropy [erg/g/K], along with 292 | ! their derivatives with respect to temperature, density, abar, and zbar. 293 | ! other quantites such the normalized chemical potential eta (plus its 294 | ! derivatives), number density of electrons and positron pair (along 295 | ! with their derivatives), adiabatic indices, specific heats, and 296 | ! relativistically correct sound speed are also returned. 297 | ! 298 | ! this routine assumes planckian photons, an ideal gas of ions, 299 | ! and an electron-positron gas with an arbitrary degree of relativity 300 | ! and degeneracy. interpolation in a table of the helmholtz free energy 301 | ! is used to return the electron-positron thermodynamic quantities. 302 | ! all other derivatives are analytic. 303 | ! 304 | ! references: cox & giuli chapter 24 ; timmes & swesty apj 1999 305 | 306 | 307 | ! declare 308 | integer i,j 309 | double precision temp,den,abar,zbar,ytot1,ye, & 310 | x,y,zz,zzi,deni,tempi,xni,dxnidd,dxnida, & 311 | dpepdt,dpepdd,deepdt,deepdd,dsepdd,dsepdt, & 312 | dpraddd,dpraddt,deraddd,deraddt,dpiondd,dpiondt, & 313 | deiondd,deiondt,dsraddd,dsraddt,dsiondd,dsiondt, & 314 | dse,dpe,dsp,kt,ktinv,prad,erad,srad,pion,eion, & 315 | sion,xnem,pele,eele,sele,pres,ener,entr,dpresdd, & 316 | dpresdt,denerdd,denerdt,dentrdd,dentrdt,cv,cp, & 317 | gam1,gam2,gam3,chit,chid,nabad,sound,etaele, & 318 | detadt,detadd,xnefer,dxnedt,dxnedd,s 319 | 320 | double precision pgas,dpgasdd,dpgasdt,dpgasda,dpgasdz, & 321 | egas,degasdd,degasdt,degasda,degasdz, & 322 | sgas,dsgasdd,dsgasdt,dsgasda,dsgasdz, & 323 | cv_gas,cp_gas,gam1_gas,gam2_gas,gam3_gas, & 324 | chit_gas,chid_gas,nabad_gas,sound_gas 325 | 326 | 327 | double precision sioncon,forth,forpi,kergavo,ikavo,asoli3,light2 328 | parameter (sioncon = (2.0d0 * pi * amu * kerg)/(h*h), & 329 | forth = 4.0d0/3.0d0, & 330 | forpi = 4.0d0 * pi, & 331 | kergavo = kerg * avo, & 332 | ikavo = 1.0d0/kergavo, & 333 | asoli3 = asol/3.0d0, & 334 | light2 = clight * clight) 335 | 336 | ! for the abar derivatives 337 | double precision dpradda,deradda,dsradda, & 338 | dpionda,deionda,dsionda, & 339 | dpepda,deepda,dsepda, & 340 | dpresda,denerda,dentrda, & 341 | detada,dxneda 342 | 343 | ! for the zbar derivatives 344 | double precision dpraddz,deraddz,dsraddz, & 345 | dpiondz,deiondz,dsiondz, & 346 | dpepdz,deepdz,dsepdz, & 347 | dpresdz,denerdz,dentrdz, & 348 | detadz,dxnedz 349 | 350 | ! for the interpolations 351 | integer iat,jat 352 | double precision free,df_d,df_t,df_dd,df_tt,df_dt 353 | double precision xt,xd,mxt,mxd, & 354 | si0t,si1t,si2t,si0mt,si1mt,si2mt, & 355 | si0d,si1d,si2d,si0md,si1md,si2md, & 356 | dsi0t,dsi1t,dsi2t,dsi0mt,dsi1mt,dsi2mt, & 357 | dsi0d,dsi1d,dsi2d,dsi0md,dsi1md,dsi2md, & 358 | ddsi0t,ddsi1t,ddsi2t,ddsi0mt,ddsi1mt,ddsi2mt, & 359 | ddsi0d,ddsi1d,ddsi2d,ddsi0md,ddsi1md,ddsi2md, & 360 | z,psi0,dpsi0,ddpsi0,psi1,dpsi1,ddpsi1,psi2, & 361 | dpsi2,ddpsi2,din,h5,fi(36), & 362 | xpsi0,xdpsi0,xpsi1,xdpsi1,h3, & 363 | w0t,w1t,w2t,w0mt,w1mt,w2mt, & 364 | w0d,w1d,w2d,w0md,w1md,w2md 365 | 366 | 367 | ! for the uniform background coulomb correction 368 | double precision dsdd,dsda,lami,inv_lami,lamida,lamidd, & 369 | plasg,plasgdd,plasgdt,plasgda,plasgdz, & 370 | ecoul,decouldd,decouldt,decoulda,decouldz, & 371 | pcoul,dpcouldd,dpcouldt,dpcoulda,dpcouldz, & 372 | scoul,dscouldd,dscouldt,dscoulda,dscouldz, & 373 | a1,b1,c1,d1,e1,a2,b2,c2,third,esqu 374 | parameter (a1 = -0.898004d0, & 375 | b1 = 0.96786d0, & 376 | c1 = 0.220703d0, & 377 | d1 = -0.86097d0, & 378 | e1 = 2.5269d0, & 379 | a2 = 0.29561d0, & 380 | b2 = 1.9885d0, & 381 | c2 = 0.288675d0, & 382 | third = 1.0d0/3.0d0, & 383 | esqu = qe * qe) 384 | 385 | 386 | ! quintic hermite polynomial statement functions 387 | ! psi0 and its derivatives 388 | psi0(z) = z**3 * ( z * (-6.0d0*z + 15.0d0) -10.0d0) + 1.0d0 389 | dpsi0(z) = z**2 * ( z * (-30.0d0*z + 60.0d0) - 30.0d0) 390 | ddpsi0(z) = z* ( z*( -120.0d0*z + 180.0d0) -60.0d0) 391 | 392 | 393 | ! psi1 and its derivatives 394 | psi1(z) = z* ( z**2 * ( z * (-3.0d0*z + 8.0d0) - 6.0d0) + 1.0d0) 395 | dpsi1(z) = z*z * ( z * (-15.0d0*z + 32.0d0) - 18.0d0) +1.0d0 396 | ddpsi1(z) = z * (z * (-60.0d0*z + 96.0d0) -36.0d0) 397 | 398 | 399 | ! psi2 and its derivatives 400 | psi2(z) = 0.5d0*z*z*( z* ( z * (-z + 3.0d0) - 3.0d0) + 1.0d0) 401 | dpsi2(z) = 0.5d0*z*( z*(z*(-5.0d0*z + 12.0d0) - 9.0d0) + 2.0d0) 402 | ddpsi2(z) = 0.5d0*(z*( z * (-20.0d0*z + 36.0d0) - 18.0d0) + 2.0d0) 403 | 404 | 405 | ! biquintic hermite polynomial statement function 406 | h5(i,j,w0t,w1t,w2t,w0mt,w1mt,w2mt,w0d,w1d,w2d,w0md,w1md,w2md)= & 407 | fi(1) *w0d*w0t + fi(2) *w0md*w0t & 408 | + fi(3) *w0d*w0mt + fi(4) *w0md*w0mt & 409 | + fi(5) *w0d*w1t + fi(6) *w0md*w1t & 410 | + fi(7) *w0d*w1mt + fi(8) *w0md*w1mt & 411 | + fi(9) *w0d*w2t + fi(10) *w0md*w2t & 412 | + fi(11) *w0d*w2mt + fi(12) *w0md*w2mt & 413 | + fi(13) *w1d*w0t + fi(14) *w1md*w0t & 414 | + fi(15) *w1d*w0mt + fi(16) *w1md*w0mt & 415 | + fi(17) *w2d*w0t + fi(18) *w2md*w0t & 416 | + fi(19) *w2d*w0mt + fi(20) *w2md*w0mt & 417 | + fi(21) *w1d*w1t + fi(22) *w1md*w1t & 418 | + fi(23) *w1d*w1mt + fi(24) *w1md*w1mt & 419 | + fi(25) *w2d*w1t + fi(26) *w2md*w1t & 420 | + fi(27) *w2d*w1mt + fi(28) *w2md*w1mt & 421 | + fi(29) *w1d*w2t + fi(30) *w1md*w2t & 422 | + fi(31) *w1d*w2mt + fi(32) *w1md*w2mt & 423 | + fi(33) *w2d*w2t + fi(34) *w2md*w2t & 424 | + fi(35) *w2d*w2mt + fi(36) *w2md*w2mt 425 | 426 | 427 | 428 | ! cubic hermite polynomial statement functions 429 | ! psi0 & derivatives 430 | xpsi0(z) = z * z * (2.0d0*z - 3.0d0) + 1.0 431 | xdpsi0(z) = z * (6.0d0*z - 6.0d0) 432 | 433 | 434 | ! psi1 & derivatives 435 | xpsi1(z) = z * ( z * (z - 2.0d0) + 1.0d0) 436 | xdpsi1(z) = z * (3.0d0*z - 4.0d0) + 1.0d0 437 | 438 | 439 | ! bicubic hermite polynomial statement function 440 | h3(i,j,w0t,w1t,w0mt,w1mt,w0d,w1d,w0md,w1md) = & 441 | fi(1) *w0d*w0t + fi(2) *w0md*w0t & 442 | + fi(3) *w0d*w0mt + fi(4) *w0md*w0mt & 443 | + fi(5) *w0d*w1t + fi(6) *w0md*w1t & 444 | + fi(7) *w0d*w1mt + fi(8) *w0md*w1mt & 445 | + fi(9) *w1d*w0t + fi(10) *w1md*w0t & 446 | + fi(11) *w1d*w0mt + fi(12) *w1md*w0mt & 447 | + fi(13) *w1d*w1t + fi(14) *w1md*w1t & 448 | + fi(15) *w1d*w1mt + fi(16) *w1md*w1mt 449 | 450 | 451 | 452 | ! popular format statements 453 | 01 format(1x,5(a,1pe11.3)) 454 | 02 format(1x,a,1p4e16.8) 455 | 03 format(1x,4(a,1pe11.3)) 456 | 04 format(1x,4(a,i4)) 457 | 458 | 459 | 460 | ! start of pipeline loop, normal execution starts here 461 | eosfail = .false. 462 | do j=jlo_eos,jhi_eos 463 | 464 | ! if (temp_row(j) .le. 0.0) stop 'temp less than 0 in helmeos' 465 | ! if (den_row(j) .le. 0.0) stop 'den less than 0 in helmeos' 466 | 467 | temp = temp_row(j) 468 | den = den_row(j) 469 | abar = abar_row(j) 470 | zbar = zbar_row(j) 471 | ytot1 = 1.0d0/abar 472 | ye = max(1.0d-16,ytot1 * zbar) 473 | 474 | 475 | 476 | ! initialize 477 | deni = 1.0d0/den 478 | tempi = 1.0d0/temp 479 | kt = kerg * temp 480 | ktinv = 1.0d0/kt 481 | 482 | 483 | ! radiation section: 484 | prad = asoli3 * temp * temp * temp * temp 485 | dpraddd = 0.0d0 486 | dpraddt = 4.0d0 * prad*tempi 487 | dpradda = 0.0d0 488 | dpraddz = 0.0d0 489 | 490 | erad = 3.0d0 * prad*deni 491 | deraddd = -erad*deni 492 | deraddt = 3.0d0 * dpraddt*deni 493 | deradda = 0.0d0 494 | deraddz = 0.0d0 495 | 496 | srad = (prad*deni + erad)*tempi 497 | dsraddd = (dpraddd*deni - prad*deni*deni + deraddd)*tempi 498 | dsraddt = (dpraddt*deni + deraddt - srad)*tempi 499 | dsradda = 0.0d0 500 | dsraddz = 0.0d0 501 | 502 | 503 | ! ion section: 504 | xni = avo * ytot1 * den 505 | dxnidd = avo * ytot1 506 | dxnida = -xni * ytot1 507 | 508 | pion = xni * kt 509 | dpiondd = dxnidd * kt 510 | dpiondt = xni * kerg 511 | dpionda = dxnida * kt 512 | dpiondz = 0.0d0 513 | 514 | eion = 1.5d0 * pion*deni 515 | deiondd = (1.5d0 * dpiondd - eion)*deni 516 | deiondt = 1.5d0 * dpiondt*deni 517 | deionda = 1.5d0 * dpionda*deni 518 | deiondz = 0.0d0 519 | 520 | 521 | ! sackur-tetrode equation for the ion entropy of 522 | ! a single ideal gas characterized by abar 523 | x = abar*abar*sqrt(abar) * deni/avo 524 | s = sioncon * temp 525 | z = x * s * sqrt(s) 526 | y = log(z) 527 | 528 | ! y = 1.0d0/(abar*kt) 529 | ! yy = y * sqrt(y) 530 | ! z = xni * sifac * yy 531 | ! etaion = log(z) 532 | 533 | 534 | sion = (pion*deni + eion)*tempi + kergavo * ytot1 * y 535 | dsiondd = (dpiondd*deni - pion*deni*deni + deiondd)*tempi & 536 | - kergavo * deni * ytot1 537 | dsiondt = (dpiondt*deni + deiondt)*tempi - & 538 | (pion*deni + eion) * tempi*tempi & 539 | + 1.5d0 * kergavo * tempi*ytot1 540 | x = avo*kerg/abar 541 | dsionda = (dpionda*deni + deionda)*tempi & 542 | + kergavo*ytot1*ytot1* (2.5d0 - y) 543 | dsiondz = 0.0d0 544 | 545 | 546 | 547 | ! electron-positron section: 548 | 549 | 550 | ! assume complete ionization 551 | xnem = xni * zbar 552 | 553 | 554 | ! enter the table with ye*den 555 | din = ye*den 556 | 557 | 558 | ! bomb proof the input 559 | if (temp .gt. t(jmax)) then 560 | write(6,01) 'temp=',temp,' t(jmax)=',t(jmax) 561 | write(6,*) 'temp too hot, off grid' 562 | write(6,*) 'setting eosfail to true and returning' 563 | eosfail = .true. 564 | return 565 | end if 566 | if (temp .lt. t(1)) then 567 | write(6,01) 'temp=',temp,' t(1)=',t(1) 568 | write(6,*) 'temp too cold, off grid' 569 | write(6,*) 'setting eosfail to true and returning' 570 | eosfail = .true. 571 | return 572 | end if 573 | if (din .gt. d(imax)) then 574 | write(6,01) 'den*ye=',din,' d(imax)=',d(imax) 575 | write(6,*) 'ye*den too big, off grid' 576 | write(6,*) 'setting eosfail to true and returning' 577 | eosfail = .true. 578 | return 579 | end if 580 | if (din .lt. d(1)) then 581 | write(6,01) 'ye*den=',din,' d(1)=',d(1) 582 | write(6,*) 'ye*den too small, off grid' 583 | write(6,*) 'setting eosfail to true and returning' 584 | eosfail = .true. 585 | return 586 | end if 587 | 588 | ! hash locate this temperature and density 589 | jat = int((log10(temp) - tlo)*tstpi) + 1 590 | jat = max(1,min(jat,jmax-1)) 591 | iat = int((log10(din) - dlo)*dstpi) + 1 592 | iat = max(1,min(iat,imax-1)) 593 | 594 | 595 | ! access the table locations only once 596 | fi(1) = f(iat,jat) 597 | fi(2) = f(iat+1,jat) 598 | fi(3) = f(iat,jat+1) 599 | fi(4) = f(iat+1,jat+1) 600 | fi(5) = ft(iat,jat) 601 | fi(6) = ft(iat+1,jat) 602 | fi(7) = ft(iat,jat+1) 603 | fi(8) = ft(iat+1,jat+1) 604 | fi(9) = ftt(iat,jat) 605 | fi(10) = ftt(iat+1,jat) 606 | fi(11) = ftt(iat,jat+1) 607 | fi(12) = ftt(iat+1,jat+1) 608 | fi(13) = fd(iat,jat) 609 | fi(14) = fd(iat+1,jat) 610 | fi(15) = fd(iat,jat+1) 611 | fi(16) = fd(iat+1,jat+1) 612 | fi(17) = fdd(iat,jat) 613 | fi(18) = fdd(iat+1,jat) 614 | fi(19) = fdd(iat,jat+1) 615 | fi(20) = fdd(iat+1,jat+1) 616 | fi(21) = fdt(iat,jat) 617 | fi(22) = fdt(iat+1,jat) 618 | fi(23) = fdt(iat,jat+1) 619 | fi(24) = fdt(iat+1,jat+1) 620 | fi(25) = fddt(iat,jat) 621 | fi(26) = fddt(iat+1,jat) 622 | fi(27) = fddt(iat,jat+1) 623 | fi(28) = fddt(iat+1,jat+1) 624 | fi(29) = fdtt(iat,jat) 625 | fi(30) = fdtt(iat+1,jat) 626 | fi(31) = fdtt(iat,jat+1) 627 | fi(32) = fdtt(iat+1,jat+1) 628 | fi(33) = fddtt(iat,jat) 629 | fi(34) = fddtt(iat+1,jat) 630 | fi(35) = fddtt(iat,jat+1) 631 | fi(36) = fddtt(iat+1,jat+1) 632 | 633 | 634 | ! various differences 635 | xt = max( (temp - t(jat))*dti_sav(jat), 0.0d0) 636 | xd = max( (din - d(iat))*ddi_sav(iat), 0.0d0) 637 | mxt = 1.0d0 - xt 638 | mxd = 1.0d0 - xd 639 | 640 | ! the six density and six temperature basis functions 641 | si0t = psi0(xt) 642 | si1t = psi1(xt)*dt_sav(jat) 643 | si2t = psi2(xt)*dt2_sav(jat) 644 | 645 | si0mt = psi0(mxt) 646 | si1mt = -psi1(mxt)*dt_sav(jat) 647 | si2mt = psi2(mxt)*dt2_sav(jat) 648 | 649 | si0d = psi0(xd) 650 | si1d = psi1(xd)*dd_sav(iat) 651 | si2d = psi2(xd)*dd2_sav(iat) 652 | 653 | si0md = psi0(mxd) 654 | si1md = -psi1(mxd)*dd_sav(iat) 655 | si2md = psi2(mxd)*dd2_sav(iat) 656 | 657 | ! derivatives of the weight functions 658 | dsi0t = dpsi0(xt)*dti_sav(jat) 659 | dsi1t = dpsi1(xt) 660 | dsi2t = dpsi2(xt)*dt_sav(jat) 661 | 662 | dsi0mt = -dpsi0(mxt)*dti_sav(jat) 663 | dsi1mt = dpsi1(mxt) 664 | dsi2mt = -dpsi2(mxt)*dt_sav(jat) 665 | 666 | dsi0d = dpsi0(xd)*ddi_sav(iat) 667 | dsi1d = dpsi1(xd) 668 | dsi2d = dpsi2(xd)*dd_sav(iat) 669 | 670 | dsi0md = -dpsi0(mxd)*ddi_sav(iat) 671 | dsi1md = dpsi1(mxd) 672 | dsi2md = -dpsi2(mxd)*dd_sav(iat) 673 | 674 | ! second derivatives of the weight functions 675 | ddsi0t = ddpsi0(xt)*dt2i_sav(jat) 676 | ddsi1t = ddpsi1(xt)*dti_sav(jat) 677 | ddsi2t = ddpsi2(xt) 678 | 679 | ddsi0mt = ddpsi0(mxt)*dt2i_sav(jat) 680 | ddsi1mt = -ddpsi1(mxt)*dti_sav(jat) 681 | ddsi2mt = ddpsi2(mxt) 682 | 683 | ! ddsi0d = ddpsi0(xd)*dd2i_sav(iat) 684 | ! ddsi1d = ddpsi1(xd)*ddi_sav(iat) 685 | ! ddsi2d = ddpsi2(xd) 686 | 687 | ! ddsi0md = ddpsi0(mxd)*dd2i_sav(iat) 688 | ! ddsi1md = -ddpsi1(mxd)*ddi_sav(iat) 689 | ! ddsi2md = ddpsi2(mxd) 690 | 691 | 692 | ! the free energy 693 | free = h5(iat,jat, & 694 | si0t, si1t, si2t, si0mt, si1mt, si2mt, & 695 | si0d, si1d, si2d, si0md, si1md, si2md) 696 | 697 | ! derivative with respect to density 698 | df_d = h5(iat,jat, & 699 | si0t, si1t, si2t, si0mt, si1mt, si2mt, & 700 | dsi0d, dsi1d, dsi2d, dsi0md, dsi1md, dsi2md) 701 | 702 | 703 | ! derivative with respect to temperature 704 | df_t = h5(iat,jat, & 705 | dsi0t, dsi1t, dsi2t, dsi0mt, dsi1mt, dsi2mt, & 706 | si0d, si1d, si2d, si0md, si1md, si2md) 707 | 708 | ! derivative with respect to density**2 709 | ! df_dd = h5(iat,jat, 710 | ! 1 si0t, si1t, si2t, si0mt, si1mt, si2mt, 711 | ! 2 ddsi0d, ddsi1d, ddsi2d, ddsi0md, ddsi1md, ddsi2md) 712 | 713 | ! derivative with respect to temperature**2 714 | df_tt = h5(iat,jat, & 715 | ddsi0t, ddsi1t, ddsi2t, ddsi0mt, ddsi1mt, ddsi2mt, & 716 | si0d, si1d, si2d, si0md, si1md, si2md) 717 | 718 | ! derivative with respect to temperature and density 719 | df_dt = h5(iat,jat, & 720 | dsi0t, dsi1t, dsi2t, dsi0mt, dsi1mt, dsi2mt, & 721 | dsi0d, dsi1d, dsi2d, dsi0md, dsi1md, dsi2md) 722 | 723 | 724 | 725 | ! now get the pressure derivative with density, chemical potential, and 726 | ! electron positron number densities 727 | ! get the interpolation weight functions 728 | si0t = xpsi0(xt) 729 | si1t = xpsi1(xt)*dt_sav(jat) 730 | 731 | si0mt = xpsi0(mxt) 732 | si1mt = -xpsi1(mxt)*dt_sav(jat) 733 | 734 | si0d = xpsi0(xd) 735 | si1d = xpsi1(xd)*dd_sav(iat) 736 | 737 | si0md = xpsi0(mxd) 738 | si1md = -xpsi1(mxd)*dd_sav(iat) 739 | 740 | 741 | ! derivatives of weight functions 742 | dsi0t = xdpsi0(xt)*dti_sav(jat) 743 | dsi1t = xdpsi1(xt) 744 | 745 | dsi0mt = -xdpsi0(mxt)*dti_sav(jat) 746 | dsi1mt = xdpsi1(mxt) 747 | 748 | dsi0d = xdpsi0(xd)*ddi_sav(iat) 749 | dsi1d = xdpsi1(xd) 750 | 751 | dsi0md = -xdpsi0(mxd)*ddi_sav(iat) 752 | dsi1md = xdpsi1(mxd) 753 | 754 | 755 | ! look in the pressure derivative only once 756 | fi(1) = dpdf(iat,jat) 757 | fi(2) = dpdf(iat+1,jat) 758 | fi(3) = dpdf(iat,jat+1) 759 | fi(4) = dpdf(iat+1,jat+1) 760 | fi(5) = dpdft(iat,jat) 761 | fi(6) = dpdft(iat+1,jat) 762 | fi(7) = dpdft(iat,jat+1) 763 | fi(8) = dpdft(iat+1,jat+1) 764 | fi(9) = dpdfd(iat,jat) 765 | fi(10) = dpdfd(iat+1,jat) 766 | fi(11) = dpdfd(iat,jat+1) 767 | fi(12) = dpdfd(iat+1,jat+1) 768 | fi(13) = dpdfdt(iat,jat) 769 | fi(14) = dpdfdt(iat+1,jat) 770 | fi(15) = dpdfdt(iat,jat+1) 771 | fi(16) = dpdfdt(iat+1,jat+1) 772 | 773 | ! pressure derivative with density 774 | dpepdd = h3(iat,jat, & 775 | si0t, si1t, si0mt, si1mt, & 776 | si0d, si1d, si0md, si1md) 777 | dpepdd = max(ye * dpepdd,1.0d-30) 778 | 779 | 780 | 781 | ! look in the electron chemical potential table only once 782 | fi(1) = ef(iat,jat) 783 | fi(2) = ef(iat+1,jat) 784 | fi(3) = ef(iat,jat+1) 785 | fi(4) = ef(iat+1,jat+1) 786 | fi(5) = eft(iat,jat) 787 | fi(6) = eft(iat+1,jat) 788 | fi(7) = eft(iat,jat+1) 789 | fi(8) = eft(iat+1,jat+1) 790 | fi(9) = efd(iat,jat) 791 | fi(10) = efd(iat+1,jat) 792 | fi(11) = efd(iat,jat+1) 793 | fi(12) = efd(iat+1,jat+1) 794 | fi(13) = efdt(iat,jat) 795 | fi(14) = efdt(iat+1,jat) 796 | fi(15) = efdt(iat,jat+1) 797 | fi(16) = efdt(iat+1,jat+1) 798 | 799 | 800 | ! electron chemical potential etaele 801 | etaele = h3(iat,jat, & 802 | si0t, si1t, si0mt, si1mt, & 803 | si0d, si1d, si0md, si1md) 804 | 805 | 806 | ! derivative with respect to density 807 | x = h3(iat,jat, & 808 | si0t, si1t, si0mt, si1mt, & 809 | dsi0d, dsi1d, dsi0md, dsi1md) 810 | detadd = ye * x 811 | 812 | ! derivative with respect to temperature 813 | detadt = h3(iat,jat, & 814 | dsi0t, dsi1t, dsi0mt, dsi1mt, & 815 | si0d, si1d, si0md, si1md) 816 | 817 | ! derivative with respect to abar and zbar 818 | detada = -x * din * ytot1 819 | detadz = x * den * ytot1 820 | 821 | 822 | 823 | ! look in the number density table only once 824 | fi(1) = xf(iat,jat) 825 | fi(2) = xf(iat+1,jat) 826 | fi(3) = xf(iat,jat+1) 827 | fi(4) = xf(iat+1,jat+1) 828 | fi(5) = xft(iat,jat) 829 | fi(6) = xft(iat+1,jat) 830 | fi(7) = xft(iat,jat+1) 831 | fi(8) = xft(iat+1,jat+1) 832 | fi(9) = xfd(iat,jat) 833 | fi(10) = xfd(iat+1,jat) 834 | fi(11) = xfd(iat,jat+1) 835 | fi(12) = xfd(iat+1,jat+1) 836 | fi(13) = xfdt(iat,jat) 837 | fi(14) = xfdt(iat+1,jat) 838 | fi(15) = xfdt(iat,jat+1) 839 | fi(16) = xfdt(iat+1,jat+1) 840 | 841 | ! electron + positron number densities 842 | xnefer = h3(iat,jat, & 843 | si0t, si1t, si0mt, si1mt, & 844 | si0d, si1d, si0md, si1md) 845 | 846 | ! derivative with respect to density 847 | x = h3(iat,jat, & 848 | si0t, si1t, si0mt, si1mt, & 849 | dsi0d, dsi1d, dsi0md, dsi1md) 850 | x = max(x,1.0d-30) 851 | dxnedd = ye * x 852 | 853 | ! derivative with respect to temperature 854 | dxnedt = h3(iat,jat, & 855 | dsi0t, dsi1t, dsi0mt, dsi1mt, & 856 | si0d, si1d, si0md, si1md) 857 | 858 | ! derivative with respect to abar and zbar 859 | dxneda = -x * din * ytot1 860 | dxnedz = x * den * ytot1 861 | 862 | 863 | ! the desired electron-positron thermodynamic quantities 864 | 865 | ! dpepdd at high temperatures and low densities is below the 866 | ! floating point limit of the subtraction of two large terms. 867 | ! since dpresdd doesn't enter the maxwell relations at all, use the 868 | ! bicubic interpolation done above instead of the formally correct expression 869 | x = din * din 870 | pele = x * df_d 871 | dpepdt = x * df_dt 872 | ! dpepdd = ye * (x * df_dd + 2.0d0 * din * df_d) 873 | s = dpepdd/ye - 2.0d0 * din * df_d 874 | dpepda = -ytot1 * (2.0d0 * pele + s * din) 875 | dpepdz = den*ytot1*(2.0d0 * din * df_d + s) 876 | 877 | 878 | x = ye * ye 879 | sele = -df_t * ye 880 | dsepdt = -df_tt * ye 881 | dsepdd = -df_dt * x 882 | dsepda = ytot1 * (ye * df_dt * din - sele) 883 | dsepdz = -ytot1 * (ye * df_dt * den + df_t) 884 | 885 | 886 | eele = ye*free + temp * sele 887 | deepdt = temp * dsepdt 888 | deepdd = x * df_d + temp * dsepdd 889 | deepda = -ye * ytot1 * (free + df_d * din) + temp * dsepda 890 | deepdz = ytot1* (free + ye * df_d * den) + temp * dsepdz 891 | 892 | 893 | 894 | 895 | ! coulomb section: 896 | 897 | ! uniform background corrections only 898 | ! from yakovlev & shalybkov 1989 899 | ! lami is the average ion seperation 900 | ! plasg is the plasma coupling parameter 901 | 902 | z = forth * pi 903 | s = z * xni 904 | dsdd = z * dxnidd 905 | dsda = z * dxnida 906 | 907 | lami = 1.0d0/s**third 908 | inv_lami = 1.0d0/lami 909 | z = -third * lami 910 | lamidd = z * dsdd/s 911 | lamida = z * dsda/s 912 | 913 | plasg = zbar*zbar*esqu*ktinv*inv_lami 914 | z = -plasg * inv_lami 915 | plasgdd = z * lamidd 916 | plasgda = z * lamida 917 | plasgdt = -plasg*ktinv * kerg 918 | plasgdz = 2.0d0 * plasg/zbar 919 | 920 | 921 | ! yakovlev & shalybkov 1989 equations 82, 85, 86, 87 922 | if (plasg .ge. 1.0) then 923 | x = plasg**(0.25d0) 924 | y = avo * ytot1 * kerg 925 | ecoul = y * temp * (a1*plasg + b1*x + c1/x + d1) 926 | pcoul = third * den * ecoul 927 | scoul = -y * (3.0d0*b1*x - 5.0d0*c1/x & 928 | + d1 * (log(plasg) - 1.0d0) - e1) 929 | 930 | y = avo*ytot1*kt*(a1 + 0.25d0/plasg*(b1*x - c1/x)) 931 | decouldd = y * plasgdd 932 | decouldt = y * plasgdt + ecoul/temp 933 | decoulda = y * plasgda - ecoul/abar 934 | decouldz = y * plasgdz 935 | 936 | y = third * den 937 | dpcouldd = third * ecoul + y*decouldd 938 | dpcouldt = y * decouldt 939 | dpcoulda = y * decoulda 940 | dpcouldz = y * decouldz 941 | 942 | 943 | y = -avo*kerg/(abar*plasg)*(0.75d0*b1*x+1.25d0*c1/x+d1) 944 | dscouldd = y * plasgdd 945 | dscouldt = y * plasgdt 946 | dscoulda = y * plasgda - scoul/abar 947 | dscouldz = y * plasgdz 948 | 949 | 950 | ! yakovlev & shalybkov 1989 equations 102, 103, 104 951 | else if (plasg .lt. 1.0) then 952 | x = plasg*sqrt(plasg) 953 | y = plasg**b2 954 | z = c2 * x - third * a2 * y 955 | pcoul = -pion * z 956 | ecoul = 3.0d0 * pcoul/den 957 | scoul = -avo/abar*kerg*(c2*x -a2*(b2-1.0d0)/b2*y) 958 | 959 | s = 1.5d0*c2*x/plasg - third*a2*b2*y/plasg 960 | dpcouldd = -dpiondd*z - pion*s*plasgdd 961 | dpcouldt = -dpiondt*z - pion*s*plasgdt 962 | dpcoulda = -dpionda*z - pion*s*plasgda 963 | dpcouldz = -dpiondz*z - pion*s*plasgdz 964 | 965 | s = 3.0d0/den 966 | decouldd = s * dpcouldd - ecoul/den 967 | decouldt = s * dpcouldt 968 | decoulda = s * dpcoulda 969 | decouldz = s * dpcouldz 970 | 971 | s = -avo*kerg/(abar*plasg)*(1.5d0*c2*x-a2*(b2-1.0d0)*y) 972 | dscouldd = s * plasgdd 973 | dscouldt = s * plasgdt 974 | dscoulda = s * plasgda - scoul/abar 975 | dscouldz = s * plasgdz 976 | end if 977 | 978 | 979 | ! bomb proof 980 | x = prad + pion + pele + pcoul 981 | y = erad + eion + eele + ecoul 982 | z = srad + sion + sele + scoul 983 | 984 | ! write(6,*) x,y,z 985 | ! if (x .le. 0.0 .or. y .le. 0.0 .or. z .le. 0.0) then 986 | if (x .le. 0.0 .or. y .le. 0.0) then 987 | ! if (x .le. 0.0) then 988 | 989 | ! write(6,*) 990 | ! write(6,*) 'coulomb corrections are causing a negative pressure' 991 | ! write(6,*) 'setting all coulomb corrections to zero' 992 | ! write(6,*) 993 | 994 | pcoul = 0.0d0 995 | dpcouldd = 0.0d0 996 | dpcouldt = 0.0d0 997 | dpcoulda = 0.0d0 998 | dpcouldz = 0.0d0 999 | ecoul = 0.0d0 1000 | decouldd = 0.0d0 1001 | decouldt = 0.0d0 1002 | decoulda = 0.0d0 1003 | decouldz = 0.0d0 1004 | scoul = 0.0d0 1005 | dscouldd = 0.0d0 1006 | dscouldt = 0.0d0 1007 | dscoulda = 0.0d0 1008 | dscouldz = 0.0d0 1009 | end if 1010 | 1011 | 1012 | ! sum all the gas components 1013 | pgas = pion + pele + pcoul 1014 | egas = eion + eele + ecoul 1015 | sgas = sion + sele + scoul 1016 | 1017 | dpgasdd = dpiondd + dpepdd + dpcouldd 1018 | dpgasdt = dpiondt + dpepdt + dpcouldt 1019 | dpgasda = dpionda + dpepda + dpcoulda 1020 | dpgasdz = dpiondz + dpepdz + dpcouldz 1021 | 1022 | degasdd = deiondd + deepdd + decouldd 1023 | degasdt = deiondt + deepdt + decouldt 1024 | degasda = deionda + deepda + decoulda 1025 | degasdz = deiondz + deepdz + decouldz 1026 | 1027 | dsgasdd = dsiondd + dsepdd + dscouldd 1028 | dsgasdt = dsiondt + dsepdt + dscouldt 1029 | dsgasda = dsionda + dsepda + dscoulda 1030 | dsgasdz = dsiondz + dsepdz + dscouldz 1031 | 1032 | 1033 | 1034 | 1035 | ! add in radiation to get the total 1036 | pres = prad + pgas 1037 | ener = erad + egas 1038 | entr = srad + sgas 1039 | 1040 | dpresdd = dpraddd + dpgasdd 1041 | dpresdt = dpraddt + dpgasdt 1042 | dpresda = dpradda + dpgasda 1043 | dpresdz = dpraddz + dpgasdz 1044 | 1045 | denerdd = deraddd + degasdd 1046 | denerdt = deraddt + degasdt 1047 | denerda = deradda + degasda 1048 | denerdz = deraddz + degasdz 1049 | 1050 | dentrdd = dsraddd + dsgasdd 1051 | dentrdt = dsraddt + dsgasdt 1052 | dentrda = dsradda + dsgasda 1053 | dentrdz = dsraddz + dsgasdz 1054 | 1055 | 1056 | ! for the gas 1057 | ! the temperature and density exponents (c&g 9.81 9.82) 1058 | ! the specific heat at constant volume (c&g 9.92) 1059 | ! the third adiabatic exponent (c&g 9.93) 1060 | ! the first adiabatic exponent (c&g 9.97) 1061 | ! the second adiabatic exponent (c&g 9.105) 1062 | ! the specific heat at constant pressure (c&g 9.98) 1063 | ! and relativistic formula for the sound speed (c&g 14.29) 1064 | 1065 | zz = pgas*deni 1066 | zzi = den/pgas 1067 | chit_gas = temp/pgas * dpgasdt 1068 | chid_gas = dpgasdd*zzi 1069 | cv_gas = degasdt 1070 | x = zz * chit_gas/(temp * cv_gas) 1071 | gam3_gas = x + 1.0d0 1072 | gam1_gas = chit_gas*x + chid_gas 1073 | nabad_gas = x/gam1_gas 1074 | gam2_gas = 1.0d0/(1.0d0 - nabad_gas) 1075 | cp_gas = cv_gas * gam1_gas/chid_gas 1076 | z = 1.0d0 + (egas + light2)*zzi 1077 | sound_gas = clight * sqrt(gam1_gas/z) 1078 | 1079 | 1080 | 1081 | ! for the totals 1082 | zz = pres*deni 1083 | zzi = den/pres 1084 | chit = temp/pres * dpresdt 1085 | chid = dpresdd*zzi 1086 | cv = denerdt 1087 | x = zz * chit/(temp * cv) 1088 | gam3 = x + 1.0d0 1089 | gam1 = chit*x + chid 1090 | nabad = x/gam1 1091 | gam2 = 1.0d0/(1.0d0 - nabad) 1092 | cp = cv * gam1/chid 1093 | z = 1.0d0 + (ener + light2)*zzi 1094 | sound = clight * sqrt(gam1/z) 1095 | 1096 | 1097 | 1098 | ! maxwell relations; each is zero if the consistency is perfect 1099 | x = den * den 1100 | 1101 | dse = temp*dentrdt/denerdt - 1.0d0 1102 | 1103 | dpe = (denerdd*x + temp*dpresdt)/pres - 1.0d0 1104 | 1105 | dsp = -dentrdd*x/dpresdt - 1.0d0 1106 | 1107 | 1108 | ! store this row 1109 | ptot_row(j) = pres 1110 | dpt_row(j) = dpresdt 1111 | dpd_row(j) = dpresdd 1112 | dpa_row(j) = dpresda 1113 | dpz_row(j) = dpresdz 1114 | 1115 | etot_row(j) = ener 1116 | det_row(j) = denerdt 1117 | ded_row(j) = denerdd 1118 | dea_row(j) = denerda 1119 | dez_row(j) = denerdz 1120 | 1121 | stot_row(j) = entr 1122 | dst_row(j) = dentrdt 1123 | dsd_row(j) = dentrdd 1124 | dsa_row(j) = dentrda 1125 | dsz_row(j) = dentrdz 1126 | 1127 | 1128 | pgas_row(j) = pgas 1129 | dpgast_row(j) = dpgasdt 1130 | dpgasd_row(j) = dpgasdd 1131 | dpgasa_row(j) = dpgasda 1132 | dpgasz_row(j) = dpgasdz 1133 | 1134 | egas_row(j) = egas 1135 | degast_row(j) = degasdt 1136 | degasd_row(j) = degasdd 1137 | degasa_row(j) = degasda 1138 | degasz_row(j) = degasdz 1139 | 1140 | sgas_row(j) = sgas 1141 | dsgast_row(j) = dsgasdt 1142 | dsgasd_row(j) = dsgasdd 1143 | dsgasa_row(j) = dsgasda 1144 | dsgasz_row(j) = dsgasdz 1145 | 1146 | 1147 | prad_row(j) = prad 1148 | dpradt_row(j) = dpraddt 1149 | dpradd_row(j) = dpraddd 1150 | dprada_row(j) = dpradda 1151 | dpradz_row(j) = dpraddz 1152 | 1153 | erad_row(j) = erad 1154 | deradt_row(j) = deraddt 1155 | deradd_row(j) = deraddd 1156 | derada_row(j) = deradda 1157 | deradz_row(j) = deraddz 1158 | 1159 | srad_row(j) = srad 1160 | dsradt_row(j) = dsraddt 1161 | dsradd_row(j) = dsraddd 1162 | dsrada_row(j) = dsradda 1163 | dsradz_row(j) = dsraddz 1164 | 1165 | 1166 | pion_row(j) = pion 1167 | dpiont_row(j) = dpiondt 1168 | dpiond_row(j) = dpiondd 1169 | dpiona_row(j) = dpionda 1170 | dpionz_row(j) = dpiondz 1171 | 1172 | eion_row(j) = eion 1173 | deiont_row(j) = deiondt 1174 | deiond_row(j) = deiondd 1175 | deiona_row(j) = deionda 1176 | deionz_row(j) = deiondz 1177 | 1178 | sion_row(j) = sion 1179 | dsiont_row(j) = dsiondt 1180 | dsiond_row(j) = dsiondd 1181 | dsiona_row(j) = dsionda 1182 | dsionz_row(j) = dsiondz 1183 | 1184 | xni_row(j) = xni 1185 | 1186 | pele_row(j) = pele 1187 | ppos_row(j) = 0.0d0 1188 | dpept_row(j) = dpepdt 1189 | dpepd_row(j) = dpepdd 1190 | dpepa_row(j) = dpepda 1191 | dpepz_row(j) = dpepdz 1192 | 1193 | eele_row(j) = eele 1194 | epos_row(j) = 0.0d0 1195 | deept_row(j) = deepdt 1196 | deepd_row(j) = deepdd 1197 | deepa_row(j) = deepda 1198 | deepz_row(j) = deepdz 1199 | 1200 | sele_row(j) = sele 1201 | spos_row(j) = 0.0d0 1202 | dsept_row(j) = dsepdt 1203 | dsepd_row(j) = dsepdd 1204 | dsepa_row(j) = dsepda 1205 | dsepz_row(j) = dsepdz 1206 | 1207 | xnem_row(j) = xnem 1208 | xne_row(j) = xnefer 1209 | dxnet_row(j) = dxnedt 1210 | dxned_row(j) = dxnedd 1211 | dxnea_row(j) = dxneda 1212 | dxnez_row(j) = dxnedz 1213 | xnp_row(j) = 0.0d0 1214 | zeff_row(j) = zbar 1215 | 1216 | etaele_row(j) = etaele 1217 | detat_row(j) = detadt 1218 | detad_row(j) = detadd 1219 | detaa_row(j) = detada 1220 | detaz_row(j) = detadz 1221 | etapos_row(j) = 0.0d0 1222 | 1223 | pcou_row(j) = pcoul 1224 | dpcout_row(j) = dpcouldt 1225 | dpcoud_row(j) = dpcouldd 1226 | dpcoua_row(j) = dpcoulda 1227 | dpcouz_row(j) = dpcouldz 1228 | 1229 | ecou_row(j) = ecoul 1230 | decout_row(j) = decouldt 1231 | decoud_row(j) = decouldd 1232 | decoua_row(j) = decoulda 1233 | decouz_row(j) = decouldz 1234 | 1235 | scou_row(j) = scoul 1236 | dscout_row(j) = dscouldt 1237 | dscoud_row(j) = dscouldd 1238 | dscoua_row(j) = dscoulda 1239 | dscouz_row(j) = dscouldz 1240 | 1241 | plasg_row(j) = plasg 1242 | 1243 | dse_row(j) = dse 1244 | dpe_row(j) = dpe 1245 | dsp_row(j) = dsp 1246 | 1247 | cv_gas_row(j) = cv_gas 1248 | cp_gas_row(j) = cp_gas 1249 | gam1_gas_row(j) = gam1_gas 1250 | gam2_gas_row(j) = gam2_gas 1251 | gam3_gas_row(j) = gam3_gas 1252 | nabad_gas_row(j) = nabad_gas 1253 | cs_gas_row(j) = sound_gas 1254 | 1255 | cv_row(j) = cv 1256 | cp_row(j) = cp 1257 | gam1_row(j) = gam1 1258 | gam2_row(j) = gam2 1259 | gam3_row(j) = gam3 1260 | nabad_row(j) = nabad 1261 | cs_row(j) = sound 1262 | 1263 | ! end of pipeline loop 1264 | enddo 1265 | return 1266 | end 1267 | 1268 | 1269 | 1270 | 1271 | 1272 | 1273 | 1274 | 1275 | 1276 | 1277 | 1278 | subroutine pretty_eos_out(whose) 1279 | include 'implno.dek' 1280 | include 'vector_eos.dek' 1281 | 1282 | ! writes a pretty output for the eos tester 1283 | 1284 | 1285 | ! declare the pass 1286 | character*(*) whose 1287 | 1288 | 1289 | ! local variables 1290 | integer i,j 1291 | double precision ye,xcess,avo,kerg,xka 1292 | parameter (avo = 6.0221417930d23, & 1293 | kerg = 1.380650424d-16, & 1294 | xka = kerg*avo) 1295 | 1296 | 1297 | ! popular formats 1298 | 01 format(1x,t2,a,t11,a,t27,a,t43,a,t59,a,t75,a,t91,a,t107,a) 1299 | 02 format(1x,t2,a,1p7e16.8) 1300 | 03 format(1x,t2,a7,1pe12.4,t22,a7,1pe12.4, & 1301 | t42,a7,1pe12.4,t62,a7,1pe12.4) 1302 | 04 format(1x,t2,a,t11,'total',t24,'ion',t34,'e- + e+', & 1303 | t58,'radiation',t70,'coulomb') 1304 | 05 format(1x,t2,a,1p3e12.4,t56,1p2e12.4) 1305 | 06 format(1x,t2,a,a,1pe12.4, & 1306 | t30,a,a,1pe12.4, & 1307 | t58,a,a,1pe12.4) 1308 | 1309 | 1310 | 1311 | ! loop over the pipeline 1312 | do j=jlo_eos,jhi_eos 1313 | 1314 | 1315 | ! the input 1316 | write(6,03) 'temp =',temp_row(j),'den =',den_row(j), & 1317 | 'abar =',abar_row(j),'zbar =',zbar_row(j) 1318 | 1319 | ye = zbar_row(1)/abar_row(1) 1320 | xcess = 1.0d0 - 2.0d0*ye 1321 | write(6,03) 'ye =',ye,'xcess =',xcess 1322 | write(6,*) ' ' 1323 | 1324 | 1325 | ! and the output 1326 | 1327 | write(6,01) whose,'value','d/dd','d/dt','d/da','d/dz' 1328 | 1329 | write(6,02) 'p tot=',ptot_row(j), & 1330 | dpd_row(j),dpt_row(j),dpa_row(j),dpz_row(j) 1331 | write(6,02) 'p gas=',pgas_row(j), & 1332 | dpgasd_row(j),dpgast_row(j),dpgasa_row(j),dpgasz_row(j) 1333 | write(6,02) 'p rad=',prad_row(j), & 1334 | dpradd_row(j),dpradt_row(j),dprada_row(j),dpradz_row(j) 1335 | write(6,02) 'p ion=',pion_row(j), & 1336 | dpiond_row(j),dpiont_row(j),dpiona_row(j),dpionz_row(j) 1337 | write(6,02) 'p e-=',pele_row(j), & 1338 | dpepd_row(j),dpept_row(j),dpepa_row(j),dpepz_row(j) 1339 | write(6,02) 'p e+=',ppos_row(j) 1340 | write(6,02) 'p cou=',pcou_row(j), & 1341 | dpcoud_row(j),dpcout_row(j),dpcoua_row(j),dpcouz_row(j) 1342 | 1343 | 1344 | write(6,*) ' ' 1345 | write(6,02) 'e tot=',etot_row(j), & 1346 | ded_row(j),det_row(j),dea_row(j),dez_row(j) 1347 | write(6,02) 'e gas=',egas_row(j), & 1348 | degasd_row(j),degast_row(j),degasa_row(j),degasz_row(j) 1349 | write(6,02) 'e rad=',erad_row(j), & 1350 | deradd_row(j),deradt_row(j),derada_row(j),deradz_row(j) 1351 | write(6,02) 'e ion=',eion_row(j), & 1352 | deiond_row(j),deiont_row(j),deiona_row(j),deionz_row(j) 1353 | write(6,02) 'e e-=',eele_row(j), & 1354 | deepd_row(j),deept_row(j),deepa_row(j),deepz_row(j) 1355 | write(6,02) 'e e+=',epos_row(j) 1356 | write(6,02) 'e cou=',ecou_row(j), & 1357 | decoud_row(j),decout_row(j),decoua_row(j),decouz_row(j) 1358 | 1359 | write(6,*) ' ' 1360 | write(6,02) 's tot=',stot_row(j), & 1361 | dsd_row(j),dst_row(j),dsa_row(j),dsz_row(j) 1362 | write(6,02) 's/xka=',stot_row(j)/xka, & 1363 | dsd_row(j)/xka,dst_row(j)/xka,dsa_row(j)/xka,dsz_row(j)/xka 1364 | write(6,02) 's gas=',sgas_row(j), & 1365 | dsgasd_row(j),dsgast_row(j),dsgasa_row(j),dsgasz_row(j) 1366 | write(6,02) 's rad=',srad_row(j), & 1367 | dsradd_row(j),dsradt_row(j),dsrada_row(j),dsradz_row(j) 1368 | write(6,02) 's ion=',sion_row(j), & 1369 | dsiond_row(j),dsiont_row(j),dsiona_row(j),dsionz_row(j) 1370 | write(6,02) 's e-=',sele_row(j), & 1371 | dsepd_row(j),dsept_row(j),dsepa_row(j),dsepz_row(j) 1372 | write(6,02) 's e+=',spos_row(j) 1373 | write(6,02) 's cou=',scou_row(j), & 1374 | dscoud_row(j),dscout_row(j),dscoua_row(j),dscouz_row(j) 1375 | 1376 | 1377 | ! specific heats, and ratio of electostatic to thermal energy 1378 | ! the 3 gammas and the sound speed for both the gas and the total 1379 | write(6,*) ' ' 1380 | write(6,02) 'cv =',cv_row(j)/(kerg*avo)*abar_row(1), & 1381 | dcvdd_row(j),dcvdt_row(j), & 1382 | dcvda_row(j),dcvdz_row(j) 1383 | write(6,02) 'cp =',cp_row(j), & 1384 | dcpdd_row(j),dcpdt_row(j), & 1385 | dcpda_row(j),dcpdz_row(j) 1386 | write(6,02) 'gam1=',gam1_row(j), & 1387 | dgam1dd_row(j),dgam1dt_row(j), & 1388 | dgam1da_row(j),dgam1dz_row(j) 1389 | write(6,02) 'gam2=',gam2_row(j), & 1390 | dgam2dd_row(j),dgam2dt_row(j), & 1391 | dgam2da_row(j),dgam2dz_row(j) 1392 | write(6,02) 'gam3=',gam3_row(j), & 1393 | dgam3dd_row(j),dgam3dt_row(j), & 1394 | dgam3da_row(j),dgam3dz_row(j) 1395 | write(6,02) 'cs =',cs_row(j), & 1396 | dcsdd_row(j),dcsdt_row(j), & 1397 | dcsda_row(j),dcsdz_row(j) 1398 | 1399 | write(6,*) ' ' 1400 | write(6,02) 'cvgas=',cv_gas_row(j)/(kerg*avo)*abar_row(1), & 1401 | dcv_gasdd_row(j),dcv_gasdt_row(j), & 1402 | dcv_gasda_row(j),dcv_gasdz_row(j) 1403 | write(6,02) 'cpgas=',cp_gas_row(j), & 1404 | dcp_gasdd_row(j),dcp_gasdt_row(j), & 1405 | dcp_gasda_row(j),dcp_gasdz_row(j) 1406 | write(6,02) 'g1gas=',gam1_gas_row(j), & 1407 | dgam1_gasdd_row(j),dgam1_gasdt_row(j), & 1408 | dgam1_gasda_row(j),dgam1_gasdz_row(j) 1409 | write(6,02) 'g2gas=',gam2_gas_row(j), & 1410 | dgam2_gasdd_row(j),dgam2_gasdt_row(j), & 1411 | dgam2_gasda_row(j),dgam2_gasdz_row(j) 1412 | write(6,02) 'g3gas=',gam3_gas_row(j), & 1413 | dgam3_gasdd_row(j),dgam3_gasdt_row(j), & 1414 | dgam3_gasda_row(j),dgam3_gasdz_row(j) 1415 | write(6,02) 'csgas=',cs_gas_row(j), & 1416 | dcs_gasdd_row(j),dcs_gasdt_row(j), & 1417 | dcs_gasda_row(j),dcs_gasdz_row(j) 1418 | 1419 | 1420 | ! the thermodynamic consistency relations, these should all be 1421 | ! at the floating point limit of zero 1422 | write(6,*) ' ' 1423 | write(6,03) 'maxw1 =',dse_row(j),'maxw2 =',dpe_row(j), & 1424 | 'maxw3 =',dsp_row(j) 1425 | 1426 | ! number density of ions and its derivatives 1427 | write(6,03) 'xni =',xni_row(j), 'xnim =',xnim_row(j) 1428 | write(6,03) 'dxnidd=',dxned_row(j),'dxnidt=',dxnet_row(j), & 1429 | 'dxnida=',dxnea_row(j),'dxnidz=',dxnez_row(j) 1430 | 1431 | ! ion chemical potential and its derivatives 1432 | write(6,03) 'etaion=',etaion_row(j) 1433 | write(6,03) 'detaid=',detaid_row(j),'detait=',detait_row(j), & 1434 | 'detaia=',detaia_row(j),'detaiz=',detaiz_row(j) 1435 | 1436 | 1437 | ! number density of electrons+positrons and its derivatives 1438 | write(6,03) 'xnele =',xne_row(j),'xnpos =',xnp_row(j), & 1439 | 'xnem =',xnem_row(j) 1440 | write(6,03) 'dxnedd=',dxned_row(j),'dxnedt=',dxnet_row(j), & 1441 | 'dxneda=',dxnea_row(j),'dxnedz=',dxnez_row(j) 1442 | 1443 | 1444 | ! electron chemical potential, positron chemical potential and its derivatives 1445 | write(6,03) 'etaele=',etaele_row(j),'etapos=',etapos_row(j) 1446 | write(6,03) 'detadd=',detad_row(j),'detadt=',detat_row(j), & 1447 | 'detada=',detaa_row(j),'detadz=',detaz_row(j) 1448 | 1449 | write(6,03) 'zeff =',zeff_row(j), & 1450 | 'ionzd =',zeff_row(j)/zbar_row(j), & 1451 | 'plasg =',plasg_row(j) 1452 | 1453 | ! end of pipeline loop 1454 | enddo 1455 | 1456 | return 1457 | end 1458 | 1459 | 1460 | -------------------------------------------------------------------------------- /helmholtz.py: -------------------------------------------------------------------------------- 1 | from . import fhelmholtz 2 | from . import ftimmes 3 | import numpy as np 4 | 5 | # list of common blocks that hold interesting information 6 | CBLOCK_NAMES = ('crpc1', 'deedoo', 'etotc1', 'etapc1', 'ptotc1', 7 | 'stotc1', 'th_xni_ion', 'thcou', 'thdergc1', 'thdergc2', 8 | 'thdertc1', 'thdertc2', 'theepc1', 'thegasc2', 'theion', 9 | 'therad', 'thetaion', 'thinp', 'thmax', 'thpepc1', 10 | 'thpgasc1', 'thpion', 'thprad', 'thsepc1', 'thsgasc1', 11 | 'thsion', 'thsrad', 'thxip', 'thxnec1') 12 | 13 | 14 | class HelmholtzOutput: 15 | 16 | def __init__(self, size, shape): 17 | 18 | # set size and shape data 19 | self.size = size 20 | self.shape = shape 21 | 22 | # loop through and nicely reformat everything 23 | for cblock_name in CBLOCK_NAMES: 24 | cblock = getattr(fhelmholtz,cblock_name) 25 | for row_name in vars(cblock): 26 | row_data = np.copy(getattr(cblock,row_name)) 27 | setattr(self, self._demangle(row_name), self._reshape(row_data)) 28 | 29 | def _demangle(self, name): 30 | # remove the "_row" postfix 31 | return name[:-4] 32 | 33 | def _reshape(self, data): 34 | # put things back like they came in 35 | return np.reshape(data[:self.size], self.shape) 36 | 37 | 38 | class TimmesOutput: 39 | 40 | def __init__(self, size, shape): 41 | 42 | # set size and shape data 43 | self.size = size 44 | self.shape = shape 45 | 46 | # loop through and nicely reformat everything 47 | for cblock_name in CBLOCK_NAMES: 48 | cblock = getattr(ftimmes,cblock_name) 49 | for row_name in vars(cblock): 50 | row_data = np.copy(getattr(cblock,row_name)) 51 | setattr(self, self._demangle(row_name), self._reshape(row_data)) 52 | 53 | def _demangle(self, name): 54 | # remove the "_row" postfix 55 | return name[:-4] 56 | 57 | def _reshape(self, data): 58 | # put things back like they came in 59 | return np.reshape(data[:self.size], self.shape) 60 | 61 | 62 | def _make_uniform_arrays(inputs): 63 | 64 | # make numpy arrays out of everthing 65 | arrays = [np.array(array) for array in inputs] 66 | 67 | # set size & shape to 1st non-scalar input 68 | size = 1 69 | shape = (1,) 70 | for array in arrays: 71 | if array.size != 1: 72 | size = array.size 73 | shape = array.shape 74 | break 75 | 76 | outputs = [] 77 | for array in arrays: 78 | if array.size == 1: 79 | outputs.append(np.tile(array.flatten(), size)) 80 | else: 81 | outputs.append(array.flatten()) 82 | 83 | return size, shape, outputs 84 | 85 | 86 | def helmeos(dens, temp, abar, zbar): 87 | 88 | # make sure everything is the same size and shape 89 | inputs = (dens, temp, abar, zbar) 90 | size, shape, finputs = _make_uniform_arrays(inputs) 91 | 92 | # call the eos 93 | fhelmholtz.call_helmeos(*finputs) 94 | 95 | # container for output 96 | return HelmholtzOutput(size, shape) 97 | 98 | 99 | def helmeos_DE(dens, ener, abar, zbar, tguess = None): 100 | 101 | # set default temperature guess 102 | if tguess == None: 103 | tguess = 1e7 104 | 105 | # make sure everything is the same size and shape 106 | inputs = (dens, ener, abar, zbar, tguess) 107 | size, shape, finputs = _make_uniform_arrays(inputs) 108 | 109 | # call the eos 110 | fhelmholtz.call_helmeos_de(*finputs) 111 | 112 | return HelmholtzOutput(size, shape) 113 | 114 | 115 | def helmeos_DP(dens, pres, abar, zbar, tguess = None): 116 | 117 | # set default temperature guess 118 | if tguess is None: 119 | tguess = 1e7 120 | 121 | # make sure everything is the same size and shape 122 | inputs = (dens, pres, abar, zbar, tguess) 123 | size, shape, finputs = _make_uniform_arrays(inputs) 124 | 125 | # call the eos 126 | fhelmholtz.call_helmeos_dp(*finputs) 127 | 128 | return HelmholtzOutput(size, shape) 129 | 130 | 131 | def helmeos_DS(dens, entr, abar, zbar, tguess = None): 132 | 133 | # set default temperature guess 134 | if tguess is None: 135 | tguess = 1e7 136 | 137 | # make sure everything is the same size and shape 138 | inputs = (dens, entr, abar, zbar, tguess) 139 | size, shape, finputs = _make_uniform_arrays(inputs) 140 | 141 | # call the eos 142 | fhelmholtz.call_helmeos_ds(*finputs) 143 | 144 | return HelmholtzOutput(size, shape) 145 | 146 | 147 | def eosfxt(dens, temp, abar, zbar): 148 | 149 | # make sure everything is the same size and shape 150 | inputs = (dens, temp, abar, zbar) 151 | size, shape, finputs = _make_uniform_arrays(inputs) 152 | 153 | # call the eos 154 | ftimmes.call_eosfxt(*finputs) 155 | 156 | # container for output 157 | return TimmesOutput(size, shape) 158 | -------------------------------------------------------------------------------- /implno.dek: -------------------------------------------------------------------------------- 1 | ! implicit declarations 2 | implicit none 3 | save 4 | -------------------------------------------------------------------------------- /pycall.f90: -------------------------------------------------------------------------------- 1 | ! here is the tabular helmholtz free energy eos: 2 | subroutine call_helmeos(nrow, den, temp, abar, zbar) 3 | include 'implno.dek' 4 | include 'vector_eos.dek' 5 | 6 | ! tests the eos routine 7 | ! 8 | ! ionmax = number of isotopes in the network 9 | ! xmass = mass fraction of isotope i 10 | ! aion = number of nucleons in isotope i 11 | ! zion = number of protons in isotope i 12 | 13 | integer, intent(in) :: nrow 14 | double precision, intent(in), dimension(nrow) :: den, temp, abar, zbar 15 | !f2py INTEGER, INTENT(hide) :: nrow 16 | !f2py DOUBLE PRECISION, DIMENSION(nrow), INTENT(in) :: den, temp, abar, zbar 17 | 18 | integer :: i 19 | 20 | ! don't try and overfill the array 21 | ! if (ninput.gt.nrowmax) then stop 22 | 23 | ! set the input vector. pipeline is only 1 element long 24 | 25 | jlo_eos = 1 ; jhi_eos = nrow 26 | do i = 1, nrow 27 | temp_row(i) = temp(i) 28 | den_row(i) = den(i) 29 | abar_row(i) = abar(i) 30 | zbar_row(i) = zbar(i) 31 | end do 32 | 33 | ! read the data table and call the eos 34 | call read_helm_table 35 | call helmeos 36 | 37 | end 38 | 39 | 40 | subroutine call_helmeos_DP(nrow, den, pres, abar, zbar, tguess) 41 | include 'implno.dek' 42 | include 'vector_eos.dek' 43 | 44 | ! tests the eos routine 45 | ! 46 | ! ionmax = number of isotopes in the network 47 | ! xmass = mass fraction of isotope i 48 | ! aion = number of nucleons in isotope i 49 | ! zion = number of protons in isotope i 50 | 51 | integer, intent(in) :: nrow 52 | double precision, intent(in), dimension(nrow) :: den, pres, abar, zbar, tguess 53 | !f2py INTEGER, INTENT(hide) :: nrow 54 | !f2py DOUBLE PRECISION, DIMENSION(nrow), INTENT(in) :: den, pres, abar, zbar, tguess 55 | double precision, dimension(nrow) :: rerr_P, rerr_T 56 | double precision, dimension(nrow) :: delta_P, delta_T 57 | double precision, dimension(nrow) :: T_lower, T_upper 58 | double precision, dimension(nrow) :: Pgoal 59 | logical, dimension(nrow) :: NR_converged 60 | 61 | double precision, parameter :: temp_floor = 1e4 62 | double precision, parameter :: rtol = 1e-6 63 | 64 | integer :: i, iter 65 | integer, parameter :: max_iter = 100 66 | 67 | ! don't try and overfill the array 68 | ! if (ninput.gt.nrowmax) then stop 69 | 70 | ! read the data table 71 | call read_helm_table 72 | 73 | ! set the input vector. pipeline is only 1 element long 74 | 75 | jlo_eos = 1 ; jhi_eos = nrow 76 | do i = 1, nrow 77 | Pgoal(i) = pres(i) 78 | temp_row(i) = tguess(i) 79 | den_row(i) = den(i) 80 | abar_row(i) = abar(i) 81 | zbar_row(i) = zbar(i) 82 | end do 83 | 84 | T_lower = temp_floor 85 | T_upper = 1e12 86 | NR_converged = .FALSE. 87 | 88 | ! do the NR iteration 89 | 90 | do iter = 1, max_iter 91 | 92 | call helmeos 93 | 94 | do i = 1, nrow 95 | 96 | ! if this point is converged, go to the next one 97 | if (NR_converged(i)) cycle 98 | 99 | ! energy difference 100 | delta_P(i) = Pgoal(i) - ptot_row(i) 101 | 102 | ! keep things safe with bisect-limits 103 | if (delta_P(i).gt.0) then 104 | t_lower(i) = temp_row(i) 105 | else 106 | t_upper(i) = temp_row(i) 107 | end if 108 | 109 | ! update temperature 110 | delta_T(i) = delta_P(i) / dpt_row(i) 111 | temp_row(i) = temp_row(i) + delta_T(i) 112 | 113 | ! if this took us out of bounds, don't let it happen 114 | ! choose a new point inside the interval [t_lower, t_upper] 115 | ! the point is in the middle of the interval (logarthmically) 116 | 117 | if ((temp_row(i).gt.t_upper(i)).OR.(temp_row(i).lt.t_lower(i))) then 118 | temp_row(i) = sqrt(t_lower(i) * t_upper(i)) 119 | end if 120 | 121 | ! calculate relative errors 122 | rerr_P(i) = delta_P(i) / Pgoal(i) 123 | rerr_T(i) = delta_T(i) / temp_row(i) 124 | 125 | ! if we're at tolerances, end this 126 | if ((abs(rerr_P(i)).LE.rtol).AND.(abs(rerr_T(i)).LE.rtol)) then 127 | NR_converged(i) = .TRUE. 128 | endif 129 | 130 | !allow points at the temperature floor to "converge" 131 | if (t_upper(i).le.temp_floor * (1d0 + rtol)) then 132 | NR_converged(i) = .TRUE. 133 | temp_row(i) = temp_floor 134 | end if 135 | 136 | end do 137 | 138 | if (ALL(NR_converged)) exit 139 | 140 | end do 141 | 142 | ! once more, with feeling 143 | NR_converged = .FALSE. 144 | 145 | call helmeos 146 | 147 | end subroutine call_helmeos_DP 148 | 149 | subroutine call_helmeos_DS(nrow, den, entr, abar, zbar, tguess) 150 | include 'implno.dek' 151 | include 'vector_eos.dek' 152 | 153 | ! tests the eos routine 154 | ! 155 | ! ionmax = number of isotopes in the network 156 | ! xmass = mass fraction of isotope i 157 | ! aion = number of nucleons in isotope i 158 | ! zion = number of protons in isotope i 159 | 160 | integer, intent(in) :: nrow 161 | double precision, intent(in), dimension(nrow) :: den, entr, abar, zbar, tguess 162 | !f2py INTEGER, INTENT(hide) :: nrow 163 | !f2py DOUBLE PRECISION, DIMENSION(nrow), INTENT(in) :: den, entr, abar, zbar, tguess 164 | double precision, dimension(nrow) :: rerr_S, rerr_T 165 | double precision, dimension(nrow) :: delta_S, delta_T 166 | double precision, dimension(nrow) :: T_lower, T_upper 167 | double precision, dimension(nrow) :: Sgoal 168 | logical, dimension(nrow) :: NR_converged 169 | 170 | double precision, parameter :: temp_floor = 1e4 171 | double precision, parameter :: rtol = 1e-6 172 | 173 | integer :: i, iter 174 | integer, parameter :: max_iter = 100 175 | 176 | ! don't try and overfill the array 177 | ! if (ninput.gt.nrowmax) then stop 178 | 179 | ! read the data table 180 | call read_helm_table 181 | 182 | ! set the input vector. pipeline is only 1 element long 183 | 184 | jlo_eos = 1 ; jhi_eos = nrow 185 | do i = 1, nrow 186 | Sgoal(i) = entr(i) 187 | temp_row(i) = tguess(i) 188 | den_row(i) = den(i) 189 | abar_row(i) = abar(i) 190 | zbar_row(i) = zbar(i) 191 | end do 192 | 193 | T_lower = temp_floor 194 | T_upper = 1e12 195 | NR_converged = .FALSE. 196 | 197 | ! do the NR iteration 198 | 199 | do iter = 1, max_iter 200 | 201 | call helmeos 202 | 203 | do i = 1, nrow 204 | 205 | ! if this point is converged, go to the next one 206 | if (NR_converged(i)) cycle 207 | 208 | ! energy difference 209 | delta_S(i) = Sgoal(i) - stot_row(i) 210 | 211 | ! keep things safe with bisect-limits 212 | if (delta_S(i).gt.0) then 213 | t_lower(i) = temp_row(i) 214 | else 215 | t_upper(i) = temp_row(i) 216 | end if 217 | 218 | ! update temperature 219 | delta_T(i) = delta_S(i) / dst_row(i) 220 | temp_row(i) = temp_row(i) + delta_T(i) 221 | 222 | ! if this took us out of bounds, don't let it happen 223 | ! choose a new point inside the interval [t_lower, t_upper] 224 | ! the point is in the middle of the interval (logarthmically) 225 | 226 | if ((temp_row(i).gt.t_upper(i)).OR.(temp_row(i).lt.t_lower(i))) then 227 | temp_row(i) = sqrt(t_lower(i) * t_upper(i)) 228 | end if 229 | 230 | ! calculate relative errors 231 | rerr_S(i) = delta_S(i) / Sgoal(i) 232 | rerr_T(i) = delta_T(i) / temp_row(i) 233 | 234 | ! if we're at tolerances, end this 235 | if ((abs(rerr_S(i)).LE.rtol).AND.(abs(rerr_T(i)).LE.rtol)) then 236 | NR_converged(i) = .TRUE. 237 | endif 238 | 239 | !allow points at the temperature floor to "converge" 240 | if (t_upper(i).le.temp_floor * (1d0 + rtol)) then 241 | NR_converged(i) = .TRUE. 242 | temp_row(i) = temp_floor 243 | end if 244 | 245 | end do 246 | 247 | if (ALL(NR_converged)) exit 248 | 249 | end do 250 | 251 | ! once more, with feeling 252 | NR_converged = .FALSE. 253 | 254 | call helmeos 255 | 256 | end subroutine call_helmeos_DS 257 | 258 | 259 | subroutine call_helmeos_DE(nrow, den, ener, abar, zbar, tguess) 260 | include 'implno.dek' 261 | include 'vector_eos.dek' 262 | 263 | ! tests the eos routine 264 | ! 265 | ! ionmax = number of isotopes in the network 266 | ! xmass = mass fraction of isotope i 267 | ! aion = number of nucleons in isotope i 268 | ! zion = number of protons in isotope i 269 | 270 | integer, intent(in) :: nrow 271 | double precision, intent(in), dimension(nrow) :: den, ener, abar, zbar, tguess 272 | !f2py INTEGER, INTENT(hide) :: nrow 273 | !f2py DOUBLE PRECISION, DIMENSION(nrow), INTENT(in) :: den, ener, abar, zbar, tguess 274 | double precision, dimension(nrow) :: rerr_e, rerr_T 275 | double precision, dimension(nrow) :: delta_e, delta_T 276 | double precision, dimension(nrow) :: T_lower, T_upper 277 | double precision, dimension(nrow) :: egoal 278 | logical, dimension(nrow) :: NR_converged 279 | 280 | double precision, parameter :: temp_floor = 1e4 281 | double precision, parameter :: rtol = 1e-6 282 | 283 | integer :: i, iter 284 | integer, parameter :: max_iter = 100 285 | 286 | ! don't try and overfill the array 287 | ! if (ninput.gt.nrowmax) then stop 288 | 289 | ! read the data table 290 | call read_helm_table 291 | 292 | ! set the input vector. pipeline is only 1 element long 293 | 294 | jlo_eos = 1 ; jhi_eos = nrow 295 | do i = 1, nrow 296 | egoal(i) = ener(i) / den(i) ! eos works on specific internal energy 297 | temp_row(i) = tguess(i) 298 | den_row(i) = den(i) 299 | abar_row(i) = abar(i) 300 | zbar_row(i) = zbar(i) 301 | end do 302 | 303 | T_lower = temp_floor 304 | T_upper = 1e12 305 | NR_converged = .FALSE. 306 | 307 | ! do the NR iteration 308 | 309 | do iter = 1, max_iter 310 | 311 | call helmeos 312 | 313 | do i = 1, nrow 314 | 315 | ! if this point is converged, go to the next one 316 | if (NR_converged(i)) cycle 317 | 318 | ! energy difference 319 | delta_E(i) = egoal(i) - etot_row(i) 320 | 321 | ! keep things safe with bisect-limits 322 | if (delta_E(i).gt.0) then 323 | t_lower(i) = temp_row(i) 324 | else 325 | t_upper(i) = temp_row(i) 326 | end if 327 | 328 | ! update temperature 329 | delta_T(i) = delta_E(i) / det_row(i) 330 | temp_row(i) = temp_row(i) + delta_T(i) 331 | 332 | ! if this took us out of bounds, don't let it happen 333 | ! choose a new point inside the interval [t_lower, t_upper] 334 | ! the point is in the middle of the interval (logarthmically) 335 | 336 | if ((temp_row(i).gt.t_upper(i)).OR.(temp_row(i).lt.t_lower(i))) then 337 | temp_row(i) = sqrt(t_lower(i) * t_upper(i)) 338 | end if 339 | 340 | ! calculate relative errors 341 | rerr_e(i) = delta_e(i) / egoal(i) 342 | rerr_T(i) = delta_T(i) / temp_row(i) 343 | 344 | ! if we're at tolerances, end this 345 | if ((abs(rerr_e(i)).LE.rtol).AND.(abs(rerr_T(i)).LE.rtol)) then 346 | NR_converged(i) = .TRUE. 347 | endif 348 | 349 | !allow points at the temperature floor to "converge" 350 | if (t_upper(i).le.temp_floor * (1d0 + rtol)) then 351 | NR_converged(i) = .TRUE. 352 | temp_row(i) = temp_floor 353 | end if 354 | 355 | end do 356 | 357 | if (ALL(NR_converged)) exit 358 | 359 | end do 360 | 361 | ! once more, with feeling 362 | NR_converged = .FALSE. 363 | 364 | call helmeos 365 | 366 | end subroutine call_helmeos_DE 367 | -------------------------------------------------------------------------------- /pycall_eosfxt.f90: -------------------------------------------------------------------------------- 1 | subroutine call_eosfxt(nrow, den, temp, abar, zbar) 2 | include 'implno.dek' 3 | include 'vector_eos.dek' 4 | 5 | ! tests the eos routine 6 | ! 7 | ! ionmax = number of isotopes in the network 8 | ! xmass = mass fraction of isotope i 9 | ! aion = number of nucleons in isotope i 10 | ! zion = number of protons in isotope i 11 | 12 | integer, intent(in) :: nrow 13 | double precision, intent(in), dimension(nrow) :: den, temp, abar, zbar 14 | !f2py INTEGER, INTENT(hide) :: nrow 15 | !f2py DOUBLE PRECISION, DIMENSION(nrow), INTENT(in) :: den, temp, abar, zbar 16 | 17 | integer :: i 18 | 19 | ! don't try and overfill the array 20 | ! if (ninput.gt.nrowmax) then stop 21 | 22 | ! set the input vector. pipeline is only 1 element long 23 | 24 | jlo_eos = 1 ; jhi_eos = nrow 25 | do i = 1, nrow 26 | temp_row(i) = temp(i) 27 | den_row(i) = den(i) 28 | abar_row(i) = abar(i) 29 | zbar_row(i) = zbar(i) 30 | end do 31 | 32 | ! read the data table and call the eos 33 | call eosfxt 34 | 35 | end 36 | -------------------------------------------------------------------------------- /test.f90: -------------------------------------------------------------------------------- 1 | program teos 2 | include 'implno.dek' 3 | include 'vector_eos.dek' 4 | 5 | ! tests the eos routine 6 | ! 7 | ! ionmax = number of isotopes in the network 8 | ! xmass = mass fraction of isotope i 9 | ! aion = number of nucleons in isotope i 10 | ! zion = number of protons in isotope i 11 | 12 | integer ionmax 13 | parameter (ionmax=3) 14 | double precision xmass(ionmax),aion(ionmax),zion(ionmax),temp,den,abar,zbar 15 | 16 | 17 | ! set the mass fractions, z's and a's of the composition 18 | ! hydrogen, heliu, and carbon 19 | xmass(1) = 0.75d0 ; aion(1) = 1.0d0 ; zion(1) = 1.0d0 20 | xmass(2) = 0.23d0 ; aion(2) = 4.0d0 ; zion(2) = 2.0d0 21 | xmass(3) = 0.02d0 ; aion(3) = 12.0d0 ; zion(3) = 6.0d0 22 | 23 | ! average atomic weight and charge 24 | abar = 1.0d0/sum(xmass(1:ionmax)/aion(1:ionmax)) 25 | zbar = abar * sum(xmass(1:ionmax) * zion(1:ionmax)/aion(1:ionmax)) 26 | 27 | ! set the input vector. pipeline is only 1 element long 28 | temp_row(1) = 1.0d8 ; den_row(1) = 1.0d6 ; abar_row(1) = abar ; zbar_row(1) = zbar 29 | jlo_eos = 1 ; jhi_eos = 1 30 | 31 | ! read the data table and call the eos 32 | call read_helm_table 33 | call helmeos 34 | 35 | ! write out the results 36 | call pretty_eos_out('helm: ') 37 | 38 | end 39 | -------------------------------------------------------------------------------- /vector_eos.dek: -------------------------------------------------------------------------------- 1 | ! declaration for pipelining the eos routines 2 | 3 | ! maximum length of the row vector 4 | integer nrowmax 5 | ! parameter (nrowmax = 1000) 6 | ! parameter (nrowmax = 10000) 7 | parameter (nrowmax = 1000000) 8 | 9 | 10 | ! maximum number of isotopes 11 | integer irowmax 12 | parameter (irowmax = 1) 13 | ! parameter (irowmax = 600) 14 | 15 | 16 | ! maximum number of ionization stages 17 | integer jstagemax 18 | parameter (jstagemax = 1) 19 | ! parameter (jstagemax = 30) 20 | 21 | 22 | ! failure of an eos 23 | logical eosfail 24 | common /eosfc1/ eosfail 25 | 26 | 27 | 28 | ! lower and upper limits of the loop over rows 29 | integer jlo_eos,jhi_eos 30 | common /eosvec2/ jlo_eos,jhi_eos 31 | 32 | 33 | 34 | ! thermodynamic and composition inputs 35 | double precision & 36 | temp_row(nrowmax),den_row(nrowmax), & 37 | abar_row(nrowmax),zbar_row(nrowmax), & 38 | zeff_row(nrowmax),ye_row(nrowmax) 39 | 40 | common /thinp/ & 41 | temp_row,den_row, & 42 | abar_row,zbar_row, & 43 | zeff_row,ye_row 44 | 45 | 46 | ! composition input 47 | integer niso 48 | double precision xmass_row(irowmax,nrowmax), & 49 | aion_row(irowmax,nrowmax), & 50 | zion_row(irowmax,nrowmax) 51 | common /cmpinp/ xmass_row,aion_row,zion_row,niso 52 | 53 | 54 | 55 | ! composition output 56 | double precision frac_row(jstagemax,irowmax,nrowmax) 57 | common /cmpout/ frac_row 58 | 59 | 60 | ! composition output for sneos 61 | double precision xn_row(nrowmax),xp_row(nrowmax), & 62 | xa_row(nrowmax),xhv_row(nrowmax), & 63 | xmuhat_row(nrowmax) 64 | common /cmpout2/ xn_row,xp_row, & 65 | xa_row,xhv_row, & 66 | xmuhat_row 67 | 68 | 69 | 70 | ! totals and their derivatives 71 | double precision & 72 | ptot_row(nrowmax), & 73 | dpt_row(nrowmax),dpd_row(nrowmax), & 74 | dpa_row(nrowmax),dpz_row(nrowmax), & 75 | dpdd_row(nrowmax),dpdt_row(nrowmax), & 76 | dpda_row(nrowmax),dpdz_row(nrowmax), & 77 | dptt_row(nrowmax),dpta_row(nrowmax), & 78 | dptz_row(nrowmax),dpaa_row(nrowmax), & 79 | dpaz_row(nrowmax),dpzz_row(nrowmax) 80 | 81 | common /ptotc1/ & 82 | ptot_row, & 83 | dpt_row,dpd_row, & 84 | dpa_row,dpz_row, & 85 | dpdd_row,dpdt_row, & 86 | dpda_row,dpdz_row, & 87 | dptt_row,dpta_row, & 88 | dptz_row,dpaa_row, & 89 | dpaz_row,dpzz_row 90 | 91 | double precision & 92 | etot_row(nrowmax), & 93 | det_row(nrowmax),ded_row(nrowmax), & 94 | dea_row(nrowmax),dez_row(nrowmax), & 95 | dedd_row(nrowmax),dedt_row(nrowmax), & 96 | deda_row(nrowmax),dedz_row(nrowmax), & 97 | dett_row(nrowmax),deta_row(nrowmax), & 98 | detz_row(nrowmax),deaa_row(nrowmax), & 99 | deaz_row(nrowmax),dezz_row(nrowmax) 100 | 101 | common /etotc1/ & 102 | etot_row, & 103 | det_row,ded_row, & 104 | dea_row,dez_row, & 105 | dedd_row,dedt_row, & 106 | deda_row,dedz_row, & 107 | dett_row,deta_row, & 108 | detz_row,deaa_row, & 109 | deaz_row,dezz_row 110 | 111 | double precision & 112 | stot_row(nrowmax), & 113 | dst_row(nrowmax),dsd_row(nrowmax), & 114 | dsa_row(nrowmax),dsz_row(nrowmax), & 115 | dsdd_row(nrowmax),dsdt_row(nrowmax), & 116 | dsda_row(nrowmax),dsdz_row(nrowmax), & 117 | dstt_row(nrowmax),dsta_row(nrowmax), & 118 | dstz_row(nrowmax),dsaa_row(nrowmax), & 119 | dsaz_row(nrowmax),dszz_row(nrowmax) 120 | 121 | common /stotc1/ & 122 | stot_row, & 123 | dst_row,dsd_row, & 124 | dsa_row,dsz_row, & 125 | dsdd_row,dsdt_row, & 126 | dsda_row,dsdz_row, & 127 | dstt_row,dsta_row, & 128 | dstz_row,dsaa_row, & 129 | dsaz_row,dszz_row 130 | 131 | 132 | 133 | ! radiation contributions 134 | double precision & 135 | prad_row(nrowmax), & 136 | dpradt_row(nrowmax),dpradd_row(nrowmax), & 137 | dprada_row(nrowmax),dpradz_row(nrowmax), & 138 | dpraddd_row(nrowmax),dpraddt_row(nrowmax), & 139 | dpradda_row(nrowmax),dpraddz_row(nrowmax), & 140 | dpradtt_row(nrowmax),dpradta_row(nrowmax), & 141 | dpradtz_row(nrowmax),dpradaa_row(nrowmax), & 142 | dpradaz_row(nrowmax),dpradzz_row(nrowmax) 143 | common /thprad/ & 144 | prad_row, & 145 | dpradt_row,dpradd_row, & 146 | dprada_row,dpradz_row, & 147 | dpraddd_row,dpraddt_row, & 148 | dpradda_row,dpraddz_row, & 149 | dpradtt_row,dpradta_row, & 150 | dpradtz_row,dpradaa_row, & 151 | dpradaz_row,dpradzz_row 152 | 153 | 154 | double precision & 155 | erad_row(nrowmax), & 156 | deradt_row(nrowmax),deradd_row(nrowmax), & 157 | derada_row(nrowmax),deradz_row(nrowmax), & 158 | deraddd_row(nrowmax),deraddt_row(nrowmax), & 159 | deradda_row(nrowmax),deraddz_row(nrowmax), & 160 | deradtt_row(nrowmax),deradta_row(nrowmax), & 161 | deradtz_row(nrowmax),deradaa_row(nrowmax), & 162 | deradaz_row(nrowmax),deradzz_row(nrowmax) 163 | common /therad/ & 164 | erad_row, & 165 | deradt_row,deradd_row, & 166 | derada_row,deradz_row, & 167 | deraddd_row,deraddt_row, & 168 | deradda_row,deraddz_row, & 169 | deradtt_row,deradta_row, & 170 | deradtz_row,deradaa_row, & 171 | deradaz_row,deradzz_row 172 | 173 | 174 | double precision & 175 | srad_row(nrowmax), & 176 | dsradt_row(nrowmax),dsradd_row(nrowmax), & 177 | dsrada_row(nrowmax),dsradz_row(nrowmax), & 178 | dsraddd_row(nrowmax),dsraddt_row(nrowmax), & 179 | dsradda_row(nrowmax),dsraddz_row(nrowmax), & 180 | dsradtt_row(nrowmax),dsradta_row(nrowmax), & 181 | dsradtz_row(nrowmax),dsradaa_row(nrowmax), & 182 | dsradaz_row(nrowmax),dsradzz_row(nrowmax) 183 | common /thsrad/ & 184 | srad_row, & 185 | dsradt_row,dsradd_row, & 186 | dsrada_row,dsradz_row, & 187 | dsraddd_row,dsraddt_row, & 188 | dsradda_row,dsraddz_row, & 189 | dsradtt_row,dsradta_row, & 190 | dsradtz_row,dsradaa_row, & 191 | dsradaz_row,dsradzz_row 192 | 193 | 194 | 195 | ! gas contributions 196 | double precision & 197 | pgas_row(nrowmax), & 198 | dpgast_row(nrowmax),dpgasd_row(nrowmax), & 199 | dpgasa_row(nrowmax),dpgasz_row(nrowmax), & 200 | dpgasdd_row(nrowmax),dpgasdt_row(nrowmax), & 201 | dpgasda_row(nrowmax),dpgasdz_row(nrowmax), & 202 | dpgastt_row(nrowmax),dpgasta_row(nrowmax), & 203 | dpgastz_row(nrowmax),dpgasaa_row(nrowmax), & 204 | dpgasaz_row(nrowmax),dpgaszz_row(nrowmax) 205 | 206 | common /thpgasc1/ & 207 | pgas_row, & 208 | dpgast_row,dpgasd_row, & 209 | dpgasa_row,dpgasz_row, & 210 | dpgasdd_row,dpgasdt_row, & 211 | dpgasda_row,dpgasdz_row, & 212 | dpgastt_row,dpgasta_row, & 213 | dpgastz_row,dpgasaa_row, & 214 | dpgasaz_row,dpgaszz_row 215 | 216 | double precision & 217 | egas_row(nrowmax), & 218 | degast_row(nrowmax),degasd_row(nrowmax), & 219 | degasa_row(nrowmax),degasz_row(nrowmax), & 220 | degasdd_row(nrowmax),degasdt_row(nrowmax), & 221 | degasda_row(nrowmax),degasdz_row(nrowmax), & 222 | degastt_row(nrowmax),degasta_row(nrowmax), & 223 | degastz_row(nrowmax),degasaa_row(nrowmax), & 224 | degasaz_row(nrowmax),degaszz_row(nrowmax) 225 | 226 | common /thegasc2/ & 227 | egas_row, & 228 | degast_row,degasd_row, & 229 | degasa_row,degasz_row, & 230 | degasdd_row,degasdt_row, & 231 | degasda_row,degasdz_row, & 232 | degastt_row,degasta_row, & 233 | degastz_row,degasaa_row, & 234 | degasaz_row,degaszz_row 235 | 236 | double precision & 237 | sgas_row(nrowmax), & 238 | dsgast_row(nrowmax),dsgasd_row(nrowmax), & 239 | dsgasa_row(nrowmax),dsgasz_row(nrowmax), & 240 | dsgasdd_row(nrowmax),dsgasdt_row(nrowmax), & 241 | dsgasda_row(nrowmax),dsgasdz_row(nrowmax), & 242 | dsgastt_row(nrowmax),dsgasta_row(nrowmax), & 243 | dsgastz_row(nrowmax),dsgasaa_row(nrowmax), & 244 | dsgasaz_row(nrowmax),dsgaszz_row(nrowmax) 245 | 246 | common /thsgasc1/ & 247 | sgas_row, & 248 | dsgast_row,dsgasd_row, & 249 | dsgasa_row,dsgasz_row, & 250 | dsgasdd_row,dsgasdt_row, & 251 | dsgasda_row,dsgasdz_row, & 252 | dsgastt_row,dsgasta_row, & 253 | dsgastz_row,dsgasaa_row, & 254 | dsgasaz_row,dsgaszz_row 255 | 256 | 257 | 258 | 259 | 260 | 261 | ! ion contributions 262 | double precision & 263 | pion_row(nrowmax), & 264 | dpiont_row(nrowmax),dpiond_row(nrowmax), & 265 | dpiona_row(nrowmax),dpionz_row(nrowmax), & 266 | dpiondd_row(nrowmax),dpiondt_row(nrowmax), & 267 | dpionda_row(nrowmax),dpiondz_row(nrowmax), & 268 | dpiontt_row(nrowmax),dpionta_row(nrowmax), & 269 | dpiontz_row(nrowmax),dpionaa_row(nrowmax), & 270 | dpionaz_row(nrowmax),dpionzz_row(nrowmax) 271 | common /thpion/ & 272 | pion_row, & 273 | dpiont_row,dpiond_row, & 274 | dpiona_row,dpionz_row, & 275 | dpiondd_row,dpiondt_row, & 276 | dpionda_row,dpiondz_row, & 277 | dpiontt_row,dpionta_row, & 278 | dpiontz_row,dpionaa_row, & 279 | dpionaz_row,dpionzz_row 280 | 281 | 282 | double precision & 283 | eion_row(nrowmax), & 284 | deiont_row(nrowmax),deiond_row(nrowmax), & 285 | deiona_row(nrowmax),deionz_row(nrowmax), & 286 | deiondd_row(nrowmax),deiondt_row(nrowmax), & 287 | deionda_row(nrowmax),deiondz_row(nrowmax), & 288 | deiontt_row(nrowmax),deionta_row(nrowmax), & 289 | deiontz_row(nrowmax),deionaa_row(nrowmax), & 290 | deionaz_row(nrowmax),deionzz_row(nrowmax) 291 | common /theion/ & 292 | eion_row, & 293 | deiont_row,deiond_row, & 294 | deiona_row,deionz_row, & 295 | deiondd_row,deiondt_row, & 296 | deionda_row,deiondz_row, & 297 | deiontt_row,deionta_row, & 298 | deiontz_row,deionaa_row, & 299 | deionaz_row,deionzz_row 300 | 301 | 302 | double precision & 303 | sion_row(nrowmax), & 304 | dsiont_row(nrowmax),dsiond_row(nrowmax), & 305 | dsiona_row(nrowmax),dsionz_row(nrowmax), & 306 | dsiondd_row(nrowmax),dsiondt_row(nrowmax), & 307 | dsionda_row(nrowmax),dsiondz_row(nrowmax), & 308 | dsiontt_row(nrowmax),dsionta_row(nrowmax), & 309 | dsiontz_row(nrowmax),dsionaa_row(nrowmax), & 310 | dsionaz_row(nrowmax),dsionzz_row(nrowmax) 311 | common /thsion/ & 312 | sion_row, & 313 | dsiont_row,dsiond_row, & 314 | dsiona_row,dsionz_row, & 315 | dsiondd_row,dsiondt_row, & 316 | dsionda_row,dsiondz_row, & 317 | dsiontt_row,dsionta_row, & 318 | dsiontz_row,dsionaa_row, & 319 | dsionaz_row,dsionzz_row 320 | 321 | double precision & 322 | etaion_row(nrowmax), & 323 | detait_row(nrowmax),detaid_row(nrowmax), & 324 | detaia_row(nrowmax),detaiz_row(nrowmax), & 325 | detaidd_row(nrowmax),detaidt_row(nrowmax), & 326 | detaida_row(nrowmax),detaidz_row(nrowmax), & 327 | detaitt_row(nrowmax),detaita_row(nrowmax), & 328 | detaitz_row(nrowmax),detaiaa_row(nrowmax), & 329 | detaiaz_row(nrowmax),detaizz_row(nrowmax) 330 | common /thetaion/ & 331 | etaion_row, & 332 | detait_row,detaid_row, & 333 | detaia_row,detaiz_row, & 334 | detaidd_row,detaidt_row, & 335 | detaida_row,detaidz_row, & 336 | detaitt_row,detaita_row, & 337 | detaitz_row,detaiaa_row, & 338 | detaiaz_row,detaizz_row 339 | 340 | 341 | double precision & 342 | xni_row(nrowmax),xnim_row(nrowmax), & 343 | dxnit_row(nrowmax),dxnid_row(nrowmax), & 344 | dxnia_row(nrowmax),dxniz_row(nrowmax), & 345 | dxnidd_row(nrowmax),dxnidt_row(nrowmax), & 346 | dxnida_row(nrowmax),dxnidz_row(nrowmax), & 347 | dxnitt_row(nrowmax),dxnita_row(nrowmax), & 348 | dxnitz_row(nrowmax),dxniaa_row(nrowmax), & 349 | dxniaz_row(nrowmax),dxnizz_row(nrowmax) 350 | common /th_xni_ion/ & 351 | xni_row,xnim_row, & 352 | dxnit_row,dxnid_row, & 353 | dxnia_row,dxniz_row, & 354 | dxnidd_row,dxnidt_row, & 355 | dxnida_row,dxnidz_row, & 356 | dxnitt_row,dxnita_row, & 357 | dxnitz_row,dxniaa_row, & 358 | dxniaz_row,dxnizz_row 359 | 360 | 361 | 362 | ! electron-positron contributions 363 | 364 | double precision & 365 | etaele_row(nrowmax),etapos_row(nrowmax), & 366 | detat_row(nrowmax),detad_row(nrowmax), & 367 | detaa_row(nrowmax),detaz_row(nrowmax), & 368 | detadd_row(nrowmax),detadt_row(nrowmax), & 369 | detada_row(nrowmax),detadz_row(nrowmax), & 370 | detatt_row(nrowmax),detata_row(nrowmax), & 371 | detatz_row(nrowmax),detaaa_row(nrowmax), & 372 | detaaz_row(nrowmax),detazz_row(nrowmax) 373 | 374 | common /etapc1/ & 375 | etaele_row,etapos_row, & 376 | detat_row,detad_row, & 377 | detaa_row,detaz_row, & 378 | detadd_row,detadt_row, & 379 | detada_row,detadz_row, & 380 | detatt_row,detata_row, & 381 | detatz_row,detaaa_row, & 382 | detaaz_row,detazz_row 383 | 384 | double precision & 385 | pele_row(nrowmax),ppos_row(nrowmax), & 386 | dpept_row(nrowmax),dpepd_row(nrowmax), & 387 | dpepa_row(nrowmax),dpepz_row(nrowmax), & 388 | dpepdd_row(nrowmax),dpepdt_row(nrowmax), & 389 | dpepda_row(nrowmax),dpepdz_row(nrowmax), & 390 | dpeptt_row(nrowmax),dpepta_row(nrowmax), & 391 | dpeptz_row(nrowmax),dpepaa_row(nrowmax), & 392 | dpepaz_row(nrowmax),dpepzz_row(nrowmax) 393 | 394 | common /thpepc1/ & 395 | pele_row,ppos_row, & 396 | dpept_row,dpepd_row, & 397 | dpepa_row,dpepz_row, & 398 | dpepdd_row,dpepdt_row, & 399 | dpepda_row,dpepdz_row, & 400 | dpeptt_row,dpepta_row, & 401 | dpeptz_row,dpepaa_row, & 402 | dpepaz_row,dpepzz_row 403 | 404 | 405 | double precision & 406 | eele_row(nrowmax),epos_row(nrowmax), & 407 | deept_row(nrowmax),deepd_row(nrowmax), & 408 | deepa_row(nrowmax),deepz_row(nrowmax), & 409 | deepdd_row(nrowmax),deepdt_row(nrowmax), & 410 | deepda_row(nrowmax),deepdz_row(nrowmax), & 411 | deeptt_row(nrowmax),deepta_row(nrowmax), & 412 | deeptz_row(nrowmax),deepaa_row(nrowmax), & 413 | deepaz_row(nrowmax),deepzz_row(nrowmax) 414 | 415 | common /theepc1/ & 416 | eele_row,epos_row, & 417 | deept_row,deepd_row, & 418 | deepa_row,deepz_row, & 419 | deepdd_row,deepdt_row, & 420 | deepda_row,deepdz_row, & 421 | deeptt_row,deepta_row, & 422 | deeptz_row,deepaa_row, & 423 | deepaz_row,deepzz_row 424 | 425 | 426 | double precision & 427 | sele_row(nrowmax),spos_row(nrowmax), & 428 | dsept_row(nrowmax),dsepd_row(nrowmax), & 429 | dsepa_row(nrowmax),dsepz_row(nrowmax), & 430 | dsepdd_row(nrowmax),dsepdt_row(nrowmax), & 431 | dsepda_row(nrowmax),dsepdz_row(nrowmax), & 432 | dseptt_row(nrowmax),dsepta_row(nrowmax), & 433 | dseptz_row(nrowmax),dsepaa_row(nrowmax), & 434 | dsepaz_row(nrowmax),dsepzz_row(nrowmax) 435 | 436 | common /thsepc1/ & 437 | sele_row,spos_row, & 438 | dsept_row,dsepd_row, & 439 | dsepa_row,dsepz_row, & 440 | dsepdd_row,dsepdt_row, & 441 | dsepda_row,dsepdz_row, & 442 | dseptt_row,dsepta_row, & 443 | dseptz_row,dsepaa_row, & 444 | dsepaz_row,dsepzz_row 445 | 446 | 447 | double precision & 448 | xne_row(nrowmax),xnp_row(nrowmax),xnem_row(nrowmax), & 449 | dxnet_row(nrowmax),dxned_row(nrowmax), & 450 | dxnea_row(nrowmax),dxnez_row(nrowmax), & 451 | dxnedd_row(nrowmax),dxnedt_row(nrowmax), & 452 | dxneda_row(nrowmax),dxnedz_row(nrowmax), & 453 | dxnett_row(nrowmax),dxneta_row(nrowmax), & 454 | dxnetz_row(nrowmax),dxneaa_row(nrowmax), & 455 | dxneaz_row(nrowmax),dxnezz_row(nrowmax) 456 | 457 | common /thxnec1/ & 458 | xne_row,xnp_row,xnem_row, & 459 | dxnet_row,dxned_row, & 460 | dxnea_row,dxnez_row, & 461 | dxnedd_row,dxnedt_row, & 462 | dxneda_row,dxnedz_row, & 463 | dxnett_row,dxneta_row, & 464 | dxnetz_row,dxneaa_row, & 465 | dxneaz_row,dxnezz_row 466 | 467 | 468 | 469 | ! ionization potential contributions 470 | double precision pip_row(nrowmax), & 471 | dpipt_row(nrowmax), dpipd_row(nrowmax), & 472 | dpipa_row(nrowmax), dpipz_row(nrowmax), & 473 | eip_row(nrowmax), & 474 | deipt_row(nrowmax), deipd_row(nrowmax), & 475 | deipa_row(nrowmax), deipz_row(nrowmax), & 476 | sip_row(nrowmax), & 477 | dsipt_row(nrowmax), dsipd_row(nrowmax), & 478 | dsipa_row(nrowmax), dsipz_row(nrowmax) 479 | common /thxip/ pip_row,dpipt_row,dpipd_row,dpipa_row,dpipz_row, & 480 | eip_row,deipt_row,deipd_row,deipa_row,deipz_row, & 481 | sip_row,dsipt_row,dsipd_row,dsipa_row,dsipz_row 482 | 483 | 484 | 485 | ! coulomb contributions 486 | double precision & 487 | pcou_row(nrowmax), & 488 | dpcout_row(nrowmax),dpcoud_row(nrowmax), & 489 | dpcoua_row(nrowmax),dpcouz_row(nrowmax), & 490 | ecou_row(nrowmax), & 491 | decout_row(nrowmax),decoud_row(nrowmax), & 492 | decoua_row(nrowmax),decouz_row(nrowmax), & 493 | scou_row(nrowmax), & 494 | dscout_row(nrowmax),dscoud_row(nrowmax), & 495 | dscoua_row(nrowmax),dscouz_row(nrowmax), & 496 | plasg_row(nrowmax) 497 | common /thcou/ & 498 | pcou_row, & 499 | dpcout_row,dpcoud_row, & 500 | dpcoua_row,dpcouz_row, & 501 | ecou_row, & 502 | decout_row,decoud_row, & 503 | decoua_row,decouz_row, & 504 | scou_row, & 505 | dscout_row,dscoud_row, & 506 | dscoua_row,dscouz_row, & 507 | plasg_row 508 | 509 | 510 | ! thermodynamic consistency checks; maxwell relations 511 | double precision & 512 | dse_row(nrowmax),dpe_row(nrowmax),dsp_row(nrowmax) 513 | common /thmax/ & 514 | dse_row,dpe_row,dsp_row 515 | 516 | 517 | ! derivative based quantities for the gas 518 | double precision & 519 | cp_gas_row(nrowmax), & 520 | dcp_gasdd_row(nrowmax),dcp_gasdt_row(nrowmax), & 521 | dcp_gasda_row(nrowmax),dcp_gasdz_row(nrowmax), & 522 | cv_gas_row(nrowmax), & 523 | dcv_gasdd_row(nrowmax),dcv_gasdt_row(nrowmax), & 524 | dcv_gasda_row(nrowmax),dcv_gasdz_row(nrowmax) 525 | 526 | common /thdergc1/ & 527 | cp_gas_row, & 528 | dcp_gasdd_row,dcp_gasdt_row, & 529 | dcp_gasda_row,dcp_gasdz_row, & 530 | cv_gas_row, & 531 | dcv_gasdd_row,dcv_gasdt_row, & 532 | dcv_gasda_row,dcv_gasdz_row 533 | 534 | double precision & 535 | gam1_gas_row(nrowmax), & 536 | dgam1_gasdd_row(nrowmax),dgam1_gasdt_row(nrowmax), & 537 | dgam1_gasda_row(nrowmax),dgam1_gasdz_row(nrowmax), & 538 | gam2_gas_row(nrowmax), & 539 | dgam2_gasdd_row(nrowmax),dgam2_gasdt_row(nrowmax), & 540 | dgam2_gasda_row(nrowmax),dgam2_gasdz_row(nrowmax), & 541 | gam3_gas_row(nrowmax), & 542 | dgam3_gasdd_row(nrowmax),dgam3_gasdt_row(nrowmax), & 543 | dgam3_gasda_row(nrowmax),dgam3_gasdz_row(nrowmax), & 544 | nabad_gas_row(nrowmax), & 545 | dnab_gasdd_row(nrowmax),dnab_gasdt_row(nrowmax), & 546 | dnab_gasda_row(nrowmax),dnab_gasdz_row(nrowmax), & 547 | cs_gas_row(nrowmax), & 548 | dcs_gasdd_row(nrowmax),dcs_gasdt_row(nrowmax), & 549 | dcs_gasda_row(nrowmax),dcs_gasdz_row(nrowmax) 550 | 551 | common /thdergc2/ & 552 | gam1_gas_row, & 553 | dgam1_gasdd_row,dgam1_gasdt_row, & 554 | dgam1_gasda_row,dgam1_gasdz_row, & 555 | gam2_gas_row, & 556 | dgam2_gasdd_row,dgam2_gasdt_row, & 557 | dgam2_gasda_row,dgam2_gasdz_row, & 558 | gam3_gas_row, & 559 | dgam3_gasdd_row,dgam3_gasdt_row, & 560 | dgam3_gasda_row,dgam3_gasdz_row, & 561 | nabad_gas_row, & 562 | dnab_gasdd_row,dnab_gasdt_row, & 563 | dnab_gasda_row,dnab_gasdz_row, & 564 | cs_gas_row, & 565 | dcs_gasdd_row,dcs_gasdt_row, & 566 | dcs_gasda_row,dcs_gasdz_row 567 | 568 | 569 | 570 | ! derivative based quantities for the totals 571 | double precision & 572 | cp_row(nrowmax), & 573 | dcpdd_row(nrowmax),dcpdt_row(nrowmax), & 574 | dcpda_row(nrowmax),dcpdz_row(nrowmax), & 575 | cv_row(nrowmax), & 576 | dcvdd_row(nrowmax),dcvdt_row(nrowmax), & 577 | dcvda_row(nrowmax),dcvdz_row(nrowmax) 578 | 579 | common /thdertc1/ & 580 | cp_row, & 581 | dcpdd_row,dcpdt_row, & 582 | dcpda_row,dcpdz_row, & 583 | cv_row, & 584 | dcvdd_row,dcvdt_row, & 585 | dcvda_row,dcvdz_row 586 | 587 | double precision & 588 | gam1_row(nrowmax), & 589 | dgam1dd_row(nrowmax),dgam1dt_row(nrowmax), & 590 | dgam1da_row(nrowmax),dgam1dz_row(nrowmax), & 591 | gam2_row(nrowmax), & 592 | dgam2dd_row(nrowmax),dgam2dt_row(nrowmax), & 593 | dgam2da_row(nrowmax),dgam2dz_row(nrowmax), & 594 | gam3_row(nrowmax), & 595 | dgam3dd_row(nrowmax),dgam3dt_row(nrowmax), & 596 | dgam3da_row(nrowmax),dgam3dz_row(nrowmax), & 597 | nabad_row(nrowmax), & 598 | dnabdd_row(nrowmax),dnabdt_row(nrowmax), & 599 | dnabda_row(nrowmax),dnabdz_row(nrowmax), & 600 | cs_row(nrowmax), & 601 | dcsdd_row(nrowmax),dcsdt_row(nrowmax), & 602 | dcsda_row(nrowmax),dcsdz_row(nrowmax) 603 | 604 | common /thdertc2/ & 605 | gam1_row, & 606 | dgam1dd_row,dgam1dt_row, & 607 | dgam1da_row,dgam1dz_row, & 608 | gam2_row, & 609 | dgam2dd_row,dgam2dt_row, & 610 | dgam2da_row,dgam2dz_row, & 611 | gam3_row, & 612 | dgam3dd_row,dgam3dt_row, & 613 | dgam3da_row,dgam3dz_row, & 614 | nabad_row, & 615 | dnabdd_row,dnabdt_row, & 616 | dnabda_row,dnabdz_row, & 617 | cs_row, & 618 | dcsdd_row,dcsdt_row, & 619 | dcsda_row,dcsdz_row 620 | 621 | 622 | 623 | 624 | ! a few work arrays 625 | double precision eoswrk01(nrowmax),eoswrk02(nrowmax), & 626 | eoswrk03(nrowmax),eoswrk04(nrowmax) 627 | common /deedoo/ eoswrk01,eoswrk02,eoswrk03,eoswrk04 628 | 629 | 630 | ! for debugging 631 | double precision & 632 | crp_row(nrowmax), & 633 | dcrpt_row(nrowmax),dcrpd_row(nrowmax), & 634 | dcrpa_row(nrowmax),dcrpz_row(nrowmax), & 635 | dcrpdd_row(nrowmax),dcrpdt_row(nrowmax), & 636 | dcrpda_row(nrowmax),dcrpdz_row(nrowmax), & 637 | dcrptt_row(nrowmax),dcrpta_row(nrowmax), & 638 | dcrptz_row(nrowmax),dcrpaa_row(nrowmax), & 639 | dcrpaz_row(nrowmax),dcrpzz_row(nrowmax) 640 | 641 | 642 | common /crpc1/ & 643 | crp_row, & 644 | dcrpt_row,dcrpd_row, & 645 | dcrpa_row,dcrpz_row, & 646 | dcrpdd_row,dcrpdt_row, & 647 | dcrpda_row,dcrpdz_row, & 648 | dcrptt_row,dcrpta_row, & 649 | dcrptz_row,dcrpaa_row, & 650 | dcrpaz_row,dcrpzz_row 651 | --------------------------------------------------------------------------------