Sola/GEOS-Chem-adjoint-v35-note
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add files via upload

Browse Source
This commit is contained in:
Xuesong (Steve)
2018-08-28 00:43:47 -04:00
committed by GitHub
parent b9acb75507
commit e17feeaad3
96 changed files with 68216 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

212
code/fjx_acet_mod.f Normal file
View File

@ -0,0 +1,212 @@
!------------------------------------------------------------------------------
! 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