88 lines
2.3 KiB
Fortran
88 lines
2.3 KiB
Fortran
subroutine cia_h2h(t,ah2,ah,ff,opac)
|
|
c ====================================
|
|
c
|
|
c CIA H2-H opacity - data taken from TURBOSPEC
|
|
c
|
|
IMPLICIT REAL*8(A-H,O-Z)
|
|
parameter (nlines=67)
|
|
dimension freq(nlines),temp(4),alpha(nlines,4)
|
|
parameter (amagat=2.6867774d+19,fac=1./amagat**2)
|
|
data temp / 1000. , 1500., 2000. , 2500. /
|
|
data ntemp /4/
|
|
data ifirst /0/
|
|
PARAMETER (CAS=2.997925D10)
|
|
c input frequency in Hz but needed wave numbers in cm^-1
|
|
f=ff/cas
|
|
c read in CIA tables if this is the first call
|
|
if (ifirst.eq.0) then
|
|
write(*,'(a)') 'Reading in H2-H CIA opacity tables...'
|
|
open(10,file="./data/CIA_H2H.dat",status='old')
|
|
do i=1,3
|
|
read (10,*)
|
|
enddo
|
|
do i=1,nlines
|
|
read (10,*) freq(i),(alpha(i,j),j=1,ntemp)
|
|
enddo
|
|
close(10)
|
|
|
|
c take logarithm of tables prior to doing linear interpolations
|
|
|
|
do i=1,nlines
|
|
do j=1,ntemp
|
|
alpha(i,j)=log(alpha(i,j))
|
|
enddo
|
|
enddo
|
|
|
|
ifirst=1
|
|
endif
|
|
|
|
c locate position in temperature array
|
|
call locate(temp,ntemp,t,j,ntemp)
|
|
|
|
if (j.eq.0) then
|
|
write(*,*)
|
|
write(*,'(a,f6.0,a)')
|
|
* 'Warning: requested temperature is below',temp(1),' K'
|
|
write(*,'(a)') 'CIA H2-H opacity set to 0'
|
|
write(*,*)
|
|
opac=0.
|
|
return
|
|
endif
|
|
|
|
c locate position in frequency array
|
|
call locate(freq,nlines,f,i,nlines)
|
|
|
|
c linearly interpolate in frequency and temperature
|
|
|
|
if (j.eq.ntemp) then
|
|
c hold values constant if off high temperature end of table
|
|
y1=alpha(i,j)
|
|
y2=alpha(i+1,j)
|
|
tt=(f-freq(i))/(freq(i+1)-freq(i))
|
|
alp=(1.-tt)*y1 + tt*y2
|
|
else if (i.eq.0 .or. i.eq.nlines) then
|
|
c set values to a very small number if off frequency table
|
|
alp=-50.
|
|
else
|
|
c interpolate linearly within table
|
|
y1=alpha(i,j)
|
|
y2=alpha(i+1,j)
|
|
y3=alpha(i+1,j+1)
|
|
y4=alpha(i,j+1)
|
|
|
|
tt=(f-freq(i))/(freq(i+1)-freq(i))
|
|
uu=(t-temp(j))/(temp(j+1)-temp(j))
|
|
|
|
alp=(1.-tt)*(1.-uu)*y1 + tt*(1.-uu)*y2 + tt*uu*y3 +
|
|
* (1.-tt)*uu*y4
|
|
endif
|
|
|
|
alp=exp(alp)
|
|
|
|
c final opacity
|
|
|
|
opac=fac*ah2*ah*alp
|
|
c
|
|
return
|
|
end
|