974 lines
30 KiB
Fortran
974 lines
30 KiB
Fortran
!------------------------------------------------------------------------------
|
|
! University of California, Irvine, Atmospheric Chemistry !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !MODULE: rcp_mod
|
|
!
|
|
! !DESCRIPTION: Module RCP\_MOD provides access to the RCP emission inventories
|
|
! that were prepared for IPCC AR5. The inventory includes anthropogenic
|
|
! emissions from land, ships, and aircraft. Species include trace gases
|
|
! (NOx, CO, NH3, SO2, various VOCs) and aerosols (BC, OC). Land emissions
|
|
! include fossil fuel and biofuel use, energy production and distribution,
|
|
! residential and commercial combustion, industry, transportation, waste
|
|
! treatment and disposal, solvent production and use, agriculture, and
|
|
! agricultural waste burning. Data sources are documented in the data
|
|
! directories.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
MODULE RCP_MOD
|
|
!
|
|
! !USES:
|
|
!
|
|
IMPLICIT NONE
|
|
PRIVATE
|
|
!
|
|
! !PUBLIC DATA MEMBERS:
|
|
!
|
|
!NONE
|
|
!
|
|
! !PUBLIC MEMBER FUNCTIONS:
|
|
!
|
|
PUBLIC :: CLEANUP_RCP
|
|
PUBLIC :: LOAD_RCP_EMISSIONS
|
|
PUBLIC :: GET_RCP_EMISSION
|
|
PUBLIC :: RCPNAME, RCPYEAR
|
|
PUBLIC :: RCP_AIREMISS
|
|
!
|
|
! !PRIVATE DATA MEMBERS:
|
|
!
|
|
REAL*4, ALLOCATABLE :: RCP_LAND(:,:,:)
|
|
REAL*4, ALLOCATABLE :: RCP_AIR(:,:,:,:)
|
|
REAL*4, ALLOCATABLE :: RCP_SHIP(:,:,:)
|
|
CHARACTER(LEN=20) :: RCPNAME
|
|
INTEGER :: RCPYEAR
|
|
INTEGER :: IDTRCP_LAND(20), IDTRCP_SHIP(20),
|
|
& IDTRCP_AIR(3)
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 14 Jun 2012 - C. Holmes - Initial version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
|
|
CONTAINS
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: load_rcp_emissions
|
|
!
|
|
! !DESCRIPTION: Subroutine LOAD\_RCP\_EMISSIONS reads all RCP emissions at the
|
|
! beginning of each month. (cdh, 10/14/11)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE LOAD_RCP_EMISSIONS
|
|
!
|
|
! !USES:
|
|
!
|
|
USE BPCH2_MOD, ONLY : GET_TAU0, GET_RES_EXT
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR
|
|
USE ERROR_MOD, ONLY : GEOS_CHEM_STOP
|
|
USE LOGICAL_MOD, ONLY : LRCP, LRCPSHIP, LRCPAIR
|
|
USE TIME_MOD, ONLY : GET_MONTH
|
|
USE TRACERID_MOD
|
|
USE TRACER_MOD, ONLY : TRACER_NAME
|
|
|
|
# include "define.h"
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 22 Jul 2013 - M. Sulprizio- Added ProTeX headers
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
INTEGER :: THISMONTH, I
|
|
CHARACTER(LEN=20) :: RCPSPECIES, YEARSTR
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
REAL*8 :: XTAU
|
|
|
|
!=================================================================
|
|
! LOAD_RCP_EMISSIONS begins here
|
|
!=================================================================
|
|
|
|
! First-time initialization
|
|
IF ( FIRST ) THEN
|
|
|
|
! Allocate arrays
|
|
CALL INIT_RCP
|
|
|
|
! Reset first-time flag
|
|
FIRST = .FALSE.
|
|
|
|
ENDIF
|
|
|
|
! Get month
|
|
THISMONTH = GET_MONTH()
|
|
|
|
! Convert to string
|
|
WRITE( YEARSTR, '(I4)' ) RCPYEAR
|
|
|
|
!=================================================================
|
|
! Land and ship emissions
|
|
!=================================================================
|
|
|
|
IF( LRCP .OR. LRCPSHIP) THEN
|
|
|
|
! Land file name
|
|
FILENAME = TRIM( DATA_DIR ) // 'RCP_201206/' //
|
|
& trim( RCPNAME ) // '/' //
|
|
& trim( RCPNAME ) // '_anthropogenic_' //
|
|
& trim( YEARSTR ) // '.' //
|
|
& GET_RES_EXT() // '.bpch'
|
|
! Date for emissions
|
|
! Land emissions dated Jan 1 because all months are the same
|
|
XTAU = GET_TAU0( 1, 1, RCPYEAR )
|
|
|
|
! Read data (LAND -> TYPE=1)
|
|
CALL READ_RCP_BPCH( FILENAME, TYPE=1, TAU0=XTAU )
|
|
|
|
! Ship file name
|
|
FILENAME = TRIM( DATA_DIR ) // 'RCP_201206/' //
|
|
& trim( RCPNAME ) // '/' //
|
|
& trim( RCPNAME ) // '_ships_' //
|
|
& trim( YEARSTR ) // '.' //
|
|
& GET_RES_EXT() // '.bpch'
|
|
|
|
! Date for emissions
|
|
XTAU = GET_TAU0( THISMONTH, 1, RCPYEAR )
|
|
|
|
! Read data (SHIP -> TYPE=2)
|
|
CALL READ_RCP_BPCH( FILENAME, TYPE=2, TAU0=XTAU )
|
|
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! Aircraft emissions
|
|
!=================================================================
|
|
|
|
IF (LRCPAIR) THEN
|
|
FILENAME = TRIM( DATA_DIR ) // 'RCP_201206/' //
|
|
& trim( RCPNAME ) // '/' //
|
|
& trim( RCPNAME ) // '_aircraft_' //
|
|
& trim( YEARSTR ) // '.' //
|
|
& GET_RES_EXT() // '.bpch'
|
|
|
|
! Date for emissions
|
|
XTAU = GET_TAU0( THISMONTH, 1, RCPYEAR )
|
|
|
|
! Read data (AIRCRAFT -> TYPE=3)
|
|
CALL READ_RCP_BPCH( FILENAME, TYPE=3, TAU0=XTAU )
|
|
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! Print totals to log
|
|
!=================================================================
|
|
|
|
CALL TOTAL_ANTHRO_RCP( THISMONTH )
|
|
|
|
! Fancy output
|
|
WRITE(6, '(a)' ) REPEAT( '=', 79)
|
|
|
|
END SUBROUTINE LOAD_RCP_EMISSIONS
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: read_rcp_bpch
|
|
!
|
|
! !DESCRIPTION: Subroutine READ\_RCP\_BPCH reads a BPCH file containing RCP
|
|
! data. (cdh, 10/14/11)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE READ_RCP_BPCH( FILENAME, TYPE, TAU0 )
|
|
!
|
|
! !USES:
|
|
!
|
|
USE BPCH2_MOD, ONLY : OPEN_BPCH2_FOR_READ
|
|
USE FILE_MOD, ONLY : IU_FILE, IOERROR
|
|
USE TRANSFER_MOD, ONLY : TRANSFER_2D
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
USE TRACERID_MOD ! tracer ID numbers
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
CHARACTER(LEN=*), INTENT(IN) :: FILENAME
|
|
INTEGER, INTENT(IN) :: TYPE ! 1=LAND, 2=SHIP, 3=AIRCRAFT
|
|
REAL*8,OPTIONAL, INTENT(IN) :: TAU0
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 22 Jul 2013 - M. Sulprizio- Added ProTeX headers
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
INTEGER :: I, J, L, N, IOS, K, IDT
|
|
INTEGER :: NI, NJ, NL
|
|
INTEGER :: IFIRST, JFIRST, LFIRST
|
|
INTEGER :: NTRACER, NSKIP
|
|
INTEGER :: HALFPOLAR, CENTER180
|
|
INTEGER :: SCALEYEAR, BASEYEAR
|
|
REAL*4 :: LONRES, LATRES
|
|
REAL*4 :: ARRAY(IIPAR,JJPAR,LLPAR)
|
|
REAL*4 :: TMP(IIPAR,JJPAR)
|
|
REAL*8 :: ZTAU0, ZTAU1
|
|
CHARACTER(LEN=20) :: MODELNAME
|
|
CHARACTER(LEN=40) :: CATEGORY
|
|
CHARACTER(LEN=40) :: UNIT
|
|
CHARACTER(LEN=40) :: RESERVED
|
|
CHARACTER(LEN=20) :: STR
|
|
|
|
!=================================================================
|
|
! READ_RCP_BPCH begins here
|
|
!=================================================================
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
100 FORMAT( 'READ_RCP_BPCH: Reading ', a )
|
|
|
|
! Open file
|
|
CALL OPEN_BPCH2_FOR_READ( IU_FILE, FILENAME)
|
|
|
|
! Initialize
|
|
K = 0
|
|
|
|
! 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
|
|
|
|
IF ( CATEGORY /= 'ANTHSRCE' )
|
|
& CALL ERROR_STOP( 'ANTHSRCE not found', 'READ_RCP_BPCH' )
|
|
|
|
! Error check
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_FILE, 'read_data:3' )
|
|
|
|
! Read data
|
|
READ( IU_FILE, IOSTAT=IOS )
|
|
& ( ( ( ARRAY(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
|
|
|
|
! Error check
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_FILE, 'read_data:4' )
|
|
|
|
!==============================================================
|
|
! Save into tracer arrays
|
|
!==============================================================
|
|
|
|
! Select date, if this argument is present
|
|
IF ( PRESENT( TAU0 ) ) THEN
|
|
IF (ZTAU0 /= TAU0) CYCLE
|
|
ENDIF
|
|
|
|
IDT = 0
|
|
|
|
! Find GEOS-Chem tracer ID for each species in file
|
|
! These ID numbers will be the same as the ID numbers
|
|
! stored in the files, but we do this in case the GEOS-Chem tracer
|
|
! numbers change in the future
|
|
SELECT CASE ( NTRACER )
|
|
CASE ( 1 )
|
|
IDT = IDTNOX
|
|
CASE ( 4 )
|
|
IDT = IDTCO
|
|
CASE ( 5 )
|
|
IDT = IDTALK4
|
|
CASE ( 9 )
|
|
! We expect ACET to be lumped with MEK, as explained below
|
|
! and in RETRO implementation
|
|
CALL ERROR_STOP( 'RCP file unexpectely contains ACET: ' //
|
|
& FILENAME, 'READ_RCP_BPCH ' )
|
|
! IDT = IDTACET
|
|
CASE ( 10 )
|
|
IDT = IDTMEK
|
|
CASE ( 11 )
|
|
IDT = IDTALD2
|
|
CASE ( 18 )
|
|
IDT = IDTPRPE
|
|
CASE ( 19 )
|
|
IDT = IDTC3H8
|
|
CASE ( 20 )
|
|
IDT = IDTCH2O
|
|
CASE ( 21 )
|
|
IDT = IDTC2H6
|
|
CASE ( 26 )
|
|
IDT = IDTSO2
|
|
CASE ( 30 )
|
|
IDT = IDTNH3
|
|
CASE ( 36 )
|
|
IDT = IDTBCPO
|
|
CASE ( 37 )
|
|
IDT = IDTOCPO
|
|
CASE ( 59 )
|
|
IDT = IDTBENZ
|
|
CASE ( 60 )
|
|
IDT = IDTTOLU
|
|
CASE ( 61 )
|
|
IDT = IDTXYLE
|
|
CASE ( 65 )
|
|
IDT = IDTC2H4
|
|
CASE ( 66 )
|
|
IDT = IDTC2H2
|
|
CASE DEFAULT
|
|
! DO NOTHING
|
|
END SELECT
|
|
|
|
! Tracer number must be positive,
|
|
! otherwise it's not used for this simulation type
|
|
IF ( IDT > 0 ) THEN
|
|
|
|
! Increment tracer counter
|
|
K = K + 1
|
|
|
|
! Save emissions and tracer number
|
|
SELECT CASE ( TYPE )
|
|
CASE ( 1 )
|
|
|
|
! Error check
|
|
IF (K > SIZE( IDTRCP_LAND )) THEN
|
|
WRITE( STR, '(I4)' ) K
|
|
CALL ERROR_STOP( 'TOO MANY SPECIES FOR RCP_LAND '//
|
|
& TRIM(STR), 'READ_RCP_BPCH' )
|
|
ENDIF
|
|
|
|
CALL TRANSFER_2D( ARRAY(:,:,1), RCP_LAND(:,:,K) )
|
|
IDTRCP_LAND(K) = IDT
|
|
|
|
CASE ( 2 )
|
|
|
|
! Error check
|
|
IF (K > SIZE( IDTRCP_SHIP )) THEN
|
|
WRITE( STR, '(I4)' ) K
|
|
CALL ERROR_STOP( 'TOO MANY SPECIES FOR RCP_SHIP '//
|
|
& TRIM(STR), 'READ_RCP_BPCH' )
|
|
ENDIF
|
|
|
|
CALL TRANSFER_2D( ARRAY(:,:,1), RCP_SHIP(:,:,K) )
|
|
IDTRCP_SHIP(K) = IDT
|
|
|
|
CASE ( 3 )
|
|
|
|
! Error check
|
|
IF (K > SIZE( IDTRCP_AIR )) THEN
|
|
WRITE( STR, '(I4)' ) K
|
|
CALL ERROR_STOP( 'TOO MANY SPECIES FOR RCP_AIR '//
|
|
& TRIM(STR), 'READ_RCP_BPCH' )
|
|
ENDIF
|
|
|
|
! Transfer,
|
|
DO L=1, LLPAR
|
|
CALL TRANSFER_2D( ARRAY(:,:,L), RCP_AIR(:,:,L,K) )
|
|
ENDDO
|
|
IDTRCP_AIR(K) = IDT
|
|
|
|
CASE DEFAULT
|
|
END SELECT
|
|
|
|
!==============================================================
|
|
! Special case for MEK
|
|
! Partition ketones into 75% acetone and 25% MEK
|
|
! In the file, MEK contains all ketones.
|
|
! As done for RETRO (cdh, 10/18/11; dbm, 8/18/2011)
|
|
!==============================================================
|
|
|
|
IF (IDT == IDTMEK) THEN
|
|
|
|
! Reduce MEK emissions
|
|
SELECT CASE ( TYPE )
|
|
CASE ( 1 )
|
|
RCP_LAND(:,:,K) = RCP_LAND(:,:,K) * 0.25D0
|
|
CASE ( 2 )
|
|
RCP_SHIP(:,:,K) = RCP_SHIP(:,:,K) * 0.25D0
|
|
CASE DEFAULT
|
|
! No MEK emissions expected for aircraft
|
|
END SELECT
|
|
|
|
IF (IDTACET > 0d0) THEN
|
|
|
|
! Increment tracer counter
|
|
K = K + 1
|
|
|
|
! Save ACET emissions (75% of original MEK = 3*25%)
|
|
SELECT CASE ( TYPE )
|
|
CASE ( 1 )
|
|
RCP_LAND(:,:,K) = RCP_LAND(:,:,K-1) * 3d0
|
|
IDTRCP_LAND(K) = IDTACET
|
|
CASE ( 2 )
|
|
RCP_SHIP(:,:,K) = RCP_SHIP(:,:,K-1) * 3d0
|
|
IDTRCP_SHIP(K) = IDTACET
|
|
CASE DEFAULT
|
|
! No MEK emissions expected for aircraft
|
|
END SELECT
|
|
|
|
ENDIF
|
|
|
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
END DO
|
|
|
|
! Close file
|
|
CLOSE( IU_FILE )
|
|
|
|
END SUBROUTINE READ_RCP_BPCH
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: rcp_airemiss
|
|
!
|
|
! !DESCRIPTION: Subroutine RCP\_AIREMISS populates EMIS\_AC\_NOx with aircraft
|
|
! NOx emissions. Also does diagnostics. (cdh, 10/14/11)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE RCP_AIREMISS
|
|
!
|
|
! !USES:
|
|
!
|
|
USE AIRCRAFT_NOX_MOD, ONLY : EMIS_AC_NOx, READAIR
|
|
USE DIAG_MOD, ONLY : AD32_AC
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
USE DAO_MOD, ONLY : BXHEIGHT
|
|
USE TRACERID_MOD, ONLY : IDTNO
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN_DIAG" ! Diagnostic switches
|
|
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 22 Jul 2013 - M. Sulprizio- Added ProTeX headers
|
|
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
INTEGER :: I, J, L, K
|
|
LOGICAL, SAVE :: FIRST=.TRUE.
|
|
LOGICAL :: TRACERFOUND
|
|
|
|
!=================================================================
|
|
! RCP_AIREMISS begins here
|
|
!=================================================================
|
|
|
|
! Allocate and initialize arrays
|
|
IF ( FIRST ) THEN
|
|
CALL READAIR ! use this only because init_aircraft_nox is private
|
|
FIRST = .FALSE.
|
|
ENDIF
|
|
|
|
! Initialized
|
|
TRACERFOUND = .FALSE.
|
|
|
|
! Locate the NOx tracer in the emission array
|
|
DO K=1, SIZE(IDTRCP_AIR)
|
|
IF (IDTNO == IDTRCP_AIR(K)) THEN
|
|
TRACERFOUND=.TRUE.
|
|
EXIT
|
|
ENDIF
|
|
ENDDO
|
|
|
|
! Error if there are no NOx emissions
|
|
IF (.NOT. TRACERFOUND)
|
|
& CALL ERROR_STOP('RCP AVIATION NOX HAS NOT BEEN READ',
|
|
& 'RCP_AIREMISS' )
|
|
|
|
! Convert molec/cm2/s -> molec/cm3/s
|
|
EMIS_AC_NOx = RCP_AIR(:,:,:,K) / ( BXHEIGHT * 1D2 )
|
|
|
|
! ND32 -- save NOx in [molec/cm2], will convert to
|
|
! [molec/cm2/s] in subroutine "diag3.f" (bmy, 3/16/00)
|
|
IF ( ND32 > 0 ) THEN
|
|
!DO L=1, LLTROP
|
|
!DO J=1, JJPAR
|
|
!DO I=1, IIPAR
|
|
AD32_ac(:,:,:) = AD32_ac(:,:,:) + ( EMIS_AC_NOx(:,:,:) *
|
|
& BXHEIGHT(:,:,:) * 1d2 )
|
|
! AD32_ac(I,J,L) = AD32_ac(I,J,L) + ( EMIS_AC_NOx(I,J,L) *
|
|
! & BXHEIGHT(I,J,L) * 1d2 )
|
|
!ENDDO
|
|
!ENDDO
|
|
!ENDDO
|
|
ENDIF
|
|
|
|
END SUBROUTINE RCP_AIREMISS
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: total_anthro_rcp
|
|
!
|
|
! !DESCRIPTION: Subroutine TOTAL\_ANTHRO\_RCP prints total RCP anthropogenic
|
|
! emissions each month. (cdh, 10/14/11)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE TOTAL_ANTHRO_RCP( THISMONTH )
|
|
!
|
|
! !USES:
|
|
!
|
|
USE GRID_MOD, ONLY : GET_AREA_CM2
|
|
USE TRACER_MOD, ONLY : TRACER_MW_KG
|
|
USE TRACER_MOD, ONLY : TRACER_NAME
|
|
USE ERROR_MOD, ONLY : GEOS_CHEM_STOP
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
INTEGER, INTENT(IN) :: THISMONTH
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 22 Jul 2013 - M. Sulprizio- Added ProTeX headers
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
INTEGER :: I, J, K
|
|
REAL*8 :: A, TOTAL, TOTAL_SHIP
|
|
|
|
CHARACTER(LEN=6) :: UNIT
|
|
|
|
! Days per month
|
|
INTEGER :: D(12) = (/ 31, 28, 31, 30, 31, 30,
|
|
& 31, 31, 30, 31, 30, 31 /)
|
|
|
|
!=================================================================
|
|
! TOTAL_ANTHRO_RCP begins here
|
|
!=================================================================
|
|
|
|
! Echo info
|
|
WRITE(6, '(a)' ) REPEAT( '=', 79)
|
|
WRITE(6, 100 ) RCPNAME, RCPYEAR
|
|
100 FORMAT( 'R C P E M I S S I O N S',
|
|
& ' -- Scenario: ', A10, I6, / )
|
|
|
|
!==============================================================
|
|
! RCP Land emissions
|
|
!==============================================================
|
|
|
|
WRITE( 6, '(a)' )
|
|
DO K=1, SIZE(IDTRCP_LAND)
|
|
|
|
IF (IDTRCP_LAND(K) < 1) CYCLE
|
|
|
|
!==============================================================
|
|
! Global total emission
|
|
!==============================================================
|
|
|
|
TOTAL = 0d0
|
|
|
|
! Loop over latitudes
|
|
DO J = 1, JJPAR
|
|
|
|
! 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( J ) * ( D(THISMONTH) * 86400d-9 )
|
|
& / 6.0225d23
|
|
|
|
! Anthro emissions
|
|
TOTAL = TOTAL + SUM(RCP_LAND(:,J,K)) * A *
|
|
& TRACER_MW_KG(IDTRCP_LAND(K))
|
|
|
|
ENDDO
|
|
|
|
!==============================================================
|
|
! Units
|
|
!==============================================================
|
|
|
|
SELECT CASE ( TRACER_NAME(IDTRCP_LAND(K)) )
|
|
CASE ( 'NOx' )
|
|
! Convert to Tg(N)
|
|
TOTAL = TOTAL * 0.014 / TRACER_MW_KG(IDTRCP_LAND(K))
|
|
UNIT='N'
|
|
CASE ( 'SO2' )
|
|
! Convert to Tg(S)
|
|
TOTAL = TOTAL * 0.032 / TRACER_MW_KG(IDTRCP_LAND(K))
|
|
UNIT='S'
|
|
CASE ( 'NH3' )
|
|
! Convert to Tg(N)
|
|
TOTAL = TOTAL * 0.014 / TRACER_MW_KG(IDTRCP_LAND(K))
|
|
UNIT='N'
|
|
CASE ( 'CO' )
|
|
UNIT='CO'
|
|
CASE DEFAULT
|
|
UNIT='C'
|
|
END SELECT
|
|
|
|
!==============================================================
|
|
! Print info
|
|
!==============================================================
|
|
|
|
WRITE( 6, 101 ) 'Land', TRACER_NAME(IDTRCP_LAND(K)), THISMONTH,
|
|
& TOTAL, UNIT
|
|
101 FORMAT( 'Anthro ',a5, ' ', a4, ' for month ',
|
|
& i2.2, ': ', f13.6, ' Tg ', a3 )
|
|
|
|
ENDDO
|
|
|
|
!==============================================================
|
|
! RCP Ship emissions
|
|
!==============================================================
|
|
|
|
WRITE( 6, '(a)' )
|
|
DO K=1, SIZE(IDTRCP_SHIP)
|
|
|
|
IF (IDTRCP_SHIP(K) < 1) CYCLE
|
|
|
|
!==============================================================
|
|
! Global total emission
|
|
!==============================================================
|
|
|
|
TOTAL = 0d0
|
|
|
|
! Loop over latitudes
|
|
DO J = 1, JJPAR
|
|
|
|
! 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( J ) * ( D(THISMONTH) * 86400d-9 )
|
|
& / 6.0225d23
|
|
|
|
! Anthro emissions
|
|
TOTAL = TOTAL + SUM(RCP_SHIP(:,J,K)) * A *
|
|
& TRACER_MW_KG(IDTRCP_SHIP(K))
|
|
|
|
ENDDO
|
|
|
|
!==============================================================
|
|
! Units
|
|
!==============================================================
|
|
|
|
SELECT CASE ( TRACER_NAME(IDTRCP_SHIP(K)) )
|
|
CASE ( 'NOx' )
|
|
! Convert to Tg(N)
|
|
TOTAL = TOTAL * 0.014 / TRACER_MW_KG(IDTRCP_SHIP(K))
|
|
UNIT='N'
|
|
CASE ( 'SO2' )
|
|
! Convert to Tg(S)
|
|
TOTAL = TOTAL * 0.032 / TRACER_MW_KG(IDTRCP_SHIP(K))
|
|
UNIT='S'
|
|
CASE ( 'NH3' )
|
|
! Convert to Tg(N)
|
|
TOTAL = TOTAL * 0.014 / TRACER_MW_KG(IDTRCP_SHIP(K))
|
|
UNIT='N'
|
|
CASE ( 'CO' )
|
|
UNIT='CO'
|
|
CASE DEFAULT
|
|
UNIT='C'
|
|
END SELECT
|
|
|
|
!==============================================================
|
|
! Print info
|
|
!==============================================================
|
|
|
|
WRITE( 6, 101 ) 'Ship', TRACER_NAME(IDTRCP_SHIP(K)), THISMONTH,
|
|
& TOTAL, UNIT
|
|
|
|
ENDDO
|
|
|
|
!==============================================================
|
|
! RCP Aircraft emissions
|
|
!==============================================================
|
|
|
|
WRITE( 6, '(a)' )
|
|
DO K=1, SIZE(IDTRCP_AIR)
|
|
|
|
IF (IDTRCP_AIR(K) < 1) CYCLE
|
|
|
|
!==============================================================
|
|
! Global total emission
|
|
!==============================================================
|
|
|
|
TOTAL = 0d0
|
|
|
|
! Loop over latitudes
|
|
DO J = 1, JJPAR
|
|
|
|
! 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( J ) * ( D(THISMONTH) * 86400d-9 )
|
|
& / 6.0225d23
|
|
|
|
! Anthro emissions
|
|
TOTAL = TOTAL + SUM(RCP_AIR(:,J,:,K)) * A *
|
|
& TRACER_MW_KG(IDTRCP_AIR(K))
|
|
|
|
ENDDO
|
|
|
|
!==============================================================
|
|
! Units
|
|
!==============================================================
|
|
|
|
SELECT CASE ( TRACER_NAME(IDTRCP_AIR(K)) )
|
|
CASE ( 'NOx' )
|
|
! Convert to Tg(N)
|
|
TOTAL = TOTAL * 0.014 / TRACER_MW_KG(IDTRCP_AIR(K))
|
|
UNIT='N'
|
|
CASE ( 'SO2' )
|
|
! Convert to Tg(S)
|
|
TOTAL = TOTAL * 0.032 / TRACER_MW_KG(IDTRCP_AIR(K))
|
|
UNIT='S'
|
|
CASE ( 'NH3' )
|
|
! Convert to Tg(N)
|
|
TOTAL = TOTAL * 0.014 / TRACER_MW_KG(IDTRCP_AIR(K))
|
|
UNIT='N'
|
|
CASE ( 'CO' )
|
|
UNIT='CO'
|
|
CASE DEFAULT
|
|
UNIT='C'
|
|
END SELECT
|
|
|
|
!==============================================================
|
|
! Print info
|
|
!==============================================================
|
|
|
|
WRITE( 6, 101 ) 'Air', TRACER_NAME(IDTRCP_AIR(K)), THISMONTH,
|
|
& TOTAL, UNIT
|
|
|
|
ENDDO
|
|
|
|
END SUBROUTINE TOTAL_ANTHRO_RCP
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: get_rcp_emission
|
|
!
|
|
! !DESCRIPTION: Function GET\_RCP\_EMISSION retrieves the emissions of tracer N
|
|
! at grid location (I,J). Use LAND=.TRUE. or SHIP=.TRUE. or both to retrieve
|
|
! either land anthropogenic emissions, ship emissions, or their sum.
|
|
! "N" is the advected tracer index, i.e. the tracer index for STT.
|
|
! The function will return -1 if no emissions are found for that species.
|
|
! (cdh, 10/14/11)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
FUNCTION GET_RCP_EMISSION( I, J, N, LAND, SHIP )
|
|
& RESULT( EMISS )
|
|
!
|
|
! !USES:
|
|
!
|
|
USE TRACERID_MOD
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
INTEGER, INTENT(IN) :: I, J
|
|
INTEGER, INTENT(IN) :: N !GEOS-Chem advected tracer index
|
|
LOGICAL, INTENT(IN), OPTIONAL :: SHIP
|
|
LOGICAL, INTENT(IN), OPTIONAL :: LAND
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 22 Jul 2013 - M. Sulprizio- Added ProTeX headers
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
REAL*8 :: EMISS
|
|
CHARACTER(LEN=20) :: STR
|
|
LOGICAL :: DOLAND, DOSHIP, TRACERFOUND
|
|
INTEGER :: K
|
|
|
|
!=================================================================
|
|
! GET_RCP_EMISSION begins here!
|
|
!=================================================================
|
|
|
|
! Are we getting land emissions?
|
|
IF ( PRESENT( LAND ) ) THEN
|
|
DOLAND = LAND
|
|
ELSE
|
|
DOLAND = .FALSE.
|
|
ENDIF
|
|
|
|
! Are we getting ship emissions?
|
|
IF ( PRESENT( SHIP ) ) THEN
|
|
DOSHIP = SHIP
|
|
ELSE
|
|
DOSHIP = .FALSE.
|
|
ENDIF
|
|
|
|
! Throw error if neither emission type is requested
|
|
IF ( .NOT. (DOLAND .OR. DOSHIP) ) THEN
|
|
WRITE( STR, '(I4)' ) N
|
|
CALL ERROR_STOP( 'No land/ship emissions, tracer '//trim(STR),
|
|
& 'GET_RCP_EMISSION' )
|
|
ENDIF
|
|
|
|
! Initialize
|
|
EMISS = 0d0
|
|
TRACERFOUND = .FALSE.
|
|
|
|
! Find tracer number for land emissions
|
|
IF ( DOLAND ) THEN
|
|
! Loop over all the species we have land emissions for
|
|
DO K=1, SIZE(IDTRCP_LAND)
|
|
IF (N == IDTRCP_LAND(K)) THEN
|
|
! We found the desired tracer, so add it up and exit loop
|
|
EMISS = EMISS + RCP_LAND(I,J,K)
|
|
TRACERFOUND=.TRUE.
|
|
EXIT
|
|
ENDIF
|
|
ENDDO
|
|
ENDIF
|
|
|
|
! Find tracer number for ship emissions
|
|
IF ( DOSHIP ) THEN
|
|
! Loop over all the species we have ship emissions for
|
|
DO K=1, SIZE(IDTRCP_SHIP)
|
|
IF (N == IDTRCP_SHIP(K)) THEN
|
|
! We found the desired tracer, so add it up and exit loop
|
|
EMISS = EMISS + RCP_SHIP(I,J,K)
|
|
TRACERFOUND=.TRUE.
|
|
EXIT
|
|
ENDIF
|
|
ENDDO
|
|
ENDIF
|
|
|
|
! Return -1 if there are no emissions for tracer N
|
|
IF (.NOT. TRACERFOUND) EMISS = -1d0
|
|
|
|
END FUNCTION GET_RCP_EMISSION
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: init_rcp
|
|
!
|
|
! !DESCRIPTION: Subroutine INIT\_RCP allocates and zeroes all module arrays
|
|
! (cdh, 10/14/11)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE INIT_RCP
|
|
!
|
|
! !USES:
|
|
!
|
|
USE ERROR_MOD, ONLY : ALLOC_ERR
|
|
USE LOGICAL_MOD, ONLY : LRCP, LRCPSHIP, LRCPAIR
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 22 Jul 2013 - M. Sulprizio- Added ProTeX headers
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
INTEGER :: AS
|
|
|
|
!=================================================================
|
|
! INIT_RCP begins here
|
|
!=================================================================
|
|
|
|
! Return if we LRCP = .FALSE.
|
|
IF ( .not. (LRCP .OR. LRCPSHIP .OR. LRCPAIR) ) RETURN
|
|
|
|
IDTRCP_LAND = 0d0
|
|
IDTRCP_SHIP = 0d0
|
|
IDTRCP_AIR = 0d0
|
|
|
|
! Anthropogenic land surface emissions
|
|
ALLOCATE( RCP_LAND( IIPAR, JJPAR, SIZE(IDTRCP_LAND) ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'RCP_LAND' )
|
|
RCP_LAND = 0e0
|
|
|
|
! Shipping
|
|
ALLOCATE( RCP_SHIP( IIPAR, JJPAR, SIZE(IDTRCP_SHIP) ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'RCP_SHIP' )
|
|
RCP_SHIP = 0e0
|
|
|
|
! Aircraft
|
|
ALLOCATE( RCP_AIR( IIPAR, JJPAR, LLPAR, SIZE(IDTRCP_AIR) ),
|
|
& STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'RCP_AIR' )
|
|
RCP_AIR = 0e0
|
|
|
|
END SUBROUTINE INIT_RCP
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: cleanup_rcp
|
|
!
|
|
! !DESCRIPTION: Subroutine CLEANUP\_RCP deallocates all module arrays
|
|
! (cdh, 10/14/11)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE CLEANUP_RCP
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 22 Jul 2013 - M. Sulprizio- Added ProTeX headers
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
|
|
!=================================================================
|
|
! CLEANUP_RCP begins here
|
|
!=================================================================
|
|
|
|
IF ( ALLOCATED( RCP_LAND ) ) DEALLOCATE( RCP_LAND )
|
|
IF ( ALLOCATED( RCP_SHIP ) ) DEALLOCATE( RCP_SHIP )
|
|
IF ( ALLOCATED( RCP_AIR ) ) DEALLOCATE( RCP_AIR )
|
|
|
|
END SUBROUTINE CLEANUP_RCP
|
|
!EOC
|
|
END MODULE RCP_MOD
|