Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

add updated CFC cross section datasets #29

Merged
merged 1 commit into from
Jan 12, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Binary file added data/cross_sections/CF2CL2_JPL06.nc
Binary file not shown.
Binary file added data/cross_sections/CFC113_JPL06.nc
Binary file not shown.
Binary file added data/cross_sections/CFC114_JPL10.nc
Binary file not shown.
Binary file added data/cross_sections/CFC115_JPL10.nc
Binary file not shown.
Binary file added data/cross_sections/CFCL3_JPL06.nc
Binary file not shown.
Binary file added data/cross_sections/CH3BR_JPL06.nc
Binary file not shown.
Binary file added data/cross_sections/CHBR3_JPL10.nc
Binary file not shown.
Binary file added data/cross_sections/H1301_JPL06.nc
Binary file not shown.
Binary file added data/cross_sections/H2402_JPL06.nc
Binary file not shown.
Binary file added data/cross_sections/HCFC141b_JPL10.nc
Binary file not shown.
Binary file added data/cross_sections/HCFC142b_JPL10.nc
Binary file not shown.
Binary file added data/cross_sections/HCFC22_JPL06.nc
Binary file not shown.
383 changes: 309 additions & 74 deletions examples/ts1_tsmlt.json

Large diffs are not rendered by default.

137 changes: 102 additions & 35 deletions src/cross_sections/temperature_based.F90

Large diffs are not rendered by default.

445 changes: 441 additions & 4 deletions test/data/xsqy.doug.config.json

Large diffs are not rendered by default.

12 changes: 12 additions & 0 deletions test/unit/tuv_doug/JCALC/CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -4,10 +4,22 @@
target_sources(tuv_doug
PRIVATE
XSQY_BRO.f
XSQY_CF2CL2.f
XSQY_CFC113.f
XSQY_CFC114.f
XSQY_CFC115.f
XSQY_CFCL3.f
XSQY_CH2BR2.f
XSQY_CH3BR.f
XSQY_CHBR3.f
XSQY_CL2O2.f
XSQY_CLO.f
XSQY_H2O.f
XSQY_H1301.f
XSQY_H2402.f
XSQY_HCFC22.f
XSQY_HCFC141b.f
XSQY_HCFC142b.f
XSQY_HNO3.f
XSQY_N2O5.f
)
Expand Down
234 changes: 234 additions & 0 deletions test/unit/tuv_doug/JCALC/XSQY_CF2CL2.f
Original file line number Diff line number Diff line change
@@ -0,0 +1,234 @@
subroutine XSQY_CF2CL2(nw,wl,wc,nz,tlev,airlev,j,sq,jlabel,pn)
!-----------------------------------------------------------------------------!
! purpose: !
! provide product (cross section) x (quantum yield) for cf2cl2 photolysis: !
! CF2Cl2 + hv -> 2Cl !
! cross section: from JPL06 recommendation !
! quantum yield: assumed to be unity !
!-----------------------------------------------------------------------------!
! parameters: !
! nw - integer, number of specified intervals + 1 in working (i) !
! wavelength grid !
! wl - real, vector of lower limits of wavelength intervals in (i) !
! working wavelength grid !
! wc - real, vector of center points of wavelength intervals in (i) !
! working wavelength grid !
! nz - integer, number of altitude levels in working altitude grid (i) !
! tlev - real, temperature (k) at each specified altitude level (i) !
! airlev - real, air density (molec/cc) at each altitude level (i) !
! j - integer, counter for number of weighting functions defined (io) !
! sq - real, cross section x quantum yield (cm^2) for each (o) !
! photolysis reaction defined, at each defined wavelength and !
! at each defined altitude level !
! jlabel - character*60, string identifier for each photolysis reaction (o) !
! defined !
!-----------------------------------------------------------------------------!
! edit history: !
! 01/16/08 Doug Kinnison !
!-----------------------------------------------------------------------------!
implicit none
include 'params'

!-----------------------------------------------------------------------------!
! ... input !
!-----------------------------------------------------------------------------!
real, intent(in) :: wl(kw)
real, intent(in) :: wc(kw)
real, intent(in) :: tlev(kz)
real, intent(in) :: airlev(kz)

integer, intent(in) :: nz
integer, intent(in) :: nw

character*80, intent(in) :: pn
character*60, intent(out) :: jlabel(kj)
real, intent(out) :: sq(kj,kz,kw)

!-----------------------------------------------------------------------------!
! ... input/output !
!-----------------------------------------------------------------------------!
integer, intent(inout) :: j

!-----------------------------------------------------------------------------!
! ... local !
!-----------------------------------------------------------------------------!
integer kdata
parameter(kdata=300)
integer i, iw, n, idum, nloop, n1
integer ierr, iz, iwc, icnt
real x1 (kdata), y1 (kdata)
real xin (kdata), yin (kdata)
real wctmp(kdata), wcb (kdata)
real ytmp (nz,kdata), ycomb(nz,kdata)
real yg1(kw), tin (nz)
real ytd (nz,kw)
real AA(5), BB(5), lp(5)
real qy, ysave


