783 lines
27 KiB
Fortran
783 lines
27 KiB
Fortran
!------------------------------------------------------------------------------
|
|
! University of Minnesota Atmospheric Chemistry Group
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !MODULE: retro_mod
|
|
!
|
|
! !DESCRIPTION: Module RETRO\_MOD reads emissions from the RETRO emissions
|
|
! inventory
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
MODULE RETRO_MOD
|
|
|
|
IMPLICIT NONE
|
|
PRIVATE
|
|
!
|
|
! !PUBLIC DATA MEMBERS:
|
|
!
|
|
REAL*4, ALLOCATABLE :: RETRO_ALK4(:,:)
|
|
REAL*4, ALLOCATABLE :: RETRO_ACET(:,:)
|
|
REAL*4, ALLOCATABLE :: RETRO_MEK(:,:)
|
|
REAL*4, ALLOCATABLE :: RETRO_ALD2(:,:)
|
|
REAL*4, ALLOCATABLE :: RETRO_PRPE(:,:)
|
|
REAL*4, ALLOCATABLE :: RETRO_C3H8(:,:)
|
|
REAL*4, ALLOCATABLE :: RETRO_C2H6(:,:)
|
|
REAL*4, ALLOCATABLE :: RETRO_CH2O(:,:)
|
|
REAL*4, ALLOCATABLE :: RETRO_BENZ(:,:)
|
|
REAL*4, ALLOCATABLE :: RETRO_TOLU(:,:)
|
|
REAL*4, ALLOCATABLE :: RETRO_XYLE(:,:)
|
|
REAL*4, ALLOCATABLE :: RETRO_C2H4(:,:)
|
|
REAL*4, ALLOCATABLE :: RETRO_C2H2(:,:)
|
|
!
|
|
! !PUBLIC MEMBER FUNCTIONS:
|
|
!
|
|
PUBLIC :: CLEANUP_RETRO
|
|
PUBLIC :: EMISS_RETRO
|
|
PUBLIC :: GET_RETRO_ANTHRO
|
|
!
|
|
! !PRIVATE MEMBER FUNCTIONS:
|
|
!
|
|
PRIVATE :: INIT_RETRO
|
|
PRIVATE :: READ_RETRO
|
|
PRIVATE :: TOTAL_ANTHRO_Tg
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 08 Mar 2011 - W. Reinhart - Initial version
|
|
! 18 Aug 2011 - D. Millet - Partition ketones into 25% MEK and 75% ACET
|
|
! 18 Aug 2011 - D. Millet - Remove call to GET_ANNUAL_SCALAR
|
|
! 22 Aug 2011 - R. Yantosca - Added ProTeX headers
|
|
! 01 Mar 2012 - R. Yantosca - Now reference new grid_mod.F90
|
|
! 22 Mar 2012 - M. Payer - RETRO C2H6 emissions are too low. Use
|
|
! Yaping Xiao's C2H6 emissions instead.
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
CONTAINS
|
|
|
|
!-----------------------------------------------------------------------
|
|
#if defined( DEVEL )
|
|
SUBROUTINE EMISS_RETRO( EMISSIONS )
|
|
#else
|
|
SUBROUTINE EMISS_RETRO
|
|
#endif
|
|
!***********************************************************************
|
|
! Subroutine EMISS_RETRO reads all RETRO emissions at the beginning of
|
|
! each month. (wfr, 3/8/11)
|
|
!***********************************************************************
|
|
|
|
!
|
|
! !USES:
|
|
!
|
|
USE BPCH2_MOD, ONLY : GET_NAME_EXT_2D
|
|
USE BPCH2_MOD, ONLY : GET_RES_EXT
|
|
USE FILE_MOD, ONLY : IOERROR
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR
|
|
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_ALK4ff
|
|
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_PRPEff
|
|
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_C3H8ff
|
|
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_C2H6ff
|
|
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_VOCff
|
|
USE LOGICAL_MOD, ONLY : LFUTURE
|
|
USE TIME_MOD, ONLY : EXPAND_DATE
|
|
USE TIME_MOD, ONLY : GET_MONTH
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
#if defined( DEVEL )
|
|
USE TRACERID_MOD, ONLY : IDTALK4, IDTACET, IDTMEK,
|
|
& IDTALD2, IDTPRPE, IDTC3H8, IDTC2H6, IDTCH2O, IDTBENZ,
|
|
& IDTTOLU, IDTXYLE, IDTC2H4, IDTC2H2
|
|
USE TRACER_MOD, ONLY : N_TRACERS, TRACER_MW_KG
|
|
USE GRID_MOD, ONLY : GET_AREA_CM2
|
|
USE ERROR_MOD, ONLY : ALLOC_ERR
|
|
#endif
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 08 Mar 2011 - W. Reinhart - Initial version
|
|
! 22 Aug 2011 - R. Yantosca - Added ProTeX headers
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
INTEGER :: I, J, THISMONTH, YYYYMMDD
|
|
REAL*8 :: ALK4ff, PRPEff, C3H8ff
|
|
REAL*8 :: C2H6ff, VOCff
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
|
|
#if defined( DEVEL )
|
|
REAL*8, INTENT(INOUT) :: EMISSIONS(IIPAR,JJPAR,N_TRACERS)
|
|
REAL*8, ALLOCATABLE :: A(:,:)
|
|
INTEGER AS
|
|
#endif
|
|
!=================================================================
|
|
! EMISS_RETRO begins here
|
|
!=================================================================
|
|
|
|
! First-time initialization
|
|
IF ( FIRST ) THEN
|
|
|
|
! Allocate arrays
|
|
#if defined( DEVEL )
|
|
ALLOCATE( A( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMISS_EPA_NEI:A' )
|
|
A = 0d0
|
|
#endif
|
|
|
|
CALL INIT_RETRO
|
|
|
|
! Reset first-time flag
|
|
FIRST = .FALSE.
|
|
|
|
ENDIF
|
|
|
|
! Get month
|
|
THISMONTH = GET_MONTH()
|
|
|
|
! Get date for 2000 emissions
|
|
YYYYMMDD = 20000000 + ( THISMONTH * 100 ) + 01
|
|
|
|
! Echo info
|
|
WRITE(6, '(a)' ) REPEAT( '=', 79)
|
|
WRITE(6, 100 )
|
|
100 FORMAT( 'R E T R O E M I S S I O N S',
|
|
& ' -- Baseline Year: 2000', / )
|
|
|
|
!=================================================================
|
|
! Read RETRO average annual anthropogenic emissions
|
|
!=================================================================
|
|
|
|
! Anthro file name
|
|
FILENAME = TRIM( DATA_DIR ) // 'RETRO_201103/' //
|
|
& 'YYYYMM.' // GET_RES_EXT()
|
|
|
|
! Replace date in filename
|
|
CALL EXPAND_DATE( FILENAME, YYYYMMDD, 000000 )
|
|
|
|
! Read data
|
|
CALL READ_RETRO( FILENAME, RETRO_ALK4, RETRO_ACET, RETRO_MEK,
|
|
& RETRO_ALD2, RETRO_PRPE, RETRO_C3H8, RETRO_C2H6,
|
|
& RETRO_CH2O, RETRO_BENZ, RETRO_TOLU, RETRO_XYLE,
|
|
& RETRO_C2H4, RETRO_C2H2 )
|
|
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
|
|
|
|
!-----------------------------------
|
|
! Calculate IPCC future emissions
|
|
!-----------------------------------
|
|
IF ( LFUTURE ) THEN
|
|
|
|
! Future anthro scale factors
|
|
ALK4ff = GET_FUTURE_SCALE_ALK4ff( I, J )
|
|
VOCff = GET_FUTURE_SCALE_VOCff( I, J )
|
|
PRPEff = GET_FUTURE_SCALE_PRPEff( I, J )
|
|
C3H8ff = GET_FUTURE_SCALE_C3H8ff( I, J )
|
|
C2H6ff = GET_FUTURE_SCALE_C2H6ff( I, J )
|
|
|
|
! Apply scale factors
|
|
RETRO_ALK4 (I,J) = RETRO_ALK4 (I,J) * ALK4ff
|
|
RETRO_ACET (I,J) = RETRO_ACET (I,J) * VOCff
|
|
RETRO_MEK (I,J) = RETRO_MEK (I,J) * VOCff
|
|
RETRO_ALD2 (I,J) = RETRO_ALD2 (I,J) * VOCff
|
|
RETRO_PRPE (I,J) = RETRO_PRPE (I,J) * PRPEff
|
|
RETRO_C3H8 (I,J) = RETRO_C3H8 (I,J) * C3H8ff
|
|
RETRO_C2H6 (I,J) = RETRO_C2H6 (I,J) * C2H6ff
|
|
RETRO_CH2O (I,J) = RETRO_CH2O (I,J) * VOCff
|
|
RETRO_BENZ (I,J) = RETRO_BENZ (I,J) * VOCff
|
|
RETRO_TOLU (I,J) = RETRO_TOLU (I,J) * VOCff
|
|
RETRO_XYLE (I,J) = RETRO_XYLE (I,J) * VOCff
|
|
RETRO_C2H4 (I,J) = RETRO_C2H4 (I,J) * VOCff
|
|
RETRO_C2H2 (I,J) = RETRO_C2H2 (I,J) * VOCff
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Print totals to log
|
|
CALL TOTAL_ANTHRO_TG( THISMONTH )
|
|
|
|
! Fancy output
|
|
WRITE(6, '(a)' ) REPEAT( '=', 79)
|
|
|
|
#if defined( DEVEL )
|
|
DO I=1,IIPAR
|
|
DO J=1,JJPAR
|
|
A(I,J) = GET_AREA_CM2( I, J, 1 )
|
|
ENDDO
|
|
ENDDO
|
|
|
|
IF ( IDTALK4 > 0 ) EMISSIONS(:,:,IDTALK4) = RETRO_ALK4(:,:) *
|
|
& A * 6.0225d-23 * TRACER_MW_KG(IDTALK4)
|
|
IF ( IDTACET > 0 ) EMISSIONS(:,:,IDTACET) = RETRO_ACET(:,:) *
|
|
& A * 6.0225d-23 * TRACER_MW_KG(IDTACET)
|
|
IF ( IDTMEK > 0 ) EMISSIONS(:,:,IDTMEK) = RETRO_MEK(:,:) *
|
|
& A * 6.0225d-23 * TRACER_MW_KG(IDTMEK)
|
|
IF ( IDTALD2 > 0 ) EMISSIONS(:,:,IDTALD2) = RETRO_ALD2(:,:) *
|
|
& A * 6.0225d-23 * TRACER_MW_KG(IDTALD2)
|
|
IF ( IDTPRPE > 0 ) EMISSIONS(:,:,IDTPRPE) = RETRO_PRPE(:,:) *
|
|
& A * 6.0225d-23 * TRACER_MW_KG(IDTPRPE)
|
|
IF ( IDTC3H8 > 0 ) EMISSIONS(:,:,IDTC3H8) = RETRO_C3H8(:,:) *
|
|
& A * 6.0225d-23 * TRACER_MW_KG(IDTC3H8)
|
|
IF ( IDTC2H6 > 0 ) EMISSIONS(:,:,IDTC2H6) = RETRO_C2H6(:,:) *
|
|
& A * 6.0225d-23 * TRACER_MW_KG(IDTC2H6)
|
|
IF ( IDTCH2O > 0 ) EMISSIONS(:,:,IDTCH2O) = RETRO_CH2O(:,:) *
|
|
& A * 6.0225d-23 * TRACER_MW_KG(IDTCH2O)
|
|
IF ( IDTBENZ > 0 ) EMISSIONS(:,:,IDTBENZ) = RETRO_BENZ(:,:) *
|
|
& A * 6.0225d-23 * TRACER_MW_KG(IDTBENZ)
|
|
IF ( IDTTOLU > 0 ) EMISSIONS(:,:,IDTTOLU) = RETRO_TOLU(:,:) *
|
|
& A * 6.0225d-23 * TRACER_MW_KG(IDTTOLU)
|
|
IF ( IDTXYLE > 0 ) EMISSIONS(:,:,IDTXYLE) = RETRO_XYLE(:,:) *
|
|
& A * 6.0225d-23 * TRACER_MW_KG(IDTXYLE)
|
|
IF ( IDTC2H4 > 0 ) EMISSIONS(:,:,IDTC2H4) = RETRO_C2H4(:,:) *
|
|
& A * 6.0225d-23 * TRACER_MW_KG(IDTC2H4)
|
|
IF ( IDTC2H2 > 0 ) EMISSIONS(:,:,IDTC2H2) = RETRO_C2H2(:,:) *
|
|
& A * 6.0225d-23 * TRACER_MW_KG(IDTC2H2)
|
|
|
|
#endif
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE EMISS_RETRO
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! University of Minnesota Atmospheric Chemistry Group
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: read_retro
|
|
!
|
|
! !DESCRIPTION: Subroutine READ\_RETRO reads a BPCH file created from
|
|
! RETRO data. The data has units of [atoms C/cm2/s].
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE READ_RETRO( FILENAME, ALK4, ACET, MEK, ALD2, PRPE,
|
|
& C3H8, C2H6, CH2O, BENZ, TOLU, XYLE,
|
|
& C2H4, C2H2 )
|
|
!
|
|
! !USES:
|
|
!
|
|
USE BPCH2_MOD, ONLY : OPEN_BPCH2_FOR_READ
|
|
USE FILE_MOD, ONLY : IU_FILE, IOERROR
|
|
USE TRANSFER_MOD, ONLY : TRANSFER_2D
|
|
USE SCALE_ANTHRO_MOD, ONLY : GET_ANNUAL_SCALAR
|
|
USE TIME_MOD, ONLY : GET_YEAR
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN_O3" ! FSCLYR
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
! Name of file to read
|
|
CHARACTER(LEN=*), INTENT(IN) :: FILENAME
|
|
!
|
|
! !INPUT/OUTPUT PARAMETERS:
|
|
!
|
|
! RETRO emissions for various VOC species [molec/cm2/s]
|
|
REAL*4, INTENT(INOUT) :: ALK4(IIPAR,JJPAR)
|
|
REAL*4, INTENT(INOUT) :: ACET(IIPAR,JJPAR)
|
|
REAL*4, INTENT(INOUT) :: MEK (IIPAR,JJPAR)
|
|
REAL*4, INTENT(INOUT) :: ALD2(IIPAR,JJPAR)
|
|
REAL*4, INTENT(INOUT) :: PRPE(IIPAR,JJPAR)
|
|
REAL*4, INTENT(INOUT) :: C3H8(IIPAR,JJPAR)
|
|
REAL*4, INTENT(INOUT) :: CH2O(IIPAR,JJPAR)
|
|
REAL*4, INTENT(INOUT) :: C2H6(IIPAR,JJPAR)
|
|
REAL*4, INTENT(INOUT) :: BENZ(IIPAR,JJPAR)
|
|
REAL*4, INTENT(INOUT) :: TOLU(IIPAR,JJPAR)
|
|
REAL*4, INTENT(INOUT) :: XYLE(IIPAR,JJPAR)
|
|
REAL*4, INTENT(INOUT) :: C2H4(IIPAR,JJPAR)
|
|
REAL*4, INTENT(INOUT) :: C2H2(IIPAR,JJPAR)
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 08 Mar 2011 - W. Reinhart - Initial Version
|
|
! 18 Aug 2011 - D. Millet - Remove call to GET_ANNUAL_SCALAR
|
|
! 22 Aug 2011 - R. Yantosca - Added ProTeX headers
|
|
! 03 Aug 2012 - R. Yantosca - Move calls to findFreeLUN out of DEVEL block
|
|
! 07 Aug 2012 - R. Yantosca - Now print LUN used to open file
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
INTEGER :: I, J, L, N, IOS
|
|
INTEGER :: NI, NJ, NL
|
|
INTEGER :: IFIRST, JFIRST, LFIRST
|
|
INTEGER :: NTRACER, NSKIP
|
|
INTEGER :: HALFPOLAR, CENTER180
|
|
INTEGER :: SCALEYEAR !, BASEYEAR (dbm, 8/18/11)
|
|
REAL*4 :: LONRES, LATRES
|
|
REAL*4 :: ARRAY(IIPAR,JJPAR,1)
|
|
REAL*4 :: SC(IIPAR,JJPAR)
|
|
REAL*8 :: ZTAU0, ZTAU1
|
|
CHARACTER(LEN=20) :: MODELNAME
|
|
CHARACTER(LEN=40) :: CATEGORY
|
|
CHARACTER(LEN=40) :: UNIT
|
|
CHARACTER(LEN=40) :: RESERVED
|
|
|
|
!=================================================================
|
|
! READ_RETRO begins here
|
|
!=================================================================
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( FILENAME ), IU_FILE
|
|
100 FORMAT( 'READ_RETRO: Reading ', a, ' on unit ', i4 )
|
|
|
|
! Open file
|
|
CALL OPEN_BPCH2_FOR_READ( IU_FILE, FILENAME )
|
|
|
|
! Read the entire file in one pass
|
|
DO
|
|
|
|
! Read 1st data block header
|
|
READ( IU_FILE, IOSTAT=IOS )
|
|
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
|
|
|
|
! Check for EOF or errors
|
|
IF ( IOS < 0 ) EXIT
|
|
IF ( IOS > 0 ) CALL IOERROR( IOS, IU_FILE, 'read_data:2' )
|
|
|
|
! Read 2nd data block header line
|
|
READ (IU_FILE, IOSTAT=IOS )
|
|
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
|
|
& NI, NJ, NL, IFIRST, JFIRST, LFIRST, NSKIP
|
|
|
|
|
|
! Error check
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_FILE, 'read_data:3' )
|
|
|
|
! Read data
|
|
READ( IU_FILE, IOSTAT=IOS ) ARRAY(1:NI,1:NJ,1:NL)
|
|
|
|
! Error check
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_FILE, 'read_data:4' )
|
|
|
|
!==============================================================
|
|
! Save into tracer arrays
|
|
!==============================================================
|
|
SELECT CASE ( NTRACER )
|
|
CASE( 5 )
|
|
CALL TRANSFER_2D( ARRAY(:,:,1), ALK4 )
|
|
CASE( 9 )
|
|
CALL TRANSFER_2D( ARRAY(:,:,1), ACET )
|
|
CASE( 10 )
|
|
CALL TRANSFER_2D( ARRAY(:,:,1), MEK )
|
|
CASE( 11 )
|
|
CALL TRANSFER_2D( ARRAY(:,:,1), ALD2 )
|
|
CASE( 18 )
|
|
CALL TRANSFER_2D( ARRAY(:,:,1), PRPE )
|
|
CASE( 19 )
|
|
CALL TRANSFER_2D( ARRAY(:,:,1), C3H8 )
|
|
CASE( 20 )
|
|
CALL TRANSFER_2D( ARRAY(:,:,1), CH2O )
|
|
CASE( 21 )
|
|
CALL TRANSFER_2D( ARRAY(:,:,1), C2H6 )
|
|
CASE( 59 )
|
|
CALL TRANSFER_2D( ARRAY(:,:,1), BENZ )
|
|
CASE( 60 )
|
|
CALL TRANSFER_2D( ARRAY(:,:,1), TOLU )
|
|
CASE( 61 )
|
|
CALL TRANSFER_2D( ARRAY(:,:,1), XYLE )
|
|
CASE( 65 )
|
|
CALL TRANSFER_2D( ARRAY(:,:,1), C2H4 )
|
|
CASE( 66 )
|
|
CALL TRANSFER_2D( ARRAY(:,:,1), C2H2 )
|
|
CASE DEFAULT
|
|
! Nothing
|
|
END SELECT
|
|
END DO
|
|
|
|
! Close file
|
|
CLOSE( IU_FILE )
|
|
|
|
! Apply annual scalar factor
|
|
IF ( FSCALYR < 0 ) THEN
|
|
SCALEYEAR = GET_YEAR()
|
|
ELSE
|
|
SCALEYEAR = FSCALYR
|
|
ENDIF
|
|
|
|
END SUBROUTINE READ_RETRO
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! University of Minnesota Atmospheric Chemistry Group
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: TOTAL_ANTHRO_Tg
|
|
!
|
|
! !DESCRIPTION: Subroutine TOTAL\_ANTHRO\_Tg to print total RETRO
|
|
! anthropogenic VOC emissions each month in [Tg C].
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE TOTAL_ANTHRO_Tg( THISMONTH )
|
|
!
|
|
! !USES:
|
|
!
|
|
USE GRID_MOD, ONLY : GET_AREA_CM2
|
|
USE TRACER_MOD, ONLY : TRACER_MW_KG
|
|
USE TRACERID_MOD, ONLY : IDTALK4, IDTMEK, IDTPRPE, IDTC3H8
|
|
USE TRACERID_MOD, ONLY : IDTCH2O, IDTC2H6, IDTBENZ, IDTTOLU
|
|
USE TRACERID_MOD, ONLY : IDTXYLE, IDTC2H4, IDTC2H2
|
|
USE TRACERID_MOD, ONLY : IDTACET, IDTALD2
|
|
# include "CMN_SIZE" ! Size parameters
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
INTEGER, INTENT(IN) :: THISMONTH ! Current month
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 08 Mar 2011 - W. Reinhart - Initial Version
|
|
! 22 Aug 2011 - R. Yantosca - Added ProTeX headers
|
|
! 01 Mar 2012 - R. Yantosca - Now use GET_AREA_CM2(I,J,L) from grid_mod.F90
|
|
! 22 Mar 2012 - M. Payer - Remove print for C2H6 emissions
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
INTEGER :: I, J
|
|
REAL*8 :: ALK4, MEK, ALD2, PRPE, C3H8, CH2O
|
|
REAL*8 :: BENZ, TOLU, XYLE, C2H4, C2H2, C2H6, ACET
|
|
REAL*8 :: F_ALK4, F_MEK, F_PRPE, F_C3H8, F_CH2O
|
|
REAL*8 :: F_BENZ, F_TOLU, F_XYLE, F_C2H4, F_C2H2
|
|
REAL*8 :: F_C2H6, F_ALD2, F_ACET
|
|
REAL*8 :: A
|
|
CHARACTER(LEN=6) :: UNIT
|
|
|
|
! Days per month
|
|
INTEGER :: D(12) = (/ 31, 28, 31, 30, 31, 30,
|
|
& 31, 31, 30, 31, 30, 31 /)
|
|
|
|
!=================================================================
|
|
! TOTAL_ANTHRO_Tg begins here
|
|
!=================================================================
|
|
|
|
! Summing variables for anthro
|
|
ALK4 = 0d0
|
|
ACET = 0d0
|
|
MEK = 0d0
|
|
ALD2 = 0d0
|
|
PRPE = 0d0
|
|
C3H8 = 0d0
|
|
CH2O = 0d0
|
|
C2H6 = 0d0
|
|
BENZ = 0d0
|
|
TOLU = 0d0
|
|
XYLE = 0d0
|
|
C2H4 = 0d0
|
|
C2H2 = 0d0
|
|
|
|
! Molecular weights
|
|
F_ALK4 = 0d0
|
|
F_ACET = 0d0
|
|
F_MEK = 0d0
|
|
F_ALD2 = 0d0
|
|
F_PRPE = 0d0
|
|
F_C3H8 = 0d0
|
|
F_CH2O = 0d0
|
|
F_C2H6 = 0d0
|
|
F_BENZ = 0d0
|
|
F_TOLU = 0d0
|
|
F_XYLE = 0d0
|
|
F_C2H4 = 0d0
|
|
F_C2H2 = 0d0
|
|
|
|
! Prevent array out of bounds error for undefined tracers
|
|
IF ( IDTALK4 > 0 ) F_ALK4 = TRACER_MW_KG(IDTALK4)
|
|
IF ( IDTACET > 0 ) F_ACET = TRACER_MW_KG(IDTACET)
|
|
IF ( IDTMEK > 0 ) F_MEK = TRACER_MW_KG(IDTMEK )
|
|
IF ( IDTALD2 > 0 ) F_ALD2 = TRACER_MW_KG(IDTALD2)
|
|
IF ( IDTPRPE > 0 ) F_PRPE = TRACER_MW_KG(IDTPRPE)
|
|
IF ( IDTC2H6 > 0 ) F_C2H6 = TRACER_MW_KG(IDTC2H6)
|
|
IF ( IDTC3H8 > 0 ) F_C3H8 = TRACER_MW_KG(IDTC3H8)
|
|
IF ( IDTCH2O > 0 ) F_CH2O = TRACER_MW_KG(IDTCH2O)
|
|
IF ( IDTBENZ > 0 ) F_BENZ = TRACER_MW_KG(IDTBENZ)
|
|
IF ( IDTTOLU > 0 ) F_TOLU = TRACER_MW_KG(IDTTOLU)
|
|
IF ( IDTXYLE > 0 ) F_XYLE = TRACER_MW_KG(IDTXYLE)
|
|
IF ( IDTC2H4 > 0 ) F_C2H4 = TRACER_MW_KG(IDTC2H4)
|
|
IF ( IDTC2H2 > 0 ) F_C2H2 = TRACER_MW_KG(IDTC2H2)
|
|
|
|
!=================================================================
|
|
! Sum anthropogenic emissions
|
|
!=================================================================
|
|
|
|
! Loop over surface boxes
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
|
|
! Surface area [cm2] * seconds in the month / Avogadro's number
|
|
! Also multiply by the factor 1d-9 to convert kg to Tg
|
|
!--------------------------------------------------------------
|
|
!A = GET_AREA_CM2 (I , J, 1) !Original imported statement (yd, 3/5/13)
|
|
!--------------------------------------------------------------
|
|
A = GET_AREA_CM2( J ) !Modified statemt to suit Function on adjoint code (yd, 3/5/13)
|
|
!--------------------------------------------------------------
|
|
& * ( D(THISMONTH) * 86400d-9 ) / 6.0225d23
|
|
|
|
! Anthro emissions
|
|
ALK4 = ALK4 + RETRO_ALK4(I,J) * A * F_ALK4
|
|
ACET = ACET + RETRO_ACET(I,J) * A * F_ACET
|
|
MEK = MEK + RETRO_MEK(I,J) * A * F_MEK
|
|
ALD2 = ALD2 + RETRO_ALD2(I,J) * A * F_ALD2
|
|
PRPE = PRPE + RETRO_PRPE(I,J) * A * F_PRPE
|
|
C3H8 = C3H8 + RETRO_C3H8(I,J) * A * F_C3H8
|
|
CH2O = CH2O + RETRO_CH2O(I,J) * A * F_CH2O
|
|
C2H6 = C2H6 + RETRO_C2H6(I,J) * A * F_C2H6
|
|
BENZ = BENZ + RETRO_BENZ(I,J) * A * F_BENZ
|
|
TOLU = TOLU + RETRO_TOLU(I,J) * A * F_TOLU
|
|
XYLE = XYLE + RETRO_XYLE(I,J) * A * F_XYLE
|
|
C2H4 = C2H4 + RETRO_C2H4(I,J) * A * F_C2H4
|
|
C2H2 = C2H2 + RETRO_C2H2(I,J) * A * F_C2H2
|
|
|
|
ENDDO
|
|
ENDDO
|
|
|
|
!==============================================================
|
|
! Print info
|
|
!==============================================================
|
|
WRITE( 6, '(a)' )
|
|
WRITE( 6, 100 ) 'ALK4', THISMONTH, ALK4, ' C'
|
|
WRITE( 6, 100 ) 'ACET', THISMONTH, ACET, ' C'
|
|
WRITE( 6, 100 ) 'MEK', THISMONTH, MEK, ' C'
|
|
WRITE( 6, 100 ) 'ALD2', THISMONTH, ALD2, ' C'
|
|
WRITE( 6, 100 ) 'PRPE', THISMONTH, PRPE, ' C'
|
|
WRITE( 6, 100 ) 'C3H8', THISMONTH, C3H8, ' C'
|
|
WRITE( 6, 100 ) 'CH2O', THISMONTH, CH2O, ' C'
|
|
WRITE( 6, 100 ) 'BENZ', THISMONTH, BENZ, ' C'
|
|
WRITE( 6, 100 ) 'TOLU', THISMONTH, TOLU, ' C'
|
|
WRITE( 6, 100 ) 'XYLE', THISMONTH, XYLE, ' C'
|
|
WRITE( 6, 100 ) 'C2H4', THISMONTH, C2H4, ' C'
|
|
WRITE( 6, 100 ) 'C2H2', THISMONTH, C2H2, ' C'
|
|
100 FORMAT( 'Total anthro ', a4, ' for 2000/',
|
|
& i2.2, ': ', f13.6, ' Tg', a2 )
|
|
|
|
WRITE( 6, '(/,a,/)' ) 'RETRO_MOD: RETRO C2H6 anthro ' //
|
|
& 'emissions are too low. Using offline C2H6 ' //
|
|
& 'emissions from Yaping Xiao.'
|
|
|
|
END SUBROUTINE TOTAL_ANTHRO_TG
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! University of Minnesota Atmospheric Chemistry Group
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: get_retro_anthro
|
|
!
|
|
! !DESCRIPTION: Function GET\_RETRO\_ANTHRO returns the monthly average
|
|
! anthropogenic VOC emissions at GEOS-Chem grid box (I,J). Data will
|
|
! be returned in units of [atoms C/cm2/s].
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
FUNCTION GET_RETRO_ANTHRO( I, J, N ) RESULT( RETRO )
|
|
!
|
|
! !USES:
|
|
!
|
|
USE TRACERID_MOD, ONLY : IDTALK4, IDTMEK, IDTPRPE, IDTC3H8
|
|
USE TRACERID_MOD, ONLY : IDTCH2O, IDTC2H6, IDTBENZ, IDTTOLU
|
|
USE TRACERID_MOD, ONLY : IDTXYLE, IDTC2H4, IDTC2H2
|
|
USE TRACERID_MOD, ONLY : IDTACET, IDTALD2
|
|
# include "CMN_SIZE" ! Size parameters
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
INTEGER, INTENT(IN) :: I ! GEOS-Chem longitude index
|
|
INTEGER, INTENT(IN) :: J ! GEOS-Chem latitude index
|
|
INTEGER, INTENT(IN) :: N ! GEOS-Chem tracer index
|
|
!
|
|
! !RETURN VALUE:
|
|
!
|
|
REAL*8 :: RETRO ! RETRO emissions [mole
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 08 Mar 2011 - W. Reinhart - Initial Version
|
|
! 18 Aug 2011 - D. Millet - Partition RETRO ketones into 75% acetone
|
|
! and 25% MEK
|
|
! 22 Mar 2012 - M. Payer - RETRO C2H6 emissions are too low. Use
|
|
! Yaping Xiao's C2H6 emissions instead.
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES
|
|
!
|
|
|
|
!=================================================================
|
|
! GET_RETRO_ANTHRO begins here
|
|
!=================================================================
|
|
|
|
IF ( N == IDTALK4 ) THEN
|
|
RETRO = RETRO_ALK4(I,J)
|
|
ELSE IF ( N == IDTACET ) THEN
|
|
RETRO = 0.75d0*RETRO_MEK(I,J) ! RETRO ketones --> 75% ACET
|
|
ELSE IF ( N == IDTMEK ) THEN
|
|
RETRO = 0.25d0*RETRO_MEK(I,J) ! RETRO ketones --> 25% MEK
|
|
ELSE IF ( N == IDTALD2 ) THEN
|
|
RETRO = RETRO_ALD2(I,J)
|
|
ELSE IF ( N == IDTPRPE ) THEN
|
|
RETRO = RETRO_PRPE(I,J)
|
|
ELSE IF ( N == IDTC3H8 ) THEN
|
|
RETRO = RETRO_C3H8(I,J)
|
|
ELSE IF ( N == IDTCH2O ) THEN
|
|
RETRO = RETRO_CH2O(I,J)
|
|
ELSE IF ( N == IDTC2H6 ) THEN
|
|
RETRO = -1d0
|
|
ELSE IF ( N == IDTBENZ ) THEN
|
|
RETRO = RETRO_BENZ(I,J)
|
|
ELSE IF ( N == IDTTOLU ) THEN
|
|
RETRO = RETRO_TOLU(I,J)
|
|
ELSE IF ( N == IDTXYLE ) THEN
|
|
RETRO = RETRO_XYLE(I,J)
|
|
ELSE IF ( N == IDTC2H4 ) THEN
|
|
RETRO = RETRO_C2H4(I,J)
|
|
ELSE IF ( N == IDTC2H2 ) THEN
|
|
RETRO = RETRO_C2H2(I,J)
|
|
ELSE
|
|
RETRO = -1d0
|
|
ENDIF
|
|
|
|
END FUNCTION GET_RETRO_ANTHRO
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! University of Minnesota Atmospheric Chemistry Group
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: init_retro
|
|
!
|
|
! !DESCRIPTION: Subroutine INIT\_RETRO allocates and zeroes all module arrays.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE INIT_RETRO
|
|
!
|
|
! !USES:
|
|
!
|
|
USE ERROR_MOD, ONLY : ALLOC_ERR
|
|
USE LOGICAL_MOD, ONLY : LRETRO
|
|
# include "CMN_SIZE" ! Size parameters
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 08 Mar 2011 - W. Reinhart - Initial Version
|
|
! 22 Aug 2011 - R. Yantosca - Added ProTeX headers
|
|
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
INTEGER :: AS
|
|
|
|
!=================================================================
|
|
! INIT_RETRO begins here
|
|
!=================================================================
|
|
|
|
! Return if we LRETRO = .FALSE.
|
|
IF (.not. LRETRO ) RETURN
|
|
|
|
ALLOCATE( RETRO_ALK4( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'RETRO_ALK4' )
|
|
RETRO_ALK4 = 0e0
|
|
|
|
ALLOCATE( RETRO_ACET( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'RETRO_ACET' )
|
|
RETRO_ACET = 0e0
|
|
|
|
ALLOCATE( RETRO_MEK( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'RETRO_MEK' )
|
|
RETRO_MEK = 0e0
|
|
|
|
ALLOCATE( RETRO_ALD2( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'RETRO_ALD2' )
|
|
RETRO_ALD2 = 0e0
|
|
|
|
ALLOCATE( RETRO_PRPE( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'RETRO_PRPE' )
|
|
RETRO_PRPE = 0e0
|
|
|
|
ALLOCATE( RETRO_C3H8( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'RETRO_C3H8' )
|
|
RETRO_C3H8 = 0e0
|
|
|
|
ALLOCATE( RETRO_CH2O( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'RETRO_CH2O' )
|
|
RETRO_CH2O = 0e0
|
|
|
|
ALLOCATE( RETRO_C2H6( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'RETRO_C2H6' )
|
|
RETRO_C2H6 = 0e0
|
|
|
|
ALLOCATE( RETRO_BENZ( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'RETRO_BENZ' )
|
|
RETRO_BENZ = 0e0
|
|
|
|
ALLOCATE( RETRO_TOLU( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'RETRO_TOLU' )
|
|
RETRO_TOLU = 0e0
|
|
|
|
ALLOCATE( RETRO_XYLE( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'RETRO_XYLE' )
|
|
RETRO_XYLE = 0e0
|
|
|
|
ALLOCATE( RETRO_C2H4( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'RETRO_C2H4' )
|
|
RETRO_C2H4 = 0e0
|
|
|
|
ALLOCATE( RETRO_C2H2( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'RETRO_C2H2' )
|
|
RETRO_C2H2 = 0e0
|
|
|
|
END SUBROUTINE INIT_RETRO
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! University of Minnesota Atmospheric Chemistry Group
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: cleanup_retro
|
|
!
|
|
! !DESCRIPTION: Subroutine CLEANUP\_RETRO deallocates all module arrays.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE CLEANUP_RETRO
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 08 Mar 2011 - W. Reinhart - Initial Version
|
|
! 22 Aug 2011 - R. Yantosca - Added ProTeX headers
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!=================================================================
|
|
! CLEANUP_RETRO begins here
|
|
!=================================================================
|
|
IF ( ALLOCATED( RETRO_ALK4 ) ) DEALLOCATE( RETRO_ALK4 )
|
|
IF ( ALLOCATED( RETRO_ACET ) ) DEALLOCATE( RETRO_ACET )
|
|
IF ( ALLOCATED( RETRO_MEK ) ) DEALLOCATE( RETRO_MEK )
|
|
IF ( ALLOCATED( RETRO_ALD2 ) ) DEALLOCATE( RETRO_ALD2 )
|
|
IF ( ALLOCATED( RETRO_PRPE ) ) DEALLOCATE( RETRO_PRPE )
|
|
IF ( ALLOCATED( RETRO_C3H8 ) ) DEALLOCATE( RETRO_C3H8 )
|
|
IF ( ALLOCATED( RETRO_CH2O ) ) DEALLOCATE( RETRO_CH2O )
|
|
IF ( ALLOCATED( RETRO_C2H6 ) ) DEALLOCATE( RETRO_C2H6 )
|
|
IF ( ALLOCATED( RETRO_BENZ ) ) DEALLOCATE( RETRO_BENZ )
|
|
IF ( ALLOCATED( RETRO_TOLU ) ) DEALLOCATE( RETRO_TOLU )
|
|
IF ( ALLOCATED( RETRO_XYLE ) ) DEALLOCATE( RETRO_XYLE )
|
|
IF ( ALLOCATED( RETRO_C2H4 ) ) DEALLOCATE( RETRO_C2H4 )
|
|
IF ( ALLOCATED( RETRO_C2H2 ) ) DEALLOCATE( RETRO_C2H2 )
|
|
|
|
END SUBROUTINE CLEANUP_RETRO
|
|
!EOC
|
|
END MODULE RETRO_MOD
|