694 lines
27 KiB
Fortran
694 lines
27 KiB
Fortran
! $Id: anthroems.f,v 1.1 2009/06/09 21:51:52 daven Exp $
|
|
SUBROUTINE ANTHROEMS( NSEASON )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine ANTHROEMS reads anthropogenic tracers for each season.
|
|
! NOx emissions at levels other than the surface are now accounted for.
|
|
! (bmy, 6/4/98, 7/18/06)
|
|
!
|
|
! Arguments as input:
|
|
! ===========================================================================
|
|
! (1) NSEASON: is the seasonal index for NOx emissions:
|
|
! NSEASON=1 --> winter (Dec, Jan, Feb)
|
|
! NSEASON=2 --> spring (Mar, Apr, May)
|
|
! NSEASON=3 --> summer (Jun, Jul, Aug)
|
|
! NSEASON=4 --> autumn (Sep, Oct, Nov)
|
|
!
|
|
! (2) LNAPAPNOX: logical flag to overwrite US emissions with NAPAP NOx
|
|
!
|
|
! Passed Via CMN:
|
|
! ===========================================================================
|
|
! (1) JYEAR: 4 digit integer variable for current year (1985, 1998, etc.)
|
|
!
|
|
! Passed Via CMN_O3:
|
|
! ===========================================================================
|
|
! Fossil Fuel arrays: EMISTNOX, EMISTCO, EMISTETHE, EMISTPRPE,
|
|
! EMISTC2H6, EMISTC3H8, EMISTALK4, EMISTACET,
|
|
! EMISTMEK, EMISTSOX
|
|
!
|
|
! Emissions arrays: EMIST, EMISTN, EMISR, EMISRN, EMISRR, EMISRRN
|
|
!
|
|
! NOTES:
|
|
! (1 ) We now read the new merge file, created for SASS. (bey, 2/99)
|
|
! (2 ) ANTHROEMS should be called each time the season changes, since
|
|
! the GEIA NOx emissions are seasonal.
|
|
! (3 ) NOx emissions are stored separately in EMISTN, EMISRN, EMISRRN.
|
|
! This is because the NOx emissions can be located across several
|
|
! sigma levels, whereas the other tracers are only emitted into
|
|
! the surface level.
|
|
! (4 ) NO2 is no longer emitted as the emission species for Ox.
|
|
! (bey, bmy, 4/14/99)
|
|
! (5 ) There are 3 different types of scale factors for anthro emissions:
|
|
! (a) Yearly since 1985: done in anthroems.f
|
|
! (b) Weekday/weekend: done in emf_scale.f
|
|
! (c) Time of day: done in emfossil.f
|
|
! (6 ) At present NEMANTHRO = Total number of emitted tracers
|
|
! (set in tracerid.f). We no longer use moments in emissions.
|
|
! ORDER = NOx, CO, PRPE, C3H8, ALK4, C2H6, ALD2.
|
|
! (7 ) NOx is assumed to be the first tracer (N=1). The first usable
|
|
! row for tracers other than NOx in EMIST(I,J,N), etc. is N=2.
|
|
! (8 ) Need to offset EMISR, which has global dimensions.
|
|
! EMIST has window dimensions.
|
|
! (9 ) Now trap I/O errors and stop gracefully if file open or read
|
|
! errors are encountered. Print an error message to alert user
|
|
! which file triggered the I/O error. (bmy, 4/14/99)
|
|
! (10) Eliminate GISS-specific code and PLUMES code (bmy, 4/14/99)
|
|
! (11) Now use F90 syntax where expedient. (bmy, 4/14/99)
|
|
! (12) Cosmetic changes, added comments (bmy, 3/17/00)
|
|
! (13) Do not let SCALYEAR go higher than 1996, since right now we don't
|
|
! have FF scaling data beyond 1996. Also cosmetic changes and
|
|
! updated comments. (bmy, 4/6/01)
|
|
! (14) Now reference routines from GEIA_MOD for reading scale factor and
|
|
! other emissions data from disk. (bmy, 4/23/01)
|
|
! (15) Now read fossil-fuel emissions from a binary punch file (bmy, 4/23/01)
|
|
! (16) CO and hydrocarbons are read from disk once per year. Fossil fuel
|
|
! scale factors are also applied once per
|
|
! (17) Now comment out LNAPAPNOX. Also total fossil fuel emissions
|
|
! and echo to std output. (bmy, 4/27/01)
|
|
! (18) Bug fix: Now convert units for CO, Hydrocarbon tracers only once
|
|
! per year. Convert units for NOx once per season. (bmy, 6/7/01)
|
|
! (19) Bug fix: Now index CH26 correctly when totaling it (bmy, 8/30/01)
|
|
! (20) Now take C3H8 and C2H6 emissions as scaled from natural gas. Read
|
|
! these in subroutine READ_C3H8_C2H6_NGAS. Also scale anthropogenic
|
|
! ACET by 0.82 in order to match the acetone paper (bdf, bmy, 9/10/01)
|
|
! (21) Removed obsolete, commented-out code from 6/01 (bmy, 11/26/01)
|
|
! (22) Eliminated obsolete code from 11/01 (bmy, 2/27/02)
|
|
! (23) Replaced all instances of IM with IIPAR and JM with JJPAR, in order
|
|
! to prevent namespace confusion for the new TPCORE (bmy, 6/25/02)
|
|
! (24) Now reference IDTNOX, IDENOX, etc. from "tracerid_mod.f". Also
|
|
! do not let SCALEYEAR exceed 1998. (bmy, 1/13/03)
|
|
! (25) Now replace DXYP(JREF)*1d4 with routine GET_AREA_CM2 from "grid_mod.f"
|
|
! Now use functions GET_XOFFSET and GET_YOFFSET from "grid_mod.f".
|
|
! Now I0 and J0 are local variables. Now use functions GET_TS_EMIS,
|
|
! GET_YEAR, GET_SEASON from "time_mod.f". (bmy, 2/11/03)
|
|
! (26) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
|
|
! (27) Now replace FMOL with TRACER_MW_KG (bmy, 10/25/05)
|
|
! (28) Modified for IPCC future emissions scale factors (swu, bmy, 5/30/06)
|
|
! (29) Extend max value for FSCALYR to 2002 (bmy, 7/18/06)
|
|
! (30) Use updated int'annual scale factors for 1985-2003 (amv, 08/24/07)
|
|
! (31) As default, use EDGARv2.0 emission (fossil fuel + industry)
|
|
! for year 1985, scale to target year with CO2 from liquid fuel,
|
|
! for aromatics, C2H4, and C2H2. (tmf, 6/13/07)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE FUTURE_EMISSIONS_MOD,ONLY : GET_FUTURE_SCALE_ALK4ff
|
|
USE FUTURE_EMISSIONS_MOD,ONLY : GET_FUTURE_SCALE_C2H6ff
|
|
USE FUTURE_EMISSIONS_MOD,ONLY : GET_FUTURE_SCALE_C3H8ff
|
|
USE FUTURE_EMISSIONS_MOD,ONLY : GET_FUTURE_SCALE_COff
|
|
USE FUTURE_EMISSIONS_MOD,ONLY : GET_FUTURE_SCALE_NOxff
|
|
USE FUTURE_EMISSIONS_MOD,ONLY : GET_FUTURE_SCALE_PRPEff
|
|
USE FUTURE_EMISSIONS_MOD,ONLY : GET_FUTURE_SCALE_TONEff
|
|
USE GEIA_MOD, ONLY : READ_GEIA, READ_C3H8_C2H6_NGAS
|
|
USE GEIA_MOD, ONLY : READ_LIQCO2, READ_TODX
|
|
USE GEIA_MOD, ONLY : READ_TOTCO2, TOTAL_FOSSIL_TG
|
|
USE GRID_MOD, ONLY : GET_AREA_CM2, GET_XOFFSET
|
|
USE GRID_MOD, ONLY : GET_YOFFSET
|
|
USE LOGICAL_MOD, ONLY : LFUTURE
|
|
USE TIME_MOD, ONLY : GET_TS_EMIS, GET_YEAR
|
|
USE TIME_MOD, ONLY : GET_SEASON
|
|
USE TRACER_MOD, ONLY : TRACER_MW_KG
|
|
USE TRACERID_MOD, ONLY : IDEACET, IDEALK4
|
|
USE TRACERID_MOD, ONLY : IDEC2H6, IDEC3H8
|
|
USE TRACERID_MOD, ONLY : IDECO, IDEMEK
|
|
USE TRACERID_MOD, ONLY : IDENOX, IDEPRPE
|
|
USE TRACERID_MOD, ONLY : NEMANTHRO
|
|
USE TRACERID_MOD, ONLY : IDEBENZ, IDETOLU, IDEXYLE
|
|
USE TRACERID_MOD, ONLY : IDEC2H4, IDEC2H2
|
|
USE TRACERID_MOD, ONLY : IDTBENZ, IDTTOLU, IDTXYLE
|
|
USE TRACERID_MOD, ONLY : IDTC2H4, IDTC2H2
|
|
USE SCALE_ANTHRO_MOD, ONLY : GET_ANNUAL_SCALAR
|
|
USE SCALE_ANTHRO_MOD, ONLY : GET_ANNUAL_SCALAR_05x0666_NESTED_CH
|
|
USE EDGAR_MOD, ONLY : READ_AROMATICS, READ_C2H4
|
|
USE EDGAR_MOD, ONLY : READ_C2H2
|
|
USE EDGAR_MOD, ONLY : READ_AROMATICS_05x0666
|
|
USE EDGAR_MOD, ONLY : READ_C2H4_05x0666
|
|
USE EDGAR_MOD, ONLY : READ_C2H2_05x0666
|
|
|
|
IMPLICIT NONE
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN_O3" ! EMIST, EMISR, EMISRR, etc.
|
|
# include "comode.h" ! IDEMS
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: NSEASON
|
|
|
|
! Local Variables
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
INTEGER :: SCALEYEAR
|
|
INTEGER, SAVE :: LASTYEAR
|
|
INTEGER :: I, I0, IREF, J, J0, JREF
|
|
INTEGER :: K, L, LL, N, NN
|
|
REAL*8 :: DTSRCE, AREA_CM2
|
|
|
|
REAL*4 :: E_BENZ(IGLOB,JGLOB), E_TOLU(IGLOB,JGLOB),
|
|
& E_XYLE(IGLOB,JGLOB)
|
|
REAL*4 :: E_C2H4(IGLOB,JGLOB), E_C2H2(IGLOB,JGLOB)
|
|
REAL*8 :: GEOS1x1(I1x1,J1x1,1)
|
|
REAL*8 :: TEMP(IGLOB,JGLOB)
|
|
|
|
|
|
!=================================================================
|
|
! ANTHROEMS begins here!
|
|
!=================================================================
|
|
|
|
! Echo info
|
|
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
|
WRITE( 6, '(a)' ) 'A N T H R O P O G E N I C E M I S S I O N S'
|
|
WRITE( 6, '(a)' )
|
|
WRITE( 6, 110 ) GET_YEAR(), GET_SEASON()
|
|
110 FORMAT( 'ANTHROEMS: NYEAR, NSEASON = ', i4, 1x, i2 )
|
|
|
|
! Emission timestep [s]
|
|
DTSRCE = GET_TS_EMIS() * 60d0
|
|
|
|
! Get nested-grid offsets
|
|
I0 = GET_XOFFSET()
|
|
J0 = GET_YOFFSET()
|
|
|
|
! As of March 2009, the GEIA input files for GEOS_5, 0.5X0.666,
|
|
! NESTED_CHINA are already cropped to the nested grid domain.
|
|
! So there is no need for offsetting the emission data.
|
|
! Reset I0 = 0, J0 = 0. (tmf, 3/5/09)
|
|
#if defined( GRID05x0666 ) && defined( NESTED_CH )
|
|
|
|
I0 = 0
|
|
J0 = 0
|
|
|
|
#endif
|
|
!=================================================================
|
|
! If FSCALYR < 0 then use this year (JYEAR) for the scaling
|
|
! factors. Otherwise, use the value of FSCALYR as specified in
|
|
! 'input.ctm'.
|
|
!
|
|
! Do not let SCALEYEAR exceed 1998 for now, since this is the
|
|
! latest year for which we have data from CDIAC. (bmy, 1/13/03)
|
|
!
|
|
! Do not limit default SCALEYEAR - this is done in
|
|
! GET_ANNUAL_SCALAR. Allow users to force the scaling year
|
|
! as before with a value GT 0 in input.geos (phs, 3/11/08)
|
|
!=================================================================
|
|
!------------------
|
|
! prior to 3/11/08
|
|
! IF ( FSCALYR < 0 ) THEN
|
|
! SCALEYEAR = MIN( GET_YEAR(), 2002 )
|
|
! ELSE
|
|
! SCALEYEAR = FSCALYR
|
|
! ENDIF
|
|
!------------------
|
|
IF ( FSCALYR < 0 ) THEN
|
|
SCALEYEAR = GET_YEAR()
|
|
ELSE
|
|
SCALEYEAR = FSCALYR
|
|
ENDIF
|
|
|
|
|
|
|
|
!=================================================================
|
|
! Do the following only on the very first call to ANTHROEMS...
|
|
!=================================================================
|
|
IF ( FIRST ) THEN
|
|
|
|
! Zero emission arrays
|
|
EMISTNOX = 0e0
|
|
EMISTCO = 0e0
|
|
EMISTALK4 = 0e0
|
|
EMISTACET = 0e0
|
|
EMISTMEK = 0e0
|
|
EMISTPRPE = 0e0
|
|
EMISTC3H8 = 0e0
|
|
EMISTC2H6 = 0e0
|
|
EMISTETHE = 0e0
|
|
EMISTSOX = 0e0
|
|
EMISTBENZ = 0e0
|
|
EMISTTOLU = 0e0
|
|
EMISTXYLE = 0e0
|
|
EMISTC2H4 = 0e0
|
|
EMISTC2H2 = 0e0
|
|
|
|
! Zero arrays for holding CO & Hydrocarbons
|
|
EMIST = 0d0
|
|
EMISR = 0d0
|
|
|
|
! Read time-of-day scale factors (TODN, TODH, TODB)
|
|
! and weekday-weekend scale factors (SCNR89)
|
|
CALL READ_TODX( TODN, TODH, TODB, SCNR89 )
|
|
|
|
! Read emissions from binary punch file format for entire year:
|
|
! NOx [molec NOx/cm2/s], CO [molec CO/cm2/s], HC's [atoms C/cm2/s]
|
|
! NOTE: We don't read in ETHE or SOx for our chemistry mechanism.
|
|
CALL READ_GEIA( E_NOX = EMISTNOX, E_CO = EMISTCO,
|
|
& E_ALK4 = EMISTALK4, E_ACET = EMISTACET,
|
|
& E_MEK = EMISTMEK, E_PRPE = EMISTPRPE )
|
|
|
|
! Read C3H8 and C2H6 emissions, scaled from Natural Gas emissions
|
|
! as computed by Yaping Xiao (xyp@io.harvard.edu)
|
|
CALL READ_C3H8_C2H6_NGAS( E_C3H8=EMISTC3H8, E_C2H6=EMISTC2H6 )
|
|
|
|
!================================================================
|
|
! Read EDGARv2 aromatics emission for 1985 (tmf, 7/30/08)
|
|
!================================================================
|
|
IF ( IDTBENZ /= 0 .AND. IDTTOLU /= 0 .AND. IDTXYLE /= 0 ) THEN
|
|
#if defined(GRID05x0666) && defined( NESTED_CH )
|
|
CALL READ_AROMATICS_05x0666( E_BENZ, E_TOLU, E_XYLE )
|
|
#else
|
|
CALL READ_AROMATICS( E_BENZ, E_TOLU, E_XYLE )
|
|
#endif
|
|
|
|
EMISTBENZ = E_BENZ
|
|
EMISTTOLU = E_TOLU
|
|
EMISTXYLE = E_XYLE
|
|
ENDIF
|
|
!================================================================
|
|
! Read EDGARv2 C2H4 emission for 1985 (tmf, 7/30/08)
|
|
!================================================================
|
|
IF ( IDTC2H4 /= 0 ) THEN
|
|
#if defined(GRID05x0666) && defined( NESTED_CH )
|
|
CALL READ_C2H4_05x0666( E_C2H4 )
|
|
#else
|
|
CALL READ_C2H4( E_C2H4 )
|
|
#endif
|
|
|
|
EMISTC2H4 = E_C2H4
|
|
ENDIF
|
|
!================================================================
|
|
! Read EDGARv2 C2H2 emission for 1985 (tmf, 7/30/08)
|
|
!================================================================
|
|
IF ( IDTC2H2 /= 0 ) THEN
|
|
#if defined(GRID05x0666) && defined( NESTED_CH )
|
|
CALL READ_C2H2_05x0666( E_C2H2 )
|
|
#else
|
|
CALL READ_C2H2( E_C2H2 )
|
|
#endif
|
|
|
|
EMISTC2H2 = E_C2H2
|
|
ENDIF
|
|
!==============================================================
|
|
! Apply IPCC future scale factors to emissions (if necessary)
|
|
!==============================================================
|
|
IF ( LFUTURE ) THEN
|
|
|
|
! Loop over grid boxes
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J )
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
|
|
! Future CO [molec/cm2/s]
|
|
EMISTCO(I,J) = EMISTCO(I,J) *
|
|
& GET_FUTURE_SCALE_COff( I, J )
|
|
|
|
! Future C2H6 [atoms C/cm2/s]
|
|
EMISTC2H6(I,J) = EMISTC2H6(I,J) *
|
|
& GET_FUTURE_SCALE_C2H6ff( I, J )
|
|
|
|
! Future C3H8 emissions [atoms C/cm2/s]
|
|
EMISTC3H8(I,J) = EMISTC3H8(I,J) *
|
|
& GET_FUTURE_SCALE_C3H8ff( I, J )
|
|
|
|
! Future ALK4 [atoms C/cm2/s]
|
|
EMISTALK4(I,J) = EMISTALK4(I,J) *
|
|
& GET_FUTURE_SCALE_ALK4ff( I, J )
|
|
|
|
! Future PRPE [atoms C/cm2/s]
|
|
EMISTPRPE(I,J) = EMISTPRPE(I,J) *
|
|
& GET_FUTURE_SCALE_PRPEff( I, J )
|
|
|
|
! Future ACET [atoms C/cm2/s]
|
|
EMISTACET(I,J) = EMISTACET(I,J) *
|
|
& GET_FUTURE_SCALE_TONEff( I, J )
|
|
|
|
! Future MEK [atoms C/cm2/s]
|
|
EMISTMEK(I,J) = EMISTMEK(I,J) *
|
|
& GET_FUTURE_SCALE_TONEff( I, J )
|
|
|
|
! Future NOx [molec/cm2/s]
|
|
EMISTNOX(I,J,:,:) = EMISTNOX(I,J,:,:) *
|
|
& GET_FUTURE_SCALE_NOxff( I, J )
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
ENDIF
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! Do the following on the first call to ANTHROEMS,
|
|
! or whenever we enter into a new year:
|
|
!=================================================================
|
|
IF ( FIRST .or. SCALEYEAR /= LASTYEAR ) THEN
|
|
|
|
WRITE( 6, * )
|
|
!------------------
|
|
! prior to 3/11/08
|
|
! ! Read in scale factors based on total fuel CO2
|
|
! ! (relative to baseline year 1985) -- used for NOx
|
|
! CALL READ_TOTCO2( SCALEYEAR, FTOTCO2 )
|
|
!
|
|
! ! Read in scale factors based on liquid fuel CO2
|
|
! ! (relative to baseline year 1985) -- used for CO, HC's
|
|
! CALL READ_LIQCO2( SCALEYEAR, FLIQCO2 )
|
|
!-----------------
|
|
! now use updated scalars (amv, phs, 3/11/08)
|
|
CALL GET_ANNUAL_SCALAR( 71, 1985, SCALEYEAR, FTOTCO2 )
|
|
CALL GET_ANNUAL_SCALAR( 72, 1985, SCALEYEAR, FLIQCO2 )
|
|
|
|
! Set SCALEYEAR to this YEAR
|
|
LASTYEAR = SCALEYEAR
|
|
|
|
!==============================================================
|
|
! Apply scale factors to CO and Hydrocarbon emission species
|
|
! These are aseasonal, so we only have to do this the first
|
|
! time that anthroems.f is called.
|
|
!
|
|
! EMIST(I,J,N) contains CO and hydrocarbon emission species
|
|
! in units of [molec (C)/cm2/s]
|
|
!
|
|
! NOTE: We always assume NOx is the first tracer (N=1), so the
|
|
! first valid entry in EMIST(I,J,N) will be the N=2 row.
|
|
!==============================================================
|
|
|
|
! CO: Scale by liquid CO2 scale factors
|
|
IF ( IDECO /= 0 ) THEN
|
|
DO J = 1, JJPAR
|
|
JREF = J + J0
|
|
DO I = 1, IIPAR
|
|
IREF = I + I0
|
|
EMIST(I,J,IDECO) = EMISTCO(IREF,JREF) *
|
|
& FLIQCO2(IREF,JREF)
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Print total in Tg CO
|
|
CALL TOTAL_FOSSIL_TG( EMIST(:,:,IDECO), IIPAR, JJPAR,
|
|
& 1, 28d-3, 'CO' )
|
|
ENDIF
|
|
|
|
! ALK4: scale by liquid fuel CO scale factors
|
|
IF ( IDEALK4 /= 0 ) THEN
|
|
DO J = 1, JJPAR
|
|
JREF = J + J0
|
|
DO I = 1, IIPAR
|
|
IREF = I + I0
|
|
EMIST(I,J,IDEALK4) = EMISTALK4(IREF,JREF) *
|
|
& FLIQCO2(IREF,JREF)
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Print total in Tg C
|
|
CALL TOTAL_FOSSIL_TG( EMIST(:,:,IDEALK4), IIPAR, JJPAR,
|
|
& 1, 12d-3, 'ALK4' )
|
|
ENDIF
|
|
|
|
! ACET: scale by liquid fuel CO scale factors
|
|
IF ( IDEACET /= 0 ) THEN
|
|
DO J = 1, JJPAR
|
|
JREF = J + J0
|
|
DO I = 1, IIPAR
|
|
IREF = I + I0
|
|
|
|
! Also multiply by 0.82 in order to match the
|
|
! a posteriori acetone source (bdf, bmy, 9/5/01)
|
|
EMIST(I,J,IDEACET) = EMISTACET(IREF,JREF) *
|
|
& FLIQCO2(IREF,JREF) * 0.82d0
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Print total in Tg C
|
|
CALL TOTAL_FOSSIL_TG( EMIST(:,:,IDEACET), IIPAR, JJPAR,
|
|
& 1, 12d-3, 'ACET' )
|
|
ENDIF
|
|
|
|
! MEK: scale by liquid fuel CO scale factors
|
|
IF ( IDEMEK /= 0 ) THEN
|
|
DO J = 1, JJPAR
|
|
JREF = J + J0
|
|
DO I = 1, IIPAR
|
|
IREF = I + I0
|
|
EMIST(I,J,IDEMEK) = EMISTMEK(IREF,JREF) *
|
|
& FLIQCO2(IREF,JREF)
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Print total in Tg C
|
|
CALL TOTAL_FOSSIL_TG( EMIST(:,:,IDEMEK), IIPAR, JJPAR,
|
|
& 1, 12d-3, 'MEK' )
|
|
ENDIF
|
|
|
|
! PRPE: Scale by liquid CO2 scale factors
|
|
IF ( IDEPRPE /= 0 ) THEN
|
|
DO J = 1, JJPAR
|
|
JREF = J + J0
|
|
DO I = 1, IIPAR
|
|
IREF = I + I0
|
|
EMIST(I,J,IDEPRPE) = EMISTPRPE(IREF,JREF) *
|
|
& FLIQCO2(IREF,JREF)
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Print total in Tg C
|
|
CALL TOTAL_FOSSIL_TG( EMIST(:,:,IDEPRPE), IIPAR, JJPAR,
|
|
& 1, 12d-3, 'PRPE' )
|
|
ENDIF
|
|
|
|
! C3H8: scale by liquid fuel CO scale factors
|
|
IF ( IDEC3H8 /= 0 ) THEN
|
|
DO J = 1, JJPAR
|
|
JREF = J + J0
|
|
DO I = 1, IIPAR
|
|
IREF = I + I0
|
|
EMIST(I,J,IDEC3H8) = EMISTC3H8(IREF,JREF) *
|
|
& FLIQCO2(IREF,JREF)
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Print total in Tg C
|
|
CALL TOTAL_FOSSIL_TG( EMIST(:,:,IDEC3H8), IIPAR, JJPAR,
|
|
& 1, 12d-3, 'C3H8' )
|
|
ENDIF
|
|
|
|
! C2H6: scale by liquid fuel CO scale factors
|
|
IF ( IDEC2H6 /= 0 ) THEN
|
|
DO J = 1, JJPAR
|
|
JREF = J + J0
|
|
DO I = 1, IIPAR
|
|
IREF = I + I0
|
|
EMIST(I,J,IDEC2H6) = EMISTC2H6(IREF,JREF) *
|
|
& FLIQCO2(IREF,JREF)
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Print total in Tg C
|
|
CALL TOTAL_FOSSIL_TG( EMIST(:,:,IDEC2H6), IIPAR, JJPAR,
|
|
& 1, 12d-3, 'C2H6' )
|
|
ENDIF
|
|
|
|
!=============================================================
|
|
! Default emissions for BENZ, TOLU, XYLE, C2H2, C2H4
|
|
! are for year 1985 only. Scale to target year
|
|
!=============================================================
|
|
! BENZ: for year 1985
|
|
IF ( IDEBENZ /= 0 .AND. IDTBENZ /= 0 ) THEN
|
|
DO J = 1, JJPAR
|
|
JREF = J + J0
|
|
DO I = 1, IIPAR
|
|
IREF = I + I0
|
|
EMIST(I,J,IDEBENZ) = EMISTBENZ(IREF,JREF) *
|
|
& FLIQCO2(IREF, JREF)
|
|
! & FLIQCO2(IREF, JREF) / FLIQCO290(IREF, JREF)
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Print total in Tg C
|
|
CALL TOTAL_FOSSIL_TG( EMIST(:,:,IDEBENZ), IIPAR, JJPAR,
|
|
& 1, 12d-3, 'BENZ' )
|
|
ENDIF
|
|
|
|
! TOLU: for year 1985
|
|
IF ( IDETOLU /= 0 .AND. IDTTOLU /= 0 ) THEN
|
|
DO J = 1, JJPAR
|
|
JREF = J + J0
|
|
DO I = 1, IIPAR
|
|
IREF = I + I0
|
|
EMIST(I,J,IDETOLU) = EMISTTOLU(IREF,JREF) *
|
|
& FLIQCO2(IREF, JREF)
|
|
! & FLIQCO2(IREF, JREF) / FLIQCO290(IREF, JREF)
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Print total in Tg C
|
|
CALL TOTAL_FOSSIL_TG( EMIST(:,:,IDETOLU), IIPAR, JJPAR,
|
|
& 1, 12d-3, 'TOLU' )
|
|
ENDIF
|
|
|
|
! XYLE: for year 1985
|
|
IF ( IDEXYLE /= 0 .AND. IDTXYLE /= 0 ) THEN
|
|
DO J = 1, JJPAR
|
|
JREF = J + J0
|
|
DO I = 1, IIPAR
|
|
IREF = I + I0
|
|
EMIST(I,J,IDEXYLE) = EMISTXYLE(IREF,JREF) *
|
|
& FLIQCO2(IREF, JREF)
|
|
! & FLIQCO2(IREF, JREF) / FLIQCO290(IREF, JREF)
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Print total in Tg C
|
|
CALL TOTAL_FOSSIL_TG( EMIST(:,:,IDEXYLE), IIPAR, JJPAR,
|
|
& 1, 12d-3, 'XYLE' )
|
|
ENDIF
|
|
|
|
! C2H4: for year 1985
|
|
IF ( IDEC2H4 /= 0 .AND. IDTC2H4 /= 0 ) THEN
|
|
DO J = 1, JJPAR
|
|
JREF = J + J0
|
|
DO I = 1, IIPAR
|
|
IREF = I + I0
|
|
EMIST(I,J,IDEC2H4) = EMISTC2H4(IREF,JREF) *
|
|
& FLIQCO2(IREF, JREF)
|
|
! & FLIQCO2(IREF, JREF) / FLIQCO290(IREF, JREF)
|
|
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Print total in Tg C
|
|
CALL TOTAL_FOSSIL_TG( EMIST(:,:,IDEC2H4), IIPAR, JJPAR,
|
|
& 1, 12d-3, 'C2H4' )
|
|
ENDIF
|
|
|
|
! C2H2: for year 1985
|
|
IF ( IDEC2H2 /= 0 .AND. IDTC2H2 /= 0 ) THEN
|
|
DO J = 1, JJPAR
|
|
JREF = J + J0
|
|
DO I = 1, IIPAR
|
|
IREF = I + I0
|
|
EMIST(I,J,IDEC2H2) = EMISTC2H2(IREF,JREF) *
|
|
& FLIQCO2(IREF, JREF)
|
|
! & FLIQCO2(IREF, JREF) / FLIQCO290(IREF, JREF)
|
|
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Print total in Tg C
|
|
CALL TOTAL_FOSSIL_TG( EMIST(:,:,IDEC2H2), IIPAR, JJPAR,
|
|
& 1, 12d-3, 'C2H2' )
|
|
ENDIF
|
|
|
|
!==============================================================
|
|
! Convert CO and hydrocarbon emissions from [molec (C)/cm2/s]
|
|
! to [kg (C)/box/emission timestep]. Store in array EMISR.
|
|
!==============================================================
|
|
|
|
! Loop over the anthropogenic tracers
|
|
DO N = 1, NEMANTHRO
|
|
|
|
! NN is the actual CTM tracer #
|
|
! corresponding to emissions species N
|
|
NN = IDEMS(N)
|
|
|
|
! Skip NOx
|
|
IF ( N == IDENOX ) CYCLE
|
|
|
|
! Skip if some tracer is not present because there are more
|
|
! anthro. tracers for dicarbonyl chemistry. (ccc, 4/16/09)
|
|
IF ( NN == 0 ) CYCLE
|
|
|
|
! Convert units
|
|
DO J = 1, JJPAR
|
|
JREF = J + J0
|
|
|
|
! Grid box surface area [cm2]
|
|
AREA_CM2 = GET_AREA_CM2( J )
|
|
|
|
DO I = 1, IIPAR
|
|
IREF = I + I0
|
|
EMIST(I,J,N) = EMIST(I,J,N) * TRACER_MW_KG(NN) *
|
|
& DTSRCE * AREA_CM2 / 6.023d23
|
|
|
|
EMISR(IREF,JREF,N) = EMIST(I,J,N)
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
|
|
ENDIF ! FIRST or SCALEYEAR /= LASTYEAR
|
|
|
|
!==============================================================
|
|
! Apply total fuel CO2 scale factors to NOx emissions
|
|
! This has to be done once per season (4x/year);
|
|
! that is, every time that ANTHROEMS is called.
|
|
!==============================================================
|
|
|
|
! Zero NOx emission arrays
|
|
EMISTN = 0d0
|
|
EMISRN = 0d0
|
|
|
|
! NOX: scale by total CO2 scale factors
|
|
IF ( IDENOX > 0 ) THEN
|
|
DO LL = 1, 2 !fp to accomodate NEI08
|
|
DO J = 1, JJPAR
|
|
JREF = J + J0
|
|
DO I = 1, IIPAR
|
|
IREF = I + I0
|
|
EMISTN(I,J,LL) = EMISTNOX(IREF,JREF,NSEASON,LL) *
|
|
& FTOTCO2(IREF,JREF)
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Print total in Tg N
|
|
CALL TOTAL_FOSSIL_TG( EMISTN, IIPAR, JJPAR,
|
|
& NOXLEVELS, 14d-3, 'NOx', NSEASON )
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! Convert all emission species from [molec (C)/cm2/s] to
|
|
! [kg/box/emission timestep] and store in EMISRN, EMISR arrays.
|
|
!=================================================================
|
|
|
|
! Loop over the anthropogenic tracers
|
|
DO N = 1, NEMANTHRO
|
|
|
|
! NN is the actual CTM tracer #
|
|
! corresponding to emissions species N
|
|
NN = IDEMS(N)
|
|
|
|
! Do unit conversion for NOx separately, since it is multi-level
|
|
IF ( N == IDENOX ) THEN
|
|
DO LL = 1, NOXLEVELS
|
|
DO J = 1, JJPAR
|
|
JREF = J + J0
|
|
|
|
! Grid box surface area [cm2]
|
|
AREA_CM2 = GET_AREA_CM2( J )
|
|
|
|
DO I = 1, IIPAR
|
|
IREF = I + I0
|
|
|
|
EMISTN(I,J,LL) = EMISTN(I,J,LL) *TRACER_MW_KG(NN) *
|
|
& DTSRCE * AREA_CM2 / 6.023d23
|
|
|
|
EMISRN(IREF,JREF,LL) = EMISTN(I,J,LL)
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Exit from the loop over anthropogenic tracers
|
|
EXIT
|
|
ENDIF
|
|
ENDDO
|
|
|
|
!================================================================
|
|
! Cleanup and quit
|
|
!================================================================
|
|
|
|
! Set first-time-flag FALSE for next iteration
|
|
FIRST = .FALSE.
|
|
|
|
! Pretty output
|
|
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE ANTHROEMS
|
|
|