git push -u origin main

2026-03-19 14:05:33 +08:00
commit 1e30b7bc63
739 changed files with 572150 additions and 0 deletions
@@ -0,0 +1,89 @@
+      subroutine cia_h2h2(t,ah2,ff,opac)
+c     ===================--=============
+c
+c     CIA H2-H2 opacity
+c     data from Borysow A., Jorgensen U.G., Fu Y. 2001, JQSRT 68, 235
+c
+      IMPLICIT REAL*8(A-H,O-Z)
+      parameter (nlines=1000)
+      dimension freq(nlines),temp(7),alpha(nlines,7)
+      parameter (amagat=2.6867774d+19,fac=1./amagat**2)
+      data temp / 1000. , 2000. , 3000. , 4000. , 5000. , 6000. ,
+     *            7000. /
+      data ntemp /7/
+      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-H2 CIA opacity tables...'
+         open(10,file="./data/CIA_H2H2.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-H2 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*ah2*alp
+c
+      return
+      end