213 lines
5.9 KiB
Fortran
213 lines
5.9 KiB
Fortran
!------------------------------------------------------------------------------
|
|
! GEOS-Chem Global Chemical Transport Model !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !MODULE: FJX_ACET_MOD
|
|
!
|
|
! !DESCRIPTION: \subsection*{Overview}
|
|
! This module contains functions used for the new acetone pressure
|
|
! dependency calculation in JRATET.f introduced in FAST-JX version 6.7
|
|
! This is a hack to effectively implement Fast-JX v7.0b acetone
|
|
! photolysis into Fast-J. See use in JRATET.f
|
|
!
|
|
!\subsection*{Reference}
|
|
! Blitz, M. A., D. E. Heard, M. J. Pilling, S. R. Arnold, M. P. Chipperfield
|
|
! 2004: \emph{Pressure and temperature-dependent quantum yields for the
|
|
! photodissociation of acetone between 279 and 327.5 nm},
|
|
! \underline{GRL}, \textbf{31}, 9, L09104.
|
|
!\\
|
|
!\\
|
|
!
|
|
! !INTERFACE:
|
|
!
|
|
MODULE FJX_ACET_MOD
|
|
!
|
|
! !USES:
|
|
!
|
|
IMPLICIT NONE
|
|
PRIVATE
|
|
!
|
|
! !PUBLIC MEMBER FUNCTIONS:
|
|
!
|
|
PUBLIC :: QQA
|
|
PUBLIC :: QQB
|
|
!
|
|
! !AUTHOR:
|
|
! Original code from Michael Prather.
|
|
! Implemented into GEOS-Chem by Claire Carouge (ccarouge@seas.harvard.edu)
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 20 Apr 2009 - C. Carouge - Created the module from fastJX64.f code.
|
|
! 20 Aug 2013 - R. Yantosca - Removed "define.h", this is now obsolete
|
|
! 19 May 2014 - M. Sulprizio- Update acetone photolysis to Fast-JX v7.0b
|
|
! (S.D. Eastham)
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
CONTAINS
|
|
|
|
!------------------------------------------------------------------------------
|
|
! GEOS-Chem Global Chemical Transport Model !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: QQA
|
|
!
|
|
! !DESCRIPTION:
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
subroutine QQA(PP,QQQT,K)
|
|
!
|
|
! !USES:
|
|
!
|
|
implicit none
|
|
# include "cmn_fj.h"
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
real*8, intent(in) :: PP
|
|
integer, intent(in) :: K
|
|
!
|
|
! !OUTPUT PARAMETERS:
|
|
!
|
|
real*8, intent(out) :: QQQT
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
logical,save::FIRST=.TRUE.
|
|
real*8,dimension(7,3),save::QQQ
|
|
real*8,dimension(3),save::TQQ
|
|
|
|
if (FIRST) then
|
|
FIRST=.false.
|
|
! Declare arrays
|
|
! Pressure at which cross-sections calculated
|
|
TQQ = (/177.0d0,566.0d0,999.0d0/)
|
|
! Taking only the last 7 bins from Fast-JX (!)
|
|
QQQ(:,1) = (/ 1.980d-20, 5.927d-21, 6.000d-22, 5.868d-23,
|
|
& 5.934d-25, 0.000d0, 0.000d0 /)
|
|
QQQ(:,2) = (/ 1.240d-20, 4.464d-21, 7.146d-22, 1.171d-22,
|
|
& 2.202d-24, 0.000d0, 0.000d0 /)
|
|
QQQ(:,3) = (/ 9.213d-21, 3.702d-21, 7.100d-22, 1.357d-22,
|
|
& 3.115d-24, 0.000d0, 0.000d0 /)
|
|
endif
|
|
call X_interp_FJX (PP,QQQT, TQQ(1),QQQ(K,1),
|
|
& TQQ(2),QQQ(K,2), TQQ(3),QQQ(K,3), 3)
|
|
|
|
end subroutine QQA
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! GEOS-Chem Global Chemical Transport Model !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: QQB
|
|
!
|
|
! !DESCRIPTION:
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
subroutine QQB(TT,QQQT,K)
|
|
!
|
|
! !USES:
|
|
!
|
|
implicit none
|
|
# include "cmn_fj.h"
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
real*8, intent(in) :: TT
|
|
integer, intent(in) :: K
|
|
!
|
|
! !OUTPUT PARAMETERS:
|
|
!
|
|
real*8, intent(out) :: QQQT
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
logical,save::FIRST=.TRUE.
|
|
real*8,dimension(7,3),save::QQQ
|
|
real*8,dimension(3),save::TQQ
|
|
|
|
if (FIRST) then
|
|
FIRST=.false.
|
|
! Declare arrays
|
|
! Temperature at which cross-sections calculated
|
|
TQQ = (/235.0d0,260.0d0,298.0d0/)
|
|
! Taking only the last 7 bins from Fast-JX (!)
|
|
QQQ(:,1) = (/ 1.158d-22, 2.648d-23, 6.014d-24, 1.502d-24,
|
|
& 4.211d-26, 0.000d0, 0.000d0 /)
|
|
QQQ(:,2) = (/ 5.664d-22, 1.681d-22, 4.919d-23, 1.477d-23,
|
|
& 5.602d-25, 0.000d0, 0.000d0 /)
|
|
QQQ(:,3) = (/ 2.804d-21, 1.092d-21, 4.079d-22, 1.496d-22,
|
|
& 7.707d-24, 0.000d0, 0.000d0 /)
|
|
endif
|
|
call X_interp_FJX (TT,QQQT, TQQ(1),QQQ(K,1),
|
|
& TQQ(2),QQQ(K,2), TQQ(3),QQQ(K,3), 3)
|
|
|
|
end subroutine QQB
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! GEOS-Chem Global Chemical Transport Model !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: x_interp_fjx
|
|
!
|
|
! !DESCRIPTION: Up-to-three-point linear interpolation function for X-sections
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
subroutine X_interp_FJX (TINT,XINT, T1,X1, T2,X2, T3,X3, L123)
|
|
!
|
|
! !USES:
|
|
!
|
|
implicit none
|
|
# include "cmn_fj.h"
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
real*8, intent(in):: TINT,T1,T2,T3, X1,X2,X3
|
|
integer,intent(in):: L123
|
|
!
|
|
! !OUTPUT PARAMETERS:
|
|
!
|
|
real*8,intent(out):: XINT
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
real*8 TFACT
|
|
|
|
if (L123 .le. 1) then
|
|
XINT = X1
|
|
elseif (L123 .eq. 2) then
|
|
TFACT = max(0.d0,min(1.d0,(TINT-T1)/(T2-T1) ))
|
|
XINT = X1 + TFACT*(X2 - X1)
|
|
else
|
|
if (TINT.le. T2) then
|
|
TFACT = max(0.d0,min(1.d0,(TINT-T1)/(T2-T1) ))
|
|
XINT = X1 + TFACT*(X2 - X1)
|
|
else
|
|
TFACT = max(0.d0,min(1.d0,(TINT-T2)/(T3-T2) ))
|
|
XINT = X2 + TFACT*(X3 - X2)
|
|
endif
|
|
endif
|
|
|
|
END SUBROUTINE X_interp_FJX
|
|
!EOC
|
|
END MODULE FJX_ACET_MOD
|
|
|