!$Id: nei2005_anthro_mod.f,v 1.2 2012/03/01 22:00:26 daven Exp $ !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !MODULE: nei2005_anthro_mod ! ! !DESCRIPTION: Module NEI2005\_ANTHRO\_MOD contains variables and routines to ! read the NEI2005 anthropogenic emissions. !\\ !\\ ! !INTERFACE: ! MODULE NEI2005_ANTHRO_MOD ! ! !USES: ! IMPLICIT NONE PRIVATE ! ! !PUBLIC DATA MEMBERS: ! REAL*8, PUBLIC, ALLOCATABLE :: USA_MASK(:,:) ! ! !PUBLIC MEMBER FUNCTIONS: ! PUBLIC :: CLEANUP_NEI2005_ANTHRO PUBLIC :: EMISS_NEI2005_ANTHRO PUBLIC :: EMISS_NEI2005_ANTHRO_05x0666 PUBLIC :: GET_NEI2005_ANTHRO !-------------------------------------- ! Leave for future use (bmy, 12/3/09) !PUBLIC :: GET_NEI2005_MASK !-------------------------------------- ! ! !PRIVATE MEMBER FUNCTIONS: ! PRIVATE :: NEI2005_SCALE_FUTURE PRIVATE :: INIT_NEI2005_ANTHRO PRIVATE :: TOTAL_ANTHRO_TG PRIVATE :: READ_NEI2005_MASK PRIVATE :: GET_NEI99_SEASON PRIVATE :: GET_NEI99_SEASON_05x0666 PRIVATE :: GET_VISTAS_SEASON PRIVATE :: GET_VISTAS_SEASON_05x0666 PRIVATE :: GET_NEI99_WKSCALE PRIVATE :: GET_NEI99_WKSCALE_05x0666 ! ! !REMARKS: ! (1) NIT is available in the data file but not read here (it is not ! emitted in GEOS-Chem). ! ! !REVISION HISTORY: ! 07 Oct 2009 - A. van Donkelaar - initial version ! 20 Oct 2009 - P. Le Sager - added handling of VOC & masks ! 02 Nov 2009 - A. van Donkelaar - added seasonality, weekday factors ! 02 Dec 2009 - R. Yantosca - Added GET_NEI2005_MASK function ! 02 Dec 2009 - R. Yantosca - Updated comments etc. ! 10 Dec 2009 - D. Millet - Fix scaling, which is by ozone season ! 11 Dec 2009 - L. Zhang, A. Van Donkelaar - Add seasonality for NH3 ! 21 Dec 2009 - R. Yantosca - Added support for 0.5 x 0.666 nested grids ! 13 Aug 2010 - R. Yantosca - Add modifications for MERRA (treat like GEOS-5) !EOP !------------------------------------------------------------------------------ ! ! !PRIVATE TYPES: ! ! Array for surface area REAL*8, ALLOCATABLE :: A_CM2(:) ! Arrays for emissions REAL*8, ALLOCATABLE :: NOx(:,:,:) REAL*8, ALLOCATABLE :: CO(:,:,:) REAL*8, ALLOCATABLE :: SO2(:,:,:) REAL*8, ALLOCATABLE :: SO4(:,:,:) REAL*8, ALLOCATABLE :: NH3(:,:,:) REAL*8, ALLOCATABLE :: OC(:,:,:) REAL*8, ALLOCATABLE :: BC(:,:,:) REAL*8, ALLOCATABLE :: ALK4(:,:,:) ! 105 REAL*8, ALLOCATABLE :: ACET(:,:,:) ! 109 REAL*8, ALLOCATABLE :: MEK (:,:,:) ! 110 REAL*8, ALLOCATABLE :: ALD2(:,:,:) ! 111 REAL*8, ALLOCATABLE :: PRPE(:,:,:) ! 118 REAL*8, ALLOCATABLE :: C2H6(:,:,:) ! 121 REAL*8, ALLOCATABLE :: C3H8(:,:,:) ! 119 REAL*8, ALLOCATABLE :: CH2O(:,:,:) ! 120 REAL*8, ALLOCATABLE :: NOx_WKEND(:,:,:) REAL*8, ALLOCATABLE :: CO_WKEND(:,:,:) REAL*8, ALLOCATABLE :: SO2_WKEND(:,:,:) REAL*8, ALLOCATABLE :: SO4_WKEND(:,:,:) REAL*8, ALLOCATABLE :: NH3_WKEND(:,:,:) REAL*8, ALLOCATABLE :: OC_WKEND(:,:,:) REAL*8, ALLOCATABLE :: BC_WKEND(:,:,:) REAL*8, ALLOCATABLE :: ALK4_WKEND(:,:,:) ! 105 REAL*8, ALLOCATABLE :: ACET_WKEND(:,:,:) ! 109 REAL*8, ALLOCATABLE :: MEK_WKEND(:,:,:) ! 110 REAL*8, ALLOCATABLE :: ALD2_WKEND(:,:,:) ! 111 REAL*8, ALLOCATABLE :: PRPE_WKEND(:,:,:) ! 118 REAL*8, ALLOCATABLE :: C2H6_WKEND(:,:,:) ! 121 REAL*8, ALLOCATABLE :: C3H8_WKEND(:,:,:) ! 119 REAL*8, ALLOCATABLE :: CH2O_WKEND(:,:,:) ! 120 ! ! !DEFINED PARAMETERS: ! REAL*8, PARAMETER :: SEC_IN_YEAR = 86400d0 * 365.25d0 CONTAINS !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: get_nei2005_anthro ! ! !DESCRIPTION: Function GET\_NEI2005\_ANTHRO returns the NEI2005 ! emission for GEOS-Chem grid box (I,J,L) and tracer N. Emissions can be ! returned in units of [kg/s] or [molec/cm2/s]. !\\ !\\ ! !INTERFACE: ! FUNCTION GET_NEI2005_ANTHRO( I, J, L, N, WEEKDAY, & MOLEC_CM2_S, KG_S ) RESULT( VALUE ) ! ! !USES: ! USE TRACER_MOD, ONLY : XNUMOL USE TRACERID_MOD, ONLY : IDTACET, IDTALK4, IDTC2H6, IDTC3H8 USE TRACERID_MOD, ONLY : IDTALD2, IDTCH2O, IDTPRPE, IDTMEK USE TRACERID_MOD, ONLY : IDTNOx, IDTCO, IDTSO2, IDTNH3 USE TRACERID_MOD, ONLY : IDTSO4 ! ! !INPUT PARAMETERS: ! ! Longitude, latitude, and tracer indices INTEGER, INTENT(IN) :: I, J, L, N ! OPTIONAL -- return emissions in [molec/cm2/s] LOGICAL, INTENT(IN), OPTIONAL :: WEEKDAY, MOLEC_CM2_S ! OPTIONAL -- return emissions in [kg/s] or [kg C/s] LOGICAL, INTENT(IN), OPTIONAL :: KG_S ! ! !RETURN VALUE: ! ! Emissions output REAL*8 :: VALUE ! ! !REVISION HISTORY: ! 7 Oct 2009 - A. van Donkelaar - initial version !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! LOGICAL :: DO_KGS, DO_MCS !================================================================= ! GET_NEI2005_ANTHRO begins here! !================================================================= ! Initialize DO_KGS = .FALSE. DO_MCS = .FALSE. ! Return data in [kg/s] or [molec/cm2/s]? IF ( PRESENT( KG_S ) ) DO_KGS = KG_S IF ( PRESENT( MOLEC_CM2_S ) ) DO_MCS = MOLEC_CM2_S IF ( WEEKDAY ) THEN IF ( N == IDTNOx ) THEN ! NOx [kg/yr] VALUE = NOx(I,J,L) ELSE IF ( N == IDTCO ) THEN ! CO [kg/yr] VALUE = CO(I,J,L) ELSE IF ( N == IDTSO2 ) THEN ! SO2 [kg/yr] VALUE = SO2(I,J,L) ELSE IF ( N == IDTSO4 ) THEN ! SO4 [kg/yr] VALUE = SO4(I,J,L) ELSE IF ( N == IDTNH3 ) THEN ! NH3 [kg/yr] VALUE = NH3(I,J,L) ELSE IF ( N == IDTALK4 ) THEN ! [kg C/yr] VALUE = ALK4(I,J,L) ELSE IF ( N == IDTACET ) THEN ! [kg C/yr] VALUE = ACET(I,J,L) ELSE IF ( N == IDTMEK ) THEN ! [kg C/yr] VALUE = MEK(I,J,L) ELSE IF ( N == IDTPRPE ) THEN ! [kg C/yr] VALUE = PRPE(I,J,L) ELSE IF ( N == IDTC3H8 ) THEN ! [kg C/yr] VALUE = C3H8(I,J,L) ELSE IF ( N == IDTCH2O ) THEN ! [kg C/yr] VALUE = CH2O(I,J,L) ELSE IF ( N == IDTC2H6 ) THEN ! [kg C/yr] VALUE = C2H6(I,J,L) ELSE IF ( N == IDTALD2 ) THEN ! [kg C/yr] VALUE = ALD2(I,J,L) ELSE ! Otherwise return a negative value to indicate ! that there are no NEI2005 emissions for tracer N VALUE = -1d0 RETURN ENDIF ELSE IF ( N == IDTNOx ) THEN ! NOx [kg/yr] VALUE = NOx_WKEND(I,J,L) ELSE IF ( N == IDTCO ) THEN ! CO [kg/yr] VALUE = CO_WKEND(I,J,L) ELSE IF ( N == IDTSO2 ) THEN ! SO2 [kg/yr] VALUE = SO2_WKEND(I,J,L) ELSE IF ( N == IDTSO4 ) THEN ! SO4 [kg/yr] VALUE = SO4_WKEND(I,J,L) ELSE IF ( N == IDTNH3 ) THEN ! NH3 [kg/yr] VALUE = NH3_WKEND(I,J,L) ELSE IF ( N == IDTALK4 ) THEN ! [kg C/yr] VALUE = ALK4_WKEND(I,J,L) ELSE IF ( N == IDTACET ) THEN ! [kg C/yr] VALUE = ACET_WKEND(I,J,L) ELSE IF ( N == IDTMEK ) THEN ! [kg C/yr] VALUE = MEK_WKEND(I,J,L) ELSE IF ( N == IDTPRPE ) THEN ! [kg C/yr] VALUE = PRPE_WKEND(I,J,L) ELSE IF ( N == IDTC3H8 ) THEN ! [kg C/yr] VALUE = C3H8_WKEND(I,J,L) ELSE IF ( N == IDTCH2O ) THEN ! [kg C/yr] VALUE = CH2O_WKEND(I,J,L) ELSE IF ( N == IDTC2H6 ) THEN ! [kg C/yr] VALUE = C2H6_WKEND(I,J,L) ELSE IF ( N == IDTALD2 ) THEN ! [kg C/yr] VALUE = ALD2_WKEND(I,J,L) ELSE ! Otherwise return a negative value to indicate ! that there are no NEI2005 emissions for tracer N VALUE = -1d0 RETURN ENDIF ENDIF !------------------------------ ! Convert units (if necessary) !------------------------------ IF ( DO_KGS ) THEN ! Convert from [kg/yr] to [kg/s] or from [kgC/yr] to [kgC/s] VALUE = VALUE / SEC_IN_YEAR ELSE IF ( DO_MCS ) THEN ! Convert NOx from [kg/yr] to [molec/cm2/s] or from ! [kg C/yr] to [atom C/cm2/s] VALUE = VALUE * XNUMOL(N) / ( A_CM2(J) * SEC_IN_YEAR ) ENDIF ! Return to calling program END FUNCTION GET_NEI2005_ANTHRO !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: emiss_nei2005_anthro ! ! !DESCRIPTION: Subroutine EMISS\_NEI2005\_ANTHRO reads the NEI2005 ! emission fields at 1x1 resolution and regrids them to the ! current model resolution. !\\ !\\ ! !INTERFACE: ! SUBROUTINE EMISS_NEI2005_ANTHRO ! ! !USES: ! USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2 USE DIRECTORY_MOD, ONLY : DATA_DIR_1x1 USE LOGICAL_MOD, ONLY : LFUTURE USE REGRID_1x1_MOD, ONLY : DO_REGRID_1x1 USE TIME_MOD, ONLY : GET_YEAR, GET_MONTH USE SCALE_ANTHRO_MOD, ONLY : GET_ANNUAL_SCALAR_1x1 USE TRACERID_MOD, ONLY : IDTACET, IDTALK4, IDTC2H6, IDTC3H8 USE TRACERID_MOD, ONLY : IDTALD2, IDTCH2O, IDTPRPE, IDTMEK USE TRACERID_MOD, ONLY : IDTNOx, IDTCO, IDTSO2, IDTNH3 USE TRACERID_MOD, ONLY : IDTSO4, IDTOCPI, IDTBCPI USE TRACER_MOD, ONLY : ITS_A_FULLCHEM_SIM # include "CMN_SIZE" ! Size parameters # include "CMN_O3" ! FSCALYR ! ! !REVISION HISTORY: ! 07 Oct 2009 - A. van Donkelaar - initial version ! 20 Oct 2009 - P. Le Sager - added VOC, account for mask to get better total ! 12 Jul 2010 - R. Yantosca - Now point to NEI2005_201007 directory, to read ! in updated files (by Aaron van Donkelaar) to ! fix a problem in the VOC emissions. ! 13 Aug 2010 - R. Yantosca - Treat MERRA like GEOS-5 !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! LOGICAL, SAVE :: FIRST = .TRUE. INTEGER :: I, J, THISYEAR, SNo, ScNo INTEGER :: L, KLM, ID, MN INTEGER :: SPECIES_ID(15), SPECIES_ID_SAVE(15) REAL*4 :: ARRAY(I1x1,J1x1,5) REAL*8 :: GEOS_1x1(I1x1,J1x1,5) REAL*8 :: SC_1x1(I1x1,J1x1) REAL*8 :: TAU2005, TAU CHARACTER(LEN=255) :: FILENAME CHARACTER(LEN=4) :: SYEAR CHARACTER(LEN=5) :: SNAME CHARACTER(LEN=1) :: SSMN CHARACTER(LEN=2) :: SMN !================================================================= ! EMISS_NEI2005_ANTHRO begins here! !================================================================= ! First-time initialization IF ( FIRST ) THEN CALL INIT_NEI2005_ANTHRO FIRST = .FALSE. ENDIF ! Get emissions year IF ( FSCALYR < 0 ) THEN THISYEAR = GET_YEAR() ELSE THISYEAR = FSCALYR ENDIF #if defined( GEOS_5 ) || defined( MERRA ) || defined( GEOS_FP ) SNAME = 'GEOS5' #elif defined( GEOS_4 ) SNAME = 'GEOS4' #elif defined( GEOS_3 ) SNAME = 'GEOS3' #endif ! (zhe, dkh, 01/16/12, adj32_015) IF ( .not. ITS_A_FULLCHEM_SIM() ) THEN SPECIES_ID_SAVE = (/ IDTNOX, IDTCO, IDTSO2, IDTSO4, IDTNH3, $ IDTACET, IDTALK4, IDTC2H6, IDTC3H8, $ IDTOCPI, IDTBCPI, $ IDTALD2, IDTCH2O, IDTPRPE, IDTMEK $ /) IDTNOX = 1 IDTCO = 4 IDTSO2 = 26 IDTSO4 = 27 IDTNH3 = 30 IDTACET = 9 IDTALK4 = 5 IDTC2H6 = 21 IDTC3H8 = 19 IDTOCPI = 35 IDTBCPI = 34 IDTALD2 = 11 IDTCH2O = 20 IDTPRPE = 18 IDTMEK = 10 ENDIF ! list of ID of available species SPECIES_ID = (/ IDTNOX, IDTCO, IDTSO2, IDTSO4, IDTNH3, $ IDTACET, IDTALK4, IDTC2H6, IDTC3H8, $ IDTOCPI, IDTBCPI, $ IDTALD2, IDTCH2O, IDTPRPE, IDTMEK $ /) ! Loop over species DO KLM = 1, SIZE( SPECIES_ID ) SNo = SPECIES_ID( KLM ) ! corresponding annual scale factor # if any ScNo = 0 IF ( SNo == IDTNOx ) ScNo = 71 IF ( SNo == IDTCO ) ScNo = 72 IF ( SNo == IDTSO2 .or. SNo == IDTSO4 ) ScNo = 73 ! TAU values for 2005 TAU2005 = GET_TAU0( 1, 1, 2005 ) ! File name FILENAME = TRIM( DATA_DIR_1x1 ) // 'NEI2005_201007/' // & 'NEI2005.' // TRIM( SNAME ) // '.1x1.AVG.bpch' ! Echo info WRITE( 6, 100 ) TRIM( FILENAME ) 100 FORMAT( ' - EMISS_NEI2005_ANTHRO: Reading ', a ) CALL READ_BPCH2( FILENAME, 'ANTHSRCE', SNo, & TAU2005, I1x1, J1x1, & 5, ARRAY, QUIET=.TRUE. ) ! Cast to REAL*8 before regridding GEOS_1x1(:,:,:) = ARRAY(:,:,:) ! Apply annual scalar factor. Available for 1985-2005, ! and NOx, CO and SO2 only. IF ( ScNo .ne. 0 ) THEN CALL GET_ANNUAL_SCALAR_1x1( ScNo, 2005, & THISYEAR, SC_1x1 ) DO L = 1, 5 GEOS_1x1(:,:,L) = GEOS_1x1(:,:,L) * SC_1x1(:,:) ENDDO ENDIF ! Apply Seasonality IF ( SNo .eq. IDTNOx ) THEN CALL GET_VISTAS_SEASON( ARRAY ) ELSE CALL GET_NEI99_SEASON( SNo, ARRAY ) ENDIF GEOS_1x1(:,:,:) = GEOS_1x1(:,:,:) * ARRAY(:,:,:) ! Get Weekday/Weekend scaling CALL GET_NEI99_WKSCALE( SNo, ARRAY ) ! Regrid from GEOS 1x1 --> current model resolution IF ( SNo .eq. IDTNOx ) THEN CALL DO_REGRID_1x1( 5, 'kg/yr', GEOS_1x1, NOx ) CALL DO_REGRID_1x1( 5, 'kg/yr', & GEOS_1x1(:,:,:) * ARRAY(:,:,:), NOx_WKEND ) DO L = 1, 5 NOx(:,:,L) = NOx(:,:,L) * USA_MASK(:,:) NOx_WKEND(:,:,L) = & NOx_WKEND(:,:,L) * USA_MASK(:,:) ENDDO ELSEIF ( SNo .eq. IDTCO ) THEN CALL DO_REGRID_1x1( 5, 'kg/yr', GEOS_1x1, CO ) CALL DO_REGRID_1x1( 5, 'kg/yr', & GEOS_1x1(:,:,:) * ARRAY(:,:,:), CO_WKEND ) DO L = 1, 5 CO(:,:,L) = CO(:,:,L) * USA_MASK(:,:) CO_WKEND(:,:,L) = & CO_WKEND(:,:,L) * USA_MASK(:,:) ENDDO ELSEIF ( SNo .eq. IDTSO2 ) THEN CALL DO_REGRID_1x1( 5, 'kg/yr', GEOS_1x1, SO2 ) CALL DO_REGRID_1x1( 5, 'kg/yr', & GEOS_1x1(:,:,:) * ARRAY(:,:,:), SO2_WKEND ) DO L = 1, 5 SO2_WKEND(:,:,L) = & SO2_WKEND(:,:,L) * USA_MASK(:,:) SO2(:,:,L) = SO2(:,:,L) * USA_MASK(:,:) ENDDO ELSEIF ( SNo .eq. IDTSO4 ) THEN CALL DO_REGRID_1x1( 5, 'kg/yr', GEOS_1x1, SO4 ) CALL DO_REGRID_1x1( 5, 'kg/yr', & GEOS_1x1(:,:,:) * ARRAY(:,:,:), SO4_WKEND ) DO L = 1, 5 SO4_WKEND(:,:,L) = & SO4_WKEND(:,:,L) * USA_MASK(:,:) SO4(:,:,L) = SO4(:,:,L) * USA_MASK(:,:) ENDDO ELSEIF ( SNo .eq. IDTNH3 ) THEN CALL DO_REGRID_1x1( 5, 'kg/yr', GEOS_1x1, NH3 ) CALL DO_REGRID_1x1( 5, 'kg/yr', & GEOS_1x1(:,:,:) * ARRAY(:,:,:), NH3_WKEND ) DO L = 1, 5 NH3_WKEND(:,:,L) = & NH3_WKEND(:,:,L) * USA_MASK(:,:) NH3(:,:,L) = NH3(:,:,L) * USA_MASK(:,:) ENDDO ELSEIF ( SNo .eq. IDTOCPI ) THEN CALL DO_REGRID_1x1( 5, 'kg/yr', GEOS_1x1, OC ) CALL DO_REGRID_1x1( 5, 'kg/yr', & GEOS_1x1(:,:,:) * ARRAY(:,:,:), OC_WKEND ) DO L = 1, 5 OC_WKEND(:,:,L) = & OC_WKEND(:,:,L) * USA_MASK(:,:) OC(:,:,L) = OC(:,:,L) * USA_MASK(:,:) ENDDO ELSEIF ( SNo .eq. IDTBCPI ) THEN CALL DO_REGRID_1x1( 5, 'kg/yr', GEOS_1x1, BC ) CALL DO_REGRID_1x1( 5, 'kg/yr', & GEOS_1x1(:,:,:) * ARRAY(:,:,:), BC_WKEND ) DO L = 1, 5 BC_WKEND(:,:,L) = & BC_WKEND(:,:,L) * USA_MASK(:,:) BC(:,:,L) = BC(:,:,L) * USA_MASK(:,:) ENDDO !--VOC ELSEIF ( SNo == IDTALK4 ) THEN CALL DO_REGRID_1x1( 5, 'kg/yr', GEOS_1x1, ALK4 ) CALL DO_REGRID_1x1( 5, 'kg/yr', & GEOS_1x1(:,:,:) * ARRAY(:,:,:), ALK4_WKEND ) DO L = 1, 5 ALK4_WKEND(:,:,L) = & ALK4_WKEND(:,:,L) * USA_MASK(:,:) ALK4(:,:,L) = ALK4(:,:,L) * USA_MASK(:,:) ENDDO ELSE IF ( SNo == IDTACET ) THEN CALL DO_REGRID_1x1( 5, 'kg/yr', GEOS_1x1, ACET ) CALL DO_REGRID_1x1( 5, 'kg/yr', & GEOS_1x1(:,:,:) * ARRAY(:,:,:), ACET_WKEND ) DO L = 1, 5 ACET_WKEND(:,:,L) = & ACET_WKEND(:,:,L) * USA_MASK(:,:) ACET(:,:,L) = ACET(:,:,L) * USA_MASK(:,:) ENDDO ELSE IF ( SNo == IDTMEK ) THEN CALL DO_REGRID_1x1( 5, 'kg/yr', GEOS_1x1, MEK ) CALL DO_REGRID_1x1( 5, 'kg/yr', & GEOS_1x1(:,:,:) * ARRAY(:,:,:), MEK_WKEND ) DO L = 1, 5 MEK_WKEND(:,:,L) = & MEK_WKEND(:,:,L) * USA_MASK(:,:) MEK(:,:,L) = MEK(:,:,L) * USA_MASK(:,:) ENDDO ELSE IF ( SNo == IDTPRPE ) THEN CALL DO_REGRID_1x1( 5, 'kg/yr', GEOS_1x1, PRPE ) CALL DO_REGRID_1x1( 5, 'kg/yr', & GEOS_1x1(:,:,:) * ARRAY(:,:,:), PRPE_WKEND ) DO L = 1, 5 PRPE_WKEND(:,:,L) = & PRPE_WKEND(:,:,L) * USA_MASK(:,:) PRPE(:,:,L) = PRPE(:,:,L) * USA_MASK(:,:) ENDDO ELSE IF ( SNo == IDTC3H8 ) THEN CALL DO_REGRID_1x1( 5, 'kg/yr', GEOS_1x1, C3H8 ) CALL DO_REGRID_1x1( 5, 'kg/yr', & GEOS_1x1(:,:,:) * ARRAY(:,:,:), C3H8_WKEND ) DO L = 1, 5 C3H8_WKEND(:,:,L) = & C3H8_WKEND(:,:,L) * USA_MASK(:,:) C3H8(:,:,L) = C3H8(:,:,L) * USA_MASK(:,:) ENDDO ELSE IF ( SNo == IDTCH2O ) THEN CALL DO_REGRID_1x1( 5, 'kg/yr', GEOS_1x1, CH2O ) CALL DO_REGRID_1x1( 5, 'kg/yr', & GEOS_1x1(:,:,:) * ARRAY(:,:,:), CH2O_WKEND ) DO L = 1, 5 CH2O_WKEND(:,:,L) = & CH2O_WKEND(:,:,L) * USA_MASK(:,:) CH2O(:,:,L) = CH2O(:,:,L) * USA_MASK(:,:) ENDDO ELSE IF ( SNo == IDTC2H6 ) THEN CALL DO_REGRID_1x1( 5, 'kg/yr', GEOS_1x1, C2H6 ) CALL DO_REGRID_1x1( 5, 'kg/yr', & GEOS_1x1(:,:,:) * ARRAY(:,:,:), C2H6_WKEND ) DO L = 1, 5 C2H6_WKEND(:,:,L) = & C2H6_WKEND(:,:,L) * USA_MASK(:,:) C2H6(:,:,L) = C2H6(:,:,L) * USA_MASK(:,:) ENDDO ELSE IF ( SNo == IDTALD2 ) THEN CALL DO_REGRID_1x1( 5, 'kg/yr', GEOS_1x1, ALD2 ) CALL DO_REGRID_1x1( 5, 'kg/yr', & GEOS_1x1(:,:,:) * ARRAY(:,:,:), ALD2_WKEND ) DO L = 1, 5 ALD2_WKEND(:,:,L) = & ALD2_WKEND(:,:,L) * USA_MASK(:,:) ALD2(:,:,L) = ALD2(:,:,L) * USA_MASK(:,:) ENDDO ENDIF ENDDO ! (zhe, dkh, 01/16/12, adj32_015) IF ( .not. ITS_A_FULLCHEM_SIM() ) THEN IDTNOX = SPECIES_ID_SAVE( 1 ) IDTCO = SPECIES_ID_SAVE( 2 ) IDTSO2 = SPECIES_ID_SAVE( 3 ) IDTSO4 = SPECIES_ID_SAVE( 4 ) IDTNH3 = SPECIES_ID_SAVE( 5 ) IDTACET = SPECIES_ID_SAVE( 6 ) IDTALK4 = SPECIES_ID_SAVE( 7 ) IDTC2H6 = SPECIES_ID_SAVE( 8 ) IDTC3H8 = SPECIES_ID_SAVE( 9 ) IDTOCPI = SPECIES_ID_SAVE( 10 ) IDTBCPI = SPECIES_ID_SAVE( 11 ) IDTALD2 = SPECIES_ID_SAVE( 12 ) IDTCH2O = SPECIES_ID_SAVE( 13 ) IDTPRPE = SPECIES_ID_SAVE( 14 ) IDTMEK = SPECIES_ID_SAVE( 15 ) ENDIF !-------------------------- ! Compute future emissions !-------------------------- IF ( LFUTURE ) THEN CALL NEI2005_SCALE_FUTURE ENDIF !-------------------------- ! Print emission totals !-------------------------- CALL TOTAL_ANTHRO_Tg( THISYEAR ) ! Return to calling program END SUBROUTINE EMISS_NEI2005_ANTHRO !EOC !------------------------------------------------------------------------------ ! Dalhousie University Atmospheric Compositional Analysis Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: emiss_nei2005_anthro_05x0666 ! ! !DESCRIPTION: Subroutine EMISS\_NEI2005\_ANTHRO reads the NEI2005 ! emission fields at 1/2 x 2.3 resolution !\\ !\\ ! !INTERFACE: ! SUBROUTINE EMISS_NEI2005_ANTHRO_05x0666 ! ! !USES: ! USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2 USE DIRECTORY_MOD, ONLY : DATA_DIR USE LOGICAL_MOD, ONLY : LFUTURE USE TIME_MOD, ONLY : GET_YEAR, GET_MONTH USE SCALE_ANTHRO_MOD, ONLY : GET_ANNUAL_SCALAR_05x0666_NESTED USE TRACERID_MOD, ONLY : IDTACET, IDTALK4, IDTC2H6, IDTC3H8 USE TRACERID_MOD, ONLY : IDTALD2, IDTCH2O, IDTPRPE, IDTMEK USE TRACERID_MOD, ONLY : IDTNOx, IDTCO, IDTSO2, IDTNH3 USE TRACERID_MOD, ONLY : IDTSO4, IDTOCPI, IDTBCPI USE TRACER_MOD, ONLY : ITS_A_FULLCHEM_SIM # include "CMN_SIZE" ! Size parameters # include "CMN_O3" ! FSCALYR ! ! !REVISION HISTORY: ! 03 Nov 2009 - A. van Donkelaar - initial version ! 12 Jul 2010 - R. Yantosca - Now point to NEI2005_201007 directory, to read ! in updated files (by Aaron van Donkelaar) to ! fix a problem in the VOC emissions. ! 13 Aug 2010 - R. Yantosca - Treat MERRA like GEOS-5 (leave for future use) !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! LOGICAL, SAVE :: FIRST = .TRUE. INTEGER :: I, J,THISYEAR, SNo, ScNo INTEGER :: L, KLM, SPECIES_ID(15), ID, MN INTEGER :: SPECIES_ID_SAVE(15) REAL*4 :: ARRAY(IIPAR,JJPAR,5) REAL*8 :: GEOS_05x0666(IIPAR,JJPAR,5) REAL*4 :: SC_05x0666(IIPAR,JJPAR) REAL*8 :: TAU2005, TAU CHARACTER(LEN=255) :: FILENAME CHARACTER(LEN=4) :: SYEAR CHARACTER(LEN=5) :: SNAME CHARACTER(LEN=1) :: SSMN CHARACTER(LEN=2) :: SMN !================================================================= ! EMISS_NEI2005_ANTHRO begins here! !================================================================= ! First-time initialization IF ( FIRST ) THEN CALL INIT_NEI2005_ANTHRO FIRST = .FALSE. ENDIF ! Get emissions year IF ( FSCALYR < 0 ) THEN THISYEAR = GET_YEAR() ELSE THISYEAR = FSCALYR ENDIF #if defined( GEOS_5 ) || defined( MERRA ) || defined( GEOS_FP ) SNAME = 'GEOS5' #elif defined( GEOS_4 ) SNAME = 'GEOS4' #elif defined( GEOS_3 ) SNAME = 'GEOS3' #endif ! (zhe, dkh, 01/16/12, adj32_015) IF ( .not. ITS_A_FULLCHEM_SIM() ) THEN SPECIES_ID_SAVE = (/ IDTNOX, IDTCO, IDTSO2, IDTSO4, IDTNH3, $ IDTACET, IDTALK4, IDTC2H6, IDTC3H8, $ IDTOCPI, IDTBCPI, $ IDTALD2, IDTCH2O, IDTPRPE, IDTMEK $ /) IDTNOX = 1 IDTCO = 4 IDTSO2 = 26 IDTSO4 = 27 IDTNH3 = 30 IDTACET = 9 IDTALK4 = 5 IDTC2H6 = 21 IDTC3H8 = 19 IDTOCPI = 35 IDTBCPI = 34 IDTALD2 = 11 IDTCH2O = 20 IDTPRPE = 18 IDTMEK = 10 ENDIF ! list of ID of available species SPECIES_ID = (/ IDTNOX, IDTCO, IDTSO2, IDTSO4, IDTNH3, $ IDTACET, IDTALK4, IDTC2H6, IDTC3H8, $ IDTOCPI, IDTBCPI, $ IDTALD2, IDTCH2O, IDTPRPE, IDTMEK $ /) ! Loop over species DO KLM = 1, SIZE( SPECIES_ID ) SNo = SPECIES_ID( KLM ) ! corresponding annual scale factor # if any ScNo = 0 IF ( SNo == IDTNOx ) ScNo = 71 IF ( SNo == IDTCO ) ScNo = 72 IF ( SNo == IDTSO2 .or. SNo == IDTSO4 ) ScNo = 73 ! TAU values for 2005 TAU2005 = GET_TAU0( 1, 1, 2005 ) ! File name FILENAME = TRIM( DATA_DIR ) // 'NEI2005_201007/' // & 'NEI2005.' // TRIM( SNAME ) & // '.1t2x2t3.AVG.na.bpch' ! Echo info WRITE( 6, 100 ) TRIM( FILENAME ) 100 FORMAT( ' - EMISS_NEI2005_ANTHRO_05x0666: & Reading ', a ) CALL READ_BPCH2( FILENAME, 'ANTHSRCE', SNo, & TAU2005, IIPAR, JJPAR, & 5, ARRAY, QUIET=.TRUE. ) GEOS_05x0666(:,:,:) = ARRAY(:,:,:) ! Apply annual scalar factor. Available for 1985-2005, ! and NOx, CO and SO2 only. IF ( ScNo .ne. 0 ) THEN CALL GET_ANNUAL_SCALAR_05x0666_NESTED( ScNo,2005, & THISYEAR, SC_05x0666 ) DO L = 1, 5 GEOS_05x0666(:,:,L) = GEOS_05x0666(:,:,L) & * SC_05x0666(:,:) ENDDO ENDIF ! Apply Seasonality IF ( SNo .eq. IDTNOx ) THEN CALL GET_VISTAS_SEASON_05x0666( ARRAY ) ELSE CALL GET_NEI99_SEASON_05x0666( SNo, ARRAY ) ENDIF GEOS_05x0666(:,:,:) = GEOS_05x0666(:,:,:) & * ARRAY(:,:,:) CALL GET_NEI99_WKSCALE_05x0666( SNo, ARRAY ) IF ( SNo .eq. IDTNOx) THEN NOx(:,:,:) = GEOS_05x0666 NOx_WKEND(:,:,:) = GEOS_05x0666 * ARRAY(:,:,:) DO L = 1, 5 NOx(:,:,L) = NOx(:,:,L) * USA_MASK(:,:) NOx_WKEND(:,:,L) = & NOx_WKEND(:,:,L) * USA_MASK(:,:) ENDDO ELSEIF ( SNo .eq. IDTCO ) THEN CO(:,:,:) = GEOS_05x0666 CO_WKEND(:,:,:) = GEOS_05x0666 * ARRAY(:,:,:) DO L = 1, 5 CO(:,:,L) = CO(:,:,L) * USA_MASK(:,:) CO_WKEND(:,:,L) = & CO_WKEND(:,:,L) * USA_MASK(:,:) ENDDO ELSEIF ( SNo .eq. IDTSO2 ) THEN SO2(:,:,:) = GEOS_05x0666 SO2_WKEND(:,:,:) = GEOS_05x0666 * ARRAY(:,:,:) DO L = 1, 5 SO2_WKEND(:,:,L) = & SO2_WKEND(:,:,L) * USA_MASK(:,:) SO2(:,:,L) = SO2(:,:,L) * USA_MASK(:,:) ENDDO ELSEIF ( SNo .eq. IDTSO4 ) THEN SO4(:,:,:) = GEOS_05x0666 SO4_WKEND(:,:,:) = GEOS_05x0666 * ARRAY(:,:,:) DO L = 1, 5 SO4_WKEND(:,:,L) = & SO4_WKEND(:,:,L) * USA_MASK(:,:) SO4(:,:,L) = SO4(:,:,L) * USA_MASK(:,:) ENDDO ELSEIF ( SNo .eq. IDTNH3 ) THEN NH3(:,:,:) = GEOS_05x0666 NH3_WKEND(:,:,:) = GEOS_05x0666 * ARRAY(:,:,:) DO L = 1, 5 NH3_WKEND(:,:,L) = & NH3_WKEND(:,:,L) * USA_MASK(:,:) NH3(:,:,L) = NH3(:,:,L) * USA_MASK(:,:) ENDDO ELSEIF ( SNo .eq. IDTOCPI ) THEN OC(:,:,:) = GEOS_05x0666 OC_WKEND(:,:,:) = GEOS_05x0666 * ARRAY(:,:,:) DO L = 1, 5 OC_WKEND(:,:,L) = & OC_WKEND(:,:,L) * USA_MASK(:,:) OC(:,:,L) = OC(:,:,L) * USA_MASK(:,:) ENDDO ELSEIF ( SNo .eq. IDTBCPI ) THEN BC(:,:,:) = GEOS_05x0666 BC_WKEND(:,:,:) = GEOS_05x0666 * ARRAY(:,:,:) DO L = 1, 5 BC_WKEND(:,:,L) = & BC_WKEND(:,:,L) * USA_MASK(:,:) BC(:,:,L) = BC(:,:,L) * USA_MASK(:,:) ENDDO !--VOC ELSEIF ( SNo == IDTALK4 ) THEN ALK4(:,:,:) = GEOS_05x0666 ALK4_WKEND(:,:,:) = GEOS_05x0666 * ARRAY(:,:,:) DO L = 1, 5 ALK4_WKEND(:,:,L) = & ALK4_WKEND(:,:,L) * USA_MASK(:,:) ALK4(:,:,L) = ALK4(:,:,L) * USA_MASK(:,:) ENDDO ELSE IF ( SNo == IDTACET ) THEN ACET(:,:,:) = GEOS_05x0666 ACET_WKEND(:,:,:) = GEOS_05x0666 * ARRAY(:,:,:) DO L = 1, 5 ACET_WKEND(:,:,L) = & ACET_WKEND(:,:,L) * USA_MASK(:,:) ACET(:,:,L) = ACET(:,:,L) * USA_MASK(:,:) ENDDO ELSE IF ( SNo == IDTMEK ) THEN MEK(:,:,:) = GEOS_05x0666 MEK_WKEND(:,:,:) = GEOS_05x0666 * ARRAY(:,:,:) DO L = 1, 5 MEK_WKEND(:,:,L) = & MEK_WKEND(:,:,L) * USA_MASK(:,:) MEK(:,:,L) = MEK(:,:,L) * USA_MASK(:,:) ENDDO ELSE IF ( SNo == IDTPRPE ) THEN PRPE(:,:,:) = GEOS_05x0666 PRPE_WKEND(:,:,:) = GEOS_05x0666 * ARRAY(:,:,:) DO L = 1, 5 PRPE_WKEND(:,:,L) = & PRPE_WKEND(:,:,L) * USA_MASK(:,:) PRPE(:,:,L) = PRPE(:,:,L) * USA_MASK(:,:) ENDDO ELSE IF ( SNo == IDTC3H8 ) THEN C3H8(:,:,:) = GEOS_05x0666 C3H8_WKEND(:,:,:) = GEOS_05x0666 * ARRAY(:,:,:) DO L = 1, 5 C3H8_WKEND(:,:,L) = & C3H8_WKEND(:,:,L) * USA_MASK(:,:) C3H8(:,:,L) = C3H8(:,:,L) * USA_MASK(:,:) ENDDO ELSE IF ( SNo == IDTCH2O ) THEN CH2O(:,:,:) = GEOS_05x0666 CH2O_WKEND(:,:,:) = GEOS_05x0666 * ARRAY(:,:,:) DO L = 1, 5 CH2O_WKEND(:,:,L) = & CH2O_WKEND(:,:,L) * USA_MASK(:,:) CH2O(:,:,L) = CH2O(:,:,L) * USA_MASK(:,:) ENDDO ELSE IF ( SNo == IDTC2H6 ) THEN C2H6(:,:,:) = GEOS_05x0666 C2H6_WKEND(:,:,:) = GEOS_05x0666 * ARRAY(:,:,:) DO L = 1, 5 C2H6_WKEND(:,:,L) = & C2H6_WKEND(:,:,L) * USA_MASK(:,:) C2H6(:,:,L) = C2H6(:,:,L) * USA_MASK(:,:) ENDDO ELSE IF ( SNo == IDTALD2 ) THEN ALD2(:,:,:) = GEOS_05x0666 ALD2_WKEND(:,:,:) = GEOS_05x0666 * ARRAY(:,:,:) DO L = 1, 5 ALD2_WKEND(:,:,L) = & ALD2_WKEND(:,:,L) * USA_MASK(:,:) ALD2(:,:,L) = ALD2(:,:,L) * USA_MASK(:,:) ENDDO ENDIF ENDDO ! (zhe, dkh, 01/16/12, adj32_015) IF ( .not. ITS_A_FULLCHEM_SIM() ) THEN IDTNOX = SPECIES_ID_SAVE( 1 ) IDTCO = SPECIES_ID_SAVE( 2 ) IDTSO2 = SPECIES_ID_SAVE( 3 ) IDTSO4 = SPECIES_ID_SAVE( 4 ) IDTNH3 = SPECIES_ID_SAVE( 5 ) IDTACET = SPECIES_ID_SAVE( 6 ) IDTALK4 = SPECIES_ID_SAVE( 7 ) IDTC2H6 = SPECIES_ID_SAVE( 8 ) IDTC3H8 = SPECIES_ID_SAVE( 9 ) IDTOCPI = SPECIES_ID_SAVE( 10 ) IDTBCPI = SPECIES_ID_SAVE( 11 ) IDTALD2 = SPECIES_ID_SAVE( 12 ) IDTCH2O = SPECIES_ID_SAVE( 13 ) IDTPRPE = SPECIES_ID_SAVE( 14 ) IDTMEK = SPECIES_ID_SAVE( 15 ) ENDIF !-------------------------- ! Compute future emissions !-------------------------- IF ( LFUTURE ) THEN CALL NEI2005_SCALE_FUTURE ENDIF !-------------------------- ! Print emission totals !-------------------------- CALL TOTAL_ANTHRO_Tg( THISYEAR ) ! Return to calling program END SUBROUTINE EMISS_NEI2005_ANTHRO_05x0666 !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: get_nei99_season ! ! !DESCRIPTION: Subroutine GET\_NEI99\_SEASON returns monthly scale ! factors from EPA 1999 !\\ !\\ ! !INTERFACE: ! SUBROUTINE GET_NEI99_SEASON( TRACER, AS ) ! ! !USES: ! USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2 USE DIRECTORY_MOD, ONLY : DATA_DIR_1x1 USE TIME_MOD, ONLY : GET_MONTH USE TRACERID_MOD, ONLY : IDTACET, IDTALK4, IDTC2H6, IDTC3H8 USE TRACERID_MOD, ONLY : IDTALD2, IDTCH2O, IDTPRPE, IDTMEK USE TRACERID_MOD, ONLY : IDTNOx, IDTCO, IDTSO2, IDTNH3 USE TRACERID_MOD, ONLY : IDTSO4 # include "CMN_SIZE" ! Size parameters ! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: TRACER ! Tracer number ! ! !INPUT/OUTPUT PARAMETERS: ! REAL*4, INTENT(OUT) :: AS(I1x1,J1x1,5) ! Scale factor array ! ! !REVISION HISTORY: ! 30 Oct 2009 - A. van Donkelaar - Initial Version ! 3 Nov 2009 - P. Le Sager - update handling of boxes w/ zero emissions ! 10 Dec 2009 - D. Millet - Now scale to August, not an annual average ! 11 Dec 2009 - L. Zhang, A. van Donkelaar - Add seasonality for NH3 !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! REAL*4 :: ARRAY(I1x1,J1x1,1) ! REAL*4 :: ANNUAL(I1x1,J1x1,1) dbm, 12/9/2009 REAL*4 :: AUGUST(I1x1,J1x1,1) ! dbm, 12/9/2009 REAL*4 :: MONTHLY(I1x1,J1x1,1) CHARACTER(LEN=255) :: FILENAME CHARACTER(LEN=6) :: MYEAR REAL*8 :: TAU INTEGER :: MN, ThisMN, L ! New seasonal NH3 emission scalar based on Zhang et al. ACP 2012 (lzh, 03/2012) REAL*8, PARAMETER :: NH3_SCALE(12) = (/ & 0.216d0, 0.418d0, 0.622d0, 0.815d0, 0.982d0, 0.974d0, & 1.000d0, 0.900d0, 0.960d0, 0.600d0, 0.280d0, 0.236d0 /) !================================================================= ! GET_NEI99_SEASON begins here! !================================================================= ARRAY(:,:,1) = 0.d0 ! ANNUAL(:,:,1) = 0.d0 dbm, 12/9/2009 AUGUST(:,:,1) = 0.d0 ! dbm, 12/9/2009 MONTHLY(:,:,1) = 0.d0 ThisMN = GET_MONTH() ! lzh, amv, 12/11/2009 add NH3 emission seasonality IF ( TRACER == IDTALD2 .or. TRACER == IDTCH2O ) THEN AS = 1.d0 RETURN ELSEIF ( TRACER == IDTNH3 ) THEN AS = NH3_SCALE(ThisMN) ! (lzh, 03/2012) RETURN ENDIF ! Echo info WRITE( 6, 100 ) TRACER 100 FORMAT( ' - GET_NEI99_SEASON: Reading TRACER: ', i ) !--------------------------------- ! Read in data for August !--------------------------------- ! File name FILENAME = TRIM( DATA_DIR_1x1 ) // & 'EPA_NEI_200708/wkday_avg_an.199908.geos.1x1' ! TAU0 for 1999/08/01 TAU = GET_TAU0( 8, 1, 1999 ) ! Read data CALL READ_BPCH2( FILENAME, 'ANTHSRCE', TRACER, & TAU, I1x1, J1x1, & 1, ARRAY, QUIET=.TRUE. ) AUGUST(:,:,1) = ARRAY(:,:,1) !--------------------------------- ! Read in data for current month !--------------------------------- WRITE(MYEAR, '(i6)') 199900 + ThisMN ! File name FILENAME = TRIM( DATA_DIR_1x1 ) // & 'EPA_NEI_200708/wkday_avg_an.' // MYEAR // '.geos.1x1' ! TAU for this month of 1999 TAU = GET_TAU0( ThisMN, 1, 1999 ) ! Read data CALL READ_BPCH2( FILENAME, 'ANTHSRCE', TRACER, & TAU, I1x1, J1x1, & 1, ARRAY, QUIET=.TRUE. ) MONTHLY(:,:,1) = ARRAY(:,:,1) !--------------------------------- ! Normalize !------------- ------------------- WHERE ( AUGUST == 0d0 ) ARRAY = 1d0 ELSEWHERE ARRAY = MONTHLY / AUGUST ENDWHERE DO L = 1, SIZE(AS,3) AS(:,:,L) = ARRAY(:,:,1) ENDDO END SUBROUTINE GET_NEI99_SEASON !EOC !------------------------------------------------------------------------------ ! Dalhousie University Atmospheric Composition Analysis Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: get_nei99_season_05x0666 ! ! !DESCRIPTION: Subroutine GET\_NEI\_SEASON returns monthly scale ! factors from EPA 1999, for the 0.5 x 0.666 nested grids. !\\ !\\ ! !INTERFACE: ! SUBROUTINE GET_NEI99_SEASON_05x0666( TRACER, AS ) ! ! !USES: ! USE REGRID_1x1_MOD, ONLY : DO_REGRID_1x1 # include "CMN_SIZE" ! Size parameters ! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: TRACER ! Tracer number ! ! !INPUT/OUTPUT PARAMETERS: ! REAL*4, INTENT(INOUT) :: AS(IIPAR,JJPAR,5) ! Scale factor array ! ! !REVISION HISTORY: ! 30 Oct 2009 - A. van Donkelaar - Initial Version !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! REAL*4 :: ARRAY(I1x1,J1x1,5) REAL*8 :: ARRAY_R8(IIPAR,JJPAR,5) !================================================================= ! GET_NEI99_SEASON_05x0666 begins here! !================================================================= ARRAY(:,:,:) = 0.d0 CALL GET_NEI99_SEASON( TRACER, ARRAY ) CALL DO_REGRID_1x1( 5, 'unitless', ARRAY, ARRAY_R8 ) AS(:,:,:) = ARRAY_R8(:,:,:) END SUBROUTINE GET_NEI99_SEASON_05x0666 !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: get_vistas_season ! ! !DESCRIPTION: Subroutine GET\_VISTAS\_SEASON returns monthly scale ! factors to account for monthly variations in NOx emissions ! on 1x1 resolution grid (amv, 11/02/09) !\\ !\\ ! !INTERFACE: ! SUBROUTINE GET_VISTAS_SEASON( AS ) ! ! !USES: ! USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2 USE DIRECTORY_MOD, ONLY : DATA_DIR_1x1 USE TIME_MOD, ONLY : GET_MONTH, GET_YEAR # include "CMN_SIZE" ! Size parameters # include "CMN_O3" ! FSCALYR ! ! !INPUT/OUTPUT PARAMETERS: ! REAL*4, INTENT(INOUT) :: AS(I1x1,J1x1,5) ! Scale factor array ! ! !REVISION HISTORY: ! 30 Oct 2009 - A. van Donkelaar - Initial Version ! 3 Nov 2009 - P. Le Sager - update handling of boxes w/ zero emissions ! 10 Dec 2009 - D. Millet - Now scale to August, not an annual average !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! REAL*4 :: ARRAY(I1x1,J1x1,1) REAL*4 :: AUGUST(I1x1,J1x1,1) ! dbm, 12/9/2009 REAL*4 :: MONTHLY(I1x1,J1x1,1) REAL*4 :: O3SEASON(I1x1,J1x1,1) REAL*4 :: O3SEASON_AUGUST(I1x1,J1x1,1) ! dbm, 12/9/2009 CHARACTER(LEN=255) :: FILENAME, VISTAS_DIR CHARACTER(LEN=4) :: SYEAR CHARACTER(LEN=1) :: SSMN CHARACTER(LEN=2) :: SMN REAL*8 :: TAU2002 INTEGER :: MN, THISMONTH, LEV INTEGER :: THISYEAR !================================================================= ! GET_NEI99_SEASON begins here! !================================================================= ARRAY(:,:,1) = 0.d0 AUGUST(:,:,1) = 0.d0 ! dbm, 12/9/2009 MONTHLY(:,:,1) = 0.d0 O3SEASON(:,:,1) = 0.d0 O3SEASON_AUGUST(:,:,1) = 0.d0 ! dbm, 12/9/2009 ! Get emissions year IF ( FSCALYR < 0 ) THEN THISYEAR = GET_YEAR() ELSE THISYEAR = FSCALYR ENDIF ! cap maximum scaling year IF ( THISYEAR .gt. 2007 ) THEN THISYEAR = 2007 ENDIF VISTAS_DIR = TRIM( DATA_DIR_1x1 ) // 'VISTAS_200811/' TAU2002 = GET_TAU0( 1, 1, 2002) THISMONTH = GET_MONTH() ! ------------------- ! Read in data for August ! ------------------- FILENAME = TRIM( VISTAS_DIR ) & // 'Vistas-NOx-8.1x1' ! Echo info WRITE( 6, 100 ) TRIM( FILENAME ) 100 FORMAT( ' - GET_VISTAS_SEASON: Reading ', a ) ! Read data CALL READ_BPCH2( FILENAME, 'ANTHSRCE', 1, & TAU2002, I1x1, J1x1, & 1, ARRAY, QUIET=.TRUE. ) AUGUST(:,:,1) = ARRAY(:,:,1) ! ------------------- ! Read in data for current month ! ------------------- IF (THISMONTH .lt. 10) THEN WRITE( SSMN, '(i1)' ) THISMONTH FILENAME = TRIM( VISTAS_DIR ) & // 'Vistas-NOx-' // SSMN // '.1x1' ELSE WRITE( SMN, '(i2)' ) THISMONTH FILENAME = TRIM( VISTAS_DIR ) & // 'Vistas-NOx-' // SMN // '.1x1' ENDIF ! Echo info WRITE( 6, 100 ) TRIM( FILENAME ) ! Read data CALL READ_BPCH2( FILENAME, 'ANTHSRCE', 1, & TAU2002, I1x1, J1x1, & 1, ARRAY, QUIET=.TRUE. ) MONTHLY(:,:,1) = ARRAY(:,:,1) WRITE( SYEAR, '(i4)') THISYEAR ! Load ozone season regulation factors IF (THISMONTH .lt. 10) THEN WRITE( SSMN, '(i1)' ) THISMONTH FILENAME = TRIM( VISTAS_DIR ) & // 'ARP-SeasonalVariation-' // SYEAR // '-' & // SSMN // '.1x1' ELSE WRITE( SMN, '(i2)' ) THISMONTH FILENAME = TRIM( VISTAS_DIR ) & // 'ARP-SeasonalVariation-' // SYEAR // '-' & // SMN // '.1x1' ENDIF ! Echo info WRITE( 6, 100 ) TRIM( FILENAME ) ! Read data CALL READ_BPCH2( FILENAME, 'RATIO-2D', 71, & GET_TAU0(1,1,2002), I1x1, J1x1, & 1, ARRAY, QUIET=.TRUE. ) O3SEASON(:,:,1) = ARRAY(:,:,1) ! August ozone season regulation factors FILENAME = TRIM( VISTAS_DIR ) & // 'ARP-SeasonalVariation-' // SYEAR // '-8.1x1' ! Echo info WRITE( 6, 100 ) TRIM( FILENAME ) ! Read data CALL READ_BPCH2( FILENAME, 'RATIO-2D', 71, & GET_TAU0(1,1,2002), I1x1, J1x1, & 1, ARRAY, QUIET=.TRUE. ) O3SEASON_AUGUST(:,:,1) = ARRAY(:,:,1) ! First do seasonal scaling according to VISTAS WHERE ( AUGUST == 0d0 ) ARRAY = 1d0 ELSEWHERE ARRAY = MONTHLY / AUGUST ENDWHERE ! Now scale for summertime NOx reductions ARRAY = ARRAY * O3SEASON / O3SEASON_AUGUST DO LEV = 1, SIZE(AS,3) AS(:,:,LEV) = ARRAY(:,:,1) ENDDO END SUBROUTINE GET_VISTAS_SEASON !EOC !------------------------------------------------------------------------------ ! Dalhousie University Atmospheric Composition Analysis Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: get_vistas_season_05x0666 ! ! !DESCRIPTION: Subroutine GET\_VISTAS\_SEASON\_05x0666 returns monthly scale ! factors to account for monthly variations in NOx emissions ! for the 0.5 x 0.666 nested grids. (amv, 11/02/09) !\\ !\\ ! !INTERFACE: ! SUBROUTINE GET_VISTAS_SEASON_05x0666( AS ) ! ! !USES: ! USE REGRID_1x1_MOD, ONLY : DO_REGRID_1x1 # include "CMN_SIZE" ! Size parameters ! ! !INPUT/OUTPUT PARAMETERS: ! REAL*4, INTENT(INOUT) :: AS(IIPAR,JJPAR,5) ! Scale factor array ! ! !REVISION HISTORY: ! 03 Nov 2009 - A. van Donkelaar - Initial Version !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! REAL*4 :: ARRAY(I1x1,J1x1,5) REAL*8 :: ARRAY_R8(IIPAR,JJPAR,5) !================================================================= ! GET_VISTAS_SEASON_05x0666 begins here! !================================================================= ARRAY(:,:,:) = 0.d0 CALL GET_VISTAS_SEASON( ARRAY ) CALL DO_REGRID_1x1( 5, 'unitless', ARRAY, ARRAY_R8 ) AS(:,:,:) = ARRAY_R8(:,:,:) END SUBROUTINE GET_VISTAS_SEASON_05x0666 !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: get_nei99_wkscale ! ! !DESCRIPTION: Subroutine GET\_NEI99\_WKSCALE returns the scale ! factors to convert weekday to weekend emissions based ! on the NEI99. !\\ !\\ ! !INTERFACE: ! SUBROUTINE GET_NEI99_WKSCALE( TRACER, AS ) ! ! !USES: ! USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2 USE DIRECTORY_MOD, ONLY : DATA_DIR_1x1 USE TIME_MOD, ONLY : GET_MONTH USE TRACERID_MOD, ONLY : IDTACET, IDTALK4, IDTC2H6, IDTC3H8 USE TRACERID_MOD, ONLY : IDTALD2, IDTCH2O, IDTPRPE, IDTMEK USE TRACERID_MOD, ONLY : IDTNOx, IDTCO, IDTSO2, IDTNH3 USE TRACERID_MOD, ONLY : IDTSO4 # include "CMN_SIZE" ! Size parameters ! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: TRACER ! Tracer number ! ! !INPUT/OUTPUT PARAMETERS: ! REAL*4, INTENT(INOUT) :: AS(I1x1,J1x1,5) ! Scale factor array ! ! !REVISION HISTORY: ! 30 Oct 2009 - A. van Donkelaar - Initial Version ! 3 Nov 2009 - P. Le Sager - update handling of boxes w/ zero emissions !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! REAL*4 :: WEEKDAY(I1x1,J1x1,1) REAL*4 :: WEEKEND(I1x1,J1x1,1) CHARACTER(LEN=255) :: FILENAME CHARACTER(LEN=6) :: MYEAR REAL*8 :: TAU INTEGER :: MN, L !================================================================= ! GET_NEI99_WKSCALE begins here! !================================================================= WEEKDAY(:,:,1) = 0.d0 WEEKEND(:,:,1) = 0.d0 MN = GET_MONTH() ! NH3/ALD2/ISOP not available IF (( TRACER .eq. IDTNH3 ) .or. (TRACER .eq. IDTALD2) .or. & ( TRACER .eq. IDTCH2O )) THEN AS(:,:,:) = 1.d0 RETURN ENDIF ! Echo info WRITE( 6, 100 ) TRACER 100 FORMAT( ' - GET_NEI99_WKSCALE: Reading TRACER: ', i ) WRITE(MYEAR, '(i6)') 199900 + MN ! File name FILENAME = TRIM( DATA_DIR_1x1 ) // & 'EPA_NEI_200708/wkday_avg_an.' // MYEAR // '.geos.1x1' ! Read data CALL READ_BPCH2( FILENAME, 'ANTHSRCE', TRACER, & GET_TAU0(MN,1,1999), I1x1, J1x1, & 1, WEEKDAY, QUIET=.TRUE. ) WRITE(MYEAR, '(i6)') 199900 + MN ! File name FILENAME = TRIM( DATA_DIR_1x1 ) // & 'EPA_NEI_200708/wkend_avg_an.' // MYEAR // '.geos.1x1' ! Read data CALL READ_BPCH2( FILENAME, 'ANTHSRCE', TRACER, & GET_TAU0(MN,1,1999), I1x1, J1x1, & 1, WEEKEND, QUIET=.TRUE. ) !---see below ! ! avoid 0 / 0 ! WEEKDAY(:,:,1) = WEEKDAY(:,:,1) + 1.d0 ! WEEKEND(:,:,1) = WEEKEND(:,:,1) + 1.d0 ! ! DO L = 1,5 ! AS(:,:,L) = WEEKEND(:,:,1) / WEEKDAY(:,:,1) ! ENDDO ! --Get scalings WHERE ( WEEKDAY == 0d0 ) WEEKEND = 1d0 ELSEWHERE WEEKEND = WEEKEND / WEEKDAY ENDWHERE DO L = 1, SIZE(AS,3) AS(:,:,L) = WEEKEND(:,:,1) ENDDO END SUBROUTINE GET_NEI99_WKSCALE !EOC !------------------------------------------------------------------------------ ! Dalhousie University Atmospheric Composition Analysis Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: get_nei99_wkscale_05x0666 ! ! !DESCRIPTION: Subroutine GET\_NEI99\_WKSCALE\_05x0666 returns the scale ! factors (for 0.5 x 0.666 nested grids) to convert weekday to weekend ! emissions based on the NEI99. !\\ !\\ ! !INTERFACE: ! SUBROUTINE GET_NEI99_WKSCALE_05x0666( TRACER, AS ) ! ! !USES: ! USE REGRID_1x1_MOD, ONLY : DO_REGRID_1x1 # include "CMN_SIZE" ! Size parameters ! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: TRACER ! Tracer number ! ! !INPUT/OUTPUT PARAMETERS: ! REAL*4, INTENT(INOUT) :: AS(IIPAR,JJPAR,5) ! Scale factor array ! ! !REVISION HISTORY: ! 30 Oct 2009 - A. van Donkelaar - Initial Version !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! REAL*4 :: ARRAY(I1x1,J1x1,5) REAL*8 :: ARRAY_R8(IIPAR,JJPAR,5) !================================================================= ! GET_NEI99_SEASON_05x0666 begins here! !================================================================= ARRAY(:,:,:) = 0.d0 CALL GET_NEI99_WKSCALE( TRACER, ARRAY ) CALL DO_REGRID_1x1( 5, 'unitless', ARRAY, ARRAY_R8 ) AS(:,:,:) = ARRAY_R8(:,:,:) END SUBROUTINE GET_NEI99_WKSCALE_05x0666 !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: read_nei2005_mask ! ! !DESCRIPTION: Subroutine READ\_NEI2005\_MASK reads the mask for NEI data !\\ !\\ ! !INTERFACE: SUBROUTINE READ_NEI2005_MASK ! ! !USES: ! ! Reference to F90 modules USE BPCH2_MOD, ONLY : GET_NAME_EXT_2D, GET_RES_EXT USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2 USE LOGICAL_MOD, ONLY : LCAC, LBRAVO USE DIRECTORY_MOD, ONLY : DATA_DIR_1x1 USE REGRID_1x1_MOD, ONLY : DO_REGRID_1x1 USE TRANSFER_MOD, ONLY : TRANSFER_2D # include "CMN_SIZE" ! Size parameters ! ! !REMARKS: ! temporary mask: same as EPA 99 ! ! !REVISION HISTORY: ! 20 Oct 2009 - P. Le Sager - init ! 26 Oct 2009 - P. Le Sager - new masks !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! REAL*4 :: ARRAY2(I1x1,J1x1,1) REAL*8 :: XTAU, GEOS_1x1(I1x1,J1x1,1) CHARACTER(LEN=255) :: FILENAME, SNAME !================================================================= ! Mask specific to NEI2005 data !================================================================= SNAME = 'usa.' ! NEI2005 covers CANADA if we do not use CAC IF ( .NOT. LCAC ) SNAME = TRIM( SNAME ) // 'can.' ! NEI2005 covers Mexico if we do not use BRAVO IF ( .NOT. LBRAVO ) SNAME = TRIM( SNAME ) // 'mex.' FILENAME = TRIM( DATA_DIR_1x1 ) // 'NEI2005_200910/' // & TRIM( SNAME ) // 'mask.nei2005.geos.1x1' ! Echo info WRITE( 6, 200 ) TRIM( FILENAME ) 200 FORMAT( ' - READ_NEI2005_MASK: Reading ', a ) CALL READ_BPCH2( FILENAME, 'LANDMAP', 2, & 0d0, I1x1, J1x1, & 1, ARRAY2, QUIET=.TRUE. ) ! Cast to REAL*8 before regridding GEOS_1x1(:,:,:) = ARRAY2(:,:,:) ! Regrid from GEOS 1x1 --> current model resolution CALL DO_REGRID_1x1( 'unitless', GEOS_1x1, USA_MASK ) WHERE ( USA_MASK /= 0D0 ) USA_MASK = 1D0 ! Return to calling program END SUBROUTINE READ_NEI2005_MASK !------------------------------------------------------------------------------ ! Prior to 12/3/09: ! Leave for future use (bmy, 12/3/09) !!EOC !!------------------------------------------------------------------------------ !! Harvard University Atmospheric Chemistry Modeling Group ! !!------------------------------------------------------------------------------ !!BOP !! !! !IROUTINE: get_nei2005_mask !! !! !DESCRIPTION: Subroutine GET\_NEI2005\_MASK returns the value of the !! NEI 2005 mask to the calling program. Values of 1 denote grid boxes !! within the EPA/NEI2005 emission region.! !!\\ !!\\ !! !INTERFACE: ! ! FUNCTION GET_NEI2005_MASK( I, J ) RESULT ( USA ) !! !! !INPUT PARAMETERS: !! ! INTEGER, INTENT(IN) :: I, J ! GEOS-Chem lon & lat indices !! !! !RETURN VALUE: !! ! REAL*8 :: USA ! Value of the mask !! !! !REMARKS: !! This is entended to encapsulate the USA_MASK variable. !! !! !REVISION HISTORY: !! 02 Dec 2009 - R. Yantosca - Initial version !!EOP !!------------------------------------------------------------------------------ !!BOC !! !! !LOCAL VARIABLES: !! ! USA = USA_MASK(I,J) ! ! END FUNCTION GET_NEI2005_MASK !------------------------------------------------------------------------------ !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: nei2005_scale_future ! ! !DESCRIPTION: Subroutine NEI2005\_SCALE\_FUTURE applies the IPCC future ! scale factors to the NEI2005 anthropogenic emissions. !\\ !\\ ! !INTERFACE: SUBROUTINE NEI2005_SCALE_FUTURE ! ! !USES: ! USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_COff USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_NH3an USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_NOxff USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_SO2ff USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_OCff USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_BCff # include "CMN_SIZE" ! Size parameters ! ! !REMARKS: ! VOC are not scaled, however scale factors are available (see ! epa_nei_mod.f for procedure) ! ! !REVISION HISTORY: ! 7 Oct 2009 - A. van Donkelaar - initial version ! 20 Oct 2009 - P. Le Sager - set L OpenMP private, put L loop first !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! INTEGER :: I, J, L !================================================================= ! NEI2005_SCALE_FUTURE begins here! !================================================================= !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J, L ) DO L = 1, 5 DO J = 1, JJPAR DO I = 1, IIPAR ! Future NOx [kg NO2/yr] NOx(I,J,L) = NOx(I,J,L) * GET_FUTURE_SCALE_NOxff( I, J ) ! Future CO [kg CO /yr] CO(I,J,L) = CO(I,J,L) * GET_FUTURE_SCALE_COff( I, J ) ! Future SO2 [kg SO2/yr] SO2(I,J,L) = SO2(I,J,L) * GET_FUTURE_SCALE_SO2ff( I, J ) ! Future SO4 [kg SO4/yr] SO4(I,J,L) = SO4(I,J,L) * GET_FUTURE_SCALE_SO2ff( I, J ) ! Future NH3 [kg NH3/yr] NH3(I,J,L) = NH3(I,J,L) * GET_FUTURE_SCALE_NH3an( I, J ) ! Future OC [kg NH3/yr] OC(I,J,L) = OC(I,J,L) * GET_FUTURE_SCALE_OCff( I, J ) ! Future BC [kg NH3/yr] BC(I,J,L) = BC(I,J,L) * GET_FUTURE_SCALE_BCff( I, J ) ENDDO ENDDO ENDDO !$OMP END PARALLEL DO ! Return to calling program END SUBROUTINE NEI2005_SCALE_FUTURE !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: total_anthro_Tg ! ! !DESCRIPTION: Subroutine TOTAL\_ANTHRO\_TG prints the totals for the ! anthropogenic emissions of NOx, CO, SO2 and NH3. !\\ !\\ ! !INTERFACE: ! SUBROUTINE TOTAL_ANTHRO_TG( YEAR ) ! ! !USES: ! # include "CMN_SIZE" ! Size parameters ! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: YEAR ! Year of data to compute totals ! ! !REVISION HISTORY: ! 7 Oct 2009 - A. van Donkelaar - initial version !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! INTEGER :: I, J, L REAL*8 :: T_NOX, T_CO, T_SO2, T_NH3 REAL*8 :: T_SO4, T_OC, T_BC, T_ALK4 REAL*8 :: T_ACET, T_MEK, T_PRPE, T_C3H8 REAL*8 :: T_CH2O, T_C2H6,T_ALD2 CHARACTER(LEN=3) :: UNIT !================================================================= ! TOTAL_ANTHRO_TG begins here! !================================================================= ! Fancy output WRITE( 6, '(a)' ) REPEAT( '=', 79 ) WRITE( 6, 100 ) 100 FORMAT( 'N. E. I. 2005 U. S. A. E M I S S I O N S', / ) ! Total NOx [Tg N] T_NOX = SUM( NOx ) * 1d-9 * ( 14d0 / 46d0 ) ! Total CO [Tg CO] T_CO = SUM( CO ) * 1d-9 ! Total SO2 [Tg S] T_SO2 = SUM( SO2 ) * 1d-9 * ( 32d0 / 64d0 ) ! Total SO4 [Tg S] T_SO4 = SUM( SO4 ) * 1d-9 * ( 32d0 / 96d0 ) ! Total NH3 [Tg NH3] T_NH3 = SUM( NH3 ) * 1d-9 ! Total OC [Tg] T_OC = SUM( OC ) * 1d-9 ! Total OC [Tg] T_BC = SUM( BC ) * 1d-9 ! Total ALK4 [Tg C] T_ALK4 = SUM( ALK4 ) * 1d-9 ! Total ACET [Tg C] T_ACET = SUM( ACET ) * 1d-9 ! Total MEK [Tg C] T_MEK = SUM( MEK ) * 1d-9 ! Total PRPE [Tg C] T_PRPE = SUM( PRPE ) * 1d-9 ! Total C3H8 [Tg C] T_C3H8 = SUM( C3H8 ) * 1d-9 ! Total CH2O [Tg C] T_CH2O = SUM( CH2O ) * 1d-9 ! Total C2H6 [Tg C] T_C2H6 = SUM( C2H6 ) * 1d-9 ! Total ALD2 [Tg C] T_ALD2 = SUM( ALD2 ) * 1d-9 ! Print totals in [Tg] WRITE( 6, 110 ) 'NOx ', YEAR, T_NOx, '[Tg N ]' WRITE( 6, 110 ) 'CO ', YEAR, T_CO, '[Tg CO ]' WRITE( 6, 110 ) 'SO2 ', YEAR, T_SO2, '[Tg S ]' WRITE( 6, 110 ) 'SO4 ', YEAR, T_SO4, '[Tg S ]' WRITE( 6, 110 ) 'NH3 ', YEAR, T_NH3, '[Tg NH3]' WRITE( 6, 110 ) 'OC ' , YEAR, T_OC, '[Tg C]' WRITE( 6, 110 ) 'BC ' , YEAR, T_BC, '[Tg C]' WRITE( 6, 110 ) 'ALK4 ', YEAR, T_ALK4, '[Tg C]' WRITE( 6, 110 ) 'ACET ', YEAR, T_ACET, '[Tg C]' WRITE( 6, 110 ) 'MEK ' , YEAR, T_MEK, '[Tg C]' WRITE( 6, 110 ) 'PRPE ', YEAR, T_PRPE, '[Tg C]' WRITE( 6, 110 ) 'C3H8 ', YEAR, T_C3H8, '[Tg C]' WRITE( 6, 110 ) 'CH2O ', YEAR, T_CH2O, '[Tg C]' WRITE( 6, 110 ) 'C2H6 ', YEAR, T_C2H6, '[Tg C]' WRITE( 6, 110 ) 'ALD2 ', YEAR, T_ALD2, '[Tg C]' ! Format statement 110 FORMAT( 'NEI2005 anthro ', a5, & 'for year ', i4, ': ', f11.4, 1x, a8 ) ! Fancy output WRITE( 6, '(a)' ) REPEAT( '=', 79 ) ! Return to calling program END SUBROUTINE TOTAL_ANTHRO_Tg !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: init_nei2005_anthro ! ! !DESCRIPTION: Subroutine INIT\_NEI2005\_ANTHRO allocates and zeroes all ! module arrays. !\\ !\\ ! !INTERFACE: ! SUBROUTINE INIT_NEI2005_ANTHRO ! ! !USES: ! USE ERROR_MOD, ONLY : ALLOC_ERR USE GRID_MOD, ONLY : GET_AREA_CM2 USE LOGICAL_MOD, ONLY : LNEI05 # include "CMN_SIZE" ! Size parameters ! ! !REVISION HISTORY: !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! INTEGER :: AS, J !================================================================= ! INIT_NEI2005_ANTHRO begins here! !================================================================= ! Return if LNEI05 is false IF ( .not. LNEI05 ) RETURN !-------------------------------------------------- ! Allocate and zero arrays for emissions !-------------------------------------------------- ! allocate and read USA Mask ALLOCATE( USA_MASK( IIPAR, JJPAR ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'USA_MASK' ) USA_MASK = 0d0 CALL READ_NEI2005_MASK ALLOCATE( NOx( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'NOx' ) NOx = 0d0 ALLOCATE( CO( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'CO' ) CO = 0d0 ALLOCATE( SO2( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'SO2' ) SO2 = 0d0 ALLOCATE( SO4( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'SO4' ) SO4 = 0d0 ALLOCATE( NH3( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'NH3' ) NH3 = 0d0 ALLOCATE( OC( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'OC' ) OC = 0d0 ALLOCATE( BC( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'BC' ) BC = 0d0 ALLOCATE( ALK4( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'ALK4' ) ALK4 = 0d0 ALLOCATE( ACET( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'ACET' ) ACET = 0d0 ALLOCATE( MEK( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'MEK' ) MEK = 0d0 ALLOCATE( ALD2( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'ALD2' ) ALD2 = 0d0 ALLOCATE( PRPE( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'PRPE' ) PRPE = 0d0 ALLOCATE( C2H6( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'C2H6' ) C2H6 = 0d0 ALLOCATE( C3H8( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'C3H8' ) C3H8 = 0d0 ALLOCATE( CH2O( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'CH2O' ) CH2O = 0d0 ALLOCATE( NOx_WKEND( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'NOx_WKEND' ) NOx_WKEND = 0d0 ALLOCATE( CO_WKEND( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'CO_WKEND' ) CO_WKEND = 0d0 ALLOCATE( SO2_WKEND( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'SO2_WKEND' ) SO2_WKEND = 0d0 ALLOCATE( SO4_WKEND( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'SO4_WKEND' ) SO4_WKEND = 0d0 ALLOCATE( NH3_WKEND( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'NH3_WKEND' ) NH3_WKEND = 0d0 ALLOCATE( OC_WKEND( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'OC_WKEND' ) OC_WKEND = 0d0 ALLOCATE( BC_WKEND( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'BC_WKEND' ) BC_WKEND = 0d0 ALLOCATE( ALK4_WKEND( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'ALK4_WKEND' ) ALK4_WKEND = 0d0 ALLOCATE( ACET_WKEND( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'ACET_WKEND' ) ACET_WKEND = 0d0 ALLOCATE( MEK_WKEND( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'MEK_WKEND' ) MEK_WKEND = 0d0 ALLOCATE( ALD2_WKEND( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'ALD2_WKEND' ) ALD2_WKEND = 0d0 ALLOCATE( PRPE_WKEND( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'PRPE_WKEND' ) PRPE_WKEND = 0d0 ALLOCATE( C2H6_WKEND( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'C2H6_WKEND' ) C2H6_WKEND = 0d0 ALLOCATE( C3H8_WKEND( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'C3H8_WKEND' ) C3H8_WKEND = 0d0 ALLOCATE( CH2O_WKEND( IIPAR, JJPAR, 5 ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'CH2O_WKEND' ) CH2O_WKEND = 0d0 !--------------------------------------------------- ! Pre-store array for grid box surface area in cm2 !--------------------------------------------------- ! Allocate array ALLOCATE( A_CM2( JJPAR ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'A_CM2' ) ! Fill array DO J = 1, JJPAR A_CM2(J) = GET_AREA_CM2( J ) ENDDO ! Return to calling program END SUBROUTINE INIT_NEI2005_ANTHRO !EOC !------------------------------------------------------------------------------ ! Harvard University Atmospheric Chemistry Modeling Group ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: cleanup_nei2005_anthro ! ! !DESCRIPTION: Subroutine CLEANUP\_NEI2005\_ANTHRO deallocates all module ! arrays. !\\ !\\ ! !INTERFACE: ! SUBROUTINE CLEANUP_NEI2005_ANTHRO ! ! !REVISION HISTORY: !EOP !------------------------------------------------------------------------------ !BOC !================================================================= ! CLEANUP_NEIO2005_ANTHRO begins here! !================================================================= ! USA mask IF ( ALLOCATED( USA_MASK) ) DEALLOCATE( USA_MASK ) IF ( ALLOCATED( A_CM2 ) ) DEALLOCATE( A_CM2 ) IF ( ALLOCATED( NOx ) ) DEALLOCATE( NOx ) IF ( ALLOCATED( CO ) ) DEALLOCATE( CO ) IF ( ALLOCATED( SO2 ) ) DEALLOCATE( SO2 ) IF ( ALLOCATED( SO4 ) ) DEALLOCATE( SO4 ) IF ( ALLOCATED( NH3 ) ) DEALLOCATE( NH3 ) IF ( ALLOCATED( OC ) ) DEALLOCATE( OC ) IF ( ALLOCATED( BC ) ) DEALLOCATE( BC ) IF ( ALLOCATED( ALK4 ) ) DEALLOCATE( ALK4 ) IF ( ALLOCATED( ACET ) ) DEALLOCATE( ACET ) IF ( ALLOCATED( MEK ) ) DEALLOCATE( MEK ) IF ( ALLOCATED( ALD2 ) ) DEALLOCATE( ALD2 ) IF ( ALLOCATED( PRPE ) ) DEALLOCATE( PRPE ) IF ( ALLOCATED( C2H6 ) ) DEALLOCATE( C2H6 ) IF ( ALLOCATED( C3H8 ) ) DEALLOCATE( C3H8 ) IF ( ALLOCATED( CH2O ) ) DEALLOCATE( CH2O ) IF (ALLOCATED(NOx_WKEND) ) DEALLOCATE(NOx_WKEND ) IF (ALLOCATED(CO_WKEND )) DEALLOCATE(CO_WKEND ) IF (ALLOCATED(SO2_WKEND )) DEALLOCATE(SO2_WKEND ) IF (ALLOCATED(SO4_WKEND )) DEALLOCATE(SO4_WKEND ) IF (ALLOCATED(NH3_WKEND )) DEALLOCATE(NH3_WKEND ) IF (ALLOCATED(OC_WKEND )) DEALLOCATE(OC_WKEND ) IF (ALLOCATED(BC_WKEND )) DEALLOCATE(BC_WKEND ) IF (ALLOCATED(ALK4_WKEND)) DEALLOCATE(ALK4_WKEND) IF (ALLOCATED(ACET_WKEND)) DEALLOCATE(ACET_WKEND) IF (ALLOCATED(MEK_WKEND )) DEALLOCATE(MEK_WKEND ) IF (ALLOCATED(ALD2_WKEND)) DEALLOCATE(ALD2_WKEND) IF (ALLOCATED(PRPE_WKEND)) DEALLOCATE(PRPE_WKEND) IF (ALLOCATED(C2H6_WKEND)) DEALLOCATE(C2H6_WKEND) IF (ALLOCATED(C3H8_WKEND)) DEALLOCATE(C3H8_WKEND) IF (ALLOCATED(CH2O_WKEND)) DEALLOCATE(CH2O_WKEND) END SUBROUTINE CLEANUP_NEI2005_ANTHRO !EOC END MODULE NEI2005_ANTHRO_MOD