Add files via upload
This commit is contained in:
Xuesong (Steve)
973
code/rcp_mod.f
Normal file
973
code/rcp_mod.f
Normal file
@ -0,0 +1,973 @@
|
||||
!------------------------------------------------------------------------------
|
||||
! 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
|
||||
Reference in New Issue
Block a user