1594 lines
53 KiB
Fortran
1594 lines
53 KiB
Fortran
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !MODULE: emep_mod
|
|
!
|
|
! !DESCRIPTION: \subsection*{Overview}
|
|
! Module EMEP\_MOD contains variables and routines to read the
|
|
! EMEP European anthropogenic emission inventory for CO, NOz, and some
|
|
! NMVOCs. The EMEP files come from Marion Auvray and Isabelle Bey at EPFL.
|
|
! (bdf, bmy, amv, phs, 11/1/05, 1/28/09)
|
|
!
|
|
!\subsection*{References}
|
|
! \begin{enumerate}
|
|
! \item Vestreng, V., and H. Klein (2002), \emph{Emission data reported
|
|
! to UNECE/EMEP: Quality insurance and trend analysis and
|
|
! presentation of Web-Dab}, \underline{MSC-W Status Rep}. 2002:,
|
|
! 101 pp., Norw. Meteorol. Inst., Oslo, Norway. This paper is
|
|
! on the EMEP web site:
|
|
!\begin{verbatim}
|
|
! http://www.emep.int/mscw/mscw\_publications.html
|
|
! http://www.emep.int/publ/reports/2002/mscw\_note\_1\_2002.pdf
|
|
!\end{verbatim}
|
|
! \item Auvray, M., and I. Bey, \emph{Long-Range Transport to Europe:
|
|
! Seasonal Variations and Implications for the European Ozone
|
|
! Budget}, \underline{J. Geophys. Res.}, \textbf{110}, D11303,
|
|
! doi: 10.1029/2004JD005503, 2005.
|
|
! \end{enumerate}
|
|
!
|
|
! !INTERFACE:
|
|
!
|
|
MODULE EMEP_MOD
|
|
!
|
|
! !USES:
|
|
!
|
|
IMPLICIT NONE
|
|
# include "define.h"
|
|
PRIVATE
|
|
!
|
|
! !PUBLIC MEMBER FUNCTIONS:
|
|
!
|
|
PUBLIC :: EMISS_EMEP
|
|
PUBLIC :: EMISS_EMEP_05x0666
|
|
PUBLIC :: CLEANUP_EMEP
|
|
PUBLIC :: GET_EUROPE_MASK
|
|
PUBLIC :: GET_EMEP_ANTHRO
|
|
!
|
|
! !PRIVATE MEMBER FUNCTIONS:
|
|
!
|
|
PRIVATE :: EMEP_SCALE_FUTURE
|
|
PRIVATE :: READ_EMEP_UPDATED
|
|
PRIVATE :: READ_EMEP_UPDATED_05x0666
|
|
PRIVATE :: READ_EUROPE_MASK
|
|
PRIVATE :: READ_EUROPE_MASK_05x0666
|
|
PRIVATE :: INIT_EMEP
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 01 Nov 2005 - B. Field, R. Yantosca - Initial version
|
|
! (1 ) Now only print totals for defined tracers (bmy, 2/6/06)
|
|
! (2 ) Now modified for IPCC future emissions (swu, bmy, 5/30/06)
|
|
! (3 ) Now yearly scale factors can be applied (phs, amv, 3/17/08)
|
|
! (4 ) Now include emep SOx and emep emissions to 2005 (amv, 06/08)
|
|
! (5 ) Modify to access SHIP emissions from outside (phs, 06/08)
|
|
! (6 ) Account for monthly variations (amv, 12/9/08)
|
|
! 18 Dec 2009 - Aaron van D - Created routine EMISS_EMEP_05x0666
|
|
! 18 Dec 2009 - Aaron van D - Created routine READ_EMEP_UPDATED_05x0666
|
|
! 18 Dec 2009 - Aaron van D - Created routine READ_EUROPE_MASK_05x0666
|
|
! 11 Jan 2010 - Aaron van D - Max scale year is now 2007, for consistency
|
|
! 11 Jan 2010 - Aaron van D - Extend 1x1 emission files to 2007. Routine
|
|
! READ_EMEP_UPDATED now mimics routine
|
|
! READ_EMEP_UPDATED_05x0666.
|
|
! 26 Jan 2010 - R. Yantosca - Minor bug fix in INIT_EMEP
|
|
! 31 Aug 2010 - R. Yantosca - Updated comments
|
|
! 24 Nov 2010 - G. Vinken - Updated EMEP mask file
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!
|
|
! !PRIVATE DATA MEMBERS:
|
|
!
|
|
! Array for geographic mask
|
|
REAL*8, ALLOCATABLE :: EUROPE_MASK(:,:)
|
|
|
|
! Arrays for ground-based emissions
|
|
REAL*8, ALLOCATABLE :: EMEP_NOx(:,:)
|
|
REAL*8, ALLOCATABLE :: EMEP_CO(:,:)
|
|
REAL*8, ALLOCATABLE :: EMEP_SO2(:,:)
|
|
REAL*8, ALLOCATABLE :: EMEP_NH3(:,:)
|
|
REAL*8, ALLOCATABLE :: EMEP_ALK4(:,:)
|
|
REAL*8, ALLOCATABLE :: EMEP_MEK(:,:)
|
|
REAL*8, ALLOCATABLE :: EMEP_ALD2(:,:)
|
|
REAL*8, ALLOCATABLE :: EMEP_PRPE(:,:)
|
|
REAL*8, ALLOCATABLE :: EMEP_C2H6(:,:)
|
|
|
|
! Arrays for ship emissions
|
|
REAL*8, ALLOCATABLE :: EMEP_CO_SHIP(:,:)
|
|
REAL*8, ALLOCATABLE :: EMEP_SO2_SHIP(:,:)
|
|
REAL*8, ALLOCATABLE :: EMEP_NOx_SHIP(:,:)
|
|
|
|
CONTAINS
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: get_europe_mask
|
|
!
|
|
! !DESCRIPTION: Function GET\_EUROPE\_MASK returns the value of the EUROPE
|
|
! mask for EMEP emissions at grid box (I,J). MASK=1 if (I,J) is in the
|
|
! European region, or MASK=0 otherwise.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
FUNCTION GET_EUROPE_MASK( I, J ) RESULT( EUROPE )
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
INTEGER, INTENT(IN) :: I ! Longitude index
|
|
INTEGER, INTENT(IN) :: J ! Latitude index
|
|
!
|
|
! !RETURN VALUE:
|
|
!
|
|
REAL*8 :: EUROPE ! Returns the mask value @ (I,J)
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 01 Nov 2005 - B. Field, R. Yantosca - Initial version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
!=================================================================
|
|
! GET_EUROPE_MASK begins here!
|
|
!=================================================================
|
|
EUROPE = EUROPE_MASK(I,J)
|
|
|
|
END FUNCTION GET_EUROPE_MASK
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: get_emep_anthro
|
|
!
|
|
! !DESCRIPTION: Function GET\_EMEP\_ANTHRO returns the EMEP emission for
|
|
! GEOS-CHEM grid box (I,J) and tracer N.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
FUNCTION GET_EMEP_ANTHRO( I, J, N, KG_S, SHIP ) RESULT( EMEP )
|
|
!
|
|
! !USES:
|
|
!
|
|
USE TRACERID_MOD, ONLY : IDTNOX, IDTCO, IDTALK4, IDTMEK
|
|
USE TRACERID_MOD, ONLY : IDTALD2, IDTPRPE, IDTC2H6, IDTSO2
|
|
USE TRACERID_MOD, ONLY : IDTNH3
|
|
USE TRACER_MOD, ONLY : XNUMOL
|
|
USE GRID_MOD, ONLY : GET_AREA_CM2
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
INTEGER, INTENT(IN) :: I ! Longitude index
|
|
INTEGER, INTENT(IN) :: J ! Latitude index
|
|
INTEGER, INTENT(IN) :: N ! Tracer number
|
|
LOGICAL, INTENT(IN), OPTIONAL :: KG_S ! Return emissions in [kg/s]
|
|
LOGICAL, INTENT(IN), OPTIONAL :: SHIP ! Return ship emissions
|
|
!
|
|
! RETURN VALUE:
|
|
!
|
|
REAL*8 :: EMEP ! Returns emissions at (I,J)
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 01 Nov 2005 - B. Field, R. Yantosca - Initial version
|
|
! (1 ) added SOx, SOx ship and NH3 emissions, plus optional kg/s output
|
|
! (amv, 06/2008)
|
|
! (2 ) Now returns ship emissions if requested (phs, 6/08)
|
|
! (3 ) Added checks to avoid calling unavailable ship emissions (phs, 6/08)
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
LOGICAL :: DO_KGS, IS_SHIP
|
|
INTEGER :: NN, HAS_SHIP(3)
|
|
|
|
!=================================================================
|
|
! GET_EMEP_ANTHRO begins here!
|
|
!=================================================================
|
|
|
|
! Initialize
|
|
NN = N
|
|
IS_SHIP = .FALSE.
|
|
DO_KGS = .FALSE.
|
|
|
|
IF ( PRESENT( KG_S ) ) DO_KGS = KG_S
|
|
IF ( PRESENT( SHIP ) ) IS_SHIP = SHIP
|
|
|
|
! check SHIP availability
|
|
HAS_SHIP = (/ IDTNOX, IDTCO, IDTSO2 /)
|
|
|
|
IF ( IS_SHIP .AND. .NOT. ANY( HAS_SHIP == N) ) THEN
|
|
WRITE(6,*)'WARNING: EMEP SHIP emissions not available for'//
|
|
$ 'tracer #',N
|
|
EMEP = 0D0
|
|
RETURN
|
|
ENDIF
|
|
|
|
! NOx
|
|
IF ( N == IDTNOX ) THEN
|
|
IF ( IS_SHIP ) THEN
|
|
EMEP = EMEP_NOx_SHIP(I,J)
|
|
ELSE
|
|
EMEP = EMEP_NOx(I,J)
|
|
ENDIF
|
|
!%%%%%%%%%%%%%KLUDGE TO EMITT SHIP NOX AS NOX %%%%%%%%%%%%%%
|
|
! IF ( IS_SHIP ) THEN
|
|
! EMEP = 0d0
|
|
! ELSE
|
|
! EMEP = EMEP_NOx(I,J) + EMEP_NOx_SHIP(I,J)
|
|
! ENDIF
|
|
!%%%%%%%%%%%%% END KLUDGE %%%%%%%%%%%%%%
|
|
|
|
! CO
|
|
ELSE IF ( N == IDTCO ) THEN
|
|
IF ( IS_SHIP ) THEN
|
|
EMEP = EMEP_CO_SHIP(I,J)
|
|
ELSE
|
|
EMEP = EMEP_CO(I,J)
|
|
ENDIF
|
|
|
|
! ALK4 (>= C4 alkanes)
|
|
ELSE IF ( N == IDTALK4 ) THEN
|
|
EMEP = EMEP_ALK4(I,J)
|
|
|
|
! MEK
|
|
ELSE IF ( N == IDTMEK ) THEN
|
|
EMEP = EMEP_MEK(I,J)
|
|
|
|
! ALD2 (acetaldehyde)
|
|
ELSE IF ( N == IDTALD2 ) THEN
|
|
EMEP = EMEP_ALD2(I,J)
|
|
|
|
! PRPE (>= C3 alkenes)
|
|
ELSE IF ( N == IDTPRPE ) THEN
|
|
EMEP = EMEP_PRPE(I,J)
|
|
|
|
! C2H6
|
|
ELSE IF ( N == IDTC2H6 ) THEN
|
|
EMEP = EMEP_C2H6(I,J)
|
|
|
|
! SO2
|
|
ELSE IF ( N == IDTSO2 ) THEN
|
|
IF ( IS_SHIP ) THEN
|
|
EMEP = EMEP_SO2_SHIP(I,J)
|
|
ELSE
|
|
EMEP = EMEP_SO2(I,J)
|
|
ENDIF
|
|
|
|
! NH3
|
|
ELSE IF ( N == IDTNH3 ) THEN
|
|
EMEP = EMEP_NH3(I,J)
|
|
|
|
! Otherwise return a negative value to indicate
|
|
! that there are no EMEP emissions for tracer N
|
|
ELSE
|
|
EMEP = -1d0
|
|
|
|
ENDIF
|
|
|
|
!------------------------------
|
|
! Convert units (if necessary)
|
|
!------------------------------
|
|
IF ( DO_KGS ) THEN
|
|
|
|
EMEP = EMEP * GET_AREA_CM2(J) / XNUMOL(NN)
|
|
|
|
ENDIF
|
|
|
|
END FUNCTION GET_EMEP_ANTHRO
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: emiss_emep
|
|
!
|
|
! !DESCRIPTION: Subroutine EMISS\_EMEP reads the EMEP emission fields at
|
|
! 1x1 resolution and regrids them to the current model resolution.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE EMISS_EMEP
|
|
!
|
|
! !USES:
|
|
!
|
|
USE BPCH2_MOD, ONLY : GET_TAU0, OPEN_BPCH2_FOR_READ
|
|
USE FILE_MOD, ONLY : IU_FILE, IOERROR
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR_1x1
|
|
USE LOGICAL_MOD, ONLY : LFUTURE
|
|
USE REGRID_1x1_MOD, ONLY : DO_REGRID_1x1
|
|
USE TIME_MOD, ONLY : EXPAND_DATE, GET_YEAR
|
|
USE TIME_MOD, ONLY : GET_MONTH
|
|
USE SCALE_ANTHRO_MOD, ONLY : GET_ANNUAL_SCALAR
|
|
|
|
!USE CMN_SIZE_MOD ! Size parameters
|
|
!USE CMN_O3_MOD ! SCALEYEAR
|
|
# include "CMN_SIZE"
|
|
# include "CMN_O3"
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 01 Nov 2005 - B. Field, R. Yantosca - Initial version
|
|
! (1 ) Modified for IPCC future emissions. Now references LFUTURE from
|
|
! "logical_mod.f". (bmy, 5/30/06)
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
INTEGER :: EMEP_NYMD, EMEP_YEAR
|
|
REAL*8 :: EMEP_TAU, TAU0
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
|
|
! For bpch file format
|
|
INTEGER :: I, J, L, N, IOS
|
|
INTEGER :: NTRACER, NSKIP
|
|
INTEGER :: HALFPOLAR, CENTER180
|
|
INTEGER :: NI, NJ, NL
|
|
INTEGER :: IFIRST, JFIRST, LFIRST
|
|
INTEGER :: SCALEYEAR
|
|
REAL*4 :: ARRAY(I1x1,J1x1,1)
|
|
REAL*4 :: LONRES, LATRES
|
|
REAL*4 :: Sc(IIPAR,JJPAR)
|
|
REAL*8 :: ZTAU0, ZTAU1
|
|
CHARACTER(LEN=20) :: MODELNAME
|
|
CHARACTER(LEN=40) :: CATEGORY
|
|
CHARACTER(LEN=40) :: UNIT
|
|
CHARACTER(LEN=40) :: RESERVED
|
|
|
|
!=================================================================
|
|
! EMISS_EMEP begins here!
|
|
!=================================================================
|
|
|
|
! First-time initialization
|
|
IF ( FIRST ) THEN
|
|
CALL INIT_EMEP
|
|
FIRST = .FALSE.
|
|
ENDIF
|
|
|
|
! 1x1 file name for EMEP 2000
|
|
FILENAME = TRIM( DATA_DIR_1x1 ) //
|
|
& 'EMEP_200510/EMEP.geos.1x1.YYYY'
|
|
|
|
IF ( FSCALYR < 0 ) THEN
|
|
SCALEYEAR = GET_YEAR()
|
|
ELSE
|
|
SCALEYEAR = FSCALYR
|
|
ENDIF
|
|
|
|
! EMEP 2000 data is only defined from 1985-2000
|
|
EMEP_YEAR = MAX( MIN( SCALEYEAR, 2000 ), 1985 )
|
|
|
|
! YYYYMMDD value for 1st day of EMEP_YEAR
|
|
EMEP_NYMD = ( EMEP_YEAR * 10000 ) + 0101
|
|
|
|
! TAU0 value corresponding to EMEP_NYMD
|
|
EMEP_TAU = GET_TAU0( 1, 1, EMEP_YEAR )
|
|
|
|
! Expand filename
|
|
CALL EXPAND_DATE( FILENAME, EMEP_NYMD, 000000 )
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
100 FORMAT( ' - EMISS_EMEP: Reading ', a )
|
|
|
|
!=================================================================
|
|
! Read data at 1x1 resolution and regrid to current grid size
|
|
!=================================================================
|
|
|
|
! Open file
|
|
CALL OPEN_BPCH2_FOR_READ( IU_FILE, FILENAME )
|
|
|
|
! Read the entire file in one pass (for I/O optimization)
|
|
DO
|
|
|
|
! Read 1st data block header line
|
|
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, 'emiss_emep:2' )
|
|
|
|
! Read 2nd data block header line
|
|
READ( IU_FILE, IOSTAT=IOS )
|
|
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
|
|
& NI, NJ, NL, IFIRST, JFIRST, LFIRST, NSKIP
|
|
|
|
! Error check
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_FILE, 'emiss_emep:3' )
|
|
|
|
! Read data [molec/cm2/s] or [atoms C/cm2/s]
|
|
READ( IU_FILE, IOSTAT=IOS ) ARRAY(1:NI,1:NJ,1:NL)
|
|
|
|
! Error check
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_FILE, 'emiss_emep:4' )
|
|
|
|
! Regrid data from 1x1
|
|
SELECT CASE ( NTRACER )
|
|
|
|
! NOx [molec/cm2/s]
|
|
CASE( 1 )
|
|
CALL DO_REGRID_1x1( UNIT, ARRAY, EMEP_NOx )
|
|
|
|
! CO [molec/cm2/s]
|
|
CASE( 4 )
|
|
CALL DO_REGRID_1x1( UNIT, ARRAY, EMEP_CO )
|
|
|
|
! ALK4 [atoms C/cm2/s]
|
|
CASE( 5 )
|
|
CALL DO_REGRID_1x1( UNIT, ARRAY, EMEP_ALK4 )
|
|
|
|
! MEK [atoms C/cm2/s]
|
|
CASE( 10 )
|
|
CALL DO_REGRID_1x1( UNIT, ARRAY, EMEP_MEK )
|
|
|
|
! ALD2 [atoms C/cm2/s]
|
|
CASE( 11 )
|
|
CALL DO_REGRID_1x1( UNIT, ARRAY, EMEP_ALD2 )
|
|
|
|
! PRPE [atoms C/cm2/s]
|
|
CASE( 18 )
|
|
CALL DO_REGRID_1x1( UNIT, ARRAY, EMEP_PRPE )
|
|
|
|
! C2H6 [atoms C/cm2/s]
|
|
CASE( 21 )
|
|
CALL DO_REGRID_1x1( UNIT, ARRAY, EMEP_C2H6 )
|
|
|
|
CASE DEFAULT
|
|
! Nothing
|
|
|
|
END SELECT
|
|
|
|
ENDDO
|
|
|
|
! Close file
|
|
CLOSE( IU_FILE )
|
|
|
|
!=================================================================
|
|
! Get and apply annual emissions factors (amv, phs, 3/17/08)
|
|
!=================================================================
|
|
|
|
!=================================================================
|
|
! If we are at or above 1990, can apply updated EMEP emissions for
|
|
! NOx, CO, NH3 and include SOx (amv, 06/04/08)
|
|
!=================================================================
|
|
|
|
print*, 'SCALEYEAR=', SCALEYEAR
|
|
|
|
IF ( SCALEYEAR > 1989 ) THEN
|
|
|
|
! new EMEP data is only defined from 1990-2007
|
|
EMEP_YEAR = MIN( SCALEYEAR, 2007 )
|
|
|
|
CALL READ_EMEP_UPDATED( 1, EMEP_YEAR, EMEP_NOx, 0 )
|
|
CALL READ_EMEP_UPDATED( 4, EMEP_YEAR, EMEP_CO, 0 )
|
|
CALL READ_EMEP_UPDATED( 26, EMEP_YEAR, EMEP_SO2, 0 )
|
|
CALL READ_EMEP_UPDATED( 30, EMEP_YEAR, EMEP_NH3, 1 )
|
|
|
|
|
|
CALL READ_EMEP_UPDATED( 1, EMEP_YEAR, EMEP_NOx_SHIP, 2 )
|
|
CALL READ_EMEP_UPDATED( 4, EMEP_YEAR, EMEP_CO_SHIP, 2 )
|
|
CALL READ_EMEP_UPDATED( 26, EMEP_YEAR, EMEP_SO2_SHIP, 2 )
|
|
|
|
! Need to use for SOx/NH3 anyways, but SOx scale back further
|
|
ELSE
|
|
|
|
CALL READ_EMEP_UPDATED( 26, 1990, EMEP_SO2, 0 )
|
|
CALL READ_EMEP_UPDATED( 26, 1990, EMEP_SO2_SHIP, 2 )
|
|
CALL READ_EMEP_UPDATED( 30, 1990, EMEP_NH3, 1 )
|
|
|
|
CALL GET_ANNUAL_SCALAR( 73, 1990, SCALEYEAR, Sc )
|
|
EMEP_SO2(:,:) = EMEP_SO2(:,:) * Sc(:,:)
|
|
! EMEP_SO2_SHIP = EMEP_SO2_SHIP * Sc ! do not scale SHIP
|
|
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! Compute IPCC future emissions (if necessary)
|
|
!=================================================================
|
|
IF ( LFUTURE ) THEN
|
|
CALL EMEP_SCALE_FUTURE
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! Print emission totals
|
|
!=================================================================
|
|
|
|
! Print totals for EMEP_YEAR
|
|
CALL TOTAL_ANTHRO_TG( EMEP_YEAR, SCALEYEAR, GET_MONTH() )
|
|
|
|
END SUBROUTINE EMISS_EMEP
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: emiss_emep_05x0666
|
|
!
|
|
! !DESCRIPTION: Subroutine EMISS\_EMEP reads the EMEP emission fields at
|
|
! 05x0666 resolution and regrids them to the current model resolution.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE EMISS_EMEP_05x0666
|
|
!
|
|
! !USES:
|
|
!
|
|
USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR
|
|
USE LOGICAL_MOD, ONLY : LFUTURE
|
|
USE REGRID_1x1_MOD, ONLY : DO_REGRID_05x0666
|
|
USE TIME_MOD, ONLY : EXPAND_DATE, GET_YEAR
|
|
USE TIME_MOD, ONLY : GET_MONTH
|
|
USE SCALE_ANTHRO_MOD, ONLY : GET_ANNUAL_SCALAR_05x0666_NESTED
|
|
|
|
!USE CMN_SIZE_MOD ! Size parameters
|
|
!USE CMN_O3_MOD ! SCALEYEAR
|
|
# include "CMN_SIZE"
|
|
# include "CMN_O3"
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 23 Oct 2006 - A. v. Donkelaar - Initial version, modified from EMISS_EMEP
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
INTEGER :: EMEP_NYMD, EMEP_YEAR
|
|
REAL*8 :: EMEP_TAU, TAU0
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
|
|
! For bpch file format
|
|
INTEGER :: I, J, L, N, IOS
|
|
INTEGER :: NTRACER, NSKIP
|
|
INTEGER :: HALFPOLAR, CENTER180
|
|
INTEGER :: NI, NJ, NL
|
|
INTEGER :: IFIRST, JFIRST, LFIRST
|
|
INTEGER :: SCALEYEAR
|
|
REAL*4 :: ARRAY(IIPAR,JJPAR,1)
|
|
REAL*4 :: LONRES, LATRES
|
|
REAL*4 :: Sc(IIPAR,JJPAR)
|
|
REAL*8 :: ZTAU0, ZTAU1
|
|
CHARACTER(LEN=20) :: MODELNAME
|
|
CHARACTER(LEN=40) :: CATEGORY
|
|
CHARACTER(LEN=40) :: UNIT
|
|
CHARACTER(LEN=40) :: RESERVED
|
|
|
|
!=================================================================
|
|
! EMISS_EMEP begins here!
|
|
!=================================================================
|
|
|
|
! First-time initialization
|
|
IF ( FIRST ) THEN
|
|
CALL INIT_EMEP
|
|
FIRST = .FALSE.
|
|
ENDIF
|
|
|
|
! 1x1 file name for EMEP 2000
|
|
FILENAME = TRIM( DATA_DIR ) //
|
|
& 'EMEP_200510/EMEP.geos.05x0666.YYYY'
|
|
|
|
IF ( FSCALYR < 0 ) THEN
|
|
SCALEYEAR = GET_YEAR()
|
|
ELSE
|
|
SCALEYEAR = FSCALYR
|
|
ENDIF
|
|
|
|
! EMEP 2000 data is only defined from 1985-2000
|
|
EMEP_YEAR = MAX( MIN( SCALEYEAR, 2000 ), 1985 )
|
|
|
|
! YYYYMMDD value for 1st day of EMEP_YEAR
|
|
EMEP_NYMD = ( EMEP_YEAR * 10000 ) + 0101
|
|
|
|
! TAU0 value corresponding to EMEP_NYMD
|
|
EMEP_TAU = GET_TAU0( 1, 1, EMEP_YEAR )
|
|
|
|
! Expand filename
|
|
CALL EXPAND_DATE( FILENAME, EMEP_NYMD, 000000 )
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
100 FORMAT( ' - EMISS_EMEP_05x0666: Reading ', a )
|
|
|
|
!=================================================================
|
|
! Read data at 05x0666 resolution
|
|
!=================================================================
|
|
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', 4, EMEP_TAU,
|
|
& IIPAR, JJPAR, 1, ARRAY, QUIET=.TRUE.)
|
|
EMEP_CO(:,:) = ARRAY(:,:,1)
|
|
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', 1, EMEP_TAU,
|
|
& IIPAR, JJPAR, 1, ARRAY, QUIET=.TRUE.)
|
|
EMEP_NOx(:,:) = ARRAY(:,:,1)
|
|
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE',18, EMEP_TAU,
|
|
& IIPAR, JJPAR, 1, ARRAY, QUIET=.TRUE.)
|
|
EMEP_PRPE(:,:) = ARRAY(:,:,1)
|
|
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', 5, EMEP_TAU,
|
|
& IIPAR, JJPAR, 1, ARRAY, QUIET=.TRUE.)
|
|
EMEP_ALK4(:,:) = ARRAY(:,:,1)
|
|
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE',21, EMEP_TAU,
|
|
& IIPAR, JJPAR, 1, ARRAY, QUIET=.TRUE.)
|
|
EMEP_C2H6(:,:) = ARRAY(:,:,1)
|
|
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE',11, EMEP_TAU,
|
|
& IIPAR, JJPAR, 1, ARRAY, QUIET=.TRUE.)
|
|
EMEP_ALD2(:,:) = ARRAY(:,:,1)
|
|
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE',10, EMEP_TAU,
|
|
& IIPAR, JJPAR, 1, ARRAY, QUIET=.TRUE.)
|
|
EMEP_MEK(:,:) = ARRAY(:,:,1)
|
|
|
|
!=================================================================
|
|
! Get and apply annual emissions factors (amv, phs, 3/17/08)
|
|
!=================================================================
|
|
|
|
!=================================================================
|
|
! If we are at or above 1990, can apply updated EMEP emissions for
|
|
! NOx, CO, NH3 and include SOx (amv, 06/04/08)
|
|
!=================================================================
|
|
|
|
IF ( SCALEYEAR > 1989 ) THEN
|
|
|
|
! new EMEP data is only defined from 1990-2007
|
|
EMEP_YEAR = MIN( SCALEYEAR, 2007 )
|
|
|
|
CALL READ_EMEP_UPDATED_05x0666( 1, EMEP_YEAR, EMEP_NOx, 0 )
|
|
CALL READ_EMEP_UPDATED_05x0666( 4, EMEP_YEAR, EMEP_CO, 0 )
|
|
CALL READ_EMEP_UPDATED_05x0666( 26, EMEP_YEAR, EMEP_SO2, 0 )
|
|
CALL READ_EMEP_UPDATED_05x0666( 30, EMEP_YEAR, EMEP_NH3, 1 )
|
|
|
|
CALL READ_EMEP_UPDATED_05x0666( 1,EMEP_YEAR, EMEP_NOx_SHIP, 2)
|
|
CALL READ_EMEP_UPDATED_05x0666( 4,EMEP_YEAR, EMEP_CO_SHIP, 2)
|
|
CALL READ_EMEP_UPDATED_05x0666( 26,EMEP_YEAR, EMEP_SO2_SHIP, 2)
|
|
|
|
! Need to use for SOx/NH3 anyways, but SOx scale back further
|
|
ELSE
|
|
|
|
CALL READ_EMEP_UPDATED_05x0666( 26, 1990, EMEP_SO2, 0 )
|
|
CALL READ_EMEP_UPDATED_05x0666( 26, 1990, EMEP_SO2_SHIP, 2 )
|
|
CALL READ_EMEP_UPDATED_05x0666( 30, 1990, EMEP_NH3, 1 )
|
|
|
|
CALL GET_ANNUAL_SCALAR_05x0666_NESTED(73,1990,SCALEYEAR,Sc)
|
|
EMEP_SO2(:,:) = EMEP_SO2(:,:) * Sc(:,:)
|
|
! EMEP_SO2_SHIP = EMEP_SO2_SHIP * Sc ! do not scale SHIP
|
|
|
|
ENDIF
|
|
|
|
|
|
!=================================================================
|
|
! Compute IPCC future emissions (if necessary)
|
|
!=================================================================
|
|
IF ( LFUTURE ) THEN
|
|
CALL EMEP_SCALE_FUTURE
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! Print emission totals
|
|
!=================================================================
|
|
|
|
! Print totals for EMEP_YEAR
|
|
CALL TOTAL_ANTHRO_TG( EMEP_YEAR, SCALEYEAR, GET_MONTH() )
|
|
|
|
END SUBROUTINE EMISS_EMEP_05x0666
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: emep_scale_future
|
|
!
|
|
! !DESCRIPTION: Subroutine EMEP\_SCALE\_FUTURE applies the IPCC future
|
|
! scale factors to the EMEP anthropogenic emissions.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE EMEP_SCALE_FUTURE
|
|
!
|
|
! !USES:
|
|
!
|
|
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_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 FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_VOCff
|
|
|
|
!USE CMN_SIZE_MOD ! Size parameters
|
|
# include "CMN_SIZE"
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 30 May 2006 - S. Wu & R. Yantosca - Initial version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
INTEGER :: I, J
|
|
|
|
!=================================================================
|
|
! EMEP_SCALE_FUTURE begins here!
|
|
!=================================================================
|
|
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J )
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
|
|
! Future NOx [molec/cm2/s]
|
|
EMEP_NOx(I,J) = EMEP_NOx(I,J) *
|
|
& GET_FUTURE_SCALE_NOxff( I, J )
|
|
|
|
! Future CO [molec/cm2/s]
|
|
EMEP_CO(I,J) = EMEP_CO(I,J) *
|
|
& GET_FUTURE_SCALE_COff( I, J )
|
|
|
|
! Future ALK4 [atoms C/cm2/s]
|
|
EMEP_ALK4(I,J) = EMEP_ALK4(I,J) *
|
|
& GET_FUTURE_SCALE_ALK4ff( I, J )
|
|
|
|
! Future MEK [atoms C/cm2/s]
|
|
EMEP_MEK(I,J) = EMEP_MEK(I,J) *
|
|
& GET_FUTURE_SCALE_TONEff( I, J )
|
|
|
|
! Future ALD2 [atoms C/cm2/s]
|
|
EMEP_ALD2(I,J) = EMEP_ALD2(I,J) *
|
|
& GET_FUTURE_SCALE_VOCff( I, J )
|
|
|
|
! Future PRPE [atoms C/cm2/s]
|
|
EMEP_PRPE(I,J) = EMEP_PRPE(I,J) *
|
|
& GET_FUTURE_SCALE_PRPEff( I, J )
|
|
|
|
! Future C2H6 [atoms C/cm2/s]
|
|
EMEP_C2H6(I,J) = EMEP_C2H6(I,J) *
|
|
& GET_FUTURE_SCALE_C2H6ff( I, J )
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
END SUBROUTINE EMEP_SCALE_FUTURE
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: total_anthro_Tg
|
|
!
|
|
! !DESCRIPTION: Subroutine TOTAL\_ANTHRO\_TG prints the amount of EMEP
|
|
! anthropogenic emissions that are emitted each month in Tg or Tg C.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE TOTAL_ANTHRO_TG( EMEP_YEAR, EMISS_YEAR, EMEP_MONTH )
|
|
!
|
|
! !USES:
|
|
!
|
|
USE GRID_MOD, ONLY : GET_AREA_CM2
|
|
USE LOGICAL_MOD, ONLY : LEMEPSHIP
|
|
USE TIME_MOD, ONLY : ITS_A_LEAPYEAR
|
|
USE TRACER_MOD, ONLY : XNUMOL
|
|
USE TRACERID_MOD, ONLY : IDTNOX, IDTCO, IDTALK4, IDTMEK
|
|
USE TRACERID_MOD, ONLY : IDTALD2, IDTPRPE, IDTC2H6, IDTSO2
|
|
USE TRACERID_MOD, ONLY : IDTNH3
|
|
|
|
!USE CMN_SIZE_MOD ! Size parameters
|
|
# include "CMN_SIZE"
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
INTEGER, INTENT(IN) :: EMEP_YEAR ! EMEP base year
|
|
INTEGER, INTENT(IN) :: EMISS_YEAR ! Current simulated year
|
|
INTEGER, INTENT(IN) :: EMEP_MONTH ! Current simulated month
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 10 Nov 2004 - R. Hudman, R. Yantosca - Initial version
|
|
! (1 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
|
|
! (2 ) Now replace FMOL with TRACER_MW_KG (bmy, 10/25/05)
|
|
! (3 ) Now only print totals of defined tracers; other totals will be
|
|
! printed as zeroes. (bmy, 2/6/06)
|
|
! (4 ) Now emissions and base year are arguments. Output in Tg/month
|
|
! since this is called monthly (phs, 12/9/08)
|
|
! (5 ) Bug fix, now print out correct monthly EMEP totals (bmy, 1/30/09)
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
INTEGER :: I, J
|
|
REAL*8 :: A, B(9), NOX, CO, ALK4
|
|
REAL*8 :: MEK, ALD2, PRPE, C2H6, SO2
|
|
REAL*8 :: NH3
|
|
CHARACTER(LEN=3) :: UNIT
|
|
|
|
! Days per month
|
|
REAL*8 :: DAYS_IN_MONTH
|
|
REAL*8 :: DMON(12) = (/ 31d0, 28d0, 31d0, 30d0,
|
|
& 31d0, 30d0, 31d0, 31d0,
|
|
& 30d0, 31d0, 30d0, 31d0 /)
|
|
|
|
!=================================================================
|
|
! TOTAL_ANTHRO_TG begins here!
|
|
!=================================================================
|
|
|
|
! Fancy output
|
|
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
|
WRITE( 6, 100 )
|
|
100 FORMAT( 'M O N T H L Y E M E P E U R O P E A N
|
|
$ E M I S S I O N S', / )
|
|
|
|
! indicate if we include ship emissions (automatic before 1990)
|
|
IF ( LEMEPSHIP .OR. ( EMISS_YEAR < 1990 )) WRITE( 6, 101 )
|
|
101 FORMAT( '( INCL. SHIP )', / )
|
|
|
|
WRITE( 6, 102 ) EMEP_YEAR
|
|
102 FORMAT( 'Base Year :', i4 )
|
|
|
|
!----------------
|
|
! Sum emissions
|
|
!----------------
|
|
|
|
! Get the proper # of days in the month for totaling
|
|
IF ( EMEP_MONTH == 2 .and. ITS_A_LEAPYEAR( EMISS_YEAR ) ) THEN
|
|
DAYS_IN_MONTH = DMON(EMEP_MONTH) + 1
|
|
ELSE
|
|
DAYS_IN_MONTH = DMON(EMEP_MONTH)
|
|
ENDIF
|
|
|
|
! Define conversion factors for kg/molec
|
|
! (Undefined tracers will be zero)
|
|
B(:) = 0d0
|
|
IF ( IDTNOx > 0 ) B(1) = 14d-3 / 6.0225d23 ! Tg N
|
|
IF ( IDTCO > 0 ) B(2) = 1d0 / XNUMOL(IDTCO )
|
|
IF ( IDTALK4 > 0 ) B(3) = 1d0 / XNUMOL(IDTALK4)
|
|
IF ( IDTMEK > 0 ) B(4) = 1d0 / XNUMOL(IDTMEK )
|
|
IF ( IDTALD2 > 0 ) B(5) = 1d0 / XNUMOL(IDTALD2)
|
|
IF ( IDTPRPE > 0 ) B(6) = 1d0 / XNUMOL(IDTPRPE)
|
|
IF ( IDTC2H6 > 0 ) B(7) = 1d0 / XNUMOL(IDTC2H6)
|
|
IF ( IDTSO2 > 0 ) B(8) = 32d-3 / 6.0225d23 ! Tg S
|
|
IF ( IDTNH3 > 0 ) B(9) = 1d0 / XNUMOL(IDTNH3)
|
|
|
|
! Summing variables
|
|
NOX = 0d0
|
|
CO = 0d0
|
|
ALK4 = 0d0
|
|
MEK = 0d0
|
|
ALD2 = 0d0
|
|
PRPE = 0d0
|
|
C2H6 = 0d0
|
|
SO2 = 0d0
|
|
NH3 = 0d0
|
|
|
|
! Loop over latitudes
|
|
DO J = 1, JJPAR
|
|
|
|
! Surface area [cm2] * seconds in this year
|
|
! Multiply by 1d-9 to convert from [kg] to [Tg]
|
|
A = GET_AREA_CM2( J ) * DAYS_IN_MONTH * 86400d0 * 1d-9
|
|
|
|
! Loop over longitudes
|
|
DO I = 1, IIPAR
|
|
|
|
! Sum emissions (list NOx as Tg N)
|
|
NOX = NOX + ( EMEP_NOX (I,J) + EMEP_NOX_SHIP(I,J) )
|
|
$ * A * B(1)
|
|
CO = CO + ( EMEP_CO (I,J) + EMEP_CO_SHIP(I,J) )
|
|
$ * A * B(2)
|
|
SO2 = SO2 + ( EMEP_SO2 (I,J) + EMEP_SO2_SHIP(I,J) )
|
|
$ * A * B(8)
|
|
|
|
ALK4 = ALK4 + EMEP_ALK4(I,J) * A * B(3)
|
|
MEK = MEK + EMEP_MEK (I,J) * A * B(4)
|
|
ALD2 = ALD2 + EMEP_ALD2(I,J) * A * B(5)
|
|
PRPE = PRPE + EMEP_PRPE(I,J) * A * B(6)
|
|
C2H6 = C2H6 + EMEP_C2H6(I,J) * A * B(7)
|
|
NH3 = NH3 + EMEP_NH3 (I,J) * A * B(9)
|
|
ENDDO
|
|
ENDDO
|
|
|
|
!----------------
|
|
! Print sums
|
|
!----------------
|
|
|
|
! Print totals in [kg/month]
|
|
WRITE( 6, 110 ) 'NOx ', EMISS_YEAR, EMEP_MONTH, NOx, ' N'
|
|
WRITE( 6, 110 ) 'CO ', EMISS_YEAR, EMEP_MONTH, CO, ' '
|
|
WRITE( 6, 110 ) 'SO2 ', EMISS_YEAR, EMEP_MONTH, SO2, ' S'
|
|
WRITE( 6, 110 ) 'NH3 ', EMISS_YEAR, EMEP_MONTH, NH3, ' '
|
|
WRITE( 6, 110 ) 'ALK4', EMISS_YEAR, EMEP_MONTH, ALK4, ' C'
|
|
WRITE( 6, 110 ) 'MEK ', EMISS_YEAR, EMEP_MONTH, MEK, ' C'
|
|
WRITE( 6, 110 ) 'ALD2', EMISS_YEAR, EMEP_MONTH, ALD2, ' C'
|
|
WRITE( 6, 110 ) 'PRPE', EMISS_YEAR, EMEP_MONTH, PRPE, ' C'
|
|
WRITE( 6, 110 ) 'C2H6', EMISS_YEAR, EMEP_MONTH, C2H6, ' C'
|
|
110 FORMAT( 'EMEP anthropogenic ', a4, ' for ', i4, '/', i2.2,
|
|
& ': ', f13.6, ' Tg', a2 )
|
|
|
|
! Fancy output
|
|
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
|
|
|
END SUBROUTINE TOTAL_ANTHRO_TG
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: read_europe_mask
|
|
!
|
|
! !DESCRIPTION: Subroutine READ\_EUROPE\_MASK reads and regrids the
|
|
! Europe mask for the EMEP anthropogenic emissions.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE READ_EUROPE_MASK
|
|
!
|
|
! !USES:
|
|
!
|
|
USE BPCH2_MOD, ONLY : READ_BPCH2
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR_1x1
|
|
USE REGRID_1x1_MOD, ONLY : DO_REGRID_1x1
|
|
|
|
!USE CMN_SIZE_MOD ! Size parameters
|
|
# include "CMN_SIZE"
|
|
|
|
! !REVISION HISTORY:
|
|
! 18 Oct 2006 - R. Yantosca - Initial version
|
|
! (1 ) Now read the Europe mask from a disk file instead of defining it as
|
|
! a rectangular box (bmy, 10/18/06)
|
|
! (2 ) Updated the mask file to correspond with the 200911 EMEP emissions
|
|
! (gvinken, 11/24/10)
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
REAL*4 :: ARRAY(I1x1,J1x1,1)
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
|
|
!=================================================================
|
|
! READ_EUROPE_MASK begins here!
|
|
!=================================================================
|
|
|
|
! File name
|
|
!-----------------------------------------------------------------------
|
|
! Prior to 11/24/10:
|
|
! Read in new mask file for EMEP emissions (gvinken, 11/24/10)
|
|
! FILENAME = TRIM( DATA_DIR_1x1 ) //
|
|
! & 'EMEP_200510/EMEP_mask.geos.1x1'
|
|
!-----------------------------------------------------------------------
|
|
FILENAME = TRIM( DATA_DIR_1x1 ) //
|
|
& 'EMEP_200911/EMEP_mask.geos.1x1'
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
100 FORMAT( ' - READ_EUROPE_MASK: Reading ', a )
|
|
|
|
! Read data [unitless]
|
|
CALL READ_BPCH2( FILENAME, 'LANDMAP', 2,
|
|
& 0d0, I1x1, J1x1,
|
|
& 1, ARRAY, QUIET=.TRUE. )
|
|
|
|
! Regrid from GEOS 1x1 GRID to current model resolution
|
|
CALL DO_REGRID_1x1( 'unitless', ARRAY, EUROPE_MASK )
|
|
|
|
END SUBROUTINE READ_EUROPE_MASK
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: read_europe_mask_05x0666
|
|
!
|
|
! !DESCRIPTION: Subroutine READ\_EUROPE\_MASK reads and regrids the
|
|
! Europe mask for the EMEP anthropogenic emissions.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE READ_EUROPE_MASK_05x0666
|
|
!
|
|
! !USES:
|
|
!
|
|
USE BPCH2_MOD, ONLY : READ_BPCH2
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR
|
|
USE REGRID_1x1_MOD, ONLY : DO_REGRID_05x0666
|
|
|
|
!USE CMN_SIZE_MOD ! Size parameters
|
|
# include "CMN_SIZE"
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 18 Oct 2006 - R. Yantosca - Initial version
|
|
! (1 ) Now read the Europe mask from a disk file instead of defining it as
|
|
! a rectangular box (bmy, 10/18/06)
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
REAL*4 :: ARRAY(IIPAR,JJPAR,1)
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
|
|
!=================================================================
|
|
! READ_EUROPE_MASK begins here!
|
|
!=================================================================
|
|
|
|
! File name
|
|
FILENAME = TRIM( DATA_DIR ) //
|
|
& 'EMEP_200510/EMEP_mask.geos.05x0666'
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
100 FORMAT( ' - READ_EUROPE_MASK: Reading ', a )
|
|
|
|
! Read data [unitless]
|
|
CALL READ_BPCH2( FILENAME, 'LANDMAP', 2,
|
|
& 0d0, IIPAR, JJPAR,
|
|
& 1, ARRAY, QUIET=.TRUE. )
|
|
|
|
EUROPE_MASK(:,:) = ARRAY(:,:,1)
|
|
|
|
END SUBROUTINE READ_EUROPE_MASK_05x0666
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: read_emep_updated
|
|
!
|
|
! !DESCRIPTION: Subroutine READ\_EMEP\_UPDATED reads updated EMEP emissions
|
|
! from the year 1990 including SOx emissions. These are regridded to the
|
|
! simulation resolution. Ship emissions can also be included.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE READ_EMEP_UPDATED( TRACER, EMEP_YEAR, ARRAY, wSHIP )
|
|
!
|
|
! !USES:
|
|
!
|
|
USE BPCH2_MOD, ONLY : READ_BPCH2, GET_TAU0
|
|
USE TIME_MOD, ONLY : EXPAND_DATE, GET_MONTH
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR_1x1
|
|
USE REGRID_1x1_MOD, ONLY : DO_REGRID_1x1
|
|
USE LOGICAL_MOD, ONLY : LEMEPSHIP
|
|
USE GRID_MOD, ONLY : GET_AREA_CM2
|
|
USE TRACERID_MOD, ONLY : IDTNOx, IDTCO, IDTSO2, IDTNH3
|
|
|
|
!USE CMN_SIZE_MOD ! Size parameters
|
|
!USE CMN_O3_MOD ! SCALEYEAR
|
|
# include "CMN_SIZE"
|
|
# include "CMN_O3"
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
INTEGER, INTENT(IN) :: TRACER ! Tracer number
|
|
INTEGER, INTENT(IN) :: EMEP_YEAR ! Year of emissions to read
|
|
INTEGER, INTENT(IN) :: wSHIP ! Use ground, ship, or both?
|
|
!
|
|
! !OUTPUT PARAMETERS:
|
|
!
|
|
REAL*8, INTENT(OUT) :: ARRAY(IIPAR,JJPAR) ! Output array
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 28 Jan 2009 - A. v. Donkelaar, P. Le Sager - Initial version
|
|
! 28 Jan 2009 - P. Le Sager - Now account for LEMEPSHIP
|
|
! 29 Oct 2009 - Added multi-species seasonality (amv)
|
|
! 04 Jan 2010 - Extended to 2007, changed input format (amv)
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
REAL*4 :: ARRAY_1x1(I1x1,J1x1,1)
|
|
REAL*4 :: ARRAY_1x1_SHIP(I1x1,J1x1,1)
|
|
REAL*4 :: ARRAY_1x1_LAND(I1x1,J1x1,1)
|
|
CHARACTER(LEN=255) :: FILENAME, DIR
|
|
REAL*8 :: EMEP_TAU, TAU, A, B
|
|
INTEGER :: EMEP_NYMD, MN, RATIOID, I, J
|
|
|
|
|
|
ARRAY_1x1_SHIP(:,:,:) = 0.d0
|
|
ARRAY_1x1_LAND(:,:,:) = 0.d0
|
|
|
|
! YYYYMMDD value for 1st day of EMEP_YEAR
|
|
EMEP_NYMD = ( EMEP_YEAR * 10000 ) + 0101
|
|
|
|
! TAU0 value corresponding to EMEP_NYMD
|
|
EMEP_TAU = GET_TAU0( 1, 1, EMEP_YEAR )
|
|
|
|
! Expand filename
|
|
DIR = TRIM( DATA_DIR_1x1 ) // 'EMEP_200911/'
|
|
|
|
! wSHIP = 0 means no ship emissions included
|
|
! wSHIP = 1 means include ships emissions
|
|
! wSHIP = 2 means only ship emissions
|
|
|
|
IF ( wSHIP .lt. 2 ) THEN
|
|
|
|
FILENAME = TRIM(DIR) //
|
|
& 'EMEP-YYYY.geos.1x1'
|
|
|
|
CALL EXPAND_DATE( FILENAME, EMEP_NYMD, 000000 )
|
|
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
100 FORMAT( ' - READ_EMEP_UPDATED: Reading ', a )
|
|
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', TRACER,
|
|
& EMEP_TAU, I1x1, J1x1,
|
|
& 1, ARRAY_1x1_LAND, QUIET=.TRUE. )
|
|
|
|
ENDIF
|
|
|
|
IF ( ( wSHIP .gt. 0 ) .AND. LEMEPSHIP ) THEN
|
|
|
|
FILENAME = TRIM(DIR) //
|
|
& 'EMEP-SHIP-YYYY.geos.1x1'
|
|
|
|
CALL EXPAND_DATE( FILENAME, EMEP_NYMD, 000000 )
|
|
|
|
WRITE( 6, 101 ) TRIM( FILENAME )
|
|
101 FORMAT( ' - READ_EMEP_UPDATED: Reading ', a )
|
|
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', TRACER,
|
|
& EMEP_TAU, I1x1, J1x1,
|
|
& 1, ARRAY_1x1_SHIP, QUIET=.TRUE. )
|
|
|
|
ENDIF
|
|
|
|
! Apply monthly variation (courtesy of the GENEMIS project
|
|
! coordinated by the Institute of Energy Economics and the
|
|
! Rational Use of Energy (IER) at the University of
|
|
! Stuttgart) (amv, 11/24/2008)
|
|
|
|
IF ( wSHIP .lt. 2 ) THEN
|
|
|
|
! Apply Monthly Factors over land
|
|
TAU = GET_TAU0( GET_MONTH(), 1, 2005)
|
|
|
|
! Use hardwired numbers so this works with tagged-CO
|
|
! simulation (zhej, dkh, 02/09/12, adj32_019)
|
|
IF ( TRACER .eq. 1 ) THEN
|
|
FILENAME = TRIM( DIR ) // 'SeasonalVariation/'
|
|
& // 'NOx-EMEP-SeasonalScalar.geos.1x1'
|
|
RATIOID = 71
|
|
ELSEIF ( TRACER .eq. 4 ) THEN
|
|
FILENAME = TRIM( DIR ) // 'SeasonalVariation/'
|
|
& // 'CO-EMEP-SeasonalScalar.geos.1x1'
|
|
RATIOID = 72
|
|
ELSEIF ( TRACER .eq. 26 ) THEN
|
|
FILENAME = TRIM( DIR ) // 'SeasonalVariation/'
|
|
& // 'SOx-EMEP-SeasonalScalar.geos.1x1'
|
|
RATIOID = 73
|
|
ELSEIF ( TRACER .eq. 30 ) THEN
|
|
FILENAME = TRIM( DIR ) // 'SeasonalVariation/'
|
|
& // 'NH3-EMEP-SeasonalScalar.geos.1x1'
|
|
RATIOID = 74
|
|
ENDIF
|
|
|
|
! Echo info
|
|
WRITE( 6, 101 ) TRIM( FILENAME )
|
|
|
|
! Read data
|
|
CALL READ_BPCH2( FILENAME, 'RATIO-2D', RATIOID,
|
|
& TAU, I1x1, J1x1,
|
|
& 1, ARRAY_1x1, QUIET=.TRUE. )
|
|
|
|
ARRAY_1x1_LAND(:,:,1) = ARRAY_1x1_LAND(:,:,1)
|
|
& * ARRAY_1x1(:,:,1)
|
|
|
|
ENDIF
|
|
|
|
IF ( wSHIP .eq. 0 ) ARRAY_1x1(:,:,1) = ARRAY_1x1_LAND(:,:,1)
|
|
IF ( wSHIP .eq. 1 ) ARRAY_1x1(:,:,1) = ARRAY_1x1_LAND(:,:,1) +
|
|
& ARRAY_1x1_SHIP(:,:,1)
|
|
IF ( wSHIP .eq. 2 ) ARRAY_1x1(:,:,1) = ARRAY_1x1_SHIP(:,:,1)
|
|
|
|
CALL DO_REGRID_1x1('kg/yr', ARRAY_1x1, ARRAY)
|
|
|
|
! Convert SOx to SO2 assuming a SOx is 95% SO2 over Europe, as used
|
|
! throughout GEOS-Chem, and as per Chin et al, 2000
|
|
IF ( TRACER .eq. 26 ) ARRAY(:,:) = ARRAY(:,:) * 0.95d0
|
|
|
|
! convert to molec/cm2 for consistency with previous
|
|
! emissions
|
|
B = 0d0
|
|
! Use hardwired numbers so this works with tagged-CO
|
|
! simulation (zhej, dkh, 02/09/12, adj32_019)
|
|
IF ( TRACER .eq. 1 ) B = 1.d3 / 46d0 * 6.0225d23
|
|
IF ( TRACER .eq. 4 ) B = 1.d3 / 28d0 * 6.0225d23
|
|
IF ( TRACER .eq. 26 ) B = 1.d3 / 64d0 * 6.0225d23
|
|
IF ( TRACER .eq. 30 ) B = 1.d3 / 17d0 * 6.0225d23
|
|
|
|
! Loop over latitudes
|
|
DO J = 1, JJPAR
|
|
|
|
! Surface area [cm2] * sec per year
|
|
A = GET_AREA_CM2( J ) * 365d0 * 86400d0
|
|
|
|
! Loop over longitudes
|
|
DO I = 1, IIPAR
|
|
|
|
ARRAY(I,J) = ARRAY(I,J) / A * B
|
|
|
|
ENDDO
|
|
ENDDO
|
|
|
|
|
|
END SUBROUTINE READ_EMEP_UPDATED
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: read_emep_updated_05x0666
|
|
!
|
|
! !DESCRIPTION: Subroutine READ\_EMEP\_UPDATED reads updated EMEP emissions
|
|
! from the year 1990 including SOx emissions. These are regridded to the
|
|
! simulation resolution. Ship emissions can also be included.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE READ_EMEP_UPDATED_05x0666( TRACER, EMEP_YEAR, ARRAY,
|
|
& wSHIP )
|
|
!
|
|
! !USES:
|
|
!
|
|
USE BPCH2_MOD, ONLY : READ_BPCH2, GET_TAU0
|
|
USE TIME_MOD, ONLY : EXPAND_DATE, GET_MONTH
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR
|
|
USE REGRID_1x1_MOD, ONLY : DO_REGRID_05x0666
|
|
USE LOGICAL_MOD, ONLY : LEMEPSHIP
|
|
USE TRACERID_MOD, ONLY : IDTNOx, IDTCO, IDTSO2, IDTNH3
|
|
USE GRID_MOD, ONLY : GET_AREA_CM2
|
|
|
|
!USE CMN_SIZE_MOD ! Size parameters
|
|
!USE CMN_O3_MOD ! SCALEYEAR
|
|
# include "CMN_SIZE"
|
|
# include "CMN_O3"
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
INTEGER, INTENT(IN) :: TRACER ! Tracer number
|
|
INTEGER, INTENT(IN) :: EMEP_YEAR ! Year of emissions to read
|
|
INTEGER, INTENT(IN) :: wSHIP ! Use ground, ship, or both?
|
|
!
|
|
! !OUTPUT PARAMETERS:
|
|
!
|
|
REAL*8, INTENT(OUT) :: ARRAY(IIPAR,JJPAR) ! Output array
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 28 Jan 2009 - A. v. Donkelaar, P. Le Sager - Initial version
|
|
! 28 Jan 2009 - P. Le Sager - Now account for LEMEPSHIP
|
|
! 29 Oct 2009 - Added multi-species seasonality (amv)
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
REAL*8 :: ARRAY_05x0666(IIPAR,JJPAR,1)
|
|
REAL*4 :: ARRAY_05x0666_R4(IIPAR,JJPAR,1)
|
|
REAL*4 :: ARRAY_05x0666_SHIP(IIPAR,JJPAR,1)
|
|
REAL*4 :: ARRAY_05x0666_LAND(IIPAR,JJPAR,1)
|
|
CHARACTER(LEN=255) :: FILENAME, DIR
|
|
REAL*8 :: EMEP_TAU, TAU, A, B
|
|
INTEGER :: EMEP_NYMD, MN, RATIOID, I, J
|
|
CHARACTER(LEN=2) :: SMN
|
|
CHARACTER(LEN=1) :: SSMN
|
|
|
|
ARRAY_05x0666_SHIP(:,:,:) = 0.d0
|
|
ARRAY_05x0666_LAND(:,:,:) = 0.d0
|
|
|
|
! YYYYMMDD value for 1st day of EMEP_YEAR
|
|
EMEP_NYMD = ( EMEP_YEAR * 10000 ) + 0101
|
|
|
|
! TAU0 value corresponding to EMEP_NYMD
|
|
EMEP_TAU = GET_TAU0( 1, 1, EMEP_YEAR )
|
|
|
|
! Expand filename
|
|
DIR = TRIM( DATA_DIR ) // 'EMEP_200911/'
|
|
|
|
! wSHIP = 0 means no ship emissions included
|
|
! wSHIP = 1 means include ships emissions
|
|
! wSHIP = 2 means only ship emissions
|
|
|
|
IF ( wSHIP .lt. 2 ) THEN
|
|
|
|
FILENAME = TRIM(DIR) //
|
|
& 'EMEP-YYYY.1p2x2p3.eu.bpch'
|
|
|
|
CALL EXPAND_DATE( FILENAME, EMEP_NYMD, 000000 )
|
|
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
100 FORMAT( ' - READ_EMEP_UPDATED_05x0666
|
|
& : Reading ', a )
|
|
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', TRACER,
|
|
& EMEP_TAU, IIPAR, JJPAR,
|
|
& 1, ARRAY_05x0666_LAND, QUIET=.TRUE. )
|
|
|
|
ENDIF
|
|
|
|
IF ( ( wSHIP .gt. 0 ) .AND. LEMEPSHIP ) THEN
|
|
|
|
FILENAME = TRIM(DIR) //
|
|
& 'EMEP-SHIP-YYYY.1p2x2p3.eu.bpch'
|
|
|
|
CALL EXPAND_DATE( FILENAME, EMEP_NYMD, 000000 )
|
|
|
|
WRITE( 6, 101 ) TRIM( FILENAME )
|
|
101 FORMAT( ' - READ_EMEP_UPDATED_05x0666
|
|
& : Reading ', a )
|
|
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', TRACER,
|
|
& EMEP_TAU, IIPAR, JJPAR,
|
|
& 1, ARRAY_05x0666_SHIP, QUIET=.TRUE. )
|
|
|
|
ENDIF
|
|
|
|
! Apply monthly variation (courtesy of the GENEMIS project
|
|
! coordinated by the Institute of Energy Economics and the
|
|
! Rational Use of Energy (IER) at the University of
|
|
! Stuttgart) (amv, 11/24/2008)
|
|
|
|
! Expand filename
|
|
DIR = TRIM( DATA_DIR ) // 'EMEP_200806/'
|
|
|
|
IF ( wSHIP .lt. 2 ) THEN
|
|
|
|
! Apply Monthly Factors over land
|
|
TAU = GET_TAU0( GET_MONTH(), 1, 2005)
|
|
|
|
IF ( TRACER .eq. 1 ) THEN
|
|
FILENAME = TRIM( DIR ) // 'SeasonalVariation/'
|
|
& // 'NOx-EMEP-SeasonalScalar.geos.05x0666'
|
|
RATIOID = 71
|
|
ELSEIF ( TRACER .eq. 4 ) THEN
|
|
FILENAME = TRIM( DIR ) // 'SeasonalVariation/'
|
|
& // 'CO-EMEP-SeasonalScalar.geos.05x0666'
|
|
RATIOID = 72
|
|
ELSEIF ( TRACER .eq. 26 ) THEN
|
|
FILENAME = TRIM( DIR ) // 'SeasonalVariation/'
|
|
& // 'SOx-EMEP-SeasonalScalar.geos.05x0666'
|
|
RATIOID = 73
|
|
ELSEIF ( TRACER .eq. 30 ) THEN
|
|
FILENAME = TRIM( DIR ) // 'SeasonalVariation/'
|
|
& // 'NH3-EMEP-SeasonalScalar.geos.05x0666'
|
|
RATIOID = 74
|
|
ENDIF
|
|
|
|
! Echo info
|
|
WRITE( 6, 101 ) TRIM( FILENAME )
|
|
|
|
! Read data
|
|
CALL READ_BPCH2( FILENAME, 'RATIO-2D', RATIOID,
|
|
& TAU, IIPAR, JJPAR,
|
|
& 1, ARRAY_05x0666_R4, QUIET=.TRUE. )
|
|
|
|
ARRAY_05x0666_LAND(:,:,1) = ARRAY_05x0666_LAND(:,:,1)
|
|
& * ARRAY_05x0666_R4(:,:,1)
|
|
|
|
ENDIF
|
|
|
|
IF ( wSHIP .eq. 0 ) ARRAY_05x0666(:,:,1) =
|
|
& ARRAY_05x0666_LAND(:,:,1)
|
|
IF ( wSHIP .eq. 1 ) ARRAY_05x0666(:,:,1) =
|
|
& ARRAY_05x0666_LAND(:,:,1) + ARRAY_05x0666_SHIP(:,:,1)
|
|
IF ( wSHIP .eq. 2 ) ARRAY_05x0666(:,:,1) =
|
|
& ARRAY_05x0666_SHIP(:,:,1)
|
|
|
|
ARRAY(:,:) = ARRAY_05x0666(:,:,1)
|
|
|
|
! Convert SOx to SO2 assuming a SOx is 95% SO2 over Europe, as used
|
|
! throughout GEOS-Chem, and as per Chin et al, 2000
|
|
IF ( TRACER .eq. 26 ) ARRAY(:,:) = ARRAY(:,:) * 0.95d0
|
|
|
|
! convert to molec/cm2 for consistency with previous
|
|
! emissions
|
|
B = 0d0
|
|
! Use hardwired numbers so this works with tagged-CO
|
|
! simulation (zhej, dkh, 02/09/12, adj32_019)
|
|
IF ( TRACER .eq. 1 ) B = 1.d3 / 46d0 * 6.0225d23
|
|
IF ( TRACER .eq. 4 ) B = 1.d3 / 28d0 * 6.0225d23
|
|
IF ( TRACER .eq. 26 ) B = 1.d3 / 64d0 * 6.0225d23
|
|
IF ( TRACER .eq. 30 ) B = 1.d3 / 17d0 * 6.0225d23
|
|
|
|
! Loop over latitudes
|
|
DO J = 1, JJPAR
|
|
|
|
! Surface area [cm2] * sec per year
|
|
A = GET_AREA_CM2( J ) * 365d0 * 86400d0
|
|
|
|
! Loop over longitudes
|
|
DO I = 1, IIPAR
|
|
|
|
ARRAY(I,J) = ARRAY(I,J) / A * B
|
|
|
|
ENDDO
|
|
ENDDO
|
|
|
|
END SUBROUTINE READ_EMEP_UPDATED_05x0666
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: init_emep
|
|
!
|
|
! !DESCRIPTION: Subroutine INIT\_EMEP allocates and zeroes EMEP module
|
|
! arrays, and also creates the mask which defines the European region.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE INIT_EMEP
|
|
!
|
|
! !USES:
|
|
!
|
|
! References to F90 modules
|
|
USE ERROR_MOD, ONLY : ALLOC_ERR
|
|
USE GRID_MOD, ONLY : GET_XMID, GET_YMID
|
|
USE LOGICAL_MOD, ONLY : LEMEP
|
|
|
|
!USE CMN_SIZE_MOD ! Size parameters
|
|
# include "CMN_SIZE"
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 01 Nov 2005 - B. Field, R. Yantosca - Initial version
|
|
! (1 ) Now call READ_EUROPE_MASK to read & regrid EUROPE_MASK from disk
|
|
! instead of just defining it as a rectangular box. (bmy, 10/18/06)
|
|
! 26 Jan 2010 - R. Yantosca - Fixed cut-n-paste error. Now make sure to zero
|
|
! EMEP_CO_SHIP and EMEP_NOx_SHIP.
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
INTEGER :: AS, I, J, X, Y
|
|
|
|
!=================================================================
|
|
! INIT_EMEP begins here!
|
|
!=================================================================
|
|
|
|
! Return if LEMEP is false
|
|
IF ( .not. LEMEP ) RETURN
|
|
|
|
!--------------------------------
|
|
! Allocate and zero arrays
|
|
!--------------------------------
|
|
ALLOCATE( EMEP_NOx( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMEP_NOx' )
|
|
EMEP_NOx = 0d0
|
|
|
|
ALLOCATE( EMEP_CO( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMEP_CO' )
|
|
EMEP_CO = 0d0
|
|
|
|
ALLOCATE( EMEP_SO2( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMEP_SO2' )
|
|
EMEP_SO2 = 0d0
|
|
|
|
ALLOCATE( EMEP_SO2_SHIP( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMEP_SO2_SHIP' )
|
|
EMEP_SO2_SHIP = 0d0
|
|
|
|
ALLOCATE( EMEP_CO_SHIP( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMEP_CO_SHIP' )
|
|
EMEP_CO_SHIP = 0d0
|
|
|
|
ALLOCATE( EMEP_NOx_SHIP( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMEP_NOx_SHIP' )
|
|
EMEP_NOx_SHIP = 0d0
|
|
|
|
ALLOCATE( EMEP_NH3( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMEP_NH3' )
|
|
EMEP_NH3 = 0d0
|
|
|
|
ALLOCATE( EMEP_ALK4( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMEP_ALK4' )
|
|
EMEP_ALK4 = 0d0
|
|
|
|
ALLOCATE( EMEP_MEK( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMEP_MEK' )
|
|
EMEP_MEK = 0d0
|
|
|
|
ALLOCATE( EMEP_ALD2( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMEP_ALD2' )
|
|
EMEP_ALD2 = 0d0
|
|
|
|
ALLOCATE( EMEP_PRPE( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMEP_PRPE' )
|
|
EMEP_PRPE = 0d0
|
|
|
|
ALLOCATE( EMEP_C2H6( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EMEP_C2H6' )
|
|
EMEP_C2H6 = 0d0
|
|
|
|
ALLOCATE( EUROPE_MASK( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'EUROPE_MASK' )
|
|
EUROPE_MASK = 0d0
|
|
|
|
! Read and regrid the European mask
|
|
#if defined(GRID05x0666)
|
|
CALL READ_EUROPE_MASK_05x0666
|
|
#else
|
|
CALL READ_EUROPE_MASK
|
|
#endif
|
|
|
|
END SUBROUTINE INIT_EMEP
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: cleanup_emep
|
|
!
|
|
! !DESCRIPTION: Subroutine CLEANUP\_EMEP deallocates all module arrays.
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE CLEANUP_EMEP
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 1 Nov 2005 - R. Yantosca - Initial Version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!=================================================================
|
|
! CLEANUP_EMEP begins here!
|
|
!=================================================================
|
|
IF ( ALLOCATED( EMEP_NOx ) ) DEALLOCATE( EMEP_NOx )
|
|
IF ( ALLOCATED( EMEP_CO ) ) DEALLOCATE( EMEP_CO )
|
|
IF ( ALLOCATED( EMEP_SO2 ) ) DEALLOCATE( EMEP_SO2 )
|
|
IF ( ALLOCATED( EMEP_SO2_SHIP ) ) DEALLOCATE( EMEP_SO2_SHIP )
|
|
IF ( ALLOCATED( EMEP_CO_SHIP ) ) DEALLOCATE( EMEP_CO_SHIP )
|
|
IF ( ALLOCATED( EMEP_NOx_SHIP ) ) DEALLOCATE( EMEP_NOx_SHIP )
|
|
IF ( ALLOCATED( EMEP_NH3 ) ) DEALLOCATE( EMEP_NH3 )
|
|
IF ( ALLOCATED( EMEP_ALK4 ) ) DEALLOCATE( EMEP_ALK4 )
|
|
IF ( ALLOCATED( EMEP_MEK ) ) DEALLOCATE( EMEP_MEK )
|
|
IF ( ALLOCATED( EMEP_ALD2 ) ) DEALLOCATE( EMEP_ALD2 )
|
|
IF ( ALLOCATED( EMEP_PRPE ) ) DEALLOCATE( EMEP_PRPE )
|
|
IF ( ALLOCATED( EMEP_C2H6 ) ) DEALLOCATE( EMEP_C2H6 )
|
|
IF ( ALLOCATED( EUROPE_MASK ) ) DEALLOCATE( EUROPE_MASK )
|
|
|
|
END SUBROUTINE CLEANUP_EMEP
|
|
!EOC
|
|
END MODULE EMEP_MOD
|