AA(1) = -43.8954569
AA(2) = -2.403597e-1
AA(3) = -4.2619e-4
AA(4) = 9.8743e-6

BB(1) = 4.8438e-3
BB(2) = 4.96145e-4
BB(3) = -5.6953e-6

lp(1) = 0.0
lp(2) = 1.0
lp(3) = 2.0
lp(4) = 3.0
lp(5) = 4.0

!---------------------------------------------------
! ... tin set to tlev
!---------------------------------------------------
tin(:) = tlev(:)

!---------------------------------------------------
! ... jlabel(j) = 'CF2Cl2 + hv -> 2Cl'
!---------------------------------------------------
j = j+1
jlabel(j) = 'CF2Cl2 + hv -> 2Cl'

!---------------------------------------------------
! Derive temperature dependence
!---------------------------------------------------
! Temperature dependence good between
! 220-296K and 200 nm-231 nm
!---------------------------------------------------
iwc = 1
ytmp(:,:)= 0.0

do iw = 1, nw-1

IF ((wc(iw) .GE. 200.) .AND. (wc(iw) .LE.231.)) THEN

do iz = 1, nz

IF (tin(iz) .LT. 220.) THEN
do nloop = 1, 4
ytmp(iz,iwc) = ytmp(iz,iwc)
& + AA(nloop)* (wc(iw)-200.)**lp(nloop)
enddo
do nloop = 1, 3
ytmp(iz,iwc) = ytmp(iz,iwc)
& + (220.-296.)* BB(nloop)*(wc(iw)-200.)**lp(nloop)
enddo
wctmp(iwc) = wc(iw)
ENDIF

IF ((tin(iz) .GE. 220.).AND.(tin(iz) .LE. 296.)) THEN
do nloop = 1, 4
ytmp(iz,iwc) = ytmp(iz,iwc)
& + AA(nloop)* (wc(iw)-200.)**lp(nloop)
enddo
do nloop = 1, 3
ytmp(iz,iwc) = ytmp(iz,iwc)
& + (tin(iz)-296.)* BB(nloop)*(wc(iw)-200.)**lp(nloop)
enddo
wctmp(iwc) = wc(iw)
ENDIF

IF (tin(iz) .GT. 296.) THEN
do nloop = 1, 4
ytmp(iz,iwc) = ytmp(iz,iwc)
& + AA(nloop)* (wc(iw)-200.)**lp(nloop)
enddo
wctmp(iwc) = wc(iw)
ENDIF

enddo
iwc = iwc+ 1

ENDIF

enddo
!---------------------------------------------------
! ... For wavelengths >232 nm and <200 nm
!---------------------------------------------------
open(kin,file=TRIM(pn)//'XS_CF2CL2_JPL06.txt',status='old')

read(kin,*) idum, n
do i = 1, idum-2
read(kin,*)
enddo

do i = 1, n
read(kin,*) xin(i), yin(i)
enddo

close(kin)
!---------------------------------------------------
! ... Combine cross sections
!---------------------------------------------------
do iz = 1, nz
icnt = 1

! ... < 200nm
do i = 1, n
IF (xin(i) .LT. 200.) THEN
ycomb(iz,icnt) = yin(i)
wcb (icnt) = xin(i)
icnt = icnt + 1
ENDIF
enddo
! ... 200-231 nm
do i = 1, iwc-1
ycomb(iz,icnt) = exp(ytmp(iz,i))
wcb (icnt) = wctmp(i)
icnt = icnt+1
enddo
! ... >231nm
do i = 1, n
IF (xin(i) .GT. 231.) THEN
ycomb(iz,icnt) = yin(i)
wcb (icnt) = xin(i)
icnt = icnt+1
ENDIF
enddo
enddo
!---------------------------------------------------
! ... interpolate
!---------------------------------------------------
do iz = 1, nz
n1 = icnt-1
y1 = ycomb(iz,:)
x1 = wcb
!---------------------------------------------------
! do iw = 1, icnt-1
! print*, iw, wcb(iw), ycomb(iz,iw), tin(iz)
! enddo
! stop
!---------------------------------------------------
call addpnt(x1,y1,kdata,n1,x1(1)*(1.-deltax),0.)
call addpnt(x1,y1,kdata,n1, 0.,0.)
call addpnt(x1,y1,kdata,n1,x1(n1)*(1.+deltax),0.)
call addpnt(x1,y1,kdata,n1, 1e38,0.)
call inter2(nw,wl,yg1,n1,x1,y1,ierr)
ytd(iz,:) = yg1(:)

if (ierr .ne. 0) then
write(*,*) ierr, jlabel(j)
stop
endif
enddo
!--------------------------------------------------
! iz = 1
! do iw = 19, 64
! print*, iw, wc(iw), ytd(iz,iw), tin(iz)
! enddo
! stop
!--------------------------------------------------
!--------------------------------------------------
! ...quantum yield assumed to be unity
!--------------------------------------------------
qy = 1.
do iw = 1, nw-1
do iz = 1, nz
sq(j,iz,iw) = qy * ytd(iz,iw)
enddo
enddo

end subroutine XSQY_CF2CL2
Loading
Loading